mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +03:00
Refactor Unfold module
* Rearrange exports, export additional functions * Update docs * Disable applicative/monad/category/arrow instances * Rename const to yieldM and add yield * Remove "effect", it can be expressed by yieldM * Change order of arguments for some functions
This commit is contained in:
Harendra Kumar
parent
de06529fef
commit
a5e483b610
@ -115,7 +115,7 @@ lmapM size start =
|
||||
{-# INLINE supply #-}
|
||||
supply :: Monad m => Int -> Int -> m ()
|
||||
supply size start =
|
||||
drainTransformationDefault (size + start) (flip UF.supply start) undefined
|
||||
drainTransformationDefault (size + start) (UF.supply start) undefined
|
||||
|
||||
|
||||
{-# INLINE supplyFirst #-}
|
||||
@ -123,7 +123,7 @@ supplyFirst :: Monad m => Int -> Int -> m ()
|
||||
supplyFirst size start =
|
||||
drainTransformation
|
||||
(UF.take size UF.enumerateFromStepIntegral)
|
||||
(flip UF.supplyFirst start)
|
||||
(UF.supplyFirst start)
|
||||
1
|
||||
|
||||
{-# INLINE supplySecond #-}
|
||||
@ -131,7 +131,7 @@ supplySecond :: Monad m => Int -> Int -> m ()
|
||||
supplySecond size start =
|
||||
drainTransformation
|
||||
(UF.take size UF.enumerateFromStepIntegral)
|
||||
(flip UF.supplySecond 1)
|
||||
(UF.supplySecond 1)
|
||||
start
|
||||
|
||||
{-# INLINE discardFirst #-}
|
||||
@ -181,11 +181,6 @@ consM :: Monad m => Int -> Int -> m ()
|
||||
consM size start =
|
||||
drainTransformationDefault (size + start) (UF.consM return) start
|
||||
|
||||
{-# INLINE _effect #-}
|
||||
_effect :: Monad m => Int -> Int -> m ()
|
||||
_effect _ start =
|
||||
drainGeneration (UF.effect (return start)) undefined
|
||||
|
||||
{-# INLINE _singletonM #-}
|
||||
_singletonM :: Monad m => Int -> Int -> m ()
|
||||
_singletonM _ start = drainGeneration (UF.singletonM return) start
|
||||
@ -201,7 +196,7 @@ _identity _ start = drainGeneration UF.identity start
|
||||
{-# INLINE _const #-}
|
||||
_const :: Monad m => Int -> Int -> m ()
|
||||
_const size start =
|
||||
drainGeneration (UF.take size (UF.const (return start))) undefined
|
||||
drainGeneration (UF.take size (UF.yieldM (return start))) undefined
|
||||
|
||||
{-# INLINE unfoldrM #-}
|
||||
unfoldrM :: Monad m => Int -> Int -> m ()
|
||||
@ -413,7 +408,8 @@ toNullAp :: Monad m => Int -> Int -> m ()
|
||||
toNullAp value start =
|
||||
let end = start + nthRoot 2 value
|
||||
s = source end
|
||||
in UF.fold ((+) <$> s <*> s) FL.drain start
|
||||
-- in UF.fold ((+) <$> s <*> s) FL.drain start
|
||||
in UF.fold ((+) `fmap` s `UF.apply` s) FL.drain start
|
||||
|
||||
{-# INLINE _apDiscardFst #-}
|
||||
_apDiscardFst :: Int -> Int -> m ()
|
||||
@ -446,10 +442,15 @@ toNull :: Monad m => Int -> Int -> m ()
|
||||
toNull value start =
|
||||
let end = start + nthRoot 2 value
|
||||
src = source end
|
||||
{-
|
||||
u = do
|
||||
x <- src
|
||||
y <- src
|
||||
return (x + y)
|
||||
-}
|
||||
u = src `UF.bind` \x ->
|
||||
src `UF.bind` \y ->
|
||||
UF.yield (x + y)
|
||||
in UF.fold u FL.drain start
|
||||
|
||||
|
||||
@ -458,11 +459,16 @@ toNull3 :: Monad m => Int -> Int -> m ()
|
||||
toNull3 value start =
|
||||
let end = start + nthRoot 3 value
|
||||
src = source end
|
||||
{-
|
||||
u = do
|
||||
x <- src
|
||||
y <- src
|
||||
z <- src
|
||||
return (x + y + z)
|
||||
-}
|
||||
u = src `UF.bind` \x ->
|
||||
src `UF.bind` \y ->
|
||||
UF.yield (x + y)
|
||||
in UF.fold u FL.drain start
|
||||
|
||||
{-# INLINE toList #-}
|
||||
@ -470,10 +476,15 @@ toList :: Monad m => Int -> Int -> m [Int]
|
||||
toList value start = do
|
||||
let end = start + nthRoot 2 value
|
||||
src = source end
|
||||
{-
|
||||
u = do
|
||||
x <- src
|
||||
y <- src
|
||||
return (x + y)
|
||||
-}
|
||||
u = src `UF.bind` \x ->
|
||||
src `UF.bind` \y ->
|
||||
UF.yield (x + y)
|
||||
in UF.fold u FL.toList start
|
||||
|
||||
{-# INLINE toListSome #-}
|
||||
@ -481,10 +492,15 @@ toListSome :: Monad m => Int -> Int -> m [Int]
|
||||
toListSome value start = do
|
||||
let end = start + nthRoot 2 value
|
||||
src = source end
|
||||
{-
|
||||
u = do
|
||||
x <- src
|
||||
y <- src
|
||||
return (x + y)
|
||||
-}
|
||||
u = src `UF.bind` \x ->
|
||||
src `UF.bind` \y ->
|
||||
UF.yield (x + y)
|
||||
in UF.fold (UF.take 1000 u) FL.toList start
|
||||
|
||||
{-# INLINE filterAllOut #-}
|
||||
@ -492,13 +508,17 @@ filterAllOut :: Monad m => Int -> Int -> m ()
|
||||
filterAllOut value start = do
|
||||
let end = start + nthRoot 2 value
|
||||
src = source end
|
||||
{-
|
||||
u = do
|
||||
x <- src
|
||||
y <- src
|
||||
-}
|
||||
u = src `UF.bind` \x ->
|
||||
src `UF.bind` \y ->
|
||||
let s = x + y
|
||||
if s < 0
|
||||
then return s
|
||||
else UF.nilM (return . const ())
|
||||
in if s < 0
|
||||
then UF.yield s
|
||||
else UF.nilM (return . const ())
|
||||
in UF.fold u FL.drain start
|
||||
|
||||
{-# INLINE filterAllIn #-}
|
||||
@ -506,13 +526,17 @@ filterAllIn :: Monad m => Int -> Int -> m ()
|
||||
filterAllIn value start = do
|
||||
let end = start + nthRoot 2 value
|
||||
src = source end
|
||||
{-
|
||||
u = do
|
||||
x <- src
|
||||
y <- src
|
||||
-}
|
||||
u = src `UF.bind` \x ->
|
||||
src `UF.bind` \y ->
|
||||
let s = x + y
|
||||
if s > 0
|
||||
then return s
|
||||
else UF.nilM (return . const ())
|
||||
in if s > 0
|
||||
then UF.yield s
|
||||
else UF.nilM (return . const ())
|
||||
in UF.fold u FL.drain start
|
||||
|
||||
{-# INLINE filterSome #-}
|
||||
@ -520,13 +544,17 @@ filterSome :: Monad m => Int -> Int -> m ()
|
||||
filterSome value start = do
|
||||
let end = start + nthRoot 2 value
|
||||
src = source end
|
||||
{-
|
||||
u = do
|
||||
x <- src
|
||||
y <- src
|
||||
-}
|
||||
u = src `UF.bind` \x ->
|
||||
src `UF.bind` \y ->
|
||||
let s = x + y
|
||||
if s > 1100000
|
||||
then return s
|
||||
else UF.nilM (return . const ())
|
||||
in if s > 1100000
|
||||
then UF.yield s
|
||||
else UF.nilM (return . const ())
|
||||
in UF.fold u FL.drain start
|
||||
|
||||
{-# INLINE breakAfterSome #-}
|
||||
@ -534,13 +562,17 @@ breakAfterSome :: Int -> Int -> IO ()
|
||||
breakAfterSome value start =
|
||||
let end = start + nthRoot 2 value
|
||||
src = source end
|
||||
{-
|
||||
u = do
|
||||
x <- src
|
||||
y <- src
|
||||
-}
|
||||
u = src `UF.bind` \x ->
|
||||
src `UF.bind` \y ->
|
||||
let s = x + y
|
||||
if s > 1100000
|
||||
then error "break"
|
||||
else return s
|
||||
in if s > 1100000
|
||||
then error "break"
|
||||
else UF.yield s
|
||||
in do
|
||||
(_ :: Either ErrorCall ()) <- try $ UF.fold u FL.drain start
|
||||
return ()
|
||||
@ -594,7 +626,6 @@ o_1_space_generation size =
|
||||
-- Very small benchmarks, reporting in ns
|
||||
-- , benchIO "nilM" $ nilM size
|
||||
, benchIO "consM" $ consM size
|
||||
-- , benchIO "effect" $ effect size
|
||||
-- , benchIO "singletonM" $ singletonM size
|
||||
-- , benchIO "singleton" $ singleton size
|
||||
-- , benchIO "identity" $ identity size
|
||||
|
||||
@ -55,8 +55,64 @@ module Streamly.Data.Unfold
|
||||
(
|
||||
-- * Unfold Type
|
||||
Unfold
|
||||
|
||||
-- * Folding
|
||||
, fold
|
||||
|
||||
-- * Unfolds
|
||||
-- One to one correspondence with
|
||||
-- "Streamly.Internal.Data.Stream.IsStream.Generate"
|
||||
|
||||
-- ** Generators
|
||||
-- | Generate a monadic stream from a seed.
|
||||
, unfoldrM
|
||||
, repeatM
|
||||
, replicateM
|
||||
, iterateM
|
||||
|
||||
-- ** From Containers
|
||||
, fromList
|
||||
, fromListM
|
||||
, fromStream
|
||||
|
||||
-- * Combinators
|
||||
-- ** Mapping on Input
|
||||
, lmap
|
||||
, lmapM
|
||||
|
||||
-- ** Mapping on Output
|
||||
, mapM
|
||||
|
||||
-- ** Filtering
|
||||
, takeWhileM
|
||||
, takeWhile
|
||||
, take
|
||||
, filter
|
||||
, filterM
|
||||
, drop
|
||||
, dropWhile
|
||||
, dropWhileM
|
||||
|
||||
-- ** Zipping
|
||||
, zipWithM
|
||||
, zipWith
|
||||
|
||||
-- ** Nesting
|
||||
, cross
|
||||
, many
|
||||
|
||||
-- ** Exceptions
|
||||
, before
|
||||
, after
|
||||
, onException
|
||||
, finally
|
||||
, bracket
|
||||
, handle
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude hiding (concat, map, takeWhile, take, filter, const)
|
||||
import Prelude hiding
|
||||
( concat, map, mapM, takeWhile, take, filter, const, drop, dropWhile
|
||||
, zipWith
|
||||
)
|
||||
import Streamly.Internal.Data.Unfold
|
||||
|
||||
@ -75,9 +75,61 @@
|
||||
module Streamly.Internal.Data.Unfold
|
||||
(
|
||||
-- * Unfold Type
|
||||
Unfold
|
||||
Step(..)
|
||||
, Unfold
|
||||
|
||||
-- * Operations on Input
|
||||
-- * Folding
|
||||
, fold
|
||||
-- pipe
|
||||
|
||||
-- * Unfolds
|
||||
-- One to one correspondence with
|
||||
-- "Streamly.Internal.Data.Stream.IsStream.Generate"
|
||||
-- ** Primitives
|
||||
, singletonM
|
||||
, singleton
|
||||
, identity
|
||||
, yieldM
|
||||
, yield
|
||||
, nilM
|
||||
, consM
|
||||
|
||||
-- ** Generators
|
||||
-- | Generate a monadic stream from a seed.
|
||||
, unfoldrM
|
||||
, repeatM
|
||||
, replicateM
|
||||
, fromIndicesM
|
||||
, iterateM
|
||||
|
||||
-- ** Enumerations
|
||||
-- *** Enumerate Num
|
||||
, enumerateFromStepNum
|
||||
, numFrom
|
||||
|
||||
-- *** Enumerate Integral
|
||||
, enumerateFromStepIntegral
|
||||
, enumerateFromToIntegral
|
||||
, enumerateFromIntegral
|
||||
|
||||
-- *** Enumerate Fractional
|
||||
-- | Use 'Num' enumerations for fractional or floating point number
|
||||
-- enumerations.
|
||||
, enumerateFromToFractional
|
||||
|
||||
-- ** From Containers
|
||||
, fromList
|
||||
, fromListM
|
||||
|
||||
, fromStream
|
||||
, fromStreamK
|
||||
, fromStreamD
|
||||
|
||||
, fromSVar
|
||||
, fromProducer
|
||||
|
||||
-- * Combinators
|
||||
-- ** Mapping on Input
|
||||
, lmap
|
||||
, lmapM
|
||||
, supply
|
||||
@ -89,51 +141,12 @@ module Streamly.Internal.Data.Unfold
|
||||
-- coapply
|
||||
-- comonad
|
||||
|
||||
-- * Operations on Output
|
||||
, fold
|
||||
-- pipe
|
||||
|
||||
-- * Unfolds
|
||||
, fromStream
|
||||
, fromStreamK
|
||||
, fromStreamD
|
||||
, nilM
|
||||
, consM
|
||||
, effect
|
||||
, singletonM
|
||||
, singleton
|
||||
, identity
|
||||
, const
|
||||
, unfoldrM
|
||||
|
||||
, fromList
|
||||
, fromListM
|
||||
|
||||
, fromSVar
|
||||
, fromProducer
|
||||
|
||||
-- ** Specialized Generation
|
||||
-- | Generate a monadic stream from a seed.
|
||||
, replicateM
|
||||
, repeatM
|
||||
, iterateM
|
||||
, fromIndicesM
|
||||
|
||||
-- ** Enumerations
|
||||
, enumerateFromStepIntegral
|
||||
, enumerateFromToIntegral
|
||||
, enumerateFromIntegral
|
||||
|
||||
, enumerateFromStepNum
|
||||
, numFrom
|
||||
, enumerateFromToFractional
|
||||
|
||||
-- * Transformations
|
||||
-- ** Mapping on Output
|
||||
, map
|
||||
, mapM
|
||||
, mapMWithInput
|
||||
|
||||
-- * Filtering
|
||||
-- ** Filtering
|
||||
, takeWhileM
|
||||
, takeWhile
|
||||
, take
|
||||
@ -143,18 +156,21 @@ module Streamly.Internal.Data.Unfold
|
||||
, dropWhile
|
||||
, dropWhileM
|
||||
|
||||
-- * Zipping
|
||||
-- ** Zipping
|
||||
, zipWithM
|
||||
, zipWith
|
||||
, teeZipWith
|
||||
|
||||
-- * Nesting
|
||||
-- ** Nesting
|
||||
, cross
|
||||
, apply
|
||||
, ConcatState (..)
|
||||
, many
|
||||
, concatMapM
|
||||
, bind
|
||||
, outerProduct
|
||||
|
||||
-- * Exceptions
|
||||
-- ** Exceptions
|
||||
, gbracket_
|
||||
, gbracket
|
||||
, before
|
||||
@ -206,7 +222,7 @@ import Prelude
|
||||
-- | Map an action on the input argument of the 'Unfold'.
|
||||
--
|
||||
-- @
|
||||
-- lmapM f = many (singletonM f)
|
||||
-- lmapM f = Unfold.many (Unfold.singletonM f)
|
||||
-- @
|
||||
--
|
||||
-- /Pre-release/
|
||||
@ -214,47 +230,54 @@ import Prelude
|
||||
lmapM :: Monad m => (a -> m c) -> Unfold m c b -> Unfold m a b
|
||||
lmapM f (Unfold ustep uinject) = Unfold ustep (f >=> uinject)
|
||||
|
||||
-- XXX change the signature to the following?
|
||||
-- supply :: a -> Unfold m a b -> Unfold m Void b
|
||||
--
|
||||
-- | Supply the seed to an unfold closing the input end of the unfold.
|
||||
--
|
||||
-- @
|
||||
-- supply a = Unfold.lmap (Prelude.const a)
|
||||
-- @
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE_NORMAL supply #-}
|
||||
supply :: Unfold m a b -> a -> Unfold m Void b
|
||||
supply unf a = lmap (Prelude.const a) unf
|
||||
supply :: a -> Unfold m a b -> Unfold m Void b
|
||||
supply a = lmap (Prelude.const a)
|
||||
|
||||
-- XXX change the signature to the following?
|
||||
-- supplyFirst :: a -> Unfold m (a, b) c -> Unfold m b c
|
||||
--
|
||||
-- | Supply the first component of the tuple to an unfold that accepts a tuple
|
||||
-- as a seed resulting in a fold that accepts the second component of the tuple
|
||||
-- as a seed.
|
||||
--
|
||||
-- @
|
||||
-- supplyFirst a = Unfold.lmap (a, )
|
||||
-- @
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE_NORMAL supplyFirst #-}
|
||||
supplyFirst :: Unfold m (a, b) c -> a -> Unfold m b c
|
||||
supplyFirst unf a = lmap (a, ) unf
|
||||
supplyFirst :: a -> Unfold m (a, b) c -> Unfold m b c
|
||||
supplyFirst a = lmap (a, )
|
||||
|
||||
-- XXX change the signature to the following?
|
||||
-- supplySecond :: b -> Unfold m (a, b) c -> Unfold m a c
|
||||
--
|
||||
-- | Supply the second component of the tuple to an unfold that accepts a tuple
|
||||
-- as a seed resulting in a fold that accepts the first component of the tuple
|
||||
-- as a seed.
|
||||
--
|
||||
-- @
|
||||
-- supplySecond b = Unfold.lmap (, b)
|
||||
-- @
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE_NORMAL supplySecond #-}
|
||||
supplySecond :: Unfold m (a, b) c -> b -> Unfold m a c
|
||||
supplySecond unf b = lmap (, b) unf
|
||||
supplySecond :: b -> Unfold m (a, b) c -> Unfold m a c
|
||||
supplySecond b = lmap (, b)
|
||||
|
||||
-- | Convert an 'Unfold' into an unfold accepting a tuple as an argument,
|
||||
-- using the argument of the original fold as the second element of tuple and
|
||||
-- discarding the first element of the tuple.
|
||||
--
|
||||
-- @
|
||||
-- discardFirst = Unfold.lmap snd
|
||||
-- @
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE_NORMAL discardFirst #-}
|
||||
@ -265,6 +288,10 @@ discardFirst = lmap snd
|
||||
-- using the argument of the original fold as the first element of tuple and
|
||||
-- discarding the second element of the tuple.
|
||||
--
|
||||
-- @
|
||||
-- discardSecond = Unfold.lmap fst
|
||||
-- @
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE_NORMAL discardSecond #-}
|
||||
@ -274,6 +301,10 @@ discardSecond = lmap fst
|
||||
-- | Convert an 'Unfold' that accepts a tuple as an argument into an unfold
|
||||
-- that accepts a tuple with elements swapped.
|
||||
--
|
||||
-- @
|
||||
-- swap = Unfold.lmap Tuple.swap
|
||||
-- @
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE_NORMAL swap #-}
|
||||
@ -393,7 +424,8 @@ nilM f = Unfold step return
|
||||
{-# INLINE_LATE step #-}
|
||||
step x = f x >> return Stop
|
||||
|
||||
-- | Prepend a monadic single element generator function to an 'Unfold'.
|
||||
-- | Prepend a monadic single element generator function to an 'Unfold'. The
|
||||
-- same seed is used in the action as well as the unfold.
|
||||
--
|
||||
-- /Pre-release/
|
||||
{-# INLINE_NORMAL consM #-}
|
||||
@ -414,17 +446,6 @@ consM action unf = Unfold step inject
|
||||
Skip s -> return $ Skip (Right (Stream step1 s))
|
||||
Stop -> return Stop
|
||||
|
||||
-- | Lift a monadic effect into an unfold generating a singleton stream.
|
||||
--
|
||||
{-# INLINE effect #-}
|
||||
effect :: Monad m => m b -> Unfold m Void b
|
||||
effect eff = Unfold step inject
|
||||
where
|
||||
inject _ = return True
|
||||
{-# INLINE_LATE step #-}
|
||||
step True = eff >>= \r -> return $ Yield r False
|
||||
step False = return Stop
|
||||
|
||||
-- | Convert a list of pure values to a 'Stream'
|
||||
{-# INLINE_LATE fromList #-}
|
||||
fromList :: Monad m => Unfold m [a] a
|
||||
@ -514,6 +535,10 @@ iterateM f = Unfold step id
|
||||
-- | @fromIndicesM gen@ generates an infinite stream of values using @gen@
|
||||
-- starting from the seed.
|
||||
--
|
||||
-- @
|
||||
-- fromIndicesM f = Unfold.mapM f $ Unfold.enumerateFrom 0
|
||||
-- @
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE_NORMAL fromIndicesM #-}
|
||||
@ -655,9 +680,37 @@ dropWhileM f (Unfold step inject) = Unfold step' inject'
|
||||
dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b
|
||||
dropWhile f = dropWhileM (return . f)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Enumeration
|
||||
-------------------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
-- Enumeration of Num
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- | Generate an infinite stream starting from a starting value with increments
|
||||
-- of the given stride. The implementation is numerically stable for floating
|
||||
-- point values.
|
||||
--
|
||||
-- Note 'enumerateFromStepIntegral' is faster for integrals.
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE enumerateFromStepNum #-}
|
||||
enumerateFromStepNum :: (Monad m, Num a) => a -> Unfold m a a
|
||||
enumerateFromStepNum stride = Unfold step return
|
||||
where
|
||||
-- XXX This is numerically unstable.
|
||||
{-# INLINE_LATE step #-}
|
||||
step !s = return $ (Yield $! s) $! (s + stride)
|
||||
|
||||
-- | @numFrom = enumerateFromStepNum 1@
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE_NORMAL numFrom #-}
|
||||
numFrom :: (Monad m, Num a) => Unfold m a a
|
||||
numFrom = enumerateFromStepNum 1
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Enumeration of Integrals
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- | Can be used to enumerate unbounded integrals. This does not check for
|
||||
-- overflow or underflow for bounded integrals.
|
||||
@ -674,34 +727,20 @@ enumerateFromStepIntegral = Unfold step inject
|
||||
{-# INLINE enumerateFromToIntegral #-}
|
||||
enumerateFromToIntegral :: (Monad m, Integral a) => a -> Unfold m a a
|
||||
enumerateFromToIntegral to =
|
||||
takeWhile (<= to) $ supplySecond enumerateFromStepIntegral 1
|
||||
takeWhile (<= to) $ supplySecond 1 enumerateFromStepIntegral
|
||||
|
||||
{-# INLINE enumerateFromIntegral #-}
|
||||
enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => Unfold m a a
|
||||
enumerateFromIntegral = enumerateFromToIntegral maxBound
|
||||
|
||||
-- | Generate an infinite stream starting from the seed with increments of the
|
||||
-- given stride.
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE enumerateFromStepNum #-}
|
||||
enumerateFromStepNum :: (Monad m, Num a) => a -> Unfold m a a
|
||||
enumerateFromStepNum stride = Unfold step return
|
||||
where
|
||||
{-# INLINE_LATE step #-}
|
||||
step !s = return $ (Yield $! s) $! (s + stride)
|
||||
|
||||
-- | @numFrom = enumerateFromStepNum 1@
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE_NORMAL numFrom #-}
|
||||
numFrom :: (Monad m, Num a) => Unfold m a a
|
||||
numFrom = enumerateFromStepNum 1
|
||||
------------------------------------------------------------------------------
|
||||
-- Enumeration of Fractionals
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- | /Internal/
|
||||
--
|
||||
-- > enumerateFromToFractional to = takeWhile (<= to + 1 / 2) $ enumerateFromStepNum 1
|
||||
--
|
||||
{-# INLINE_NORMAL enumerateFromToFractional #-}
|
||||
enumerateFromToFractional :: (Monad m, Fractional a, Ord a) => a -> Unfold m a a
|
||||
enumerateFromToFractional to =
|
||||
@ -862,6 +901,7 @@ data OuterProductState s1 s2 sy x y =
|
||||
OuterProductOuter s1 y | OuterProductInner s1 sy s2 x
|
||||
|
||||
-- XXX this can be written in terms of "cross".
|
||||
-- XXX Remove this in favor of cross?
|
||||
--
|
||||
-- | Create an outer product (vector product or cartesian product) of the
|
||||
-- output streams of two unfolds.
|
||||
|
||||
@ -8,19 +8,31 @@
|
||||
|
||||
module Streamly.Internal.Data.Unfold.Type
|
||||
( Unfold (..)
|
||||
|
||||
-- * From values
|
||||
, singletonM
|
||||
, singleton
|
||||
, identity
|
||||
, ConcatState (..)
|
||||
, many
|
||||
, yieldM
|
||||
, yield
|
||||
|
||||
-- * Transformations
|
||||
, lmap
|
||||
, map
|
||||
, const
|
||||
|
||||
-- * Nesting
|
||||
, ConcatState (..)
|
||||
, many
|
||||
|
||||
, apSequence
|
||||
, apDiscardSnd
|
||||
, cross
|
||||
, apply
|
||||
, bind
|
||||
|
||||
, concatMapM
|
||||
, concatMap
|
||||
|
||||
, zipWithM
|
||||
, zipWith
|
||||
)
|
||||
@ -28,8 +40,8 @@ where
|
||||
|
||||
#include "inline.hs"
|
||||
|
||||
import Control.Arrow (Arrow(..))
|
||||
import Control.Category (Category(..))
|
||||
-- import Control.Arrow (Arrow(..))
|
||||
-- import Control.Category (Category(..))
|
||||
import Fusion.Plugin.Types (Fuse(..))
|
||||
import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))
|
||||
|
||||
@ -60,7 +72,7 @@ data Unfold m a b =
|
||||
-- | Map a function on the input argument of the 'Unfold'.
|
||||
--
|
||||
-- @
|
||||
-- lmap f = many (singleton f)
|
||||
-- lmap f = Unfold.many (Unfold.singleton f)
|
||||
-- @
|
||||
--
|
||||
-- /Pre-release/
|
||||
@ -93,9 +105,12 @@ instance Functor m => Functor (Unfold m a) where
|
||||
-- Applicative
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE const #-}
|
||||
const :: Applicative m => m b -> Unfold m a b
|
||||
const m = Unfold step inject
|
||||
-- | The unfold discards its input and generates a singleton stream using the
|
||||
-- supplied monadic action.
|
||||
--
|
||||
{-# INLINE yieldM #-}
|
||||
yieldM :: Applicative m => m b -> Unfold m a b
|
||||
yieldM m = Unfold step inject
|
||||
|
||||
where
|
||||
|
||||
@ -104,6 +119,10 @@ const m = Unfold step inject
|
||||
step False = (`Yield` True) <$> m
|
||||
step True = pure Stop
|
||||
|
||||
-- | Discards the unfold input and always returns the argument of 'yield'.
|
||||
yield :: Applicative m => b -> Unfold m a b
|
||||
yield = yieldM . pure
|
||||
|
||||
-- | Outer product discarding the first element.
|
||||
--
|
||||
-- /Unimplemented/
|
||||
@ -154,9 +173,15 @@ cross (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject
|
||||
Skip s -> Skip (CrossInner a s1 b s)
|
||||
Stop -> Skip (CrossOuter a s1)
|
||||
|
||||
apply :: Monad m => Unfold m a (b -> c) -> Unfold m a b -> Unfold m a c
|
||||
apply u1 u2 = fmap (\(a, b) -> a b) (cross u1 u2)
|
||||
|
||||
{-
|
||||
-- | Example:
|
||||
--
|
||||
-- >>> Stream.toList $ Stream.unfold ((,) <$> Unfold.lmap fst Unfold.fromList <*> Unfold.lmap snd Unfold.fromList) ([1,2],[3,4])
|
||||
-- >>> rlist = Unfold.lmap fst Unfold.fromList
|
||||
-- >>> llist = Unfold.lmap snd Unfold.fromList
|
||||
-- >>> Stream.toList $ Stream.unfold ((,) <$> rlist <*> llist) ([1,2],[3,4])
|
||||
-- [(1,3),(1,4),(2,3),(2,4)]
|
||||
--
|
||||
instance Monad m => Applicative (Unfold m a) where
|
||||
@ -164,13 +189,14 @@ instance Monad m => Applicative (Unfold m a) where
|
||||
pure = const Prelude.. return
|
||||
|
||||
{-# INLINE (<*>) #-}
|
||||
u1 <*> u2 = fmap (\(a, b) -> a b) (cross u1 u2)
|
||||
(<*>) = apply
|
||||
|
||||
-- {-# INLINE (*>) #-}
|
||||
-- (*>) = apSequence
|
||||
|
||||
-- {-# INLINE (<*) #-}
|
||||
-- (<*) = apDiscardSnd
|
||||
-}
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Monad
|
||||
@ -216,15 +242,30 @@ concatMapM f (Unfold step1 inject1) = Unfold step inject
|
||||
concatMap :: Monad m => (b -> Unfold m a c) -> Unfold m a b -> Unfold m a c
|
||||
concatMap f = concatMapM (return Prelude.. f)
|
||||
|
||||
infixl 1 `bind`
|
||||
|
||||
{-# INLINE bind #-}
|
||||
bind :: Monad m => Unfold m a b -> (b -> Unfold m a c) -> Unfold m a c
|
||||
bind = flip concatMap
|
||||
|
||||
{-
|
||||
-- Note: concatMap and Monad instance for unfolds have performance comparable
|
||||
-- to Stream. In fact, concatMap is slower than Stream, that may be some
|
||||
-- optimization issue though.
|
||||
--
|
||||
-- Monad allows an unfold to depend on the output of a previous unfold.
|
||||
-- However, it is probably easier to use streams in such situations.
|
||||
--
|
||||
-- | Example:
|
||||
--
|
||||
-- >>> u = do { x <- Unfold.lmap fst Unfold.fromList; y <- Unfold.lmap snd Unfold.fromList; return (x,y); }
|
||||
-- >>> Stream.toList $ Stream.unfold u ([1,2],[3,4])
|
||||
-- [(1,3),(1,4),(2,3),(2,4)]
|
||||
-- >>> :{
|
||||
-- u = do
|
||||
-- x <- Unfold.enumerateFromToIntegral 4
|
||||
-- y <- Unfold.enumerateFromToIntegral x
|
||||
-- return (x, y)
|
||||
-- :}
|
||||
-- >>> Stream.toList $ Stream.unfold u 1
|
||||
-- [(1,1),(2,1),(2,2),(3,1),(3,2),(3,3),(4,1),(4,2),(4,3),(4,4)]
|
||||
--
|
||||
instance Monad m => Monad (Unfold m a) where
|
||||
{-# INLINE return #-}
|
||||
@ -235,6 +276,7 @@ instance Monad m => Monad (Unfold m a) where
|
||||
|
||||
-- {-# INLINE (>>) #-}
|
||||
-- (>>) = (*>)
|
||||
-}
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Category
|
||||
@ -258,6 +300,8 @@ singletonM f = Unfold step inject
|
||||
|
||||
-- | Lift a pure function into an unfold generating a singleton stream.
|
||||
--
|
||||
-- > singleton f = singletonM $ return . f
|
||||
--
|
||||
{-# INLINE singleton #-}
|
||||
singleton :: Monad m => (a -> b) -> Unfold m a b
|
||||
singleton f = singletonM $ return Prelude.. f
|
||||
@ -265,11 +309,11 @@ singleton f = singletonM $ return Prelude.. f
|
||||
-- | Identity unfold. Generates a singleton stream with the seed as the only
|
||||
-- element in the stream.
|
||||
--
|
||||
-- > identity = singletonM return
|
||||
-- > identity = singleton Prelude.id
|
||||
--
|
||||
{-# INLINE identity #-}
|
||||
identity :: Monad m => Unfold m a a
|
||||
identity = singletonM return
|
||||
identity = singleton Prelude.id
|
||||
|
||||
{-# ANN type ConcatState Fuse #-}
|
||||
data ConcatState s1 s2 = ConcatOuter s1 | ConcatInner s1 s2
|
||||
@ -306,17 +350,25 @@ many (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject
|
||||
Skip s -> Skip (ConcatInner ost s)
|
||||
Stop -> Skip (ConcatOuter ost)
|
||||
|
||||
{-
|
||||
-- XXX There are multiple possible ways to combine the unfolds, "many" appends
|
||||
-- them, we could also have other variants of "many" e.g. manyInterleave.
|
||||
-- Should we even have a category instance or just use these functions
|
||||
-- directly?
|
||||
--
|
||||
instance Monad m => Category (Unfold m) where
|
||||
{-# INLINE id #-}
|
||||
id = identity
|
||||
|
||||
{-# INLINE (.) #-}
|
||||
(.) = flip many
|
||||
-}
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Arrow
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- | Stops as soon as any of the unfolds stops.
|
||||
{-# INLINE_NORMAL zipWithM #-}
|
||||
zipWithM :: Monad m
|
||||
=> (a -> b -> m c) -> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c
|
||||
@ -364,6 +416,16 @@ zipWith :: Monad m
|
||||
=> (a -> b -> c) -> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c
|
||||
zipWith f = zipWithM (\a b -> return (f a b))
|
||||
|
||||
{-
|
||||
-- XXX There are multiple ways of combining the outputs of two unfolds, we
|
||||
-- could zip, merge, append and more. What is the preferred way for Arrow
|
||||
-- instance? Should we even have an arrow instance or just use these functions
|
||||
-- directly?
|
||||
--
|
||||
-- | '***' is a zip like operation, in fact it is the same as @Unfold.zipWith
|
||||
-- (,)@, '&&&' is a tee like operation i.e. distributes the input to both the
|
||||
-- unfolds and then zips the output.
|
||||
--
|
||||
{-# ANN module "HLint: ignore Use zip" #-}
|
||||
instance Monad m => Arrow (Unfold m) where
|
||||
{-# INLINE arr #-}
|
||||
@ -371,3 +433,4 @@ instance Monad m => Arrow (Unfold m) where
|
||||
|
||||
{-# INLINE (***) #-}
|
||||
(***) = zipWith (,)
|
||||
-}
|
||||
|
||||
@ -262,7 +262,7 @@ getBytes = toBytes stdin
|
||||
-- @since 0.7.0
|
||||
{-# INLINE readChunks #-}
|
||||
readChunks :: MonadIO m => Unfold m Handle (Array Word8)
|
||||
readChunks = UF.supplyFirst readChunksWithBufferOf defaultChunkSize
|
||||
readChunks = UF.supplyFirst defaultChunkSize readChunksWithBufferOf
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Read File to Stream
|
||||
@ -299,7 +299,7 @@ toBytesWithBufferOf chunkSize h = AS.concat $ toChunksWithBufferOf chunkSize h
|
||||
-- @since 0.7.0
|
||||
{-# INLINE read #-}
|
||||
read :: MonadIO m => Unfold m Handle Word8
|
||||
read = UF.supplyFirst readWithBufferOf defaultChunkSize
|
||||
read = UF.supplyFirst defaultChunkSize readWithBufferOf
|
||||
|
||||
-- | Generate a byte stream from a file 'Handle'.
|
||||
--
|
||||
|
||||
@ -161,7 +161,7 @@ acceptOnAddr = acceptOnAddrWith []
|
||||
acceptOnPortWith :: MonadIO m
|
||||
=> [(SocketOption, Int)]
|
||||
-> Unfold m PortNumber Socket
|
||||
acceptOnPortWith opts = UF.supplyFirst (acceptOnAddrWith opts) (0,0,0,0)
|
||||
acceptOnPortWith opts = UF.supplyFirst (0,0,0,0) (acceptOnAddrWith opts)
|
||||
|
||||
-- | Like 'acceptOnAddr' but binds on the IPv4 address @0.0.0.0@ i.e. on all
|
||||
-- IPv4 addresses/interfaces of the machine and listens for TCP connections on
|
||||
@ -172,7 +172,7 @@ acceptOnPortWith opts = UF.supplyFirst (acceptOnAddrWith opts) (0,0,0,0)
|
||||
-- @since 0.7.0
|
||||
{-# INLINE acceptOnPort #-}
|
||||
acceptOnPort :: MonadIO m => Unfold m PortNumber Socket
|
||||
acceptOnPort = UF.supplyFirst acceptOnAddr (0,0,0,0)
|
||||
acceptOnPort = UF.supplyFirst (0,0,0,0) acceptOnAddr
|
||||
|
||||
-- | Like 'acceptOnAddr' but binds on the localhost IPv4 address @127.0.0.1@.
|
||||
-- The server can only be accessed from the local host, it cannot be accessed
|
||||
@ -183,7 +183,7 @@ acceptOnPort = UF.supplyFirst acceptOnAddr (0,0,0,0)
|
||||
-- @since 0.7.0
|
||||
{-# INLINE acceptOnPortLocal #-}
|
||||
acceptOnPortLocal :: MonadIO m => Unfold m PortNumber Socket
|
||||
acceptOnPortLocal = UF.supplyFirst acceptOnAddr (127,0,0,1)
|
||||
acceptOnPortLocal = UF.supplyFirst (127,0,0,1) acceptOnAddr
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Accept (streams)
|
||||
|
||||
@ -387,7 +387,7 @@ readChunksWithBufferOf = Unfold step return
|
||||
-- @since 0.7.0
|
||||
{-# INLINE readChunks #-}
|
||||
readChunks :: MonadIO m => Unfold m Socket (Array Word8)
|
||||
readChunks = UF.supplyFirst readChunksWithBufferOf A.defaultChunkSize
|
||||
readChunks = UF.supplyFirst A.defaultChunkSize readChunksWithBufferOf
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Read File to Stream
|
||||
@ -434,7 +434,7 @@ readWithBufferOf = UF.many readChunksWithBufferOf A.read
|
||||
-- @since 0.7.0
|
||||
{-# INLINE read #-}
|
||||
read :: MonadIO m => Unfold m Socket Word8
|
||||
read = UF.supplyFirst readWithBufferOf A.defaultChunkSize
|
||||
read = UF.supplyFirst A.defaultChunkSize readWithBufferOf
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Writing
|
||||
|
||||
@ -72,17 +72,17 @@ lmapM =
|
||||
|
||||
supply :: Bool
|
||||
supply =
|
||||
let unf = UF.supply (UF.singleton id) 1
|
||||
let unf = UF.supply 1 (UF.singleton id)
|
||||
in testUnfold unf undefined ([1] :: [Int])
|
||||
|
||||
supplyFirst :: Bool
|
||||
supplyFirst =
|
||||
let unf = UF.supplyFirst (UF.singleton id) 1
|
||||
let unf = UF.supplyFirst 1 (UF.singleton id)
|
||||
in testUnfold unf 2 ([(1, 2)] :: [(Int, Int)])
|
||||
|
||||
supplySecond :: Bool
|
||||
supplySecond =
|
||||
let unf = UF.supplySecond (UF.singleton id) 1
|
||||
let unf = UF.supplySecond 1 (UF.singleton id)
|
||||
in testUnfold unf 2 ([(2, 1)] :: [(Int, Int)])
|
||||
|
||||
discardFirst :: Bool
|
||||
@ -134,11 +134,6 @@ consM =
|
||||
unf = cns $ cns $ UF.nilM $ \a -> modify (+ a)
|
||||
in testUnfoldMD unf 1 0 3 [1, 2]
|
||||
|
||||
effect :: Bool
|
||||
effect =
|
||||
let unf = UF.effect (modify (+ 1) >> get)
|
||||
in testUnfoldMD unf undefined 0 1 [1]
|
||||
|
||||
singletonM :: Bool
|
||||
singletonM =
|
||||
let unf = UF.singletonM (\a -> modify (+ a) >> get)
|
||||
@ -146,7 +141,7 @@ singletonM =
|
||||
|
||||
const :: Bool
|
||||
const =
|
||||
let unf = UF.const (modify (+ 1) >> get)
|
||||
let unf = UF.yieldM (modify (+ 1) >> get)
|
||||
in testUnfoldMD unf (0 :: Int) 0 1 [1]
|
||||
|
||||
unfoldrM :: Property
|
||||
@ -380,7 +375,6 @@ testGeneration =
|
||||
prop "fromStreamD" fromStreamD
|
||||
prop "nilM" nilM
|
||||
prop "consM" consM
|
||||
prop "effect" effect
|
||||
prop "singletonM" singletonM
|
||||
-- prop "singleton" singleton
|
||||
-- prop "identity" identity
|
||||
|
||||
@ -457,7 +457,7 @@ unfold0 :: Property
|
||||
unfold0 = monadicIO $ do
|
||||
a <- pick $ choose (0, max_length `div` 2)
|
||||
b <- pick $ choose (0, max_length)
|
||||
let unf = UF.supply (UF.enumerateFromToIntegral b) a
|
||||
let unf = UF.supply a (UF.enumerateFromToIntegral b)
|
||||
ls <- S.toList $ IS.unfold0 unf
|
||||
return $ ls == [a..b]
|
||||
|
||||
|
||||
@ -1202,7 +1202,7 @@ transformCombineOpsCommon constr desc eq t = do
|
||||
forAll (choose (0, 100)) $ \n ->
|
||||
transform (concatMap (const [1..n]))
|
||||
t (S.unfoldMany (UF.lmap (const undefined)
|
||||
$ UF.supply UF.fromList [1..n]))
|
||||
$ UF.supply [1..n] UF.fromList))
|
||||
|
||||
toListFL :: Monad m => FL.Fold m a [a]
|
||||
toListFL = FL.toList
|
||||
|
||||
Loading…
Reference in New Issue
Block a user