-
-
Save sellout/4709e723cb649110af00217486c4466b to your computer and use it in GitHub Desktop.
-- | A “flushing” 'stream', with an additional coalgebra for flushing the | |
-- remaining values after the input has been consumed. This also allows us to | |
-- generalize the output away from lists. | |
fstream | |
:: (Cursive t (XNor a), Cursive u f, Corecursive u f, Traversable f) | |
=> Coalgebra f b -> (b -> a -> b) -> Coalgebra f b -> b -> t -> u | |
fstream ψ g ψ' = go | |
where | |
go c x = | |
let fb = ψ c | |
in if 0 < length fb | |
then embed $ fmap (flip go x) fb | |
else case project x of | |
Both a x' -> go (g c a) x' | |
None -> ana ψ' c | |
-- | Like 'fstream', but rather than using the 'length' of the 'f' from the | |
-- 'Coalgebra', we use a 'CoalgebraM' (but this makes it impossible to write | |
-- 'afstream''). It also reduces the 'Traversable' constraint to 'Functor'. | |
-- The 'CoalgebraM' also allows us to distinguish between cases where we just | |
-- want to stop processing input ('Just None') and the case when we need to | |
-- acquire more input ('Nothing'), which becomes more interesting when 'u' | |
-- isn’t a list and may have multiple leaf nodes. | |
fstream' | |
:: (Cursive t (XNor a), Cursive u f, Corecursive u f, Functor f) | |
=> CoalgebraM Maybe f b -> (b -> a -> b) -> Coalgebra f b -> b -> t -> u | |
fstream' ψ g ψ' = go | |
where | |
go c x = | |
maybe (case project x of | |
Both a x' -> go (g c a) x' | |
None -> ana ψ' c) | |
(embed . fmap (flip go x)) | |
$ ψ c | |
-- | An “auto-flushing” stream – uses the same coalgebra for streaming | |
-- generation and flushing. It gives us the original signature of 'stream', | |
-- but still generalized away from lists. | |
afstream | |
:: (Cursive t (XNor a), Cursive u f, Corecursive u f, Traversable f) | |
=> Coalgebra f b -> (b -> a -> b) -> b -> t -> u | |
afstream ψ g = fstream ψ g ψ | |
-- | A stream for truly infinite inputs. | |
sstream | |
:: (Cursive t ((,) a), Cursive u f, Traversable f) | |
=> Coalgebra f b -> (b -> a -> b) -> b -> t -> u | |
sstream ψ g = go | |
where | |
go c x = | |
let fb = ψ c | |
in if 0 < length fb | |
then embed $ fmap (flip go x) fb | |
else case project x of | |
(a, x') -> go (g c a) x' | |
-- | This is to 'sstream' as 'fstream'' is to 'fstream'. | |
sstream' | |
:: (Cursive t ((,) a), Cursive u f, Functor f) | |
=> CoalgebraM Maybe f b -> (b -> a -> b) -> b -> t -> u | |
sstream' ψ g = go | |
where | |
go c x = | |
maybe (case project x of (a, x') -> go (g c a) x') | |
(embed . fmap (flip go x)) | |
$ ψ c | |
-- | Streaming representation-changers – a.k.a., metamorphism. | |
stream :: Coalgebra (XNor c) b -> (b -> a -> b) -> b -> [a] -> [c] | |
stream ψ g = fstream ψ g (const None) | |
snoc :: [a] -> a -> [a] | |
snoc x a = x ++ [a] | |
x :: [Int] | |
x = stream project snoc [] [1, 2, 3, 4, 5] |
Some more (questionable) generalization
-- | Generalizes the input to any 0/1-tailed functor ('XNor', '(,)', 'Maybe',
-- 'Const', …).
fstream''
:: (Cursive t e, Cursive u f, Corecursive u f, Functor f)
=> CoalgebraM Maybe f b
-> (e t -> Maybe (b -> b, t))
-> Coalgebra f b
-> b
-> t
-> u
fstream'' ψ g ψ' = go
where
go c x =
maybe (maybe (ana ψ' c) (uncurry go . ((&) c *** id)) . g $ project x)
(embed . fmap (flip go x))
$ ψ c
-- | Using 'fstream''' for '(,)', we don’t need the end-of-input case (and
-- flushing 'Coalgebra'). Would be nice to eliminate them without 'error'.
sstream''
:: (Cursive t ((,) a), Cursive u f, Corecursive u f, Functor f)
=> CoalgebraM Maybe f b -> (b -> a -> b) -> b -> t -> u
sstream'' ψ g = fstream'' ψ (\(a, t) -> Just (flip g a, t)) (error "This doesn’t seem good.")
I think fstream''
generalizes about as much as possible without somehow handling branching. The new g
isn’t quite an Algebra[†]. Should work for either simple functors as mentioned in the comment, or if there’s like a Semigroup t
so the “algebra” can combine the branches.
[†]: I guess if there’s a Monoid b
, it’s an AlgebraM (WriterT (b -> b) Maybe) e t
.
fstream' :: CoalgebraM f b -> (b -> a -> b) -> Coalgebra f b -> b -> [a] -> Fix f
The second Coalgebra makes the unfold half look like a elgotGApo
… instead of returning Nothing
when it can’t produce any more from the seed, it can return the remaining seed – but we only actually apply the “helper” coalgebra if we can no longer add to the seed either.
I wonder if we can take advantage of a distributive law, so that in the case of list we could use distGApo flush
and in the case of a stream, we could use distAna
.
Ok, with the GApo
insight, I’ve rewritten it in a way that I think obsoletes all the previous stuff:
stream'
:: (Cursive t e, Cursive u f, Functor f)
=> CoalgebraM Maybe f b
-> (b -> ((b -> b, t) -> u) -> e t -> u)
-> b
-> t
-> u
stream' ψ f = go
where
go c x =
maybe (f c (uncurry go . ((&) c *** id)) $ project x)
(embed . fmap (flip go x))
$ ψ c
-- | Handles cases like infinite streams that can’t terminate, and therefore never need to flush.
streamAna
:: (Cursive t e, Cursive u f, Functor f)
=> CoalgebraM Maybe f b
-> AlgebraM ((,) (b -> b)) e t
-> b
-> t
-> u
streamAna ψ φ = stream' ψ $ \c f -> f . φ
-- | Handles streams that need to flush.
streamGApo
:: (Cursive t e, Cursive u f, Corecursive u f, Functor f)
=> Coalgebra f b
-> CoalgebraM Maybe f b
-> (e t -> Maybe (b -> b, t)) -- maybe an 'AlgebraM'
-> b
-> t
-> u
streamGApo ψ' ψ φ = stream' ψ $ \c f -> maybe (ana ψ' c) f . φ
streamAna
is like the original stream
/sstream
formulations, and streamGApo
is like the fstream
ones. With both defined in terms of stream'
that expects some extra-complicated function that handles the foldl
aspect.
So, what am I trying to do with them? Basically generalize them in the same way as other recursion schemes.
fstream'
andsstream'
manage to generalize somewhat nicely over arbitrary output types, but the inputs are still restricted to lists (and streams).