1{-# LANGUAGE ViewPatterns #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE RankNTypes #-}
5{-# LANGUAGE CPP #-}
6module Data.Conduit.StreamSpec where
7
8import           Control.Applicative
9import qualified Control.Monad
10import           Control.Monad (MonadPlus(..), liftM)
11import           Control.Monad.Identity (Identity, runIdentity)
12import           Control.Monad.State (StateT(..), get, put)
13import           Data.Conduit
14import           Data.Conduit.Internal.Fusion
15import           Data.Conduit.Internal.List.Stream
16import           Data.Conduit.List
17import qualified Data.Foldable as F
18import           Data.Function (on)
19import qualified Data.List
20import qualified Data.Maybe
21import           Data.Monoid (Monoid(..))
22import           Data.Semigroup (Semigroup(..))
23import           Prelude
24    ((.), ($), (>>=), (=<<), return, (==), Int, id, Maybe(..), Monad,
25     Eq, Show, String, Functor, fst, snd)
26import qualified Prelude
27import qualified Safe
28import           Test.Hspec
29import           Test.QuickCheck
30
31spec :: Spec
32spec = describe "Comparing list function to" $ do
33    qit "unfold" $
34        \(getBlind -> f, initial :: Int) ->
35            unfold f initial `checkInfiniteProducer`
36            (Data.List.unfoldr f initial :: [Int])
37    qit "unfoldS" $
38        \(getBlind -> f, initial :: Int) ->
39            unfoldS f initial `checkInfiniteStreamProducer`
40            (Data.List.unfoldr f initial :: [Int])
41    qit "unfoldM" $
42        \(getBlind -> f, initial :: Int) ->
43            unfoldM f initial `checkInfiniteProducerM`
44            (unfoldrM f initial :: M [Int])
45    qit "unfoldMS" $
46        \(getBlind -> f, initial :: Int) ->
47            unfoldMS f initial `checkInfiniteStreamProducerM`
48            (unfoldrM f initial :: M [Int])
49    qit "sourceList" $
50        \(xs :: [Int]) ->
51            sourceList xs `checkProducer` xs
52    qit "sourceListS" $
53        \(xs :: [Int]) ->
54            sourceListS xs `checkStreamProducer` xs
55    qit "enumFromTo" $
56        \(fr :: Small Int, to :: Small Int) ->
57            enumFromTo fr to `checkProducer`
58            Prelude.enumFromTo fr to
59    qit "enumFromToS" $
60        \(fr :: Small Int, to :: Small Int) ->
61            enumFromToS fr to `checkStreamProducer`
62            Prelude.enumFromTo fr to
63    qit "enumFromToS_int" $
64        \(getSmall -> fr :: Int, getSmall -> to :: Int) ->
65            enumFromToS_int fr to `checkStreamProducer`
66            Prelude.enumFromTo fr to
67    qit "iterate" $
68        \(getBlind -> f, initial :: Int) ->
69            iterate f initial `checkInfiniteProducer`
70            Prelude.iterate f initial
71    qit "iterateS" $
72        \(getBlind -> f, initial :: Int) ->
73            iterateS f initial `checkInfiniteStreamProducer`
74            Prelude.iterate f initial
75    qit "replicate" $
76        \(getSmall -> n, getSmall -> x) ->
77            replicate n x `checkProducer`
78            (Prelude.replicate n x :: [Int])
79    qit "replicateS" $
80        \(getSmall -> n, getSmall -> x) ->
81            replicateS n x `checkStreamProducer`
82            (Prelude.replicate n x :: [Int])
83    qit "replicateM" $
84        \(getSmall -> n, getBlind -> f) ->
85            replicateM n f `checkProducerM`
86            (Control.Monad.replicateM n f :: M [Int])
87    qit "replicateMS" $
88        \(getSmall -> n, getBlind -> f) ->
89            replicateMS n f `checkStreamProducerM`
90            (Control.Monad.replicateM n f :: M [Int])
91    qit "fold" $
92        \(getBlind -> f, initial :: Int) ->
93            fold f initial `checkConsumer`
94            Data.List.foldl' f initial
95    qit "foldS" $
96        \(getBlind -> f, initial :: Int) ->
97            foldS f initial `checkStreamConsumer`
98            Data.List.foldl' f initial
99    qit "foldM" $
100        \(getBlind -> f, initial :: Int) ->
101            foldM f initial `checkConsumerM`
102            (Control.Monad.foldM f initial :: [Int] -> M Int)
103    qit "foldMS" $
104        \(getBlind -> f, initial :: Int) ->
105            foldMS f initial `checkStreamConsumerM`
106            (Control.Monad.foldM f initial :: [Int] -> M Int)
107    qit "foldMap" $
108        \(getBlind -> (f :: Int -> Sum Int)) ->
109            foldMap f `checkConsumer`
110            F.foldMap f
111    qit "mapM_" $
112        \(getBlind -> (f :: Int -> M ())) ->
113            mapM_ f `checkConsumerM`
114            Prelude.mapM_ f
115    qit "mapM_S" $
116        \(getBlind -> (f :: Int -> M ())) ->
117            mapM_S f `checkStreamConsumerM`
118            Prelude.mapM_ f
119    qit "take" $
120        \(getSmall -> n) ->
121            take n `checkConsumer`
122            Prelude.take n
123    qit "takeS" $
124        \(getSmall -> n) ->
125            takeS n `checkStreamConsumer`
126            Prelude.take n
127    qit "head" $
128        \() ->
129            head `checkConsumer`
130            Safe.headMay
131    qit "headS" $
132        \() ->
133            headS `checkStreamConsumer`
134            Safe.headMay
135    qit "peek" $
136        \() ->
137            peek `checkConsumer`
138            Safe.headMay
139    qit "map" $
140        \(getBlind -> (f :: Int -> Int)) ->
141            map f `checkConduit`
142            Prelude.map f
143    qit "mapS" $
144        \(getBlind -> (f :: Int -> Int)) ->
145            mapS f `checkStreamConduit`
146            Prelude.map f
147    qit "mapM" $
148        \(getBlind -> (f :: Int -> M Int)) ->
149            mapM f `checkConduitT`
150            Prelude.mapM f
151    qit "mapMS" $
152        \(getBlind -> (f :: Int -> M Int)) ->
153            mapMS f `checkStreamConduitT`
154            Prelude.mapM f
155    qit "iterM" $
156        \(getBlind -> (f :: Int -> M ())) ->
157            iterM f `checkConduitT`
158            iterML f
159    qit "iterMS" $
160        \(getBlind -> (f :: Int -> M ())) ->
161            iterMS f `checkStreamConduitT`
162            iterML f
163    qit "mapMaybe" $
164        \(getBlind -> (f :: Int -> Maybe Int)) ->
165            mapMaybe f `checkConduit`
166            Data.Maybe.mapMaybe f
167    qit "mapMaybeS" $
168        \(getBlind -> (f :: Int -> Maybe Int)) ->
169            mapMaybeS f `checkStreamConduit`
170            Data.Maybe.mapMaybe f
171    qit "mapMaybeM" $
172        \(getBlind -> (f :: Int -> M (Maybe Int))) ->
173            mapMaybeM f `checkConduitT`
174            mapMaybeML f
175    qit "mapMaybeMS" $
176        \(getBlind -> (f :: Int -> M (Maybe Int))) ->
177            mapMaybeMS f `checkStreamConduitT`
178            mapMaybeML f
179    qit "catMaybes" $
180        \() ->
181            catMaybes `checkConduit`
182            (Data.Maybe.catMaybes :: [Maybe Int] -> [Int])
183    qit "catMaybesS" $
184        \() ->
185            catMaybesS `checkStreamConduit`
186            (Data.Maybe.catMaybes :: [Maybe Int] -> [Int])
187    qit "concat" $
188        \() ->
189            concat `checkConduit`
190            (Prelude.concat :: [[Int]] -> [Int])
191    qit "concatS" $
192        \() ->
193            concatS `checkStreamConduit`
194            (Prelude.concat :: [[Int]] -> [Int])
195    qit "concatMap" $
196        \(getBlind -> f) ->
197            concatMap f `checkConduit`
198            (Prelude.concatMap f :: [Int] -> [Int])
199    qit "concatMapS" $
200        \(getBlind -> f) ->
201            concatMapS f `checkStreamConduit`
202            (Prelude.concatMap f :: [Int] -> [Int])
203    qit "concatMapM" $
204        \(getBlind -> (f :: Int -> M [Int])) ->
205            concatMapM f `checkConduitT`
206            concatMapML f
207    qit "concatMapMS" $
208        \(getBlind -> (f :: Int -> M [Int])) ->
209            concatMapMS f `checkStreamConduitT`
210            concatMapML f
211    qit "concatMapAccum" $
212        \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->
213            concatMapAccum f initial `checkConduit`
214            concatMapAccumL f initial
215    qit "concatMapAccumS" $
216        \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->
217            concatMapAccumS f initial `checkStreamConduit`
218            concatMapAccumL f initial
219    {-qit "mapAccum" $
220        \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->
221            mapAccum f initial `checkConduitResult`
222            mapAccumL f initial-}
223    qit "mapAccumS" $
224        \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->
225            mapAccumS f initial `checkStreamConduitResult`
226            mapAccumL f initial
227    {-qit "mapAccumM" $
228        \(getBlind -> (f :: Int -> Int -> M (Int, [Int])), initial :: Int) ->
229            mapAccumM f initial `checkConduitResultM`
230            mapAccumML f initial-}
231    qit "mapAccumMS" $
232        \(getBlind -> (f :: Int -> Int -> M (Int, [Int])), initial :: Int) ->
233            mapAccumMS f initial `checkStreamConduitResultM`
234            mapAccumML f initial
235    {-qit "scan" $
236        \(getBlind -> (f :: Int -> Int -> Int), initial :: Int) ->
237            scan f initial `checkConduitResult`
238            scanL f initial-}
239    {-qit "scanM" $
240        \(getBlind -> (f :: Int -> Int -> M Int), initial :: Int) ->
241            scanM f initial `checkConduitResultM`
242            scanML f initial-}
243    qit "mapFoldable" $
244        \(getBlind -> (f :: Int -> [Int])) ->
245            mapFoldable f `checkConduit`
246            mapFoldableL f
247    qit "mapFoldableS" $
248        \(getBlind -> (f :: Int -> [Int])) ->
249            mapFoldableS f `checkStreamConduit`
250            mapFoldableL f
251    qit "mapFoldableM" $
252        \(getBlind -> (f :: Int -> M [Int])) ->
253            mapFoldableM f `checkConduitT`
254            mapFoldableML f
255    qit "mapFoldableMS" $
256        \(getBlind -> (f :: Int -> M [Int])) ->
257            mapFoldableMS f `checkStreamConduitT`
258            mapFoldableML f
259    qit "consume" $
260        \() ->
261            consume `checkConsumer`
262            id
263    qit "consumeS" $
264        \() ->
265            consumeS `checkStreamConsumer`
266            id
267    qit "groupBy" $
268        \(getBlind -> f) ->
269            groupBy f `checkConduit`
270            (Data.List.groupBy f :: [Int] -> [[Int]])
271    qit "groupByS" $
272        \(getBlind -> f) ->
273            groupByS f `checkStreamConduit`
274            (Data.List.groupBy f :: [Int] -> [[Int]])
275    qit "groupOn1" $
276        \(getBlind -> (f :: Int -> Int)) ->
277            groupOn1 f `checkConduit`
278            groupOn1L f
279    qit "groupOn1S" $
280        \(getBlind -> (f :: Int -> Int)) ->
281            groupOn1S f `checkStreamConduit`
282            groupOn1L f
283    qit "isolate" $
284        \n ->
285            isolate n `checkConduit`
286            (Data.List.take n :: [Int] -> [Int])
287    qit "isolateS" $
288        \n ->
289            isolateS n `checkStreamConduit`
290            (Data.List.take n :: [Int] -> [Int])
291    qit "filter" $
292        \(getBlind -> f) ->
293            filter f `checkConduit`
294            (Data.List.filter f :: [Int] -> [Int])
295    qit "filterS" $
296        \(getBlind -> f) ->
297            filterS f `checkStreamConduit`
298            (Data.List.filter f :: [Int] -> [Int])
299    qit "sourceNull" $
300        \() ->
301            sourceNull `checkProducer`
302            ([] :: [Int])
303    qit "sourceNullS" $
304        \() ->
305            sourceNullS `checkStreamProducer`
306            ([] :: [Int])
307
308qit :: (Arbitrary a, Testable prop, Show a)
309    => String -> (a -> prop) -> Spec
310qit n f = it n $ property $ forAll arbitrary f
311
312--------------------------------------------------------------------------------
313-- Quickcheck utilities for pure conduits / streams
314
315checkProducer :: (Show a, Eq a) => ConduitT () a Identity () -> [a] -> Property
316checkProducer c l  = checkProducerM' runIdentity c (return l)
317
318checkStreamProducer :: (Show a, Eq a) => StreamConduitT () a Identity () -> [a] -> Property
319checkStreamProducer s l = checkStreamProducerM' runIdentity s (return l)
320
321checkInfiniteProducer :: (Show a, Eq a) => ConduitT () a Identity () -> [a] -> Property
322checkInfiniteProducer c l = checkInfiniteProducerM' runIdentity c (return l)
323
324checkInfiniteStreamProducer :: (Show a, Eq a) => StreamConduitT () a Identity () -> [a] -> Property
325checkInfiniteStreamProducer s l = checkInfiniteStreamProducerM' runIdentity s (return l)
326
327checkConsumer :: (Show b, Eq b) => ConduitT Int Void Identity b -> ([Int] -> b) -> Property
328checkConsumer c l = checkConsumerM' runIdentity c (return . l)
329
330checkStreamConsumer :: (Show b, Eq b) => StreamConsumer Int Identity b -> ([Int] -> b) -> Property
331checkStreamConsumer c l = checkStreamConsumerM' runIdentity c (return . l)
332
333checkConduit :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b Identity () -> ([a] -> [b]) -> Property
334checkConduit c l = checkConduitT' runIdentity c (return . l)
335
336checkStreamConduit :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduitT a b Identity () -> ([a] -> [b]) -> Property
337checkStreamConduit c l = checkStreamConduitT' runIdentity c (return . l)
338
339-- checkConduitResult :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => ConduitT a b Identity r -> ([a] -> ([b], r)) -> Property
340-- checkConduitResult c l = checkConduitResultM' runIdentity c (return . l)
341
342checkStreamConduitResult :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => StreamConduitT a b Identity r -> ([a] -> ([b], r)) -> Property
343checkStreamConduitResult c l = checkStreamConduitResultM' runIdentity c (return . l)
344
345--------------------------------------------------------------------------------
346-- Quickcheck utilities for conduits / streams in the M monad.
347
348checkProducerM :: (Show a, Eq a) => ConduitT () a M () -> M [a] -> Property
349checkProducerM = checkProducerM' runM
350
351checkStreamProducerM :: (Show a, Eq a) => StreamSource M a -> M [a] -> Property
352checkStreamProducerM = checkStreamProducerM' runM
353
354checkInfiniteProducerM :: (Show a, Eq a) => ConduitT () a M () -> M [a] -> Property
355checkInfiniteProducerM = checkInfiniteProducerM' (fst . runM)
356
357checkInfiniteStreamProducerM :: (Show a, Eq a) => StreamSource M a -> M [a] -> Property
358checkInfiniteStreamProducerM = checkInfiniteStreamProducerM' (fst . runM)
359
360checkConsumerM :: (Show b, Eq b) => ConduitT Int Void M b -> ([Int] -> M b) -> Property
361checkConsumerM  = checkConsumerM' runM
362
363checkStreamConsumerM :: (Show b, Eq b) => StreamConsumer Int M b -> ([Int] -> M b) -> Property
364checkStreamConsumerM  = checkStreamConsumerM' runM
365
366checkConduitT :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b M () -> ([a] -> M [b]) -> Property
367checkConduitT = checkConduitT' runM
368
369checkStreamConduitT :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduit a M b -> ([a] -> M [b]) -> Property
370checkStreamConduitT = checkStreamConduitT' runM
371
372-- checkConduitResultM :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => ConduitT a b M r -> ([a] -> M ([b], r)) -> Property
373-- checkConduitResultM = checkConduitResultM' runM
374
375checkStreamConduitResultM :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => StreamConduitT a b M r -> ([a] -> M ([b], r)) -> Property
376checkStreamConduitResultM = checkStreamConduitResultM' runM
377
378--------------------------------------------------------------------------------
379-- Quickcheck utilities for monadic streams / conduits
380-- These are polymorphic in which Monad is used.
381
382checkProducerM' :: (Show a, Monad m, Show b, Eq b)
383                => (m [a] -> b)
384                -> ConduitT () a m ()
385                -> m [a]
386                -> Property
387checkProducerM' f c l =
388    f (runConduit (preventFusion c .| consume))
389    ===
390    f l
391
392checkStreamProducerM' :: (Show a, Monad m, Show b, Eq b)
393                      => (m [a] -> b)
394                      -> StreamSource m a
395                      -> m [a]
396                      -> Property
397checkStreamProducerM' f s l =
398    f (liftM fst $ evalStream $ s emptyStream)
399    ===
400    f l
401
402checkInfiniteProducerM' :: (Show a, Monad m, Show b, Eq b)
403                        => (m [a] -> b)
404                        -> ConduitT () a m ()
405                        -> m [a]
406                        -> Property
407checkInfiniteProducerM' f s l =
408    checkProducerM' f
409        (preventFusion s .| isolate 10)
410        (liftM (Prelude.take 10) l)
411
412checkInfiniteStreamProducerM' :: (Show a, Monad m, Show b, Eq b)
413                              => (m [a] -> b)
414                              -> StreamSource m a
415                              -> m [a]
416                              -> Property
417checkInfiniteStreamProducerM' f s l =
418    f (liftM snd $ evalStream $ takeS 10 $ s emptyStream)
419    ===
420    f (liftM (Prelude.take 10) l)
421
422checkConsumerM' :: (Show a, Monad m, Show b, Eq b)
423                => (m a -> b)
424                -> ConduitT Int Void m a
425                -> ([Int] -> m a)
426                -> Property
427checkConsumerM' f c l = forAll arbitrary $ \xs ->
428    f (runConduit (sourceList xs .| preventFusion c))
429    ===
430    f (l xs)
431
432checkStreamConsumerM' :: (Show a, Monad m, Show b, Eq b)
433                      => (m a -> b)
434                      -> StreamConsumer Int m a
435                      -> ([Int] -> m a)
436                      -> Property
437checkStreamConsumerM' f s l = forAll arbitrary $ \xs ->
438    f (liftM snd $ evalStream $ s $ sourceListS xs emptyStream)
439    ===
440    f (l xs)
441
442checkConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)
443               => (m [b] -> c)
444               -> ConduitT a b m ()
445               -> ([a] -> m [b])
446               -> Property
447checkConduitT' f c l = forAll arbitrary $ \xs ->
448    f (runConduit (sourceList xs .| preventFusion c .| consume))
449    ===
450    f (l xs)
451
452checkStreamConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)
453                     =>  (m [b] -> c)
454                     -> StreamConduit a m b
455                     -> ([a] -> m [b])
456                     -> Property
457checkStreamConduitT' f s l = forAll arbitrary $ \xs ->
458    f (liftM fst $ evalStream $ s $ sourceListS xs emptyStream)
459    ===
460    f (l xs)
461
462-- TODO: Fixing this would allow comparing conduit consumers against
463-- their list versions.
464--
465-- checkConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)
466--                      => (m ([b], r) -> c)
467--                      -> ConduitT a b m r
468--                      -> ([a] -> m ([b], r))
469--                      -> Property
470-- checkConduitResultM' f c l = FIXME forAll arbitrary $ \xs ->
471--     f (sourceList xs .| preventFusion c $$ consume)
472--     ===
473--     f (l xs)
474
475checkStreamConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)
476                           =>  (m ([b], r) -> c)
477                           -> StreamConduitT a b m r
478                           -> ([a] -> m ([b], r))
479                           -> Property
480checkStreamConduitResultM' f s l = forAll arbitrary $ \xs ->
481    f (evalStream $ s $ sourceListS xs emptyStream)
482    ===
483    f (l xs)
484
485emptyStream :: Monad m => Stream m () ()
486emptyStream = Stream (\_ -> return $ Stop ()) (return ())
487
488evalStream :: Monad m => Stream m o r -> m ([o], r)
489evalStream (Stream step s0) = go =<< s0
490  where
491    go s = do
492        res <- step s
493        case res of
494            Stop r -> return ([], r)
495            Skip s' -> go s'
496            Emit s' x -> liftM (\(l, r) -> (x:l, r)) (go s')
497
498--------------------------------------------------------------------------------
499-- Misc utilities
500
501-- Prefer this to creating an orphan instance for Data.Monoid.Sum:
502
503newtype Sum a = Sum a
504  deriving (Eq, Show, Arbitrary)
505
506instance Prelude.Num a => Semigroup (Sum a) where
507  Sum x <> Sum y = Sum $ x Prelude.+ y
508
509instance Prelude.Num a => Monoid (Sum a) where
510  mempty = Sum 0
511#if !(MIN_VERSION_base(4,11,0))
512  mappend = (<>)
513#endif
514
515preventFusion :: a -> a
516preventFusion = id
517{-# INLINE [0] preventFusion #-}
518
519newtype M a = M (StateT Int Identity a)
520  deriving (Functor, Applicative, Monad)
521
522instance Arbitrary a => Arbitrary (M a) where
523    arbitrary = do
524        f <- arbitrary
525        return $ do
526            s <- M get
527            let (x, s') = f s
528            M (put s')
529            return x
530
531runM :: M a -> (a, Int)
532runM (M m) = runIdentity $ runStateT m 0
533
534--------------------------------------------------------------------------------
535-- List versions of some functions
536
537iterML :: Monad m => (a -> m ()) -> [a] -> m [a]
538iterML f = Prelude.mapM (\a -> f a >>= \() -> return a)
539
540mapMaybeML :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
541mapMaybeML f = liftM Data.Maybe.catMaybes . Prelude.mapM f
542
543concatMapML :: Monad m => (a -> m [b]) -> [a] -> m [b]
544concatMapML f = liftM Prelude.concat . Prelude.mapM f
545
546concatMapAccumL :: (a -> s -> (s, [b])) -> s -> [a] -> [b]
547concatMapAccumL f acc0 =
548    runIdentity . concatMapAccumML (\a acc -> return $ f a acc) acc0
549
550mapAccumL :: (a -> s -> (s, b)) -> s -> [a] -> ([b], s)
551mapAccumL f acc0 =
552    runIdentity . mapAccumML (\a acc -> return $ f a acc) acc0
553
554concatMapAccumML :: Monad m => (a -> s -> m (s, [b])) -> s -> [a] -> m [b]
555concatMapAccumML f acc0 =
556    liftM (Prelude.concat . fst) . mapAccumML f acc0
557
558scanL :: (a -> b -> b) -> b -> [a] -> ([b], b)
559scanL f = mapAccumL (\a b -> let r = f a b in (r, r))
560
561scanML :: Monad m => (a -> b -> m b) -> b -> [a] -> m ([b], b)
562scanML f = mapAccumML (\a b -> f a b >>= \r -> return (r, r))
563
564mapFoldableL :: F.Foldable f => (a -> f b) -> [a] -> [b]
565mapFoldableL f = runIdentity . mapFoldableML (return . f)
566
567mapFoldableML :: (Monad m, F.Foldable f) => (a -> m (f b)) -> [a] -> m [b]
568mapFoldableML f = concatMapML (liftM F.toList . f)
569
570groupOn1L :: Eq b => (a -> b) -> [a] -> [(a, [a])]
571groupOn1L f =
572    Data.List.map (\(x:xs) -> (x, xs)) . Data.List.groupBy ((==) `on` f)
573
574mapAccumML :: Monad m => (a -> s -> m (s, b)) -> s -> [a] -> m ([b], s)
575mapAccumML f s0 = go s0
576  where
577    go s [] = return ([], s)
578    go s (x:xs) = do
579        (s', r) <- f x s
580        liftM (\(l, o) -> (r:l, o)) $ go s' xs
581
582--------------------------------------------------------------------------------
583-- Utilities taken from monad-loops package
584
585-- http://hackage.haskell.org/package/monad-loops
586
587-- |See 'Data.List.unfoldr'.  This is a monad-friendly version of that.
588unfoldrM :: (Monad m) => (a -> m (Maybe (b,a))) -> a -> m [b]
589unfoldrM = unfoldrM'
590
591-- |See 'Data.List.unfoldr'.  This is a monad-friendly version of that, with a
592-- twist.  Rather than returning a list, it returns any MonadPlus type of your
593-- choice.
594unfoldrM' :: (Monad m, MonadPlus f) => (a -> m (Maybe (b,a))) -> a -> m (f b)
595unfoldrM' f = go
596    where go z = do
597            x <- f z
598            case x of
599                Nothing         -> return mzero
600                Just (x', z')   -> do
601                        xs <- go z'
602                        return (return x' `mplus` xs)
603