git.iko.soy/streamly
on 57fad21 help sign in
streamly/src/Streamly/Streams/Instances.hs
121 lines 7.7 kB history raw
1------------------------------------------------------------------------------
2-- CPP macros for common instances
3------------------------------------------------------------------------------
5-- XXX use template haskell instead and include Monoid and IsStream instances
6-- as well.
8#define MONADPARALLEL , MonadAsync m
10#define MONAD_APPLICATIVE_INSTANCE(STREAM,CONSTRAINT) \
11instance (Monad m CONSTRAINT) => Applicative (STREAM m) where { \
12 pure = STREAM . K.yield; \
13 (<*>) = ap }
15#define MONAD_COMMON_INSTANCES(STREAM,CONSTRAINT) \
16instance Monad m => Functor (STREAM m) where { \
17 fmap = map }; \
18 \
19instance (MonadBase b m, Monad m CONSTRAINT) => MonadBase b (STREAM m) where {\
20 liftBase = liftBaseDefault }; \
21 \
22instance (MonadIO m CONSTRAINT) => MonadIO (STREAM m) where { \
23 liftIO = lift . liftIO }; \
24 \
25instance (MonadThrow m CONSTRAINT) => MonadThrow (STREAM m) where { \
26 throwM = lift . throwM }; \
27 \
28{- \
29instance (MonadError e m CONSTRAINT) => MonadError e (STREAM m) where { \
30 throwError = lift . throwError; \
31 catchError m h = \
32 fromStream $ withCatchError (toStream m) (\e -> toStream $ h e) }; \
33-} \
34 \
35instance (MonadReader r m CONSTRAINT) => MonadReader r (STREAM m) where { \
36 ask = lift ask; \
37 local f m = fromStream $ K.withLocal f (toStream m) }; \
38 \
39instance (MonadState s m CONSTRAINT) => MonadState s (STREAM m) where { \
40 get = lift get; \
41 put x = lift (put x); \
42 state k = lift (state k) }
44------------------------------------------------------------------------------
45-- Lists
46------------------------------------------------------------------------------
48-- Serial streams can act like regular lists using the Identity monad
50-- XXX Show instance is 10x slower compared to read, we can do much better.
51-- The list show instance itself is really slow.
53-- XXX The default definitions of "<" in the Ord instance etc. do not perform
54-- well, because they do not get inlined. Need to add INLINE in Ord class in
55-- base?
57#define LIST_INSTANCES(STREAM) \
58instance IsList (STREAM Identity a) where { \
59 type (Item (STREAM Identity a)) = a; \
60 {-# INLINE fromList #-}; \
61 fromList = P.fromList; \
62 {-# INLINE toList #-}; \
63 toList = runIdentity . P.toList }; \
64 \
65instance Eq a => Eq (STREAM Identity a) where { \
66 {-# INLINE (==) #-}; \
67 (==) xs ys = runIdentity $ P.eqBy (==) xs ys }; \
68 \
69instance Ord a => Ord (STREAM Identity a) where { \
70 {-# INLINE compare #-}; \
71 compare xs ys = runIdentity $ P.cmpBy compare xs ys; \
72 {-# INLINE (<) #-}; \
73 x < y = case compare x y of { LT -> True; _ -> False }; \
74 {-# INLINE (<=) #-}; \
75 x <= y = case compare x y of { GT -> False; _ -> True }; \
76 {-# INLINE (>) #-}; \
77 x > y = case compare x y of { GT -> True; _ -> False }; \
78 {-# INLINE (>=) #-}; \
79 x >= y = case compare x y of { LT -> False; _ -> True }; \
80 {-# INLINE max #-}; \
81 max x y = if x <= y then y else x; \
82 {-# INLINE min #-}; \
83 min x y = if x <= y then x else y; }; \
84 \
85instance Show a => Show (STREAM Identity a) where { \
86 showsPrec p dl = showParen (p > 10) $ \
87 showString "fromList " . shows (toList dl) }; \
88 \
89instance Read a => Read (STREAM Identity a) where { \
90 readPrec = parens $ prec 10 $ do { \
91 Ident "fromList" <- lexP; \
92 fromList <$> readPrec }; \
93 readListPrec = readListPrecDefault }; \
94 \
95instance (a ~ Char) => IsString (STREAM Identity a) where { \
96 {-# INLINE fromString #-}; \
97 fromString = P.fromList }; \
98 \
99instance NFData a => NFData (STREAM Identity a) where { rnf = rnf1 }; \
100instance NFData1 (STREAM Identity) where { \
101 {-# INLINE liftRnf #-}; \
102 liftRnf r = runIdentity . P.foldl' (\_ x -> r x) () }
104-------------------------------------------------------------------------------
105-- Foldable
106-------------------------------------------------------------------------------
108#define FOLDABLE_INSTANCE(STREAM) \
109instance (Foldable m, Monad m) => Foldable (STREAM m) where { \
110 {-# INLINE foldMap #-}; \
111 foldMap f = fold . P.foldr mappend mempty . fmap f }
113-------------------------------------------------------------------------------
114-- Traversable
115-------------------------------------------------------------------------------
117#define TRAVERSABLE_INSTANCE(STREAM) \
118instance Traversable (STREAM Identity) where { \
119 {-# INLINE traverse #-}; \
120 traverse f s = runIdentity $ P.foldr consA (pure mempty) s \
121 where { consA x ys = liftA2 K.cons (f x) ys }}