streamly-0.7.1: src/Streamly/Internal/Data/Stream/Instances.hs
------------------------------------------------------------------------------
-- CPP macros for common instances
------------------------------------------------------------------------------
-- XXX use template haskell instead and include Monoid and IsStream instances
-- as well.
#define MONADPARALLEL , MonadAsync m
#define MONAD_COMMON_INSTANCES(STREAM,CONSTRAINT) \
instance Monad m => Functor (STREAM m) where { \
{-# INLINE fmap #-}; \
fmap f (STREAM m) = D.fromStreamD $ D.mapM (return . f) $ D.toStreamD m }; \
\
instance (MonadBase b m, Monad m CONSTRAINT) => MonadBase b (STREAM m) where {\
liftBase = liftBaseDefault }; \
\
instance (MonadIO m CONSTRAINT) => MonadIO (STREAM m) where { \
liftIO = lift . liftIO }; \
\
instance (MonadThrow m CONSTRAINT) => MonadThrow (STREAM m) where { \
throwM = lift . throwM }; \
\
{- \
instance (MonadError e m CONSTRAINT) => MonadError e (STREAM m) where { \
throwError = lift . throwError; \
catchError m h = \
fromStream $ withCatchError (toStream m) (\e -> toStream $ h e) }; \
-} \
\
instance (MonadReader r m CONSTRAINT) => MonadReader r (STREAM m) where { \
ask = lift ask; \
local f m = fromStream $ K.withLocal f (toStream m) }; \
\
instance (MonadState s m CONSTRAINT) => MonadState s (STREAM m) where { \
get = lift get; \
put x = lift (put x); \
state k = lift (state k) }
------------------------------------------------------------------------------
-- Lists
------------------------------------------------------------------------------
-- Serial streams can act like regular lists using the Identity monad
-- XXX Show instance is 10x slower compared to read, we can do much better.
-- The list show instance itself is really slow.
-- XXX The default definitions of "<" in the Ord instance etc. do not perform
-- well, because they do not get inlined. Need to add INLINE in Ord class in
-- base?
#if MIN_VERSION_deepseq(1,4,3)
#define NFDATA1_INSTANCE(STREAM) \
instance NFData1 (STREAM Identity) where { \
{-# INLINE liftRnf #-}; \
liftRnf r = runIdentity . P.foldl' (\_ x -> r x) () }
#else
#define NFDATA1_INSTANCE(STREAM)
#endif
#define LIST_INSTANCES(STREAM) \
instance IsList (STREAM Identity a) where { \
type (Item (STREAM Identity a)) = a; \
{-# INLINE fromList #-}; \
fromList = P.fromList; \
{-# INLINE toList #-}; \
toList = runIdentity . P.toList }; \
\
instance Eq a => Eq (STREAM Identity a) where { \
{-# INLINE (==) #-}; \
(==) xs ys = runIdentity $ P.eqBy (==) xs ys }; \
\
instance Ord a => Ord (STREAM Identity a) where { \
{-# INLINE compare #-}; \
compare xs ys = runIdentity $ P.cmpBy compare xs ys; \
{-# INLINE (<) #-}; \
x < y = case compare x y of { LT -> True; _ -> False }; \
{-# INLINE (<=) #-}; \
x <= y = case compare x y of { GT -> False; _ -> True }; \
{-# INLINE (>) #-}; \
x > y = case compare x y of { GT -> True; _ -> False }; \
{-# INLINE (>=) #-}; \
x >= y = case compare x y of { LT -> False; _ -> True }; \
{-# INLINE max #-}; \
max x y = if x <= y then y else x; \
{-# INLINE min #-}; \
min x y = if x <= y then x else y; }; \
\
instance Show a => Show (STREAM Identity a) where { \
showsPrec p dl = showParen (p > 10) $ \
showString "fromList " . shows (toList dl) }; \
\
instance Read a => Read (STREAM Identity a) where { \
readPrec = parens $ prec 10 $ do { \
Ident "fromList" <- lexP; \
fromList <$> readPrec }; \
readListPrec = readListPrecDefault }; \
\
instance (a ~ Char) => IsString (STREAM Identity a) where { \
{-# INLINE fromString #-}; \
fromString = P.fromList }; \
\
instance NFData a => NFData (STREAM Identity a) where { \
{-# INLINE rnf #-}; \
rnf = runIdentity . P.foldl' (\_ x -> rnf x) () }; \
-------------------------------------------------------------------------------
-- Foldable
-------------------------------------------------------------------------------
-- The default Foldable instance has several issues:
-- 1) several definitions do not have INLINE on them, so we provide
-- re-implementations with INLINE pragmas.
-- 2) the definitions of sum/product/maximum/minimum are inefficient as they
-- use right folds, they cannot run in constant memory. We provide
-- implementations using strict left folds here.
#define FOLDABLE_INSTANCE(STREAM) \
instance (Foldable m, Monad m) => Foldable (STREAM m) where { \
\
{-# INLINE foldMap #-}; \
foldMap f = fold . P.foldr (mappend . f) mempty; \
\
{-# INLINE foldr #-}; \
foldr f z t = appEndo (foldMap (Endo #. f) t) z; \
\
{-# INLINE foldl' #-}; \
foldl' f z0 xs = foldr f' id xs z0 \
where { f' x k z = k $! f z x}; \
\
{-# INLINE length #-}; \
length = foldl' (\n _ -> n + 1) 0; \
\
{-# INLINE elem #-}; \
elem = any . (==); \
\
{-# INLINE maximum #-}; \
maximum = \
fromMaybe (errorWithoutStackTrace $ "maximum: empty stream") \
. toMaybe \
. foldl' getMax Nothing' where { \
getMax Nothing' x = Just' x; \
getMax (Just' mx) x = Just' $! max mx x }; \
\
{-# INLINE minimum #-}; \
minimum = \
fromMaybe (errorWithoutStackTrace $ "minimum: empty stream") \
. toMaybe \
. foldl' getMin Nothing' where { \
getMin Nothing' x = Just' x; \
getMin (Just' mn) x = Just' $! min mn x }; \
\
{-# INLINE sum #-}; \
sum = foldl' (+) 0; \
\
{-# INLINE product #-}; \
product = foldl' (*) 1 }
-------------------------------------------------------------------------------
-- Traversable
-------------------------------------------------------------------------------
#define TRAVERSABLE_INSTANCE(STREAM) \
instance Traversable (STREAM Identity) where { \
{-# INLINE traverse #-}; \
traverse f s = runIdentity $ P.foldr consA (pure mempty) s \
where { consA x ys = liftA2 K.cons (f x) ys }}