git.iko.soy/streamly
on 9268208 help sign in
streamly/src/Streamly/Fold/Types.hs
172 lines 4.5 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE ExistentialQuantification #-}
4-- |
5-- Module : Streamly.Fold.Types
6-- Copyright : (c) 2019 Composewell Technologies
7-- (c) 2013 Gabriel Gonzalez
8-- License : BSD3
9-- Maintainer : harendra.kumar@gmail.com
10-- Stability : experimental
11-- Portability : GHC
13module Streamly.Fold.Types
14 ( Fold (..)
15 )
16where
18import Control.Applicative (liftA2)
19import Data.Semigroup (Semigroup(..))
20import Streamly.Strict (Tuple'(..))
22------------------------------------------------------------------------------
23-- Monadic left folds
24------------------------------------------------------------------------------
26-- | Represents a left fold over an input stream of values of type @a@ to a
27-- single value of type @b@ in 'Monad' @m@.
29-- The fold uses an intermediate type @x@ as accumulator. The fold accumulator
30-- is initialized by calling the @init@ function and is then driven by calling
31-- the step function repeatedly. When the fold is done the @extract@ function
32-- is used to map the intermediate type @x@ to the final type @b@. This allows
33-- the state of the fold to be embedded in an arbitrary type @x@.
34--
35data Fold m a b =
36 -- | @Fold @ @ step @ @ initial @ @ extract@
37 forall x. Fold (x -> a -> m x) (m x) (x -> m b)
39-- | Maps a function on the output of the fold (the type @b@).
40instance Applicative m => Functor (Fold m a) where
41 {-# INLINE fmap #-}
42 fmap f (Fold step start done) = Fold step start done'
43 where
44 done' x = fmap f $! done x
46 {-# INLINE (<$) #-}
47 (<$) b = \_ -> pure b
49-- | The input (type @a@) of the composed fold is distributed to both the
50-- constituent folds. The outputs of the constituent folds (type @b@) are
51-- applied to a function.
52instance Applicative m => Applicative (Fold m a) where
53 {-# INLINE pure #-}
54 pure b = Fold (\() _ -> pure ()) (pure ()) (\() -> pure b)
56 {-# INLINE (<*>) #-}
57 (Fold stepL beginL doneL) <*> (Fold stepR beginR doneR) =
58 let step (Tuple' xL xR) a = Tuple' <$> stepL xL a <*> stepR xR a
59 begin = Tuple' <$> beginL <*> beginR
60 done (Tuple' xL xR) = doneL xL <*> doneR xR
61 in Fold step begin done
63 {-# INLINE (<*) #-}
64 (<*) m = \_ -> m
66 {-# INLINE (*>) #-}
67 _ *> m = m
69-- | Combines the outputs of the folds (the type @b@) using their 'Semigroup'
70-- instances.
71instance (Semigroup b, Monad m) => Semigroup (Fold m a b) where
72 {-# INLINE (<>) #-}
73 (<>) = liftA2 (<>)
75-- | Combines the outputs of the folds (the type @b@) using their 'Monoid'
76-- instances.
77instance (Semigroup b, Monoid b, Monad m) => Monoid (Fold m a b) where
78 {-# INLINE mempty #-}
79 mempty = pure mempty
81 {-# INLINE mappend #-}
82 mappend = (<>)
84-- | Combines the fold outputs (type @b@) using their 'Num' instances.
85instance (Monad m, Num b) => Num (Fold m a b) where
86 {-# INLINE fromInteger #-}
87 fromInteger = pure . fromInteger
89 {-# INLINE negate #-}
90 negate = fmap negate
92 {-# INLINE abs #-}
93 abs = fmap abs
95 {-# INLINE signum #-}
96 signum = fmap signum
98 {-# INLINE (+) #-}
99 (+) = liftA2 (+)
101 {-# INLINE (*) #-}
102 (*) = liftA2 (*)
104 {-# INLINE (-) #-}
105 (-) = liftA2 (-)
107-- | Combines the fold outputs (type @b@) using their 'Fractional' instances.
108instance (Monad m, Fractional b) => Fractional (Fold m a b) where
109 {-# INLINE fromRational #-}
110 fromRational = pure . fromRational
112 {-# INLINE recip #-}
113 recip = fmap recip
115 {-# INLINE (/) #-}
116 (/) = liftA2 (/)
118-- | Combines the fold outputs using their 'Floating' instances.
119instance (Monad m, Floating b) => Floating (Fold m a b) where
120 {-# INLINE pi #-}
121 pi = pure pi
123 {-# INLINE exp #-}
124 exp = fmap exp
126 {-# INLINE sqrt #-}
127 sqrt = fmap sqrt
129 {-# INLINE log #-}
130 log = fmap log
132 {-# INLINE sin #-}
133 sin = fmap sin
135 {-# INLINE tan #-}
136 tan = fmap tan
138 {-# INLINE cos #-}
139 cos = fmap cos
141 {-# INLINE asin #-}
142 asin = fmap asin
144 {-# INLINE atan #-}
145 atan = fmap atan
147 {-# INLINE acos #-}
148 acos = fmap acos
150 {-# INLINE sinh #-}
151 sinh = fmap sinh
153 {-# INLINE tanh #-}
154 tanh = fmap tanh
156 {-# INLINE cosh #-}
157 cosh = fmap cosh
159 {-# INLINE asinh #-}
160 asinh = fmap asinh
162 {-# INLINE atanh #-}
163 atanh = fmap atanh
165 {-# INLINE acosh #-}
166 acosh = fmap acosh
168 {-# INLINE (**) #-}
169 (**) = liftA2 (**)
171 {-# INLINE logBase #-}
172 logBase = liftA2 logBase