git.iko.soy/streamly
on efe0be3 help sign in
streamly/core/src/Streamly/Internal/Data/Stream/Cross.hs
143 lines 4.7 kB history raw
1{-# LANGUAGE UndecidableInstances #-}
3-- |
4-- Module : Streamly.Internal.Data.Stream.Cross
5-- Copyright : (c) 2017 Composewell Technologies
6--
7-- License : BSD3
8-- Maintainer : streamly@composewell.com
9-- Stability : experimental
10-- Portability : GHC
11--
12module Streamly.Internal.Data.Stream.Cross
13 (
14 CrossStream (..)
15 )
16where
18import Control.Monad.Catch (MonadThrow, throwM)
19import Control.Monad.Trans.Class (MonadTrans(lift))
20import Control.Applicative (liftA2)
21import Control.Monad.IO.Class (MonadIO(..))
22import Data.Functor.Identity (Identity(..))
23import GHC.Exts (IsList(..), IsString(..))
24import Streamly.Internal.Data.Stream.Type (Stream)
26import qualified Streamly.Internal.Data.Stream.Type as Stream
27import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
29-- $setup
30-- >>> import Streamly.Internal.Data.Stream.Cross (CrossStream(..))
31-- >>> import qualified Streamly.Data.Fold as Fold
32-- >>> import qualified Streamly.Data.Stream as Stream
34------------------------------------------------------------------------------
35-- Stream with a cross product style monad instance
36------------------------------------------------------------------------------
38-- | A newtype wrapper for the 'Stream' type with a cross product style monad
39-- instance.
40--
41-- Semigroup instance appends two streams.
42--
43-- A 'Monad' bind behaves like a @for@ loop:
44--
45-- >>> :{
46-- Stream.fold Fold.toList $ unCrossStream $ do
47-- x <- CrossStream (Stream.fromList [1,2]) -- foreach x in stream
48-- return x
49-- :}
50-- [1,2]
51--
52-- Nested monad binds behave like nested @for@ loops:
53--
54-- >>> :{
55-- Stream.fold Fold.toList $ unCrossStream $ do
56-- x <- CrossStream (Stream.fromList [1,2]) -- foreach x in stream
57-- y <- CrossStream (Stream.fromList [3,4]) -- foreach y in stream
58-- return (x, y)
59-- :}
60-- [(1,3),(1,4),(2,3),(2,4)]
61--
62newtype CrossStream m a = CrossStream {unCrossStream :: Stream m a}
63 deriving (Functor, Semigroup, Monoid, Foldable)
65-- Pure (Identity monad) stream instances
66deriving instance Traversable (CrossStream Identity)
67deriving instance IsList (CrossStream Identity a)
68deriving instance (a ~ Char) => IsString (CrossStream Identity a)
69deriving instance Eq a => Eq (CrossStream Identity a)
70deriving instance Ord a => Ord (CrossStream Identity a)
71deriving instance Show a => Show (CrossStream Identity a)
72deriving instance Read a => Read (CrossStream Identity a)
74------------------------------------------------------------------------------
75-- Applicative
76------------------------------------------------------------------------------
78-- Note: we need to define all the typeclass operations because we want to
79-- INLINE them.
80instance Monad m => Applicative (CrossStream m) where
81 {-# INLINE pure #-}
82 pure x = CrossStream (Stream.fromPure x)
84 {-# INLINE (<*>) #-}
85 (CrossStream s1) <*> (CrossStream s2) =
86 CrossStream (Stream.crossApply s1 s2)
87 -- (<*>) = K.crossApply
89 {-# INLINE liftA2 #-}
90 liftA2 f x = (<*>) (fmap f x)
92 {-# INLINE (*>) #-}
93 (CrossStream s1) *> (CrossStream s2) =
94 CrossStream (Stream.crossApplySnd s1 s2)
95 -- (*>) = K.crossApplySnd
97 {-# INLINE (<*) #-}
98 (CrossStream s1) <* (CrossStream s2) =
99 CrossStream (Stream.crossApplyFst s1 s2)
100 -- (<*) = K.crossApplyFst
102------------------------------------------------------------------------------
103-- Monad
104------------------------------------------------------------------------------
106instance Monad m => Monad (CrossStream m) where
107 return = pure
109 -- Benchmarks better with StreamD bind and pure:
110 -- toList, filterAllout, *>, *<, >> (~2x)
111 --
112 -- pure = Stream . D.fromStreamD . D.fromPure
113 -- m >>= f = D.fromStreamD $ D.concatMap (D.toStreamD . f) (D.toStreamD m)
115 -- Benchmarks better with CPS bind and pure:
116 -- Prime sieve (25x)
117 -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)
118 --
119 {-# INLINE (>>=) #-}
120 (>>=) (CrossStream m) f =
121 CrossStream
122 (Stream.fromStreamK
123 $ K.bindWith
124 K.append
125 (Stream.toStreamK m)
126 (Stream.toStreamK . unCrossStream . f))
128 {-# INLINE (>>) #-}
129 (>>) = (*>)
131------------------------------------------------------------------------------
132-- Transformers
133------------------------------------------------------------------------------
135instance (MonadIO m) => MonadIO (CrossStream m) where
136 liftIO x = CrossStream (Stream.fromEffect $ liftIO x)
138instance MonadTrans CrossStream where
139 {-# INLINE lift #-}
140 lift x = CrossStream (Stream.fromEffect x)
142instance (MonadThrow m) => MonadThrow (CrossStream m) where
143 throwM = lift . throwM