Skip to content

Add differently-constrained maps and mapped #37

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
treeowl wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Add differently-constrained maps and mapped #37

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
251b51b
Add differently-constrained maps and mapped
treeowl Aug 26, 2017
642aeb7
Add hoists
treeowl Sep 12, 2017
312fa1c
Improve hoistUnexposed
treeowl Sep 13, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions src/Streaming.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,8 +19,12 @@ module Streaming

-- * Transforming streams
maps,
maps2,
mapsM,
mapsM2,
mapped,
mapped2,
hoistUnexposed,
distribute,
groups,

Expand Down
97 changes: 91 additions & 6 deletions src/Streaming/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,9 @@ module Streaming.Internal (
-- * Transforming streams
, maps
, mapsM
, maps2
, mapsM2
, hoistUnexposed
, decompose
, mapsM_
, run
Expand Down Expand Up @@ -70,6 +73,7 @@ module Streaming.Internal (
-- * For use in implementation
, unexposed
, hoistExposed
, hoistExposed2
, mapsExposed
, mapsMExposed
, destroyExposed
Expand Down Expand Up @@ -240,6 +244,7 @@ instance Functor f => MFunctor (Stream f) where
Step f -> Step (fmap loop f)
{-# INLINABLE hoist #-}


instance Functor f => MMonad (Stream f) where
embed phi = loop where
loop stream = case stream of
Expand Down Expand Up @@ -489,8 +494,8 @@ maps phi = loop where
{-# INLINABLE maps #-}


{- | Map layers of one functor to another with a transformation involving the base monad
@maps@ is more fundamental than @mapsM@, which is best understood as a convenience
{- | Map layers of one functor to another with a transformation involving the base monad.
'maps' is more fundamental than @mapsM@, which is best understood as a convenience
for effecting this frequent composition:

> mapsM phi = decompose . maps (Compose . phi)
Expand All @@ -507,6 +512,53 @@ mapsM phi = loop where
Step f -> Effect (liftM Step (phi (fmap loop f)))
{-# INLINABLE mapsM #-}

{- | Map layers of one functor to another with a transformation. Compare
hoist, which has a similar effect on the 'monadic' parameter.

> maps2 id = id
> maps2 f . maps2 g = maps2 (f . g)
> maps2 f = maps2 f


@maps2@ is essentially the same as 'maps', but it imposes a 'Functor' constraint on
its target functor rather than its source functor. It should be preferred if 'fmap'
is cheaper for the target functor than for the source functor.
-}
maps2 :: forall m f g r. (Monad m, Functor g)
=> (forall x. f x -> g x)
-> Stream f m r -> Stream g m r
maps2 phi = loop where
loop :: Stream f m r -> Stream g m r
loop stream = case stream of
Return r -> Return r
Effect m -> Effect (liftM loop m)
Step f -> Step $ fmap loop $ phi f
{-# INLINABLE maps2 #-}

{- | Map layers of one functor to another with a transformation involving the base monad.
@mapsM2@ is essentially the same as 'mapsM', but it imposes a 'Functor' constraint on
its target functor rather than its source functor. It should be preferred if 'fmap'
is cheaper for the target functor than for the source functor.

@maps2@ is more fundamental than @mapsM2@, which is best understood as a convenience
for effecting this frequent composition:

> mapsM2 phi = decompose . maps2 (Compose . phi)

The streaming prelude exports the same function under the better name @mapped2@,
which overlaps with the lens libraries.

-}
mapsM2 :: forall m f g r. (Monad m, Functor g)
=> (forall x. f x -> m (g x))
-> Stream f m r -> Stream g m r
mapsM2 phi = loop where
loop :: Stream f m r -> Stream g m r
loop stream = case stream of
Return r -> Return r
Effect m -> Effect (liftM loop m)
Step f -> Effect $ liftM (Step . fmap loop) (phi f)
{-# INLINABLE mapsM2 #-}

{-| Rearrange a succession of layers of the form @Compose m (f x)@.

Expand Down Expand Up @@ -727,13 +779,46 @@ replicates n f = splitsAt n (repeats f) >> return ()
cycles :: (Monad m, Functor f) => Stream f m () -> Stream f m r
cycles = forever



-- | A less-efficient version of 'hoist' that works properly even when its
-- argument is not a monad morphism.
--
-- > hoistUnexposed = hoist . unexposed
hoistUnexposed :: (Monad m, Functor f)
=> (forall a. m a -> n a)
-> Stream f m r -> Stream f n r
hoistUnexposed trans = loop where
loop = Effect . trans . inspectC (pure . Return) (pure . Step . fmap loop)
{-# INLINABLE hoistUnexposed #-}

-- A version of 'inspect' that takes explicit continuations.
inspectC :: Monad m => (r -> m a) -> (f (Stream f m r) -> m a) -> Stream f m r -> m a
inspectC f g = loop where
loop (Return r) = f r
loop (Step x) = g x
loop (Effect m) = m >>= loop
{-# INLINE inspectC #-}

-- | The same as 'hoist', but explicitly named to indicate that it
-- is not entirely safe. In particular, its argument must be a monad
-- morphism.
hoistExposed :: (Functor m, Functor f) => (forall a. m a -> n a) -> Stream f m a -> Stream f n a
hoistExposed trans = loop where
loop stream = case stream of
Return r -> Return r
Effect m -> Effect (trans (liftM loop m))
Effect m -> Effect (trans (fmap loop m))
Step f -> Step (fmap loop f)
{-# INLINABLE hoistExposed #-}

-- | The same as 'hoistExposed', but with a 'Functor' constraint on
-- the target rather than the source. This must be used only with
-- a monad morphism.
hoistExposed2 :: (Functor n, Functor f) => (forall a. m a -> n a) -> Stream f m a -> Stream f n a
hoistExposed2 trans = loop where
loop stream = case stream of
Return r -> Return r
Effect m -> Effect (fmap loop (trans m))
Step f -> Step (fmap loop f)
{-# INLINABLE hoistExposed2 #-}

mapsExposed :: (Monad m, Functor f)
=> (forall x . f x -> g x) -> Stream f m r -> Stream g m r
Expand Down Expand Up @@ -1201,4 +1286,4 @@ cutoff = loop where
e <- lift $ inspect str
case e of
Left r -> return (Just r)
Right (frest) -> Step $ fmap (loop (n-1)) frest
Right (frest) -> Step $ fmap (loop (n-1)) frest
10 changes: 10 additions & 0 deletions src/Streaming/Prelude.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,9 @@ module Streaming.Prelude (
, map
, mapM
, maps
, maps2
, mapped
, mapped2
, for
, with
, subst
Expand Down Expand Up @@ -1351,6 +1353,14 @@ mapped :: (Monad m, Functor f) => (forall x . f x -> m (g x)) -> Stream f m r ->
mapped = mapsM
{-#INLINE mapped #-}

{-| A version of 'mapped' that imposes a 'Functor' constraint on the target functor rather
than the source functor. This version should be preferred if 'fmap' on the target
functor is cheaper.

-}
mapped2 :: (Monad m, Functor g) => (forall x . f x -> m (g x)) -> Stream f m r -> Stream g m r
mapped2 = mapsM2
{-# INLINE mapped2 #-}

{-| Fold streamed items into their monoidal sum

Expand Down