git.iko.soy/streamly
on master help sign in
Refactor, update, document TypeGen module
e34cd17Harendra Kumar
core/src/Streamly/Internal/Data/Stream/TypeGen.hs+101−123
compare with master
unifiedsplit
@@ -6,105 +6,72 @@
6-- Stability : experimental
6-- Stability : experimental
7-- Portability : GHC
7-- Portability : GHC
8--
8--
9−-- Template Haskell macros to create useful stream types.
9+-- Template Haskell macros to create custom newtype wrappers for the 'Stream'
10+-- type, deriving all the usual instances.
10--
11--
11−-- __Create a type with a serial zipping applicative property:__
12+-- To use this module, "Streamly.Data.Stream" or "Streamly.Data.Stream.Prelude"
13+-- must be imported as "Stream". Also, it is recommended to import this module
14+-- unqualified to bring everything needed in scope without having to import
15+-- several other modules.
12--
16--
13−-- @
14−-- import Control.Monad.Catch (MonadThrow(..))
15−-- import Control.Monad.IO.Class (MonadIO(..))
16−-- import Control.Monad.Reader.Class (MonadReader(..))
17+-- >>> import Control.Monad.Reader.Class (MonadReader(..))
17−-- import Control.Monad.Trans.Class (MonadTrans(..))
18−-- import Streamly.Data.Stream (Stream)
19−--
20−-- import qualified Streamly.Data.Stream
18+-- >>> import qualified Streamly.Data.Stream.Prelude as Stream
21−-- import qualified Streamly.Data.Stream as Stream
22−-- import qualified Streamly.Internal.Data.Stream.TypeGen as StreamTypeGen
19+-- >>> import Streamly.Internal.Data.Stream.TypeGen
23−--
24−-- applySerial :: Monad m => Stream m (a -> b) -> Stream m a -> Stream m b
25−-- applySerial = Stream.zipWith ($)
26−--
27−-- \$(StreamTypeGen.mkZippingType \"ZipSerial\" "applySerial" False)
28−-- @
29−--
30−-- __Create a type with a concurrent zipping applicative property:__
31−--
32−-- @
33−-- import Control.Monad.Catch (MonadThrow(..))
34−-- import Control.Monad.IO.Class (MonadIO(..))
35−-- import Control.Monad.Reader.Class (MonadReader(..))
36−-- import Control.Monad.Trans.Class (MonadTrans(..))
37−-- import Streamly.Data.Stream (Stream)
38--
20--
39−-- import qualified Streamly.Data.Stream
21+-- Instead of using these macros directly you could use the generated code as
40−-- import qualified Streamly.Data.Stream.Concurrent
22+-- well. Use these macros in ghci to generate the required code and paste it in
41−-- import qualified Streamly.Data.Stream.Concurrent as Concur
23+-- your package, you can customize it as you want. See the docs of the macros
42−-- import qualified Streamly.Internal.Data.Stream.TypeGen as StreamTypeGen
24+-- below for examples of viewing the generated code.
43--
25--
44−-- applyConcurrent :: Monad m => Stream m (a -> b) -> Stream m a -> Stream m b
26+-- Example, create an applicative type with zipping apply:
45−-- applyConcurrent = Concur.zipWith ($)
46--
27--
47−-- \$(StreamTypeGen.mkZippingType \"ZipConcurrent\" "applyConcurrent" True)
28+-- >>> import Streamly.Data.Stream.Prelude (Stream)
29+-- >>> :{
30+-- zipApply :: Monad m => Stream m (a -> b) -> Stream m a -> Stream m b
31+-- zipApply = Stream.zipWith ($)
48−-- @
32+-- :}
49--
33--
50−-- __Create a type with serial interleave properties:__
34+-- > $(mkZipType "ZipStream" "zipApply" False)
51--
35--
52−-- @
36+-- Example, create an applicative type with concurrent zipping apply:
53−-- import Control.Monad.Catch (MonadThrow(..))
54−-- import Control.Monad.IO.Class (MonadIO(..))
55−-- import Control.Monad.Reader.Class (MonadReader(..))
56−-- import Control.Monad.Trans.Class (MonadTrans(..))
57−-- import Streamly.Data.Stream (Stream)
58--
37--
59−-- import qualified Control.Monad
38+-- > $(mkZipType "ParZipStream" "parApply" True)
60−-- import qualified Streamly.Data.Stream
61−-- import qualified Streamly.Data.Stream as Stream
62−-- import qualified Streamly.Internal.Data.Stream.TypeGen as StreamTypeGen
63--
39--
64−-- bindInterleave :: Stream m a -> (a -> Stream m b) -> Stream m b
40+-- Example, create a monad type with an interleaving cross product bind:
65−-- bindInterleave = flip (Stream.concatMapWith Stream.interleave)
66--
41--
67−-- \$(StreamTypeGen.mkNestingType \"InterleaveSerial\" "bindInterleave" False)
42+-- >>> :{
43+-- interleaveBind :: Stream m a -> (a -> Stream m b) -> Stream m b
44+-- interleaveBind = flip (Stream.concatMapWith Stream.interleave)
68−-- @
45+-- :}
69--
46--
70−-- __Create a type with eager concurrency properties:__
47+-- > $(mkCrossType "InterleaveStream" "interleaveBind" False)
71−--
72−-- @
73−-- import Control.Monad.Catch (MonadThrow(..))
74−-- import Control.Monad.IO.Class (MonadIO(..))
75−-- import Control.Monad.Reader.Class (MonadReader(..))
76−-- import Control.Monad.Trans.Class (MonadTrans(..))
77−-- import Streamly.Data.Stream (Stream)
78−-- import Streamly.Data.Stream.Concurrent (MonadAsync)
79--
48--
80−-- import qualified Control.Monad
49+-- Example, create a monad type with an eager concurrent cross product bind:
81−-- import qualified Streamly.Data.Stream
82−-- import qualified Streamly.Data.Stream.Concurrent
83−-- import qualified Streamly.Data.Stream.Concurrent as Concur
84−-- import qualified Streamly.Internal.Data.Stream.TypeGen as StreamTypeGen
85--
50--
51+-- >>> :{
86−-- bindConcurrent :: MonadAsync m => Stream m a -> (a -> Stream m b) -> Stream m b
52+-- parBind :: Stream.MonadAsync m => Stream m a -> (a -> Stream m b) -> Stream m b
87−-- bindConcurrent = flip (Concur.concatMapWith (Concur.eager True))
53+-- parBind = flip (Stream.parConcatMap (Stream.eager True))
54+-- :}
88--
55--
89−-- \$(StreamTypeGen.mkNestingType \"Parallel\" "bindConcurrent" True)
56+-- > $(mkCrossType "ParEagerStream" "parBind" True)
90−-- @
91--
57--
92module Streamly.Internal.Data.Stream.TypeGen
58module Streamly.Internal.Data.Stream.TypeGen
93− ( mkZippingType
59+ (
94− , mkNestingType
60+ -- * Imports for Examples
61+ -- $setup
62+
63+ -- * Template Haskell Macros
64+ mkZipType
65+ , mkCrossType
66+
67+ -- * Re-exports
68+ , MonadIO(..)
69+ , MonadThrow(..)
70+ -- , MonadReader(..)
71+ , MonadTrans(..)
72+ , ap
95 ) where
73 ) where
96
74
97−--------------------------------------------------------------------------------
98−-- Developer notes
99−--------------------------------------------------------------------------------
100−
101−-- Debugging helpers,
102−--
103−-- >>> import Language.Haskell.TH
104−-- >>> import Streamly.Internal.Data.Stream.TypeGen
105−-- >>> expr <- runQ (mkNestingType "Parallel" "bindConcurrent" True)
106−-- >>> putStrLn $ pprint expr
107−
108--------------------------------------------------------------------------------
75--------------------------------------------------------------------------------
109-- Imports
76-- Imports
110--------------------------------------------------------------------------------
77--------------------------------------------------------------------------------
@@ -112,9 +79,20 @@ module Streamly.Internal.Data.Stream.TypeGen
112import Language.Haskell.TH.Lib
79import Language.Haskell.TH.Lib
113import Language.Haskell.TH.Syntax
80import Language.Haskell.TH.Syntax
114
81
82+import Control.Monad (ap)
83+import Control.Monad.Catch (MonadThrow(..))
84+import Control.Monad.IO.Class (MonadIO(..))
85+-- import Control.Monad.Reader.Class (MonadReader(..))
86+import Control.Monad.Trans.Class (MonadTrans(..))
87+import Prelude hiding (repeat)
88+
115-- $setup
89-- $setup
116-- >>> :m
90-- >>> :m
91+-- >>> :set -package mtl
92+-- >>> :set -package streamly
117-- >>> import Language.Haskell.TH
93-- >>> import Language.Haskell.TH
94+-- >>> import Control.Monad.Reader.Class (MonadReader(..))
95+-- >>> import qualified Streamly.Data.Stream.Prelude as Stream
118-- >>> import Streamly.Internal.Data.Stream.TypeGen
96-- >>> import Streamly.Internal.Data.Stream.TypeGen
119
97
120--------------------------------------------------------------------------------
98--------------------------------------------------------------------------------
@@ -141,7 +119,7 @@ _r :: Name
141_r = mkName "r"
119_r = mkName "r"
142
120
143_Stream :: Name
121_Stream :: Name
144−_Stream = mkName "Stream"
122+_Stream = mkName "Stream.Stream"
145
123
146_fmap :: Name
124_fmap :: Name
147_fmap = mkName "fmap"
125_fmap = mkName "fmap"
@@ -451,50 +429,50 @@ mkSimpleStreamInstances dtNameStr = do
451
429
452-- | Create a type with a zip-like applicative.
430-- | Create a type with a zip-like applicative.
453--
431--
454−-- >>> expr <- runQ (mkZippingType "ZipSerial" "apZipSerial" False)
432+-- >>> expr <- runQ (mkZipType "ZipStream" "zipApply" False)
455-- >>> putStrLn $ pprint expr
433-- >>> putStrLn $ pprint expr
456−-- newtype ZipSerial m a = ZipSerial (Stream m a)
434+-- newtype ZipStream m a = ZipStream (Stream.Stream m a)
457−-- mkZipSerial :: Stream m a -> ZipSerial m a
435+-- mkZipStream :: Stream.Stream m a -> ZipStream m a
458−-- mkZipSerial = ZipSerial
436+-- mkZipStream = ZipStream
459−-- unZipSerial :: ZipSerial m a -> Stream m a
437+-- unZipStream :: ZipStream m a -> Stream.Stream m a
460−-- unZipSerial (ZipSerial strm) = strm
438+-- unZipStream (ZipStream strm) = strm
461−-- instance Monad m => Functor (ZipSerial m)
439+-- instance Monad m => Functor (ZipStream m)
462-- where {-# INLINE fmap #-}
440-- where {-# INLINE fmap #-}
463−-- fmap f (ZipSerial strm) = ZipSerial (fmap f strm)
441+-- fmap f (ZipStream strm) = ZipStream (fmap f strm)
464−-- instance Monad m => Applicative (ZipSerial m)
442+-- instance Monad m => Applicative (ZipStream m)
465-- where {-# INLINE pure #-}
443-- where {-# INLINE pure #-}
466−-- pure = ZipSerial . Streamly.Data.Stream.repeat
444+-- pure = ZipStream . Stream.repeat
467-- {-# INLINE (<*>) #-}
445-- {-# INLINE (<*>) #-}
468−-- (<*>) (ZipSerial strm1) (ZipSerial strm2) = ZipSerial (apZipSerial strm1 strm2)
446+-- (<*>) (ZipStream strm1) (ZipStream strm2) = ZipStream (zipApply strm1 strm2)
469−-- instance MonadTrans ZipSerial
447+-- instance MonadTrans ZipStream
470-- where {-# INLINE lift #-}
448-- where {-# INLINE lift #-}
471−-- lift = ZipSerial . lift
449+-- lift = ZipStream . lift
472−-- instance (Monad (ZipSerial m), MonadIO m) => MonadIO (ZipSerial m)
450+-- instance (Monad (ZipStream m), MonadIO m) => MonadIO (ZipStream m)
473-- where {-# INLINE liftIO #-}
451-- where {-# INLINE liftIO #-}
474−-- liftIO = ZipSerial . (lift . liftIO)
452+-- liftIO = ZipStream . (lift . liftIO)
475−-- instance (Monad (ZipSerial m),
453+-- instance (Monad (ZipStream m),
476−-- MonadThrow m) => MonadThrow (ZipSerial m)
454+-- MonadThrow m) => MonadThrow (ZipStream m)
477-- where {-# INLINE throwM #-}
455-- where {-# INLINE throwM #-}
478−-- throwM = ZipSerial . (lift . throwM)
456+-- throwM = ZipStream . (lift . throwM)
479−-- instance (Monad (ZipSerial m), MonadReader r m) => MonadReader r
457+-- instance (Monad (ZipStream m), MonadReader r m) => MonadReader r
480−-- (ZipSerial m)
458+-- (ZipStream m)
481-- where {-# INLINE ask #-}
459-- where {-# INLINE ask #-}
482-- ask = lift ask
460-- ask = lift ask
483-- {-# INLINE local #-}
461-- {-# INLINE local #-}
484−-- local f (ZipSerial strm) = ZipSerial (local f strm)
462+-- local f (ZipStream strm) = ZipStream (local f strm)
485−mkZippingType
463+mkZipType
486 :: String -- ^ Name of the type
464 :: String -- ^ Name of the type
487 -> String -- ^ Function to use for (\<*\>)
465 -> String -- ^ Function to use for (\<*\>)
488− -> Bool -- ^ 'True' if (\<*\>) has concurrent properties
466+ -> Bool -- ^ 'True' if (\<*\>) requires MonadAsync constraint (concurrent)
489 -> Q [Dec]
467 -> Q [Dec]
490−mkZippingType dtNameStr apOpStr isConcurrent = do
468+mkZipType dtNameStr apOpStr isConcurrent = do
491 typeDec <- makeTypeDec dtNameStr
469 typeDec <- makeTypeDec dtNameStr
492 functorI <- makeStreamFunctor dtNameStr
470 functorI <- makeStreamFunctor dtNameStr
493 applicativeI <-
471 applicativeI <-
494 mkStreamApplicative
472 mkStreamApplicative
495 dtNameStr
473 dtNameStr
496 classConstraints
474 classConstraints
497− "Streamly.Data.Stream.repeat"
475+ "Stream.repeat"
498 apOpStr
476 apOpStr
499 simpleInstances <- mkSimpleStreamInstances dtNameStr
477 simpleInstances <- mkSimpleStreamInstances dtNameStr
500 return $ typeDec ++ [functorI, applicativeI] ++ simpleInstances
478 return $ typeDec ++ [functorI, applicativeI] ++ simpleInstances
@@ -503,30 +481,30 @@ mkZippingType dtNameStr apOpStr isConcurrent = do
503
481
504 classConstraints =
482 classConstraints =
505 if isConcurrent
483 if isConcurrent
506− then ["Streamly.Data.Stream.Concurrent.MonadAsync"]
484+ then ["Stream.MonadAsync"]
507 else ["Monad"]
485 else ["Monad"]
508
486
509-- | Create a type with specific stream combination properties.
487-- | Create a type with specific stream combination properties.
510--
488--
511−-- >>> expr <- runQ (mkNestingType "Parallel" "bindConcurrent" True)
489+-- >>> expr <- runQ (mkCrossType "Parallel" "parBind" True)
512-- >>> putStrLn $ pprint expr
490-- >>> putStrLn $ pprint expr
513−-- newtype Parallel m a = Parallel (Stream m a)
491+-- newtype Parallel m a = Parallel (Stream.Stream m a)
514−-- mkParallel :: Stream m a -> Parallel m a
492+-- mkParallel :: Stream.Stream m a -> Parallel m a
515-- mkParallel = Parallel
493-- mkParallel = Parallel
516−-- unParallel :: Parallel m a -> Stream m a
494+-- unParallel :: Parallel m a -> Stream.Stream m a
517-- unParallel (Parallel strm) = strm
495-- unParallel (Parallel strm) = strm
518-- instance Monad m => Functor (Parallel m)
496-- instance Monad m => Functor (Parallel m)
519-- where {-# INLINE fmap #-}
497-- where {-# INLINE fmap #-}
520-- fmap f (Parallel strm) = Parallel (fmap f strm)
498-- fmap f (Parallel strm) = Parallel (fmap f strm)
521−-- instance Streamly.Data.Stream.Concurrent.MonadAsync m => Monad (Parallel m)
499+-- instance Stream.MonadAsync m => Monad (Parallel m)
522-- where {-# INLINE (>>=) #-}
500-- where {-# INLINE (>>=) #-}
523-- (>>=) (Parallel strm1) f = let f1 a = unParallel (f a)
501-- (>>=) (Parallel strm1) f = let f1 a = unParallel (f a)
524−-- in Parallel (bindConcurrent strm1 f1)
502+-- in Parallel (parBind strm1 f1)
525−-- instance Streamly.Data.Stream.Concurrent.MonadAsync m => Applicative (Parallel m)
503+-- instance Stream.MonadAsync m => Applicative (Parallel m)
526-- where {-# INLINE pure #-}
504-- where {-# INLINE pure #-}
527−-- pure = Parallel . Streamly.Data.Stream.fromPure
505+-- pure = Parallel . Stream.fromPure
528-- {-# INLINE (<*>) #-}
506-- {-# INLINE (<*>) #-}
529−-- (<*>) (Parallel strm1) (Parallel strm2) = Parallel (Control.Monad.ap strm1 strm2)
507+-- (<*>) (Parallel strm1) (Parallel strm2) = Parallel (ap strm1 strm2)
530-- instance MonadTrans Parallel
508-- instance MonadTrans Parallel
531-- where {-# INLINE lift #-}
509-- where {-# INLINE lift #-}
532-- lift = Parallel . lift
510-- lift = Parallel . lift
@@ -543,12 +521,12 @@ mkZippingType dtNameStr apOpStr isConcurrent = do
543-- ask = lift ask
521-- ask = lift ask
544-- {-# INLINE local #-}
522-- {-# INLINE local #-}
545-- local f (Parallel strm) = Parallel (local f strm)
523-- local f (Parallel strm) = Parallel (local f strm)
546−mkNestingType
524+mkCrossType
547 :: String -- ^ Name of the type
525 :: String -- ^ Name of the type
548 -> String -- ^ Function to use for (>>=)
526 -> String -- ^ Function to use for (>>=)
549− -> Bool -- ^ 'True' if (>>=) has concurrent properties
527+ -> Bool -- ^ 'True' if (>>=) requires MonadAsync constraint (concurrent)
550 -> Q [Dec]
528 -> Q [Dec]
551−mkNestingType dtNameStr bindOpStr isConcurrent = do
529+mkCrossType dtNameStr bindOpStr isConcurrent = do
552 typeDec <- makeTypeDec dtNameStr
530 typeDec <- makeTypeDec dtNameStr
553 functorI <- makeStreamFunctor dtNameStr
531 functorI <- makeStreamFunctor dtNameStr
554 monadI <- mkStreamMonad dtNameStr classConstraints bindOpStr
532 monadI <- mkStreamMonad dtNameStr classConstraints bindOpStr
@@ -556,8 +534,8 @@ mkNestingType dtNameStr bindOpStr isConcurrent = do
556 mkStreamApplicative
534 mkStreamApplicative
557 dtNameStr
535 dtNameStr
558 classConstraints
536 classConstraints
559− "Streamly.Data.Stream.fromPure"
537+ "Stream.fromPure"
560− "Control.Monad.ap"
538+ "ap"
561 simpleInstances <- mkSimpleStreamInstances dtNameStr
539 simpleInstances <- mkSimpleStreamInstances dtNameStr
562 return $ typeDec ++ [functorI, monadI, applicativeI] ++ simpleInstances
540 return $ typeDec ++ [functorI, monadI, applicativeI] ++ simpleInstances
563
541
@@ -565,5 +543,5 @@ mkNestingType dtNameStr bindOpStr isConcurrent = do
565
543
566 classConstraints =
544 classConstraints =
567 if isConcurrent
545 if isConcurrent
568− then ["Streamly.Data.Stream.Concurrent.MonadAsync"]
546+ then ["Stream.MonadAsync"]
569 else ["Monad"]
547 else ["Monad"]