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