1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
{-# LANGUAGE RankNTypes #-}
-- | Internal helper functions, usually used for rewrite rules.
module Data.Conduit.Combinators.Internal
( initReplicate
, initReplicateConnect
, initRepeat
, initRepeatConnect
) where
import Data.Conduit
import Data.Conduit.Internal (ConduitM (..), Pipe (..), injectLeftovers)
import Data.Void (absurd)
import Control.Monad.Trans.Class (lift)
import Control.Monad (replicateM_, forever)
-- | Acquire the seed value and perform the given action with it n times,
-- yielding each result.
--
-- Since 0.2.1
initReplicate :: Monad m => m seed -> (seed -> m a) -> Int -> Producer m a
initReplicate mseed f cnt = do
seed <- lift mseed
replicateM_ cnt (lift (f seed) >>= yield)
{-# INLINE [1] initReplicate #-}
-- | Optimized version of initReplicate for the special case of connecting with
-- a @Sink@.
--
-- Since 0.2.1
initReplicateConnect :: Monad m
=> m seed
-> (seed -> m a)
-> Int
-> Sink a m b
-> m b
initReplicateConnect mseed f cnt0 (ConduitM sink0) = do
seed <- mseed
let loop cnt sink | cnt <= 0 = finish sink
loop _ (Done r) = return r
loop cnt (NeedInput p _) = f seed >>= loop (pred cnt) . p
loop _ (HaveOutput _ _ o) = absurd o
loop cnt (PipeM mp) = mp >>= loop cnt
loop _ (Leftover _ i) = absurd i
loop cnt0 (injectLeftovers sink0)
where
finish (Done r) = return r
finish (HaveOutput _ _ o) = absurd o
finish (NeedInput _ p) = finish (p ())
finish (PipeM mp) = mp >>= finish
finish (Leftover _ i) = absurd i
{-# RULES "initReplicateConnect" forall mseed f cnt sink.
initReplicate mseed f cnt $$ sink
= initReplicateConnect mseed f cnt sink
#-}
-- | Acquire the seed value and perform the given action with it forever,
-- yielding each result.
--
-- Since 0.2.1
initRepeat :: Monad m => m seed -> (seed -> m a) -> Producer m a
initRepeat mseed f = do
seed <- lift mseed
forever $ lift (f seed) >>= yield
-- | Optimized version of initRepeat for the special case of connecting with
-- a @Sink@.
--
-- Since 0.2.1
initRepeatConnect :: Monad m
=> m seed
-> (seed -> m a)
-> Sink a m b
-> m b
initRepeatConnect mseed f (ConduitM sink0) = do
seed <- mseed
let loop (Done r) = return r
loop (NeedInput p _) = f seed >>= loop . p
loop (HaveOutput _ _ o) = absurd o
loop (PipeM mp) = mp >>= loop
loop (Leftover _ i) = absurd i
loop (injectLeftovers sink0)
{-# RULES "initRepeatConnect" forall mseed f sink.
initRepeat mseed f $$ sink
= initRepeatConnect mseed f sink
#-}
|
