Merge pull request #451 from kirelagin/uncons

Implement `uncons`

conduit/ChangeLog.md

@@ -1,5 +1,9 @@
 # ChangeLog for conduit
 
+## 1.3.3
+
+* Add `uncons`, `unconsM`, `unconsEither`, `unconsEitherM`.
+
 ## 1.3.2.1
 
 * Fix isChunksForExactlyE [#445](https://github.com/snoyberg/conduit/issues/445) [#446](https://github.com/snoyberg/conduit/pull/446)

conduit/src/Data/Conduit/Internal.hs

@@ -14,6 +14,7 @@ import           Data.Conduit.Internal.Conduit hiding (await,
                                                 leftover, mapInput, mapInputM,
                                                 mapOutput, mapOutputMaybe,
                                                 transPipe,
-                                                yield, yieldM)
+                                                yield, yieldM,
+                                                unconsM, unconsEitherM)
 import           Data.Conduit.Internal.Pipe
 import           Data.Conduit.Internal.Fusion

conduit/src/Data/Conduit/Internal/Conduit.hs

@@ -38,6 +38,8 @@ module Data.Conduit.Internal.Conduit
     , runConduitRes
     , fuse
     , connect
+    , unconsM
+    , unconsEitherM
       -- ** Composition
     , connectResume
     , connectResumeConduit
@@ -106,7 +108,7 @@ import Data.Void (Void, absurd)
 import Data.Monoid (Monoid (mappend, mempty))
 import Data.Semigroup (Semigroup ((<>)))
 import Control.Monad.Trans.Resource
-import Data.Conduit.Internal.Pipe hiding (yield, mapOutput, leftover, yieldM, await, awaitForever, bracketP)
+import Data.Conduit.Internal.Pipe hiding (yield, mapOutput, leftover, yieldM, await, awaitForever, bracketP, unconsM, unconsEitherM)
 import qualified Data.Conduit.Internal.Pipe as CI
 import Control.Monad (forever)
 import Data.Traversable (Traversable (..))
@@ -720,6 +722,40 @@ connect :: Monad m
         -> m r
 connect = ($$)
 
+-- | Split a conduit into head and tail.
+--
+-- Note that you have to 'sealConduitT' it first.
+--
+-- Since 1.3.3
+unconsM :: Monad m
+        => SealedConduitT () o m ()
+        -> m (Maybe (o, SealedConduitT () o m ()))
+unconsM (SealedConduitT p) = go p
+  where
+    -- This function is the same as @Pipe.unconsM@ but it ignores leftovers.
+    go (HaveOutput p o) = pure $ Just (o, SealedConduitT p)
+    go (NeedInput _ c) = go $ c ()
+    go (Done ()) = pure Nothing
+    go (PipeM mp) = mp >>= go
+    go (Leftover p ()) = go p
+
+-- | Split a conduit into head and tail or return its result if it is done.
+--
+-- Note that you have to 'sealConduitT' it first.
+--
+-- Since 1.3.3
+unconsEitherM :: Monad m
+              => SealedConduitT () o m r
+              -> m (Either r (o, SealedConduitT () o m r))
+unconsEitherM (SealedConduitT p) = go p
+  where
+    -- This function is the same as @Pipe.unconsEitherM@ but it ignores leftovers.
+    go (HaveOutput p o) = pure $ Right (o, SealedConduitT p)
+    go (NeedInput _ c) = go $ c ()
+    go (Done r) = pure $ Left r
+    go (PipeM mp) = mp >>= go
+    go (Leftover p ()) = go p
+
 -- | Named function synonym for '.|'
 --
 -- Equivalent to '.|' and '=$='. However, the latter is

conduit/src/Data/Conduit/Internal/Pipe.hs

@@ -18,6 +18,8 @@ module Data.Conduit.Internal.Pipe
     , yield
     , yieldM
     , leftover
+    , unconsM
+    , unconsEitherM
       -- ** Finalization
     , bracketP
       -- ** Composition
@@ -271,6 +273,34 @@ leftover = Leftover (Done ())
 {-# INLINE [1] leftover #-}
 {-# RULES "conduit: leftover l >> p" forall l (p :: Pipe l i o u m r). leftover l >> p = Leftover p l #-}
 
+-- | Split a pipe into head and tail.
+--
+-- Since 1.3.3
+unconsM :: Monad m
+        => Pipe Void () o () m ()
+        -> m (Maybe (o, Pipe Void () o () m ()))
+unconsM = go
+  where
+    go (HaveOutput p o) = pure $ Just (o, p)
+    go (NeedInput _ c) = go $ c ()
+    go (Done ()) = pure Nothing
+    go (PipeM mp) = mp >>= go
+    go (Leftover _ i) = absurd i
+
+-- | Split a pipe into head and tail or return its result if it is done.
+--
+-- Since 1.3.3
+unconsEitherM :: Monad m
+              => Pipe Void () o () m r
+              -> m (Either r (o, Pipe Void () o () m r))
+unconsEitherM = go
+  where
+    go (HaveOutput p o) = pure $ Right (o, p)
+    go (NeedInput _ c) = go $ c ()
+    go (Done r) = pure $ Left r
+    go (PipeM mp) = mp >>= go
+    go (Leftover _ i) = absurd i
+
 -- | Bracket a pipe computation between allocation and release of a resource.
 -- We guarantee, via the @MonadResource@ context, that the resource
 -- finalization is exception safe. However, it will not necessarily be

conduit/src/Data/Conduit/List.hs

@@ -33,6 +33,8 @@ module Data.Conduit.List
       -- ** Pure
     , fold
     , foldMap
+    , uncons
+    , unconsEither
     , take
     , drop
     , head
@@ -42,6 +44,8 @@ module Data.Conduit.List
       -- ** Monadic
     , foldMapM
     , foldM
+    , unconsM
+    , unconsEitherM
     , mapM_
       -- * Conduits
       -- ** Pure
@@ -95,9 +99,11 @@ import Prelude
 import Data.Monoid (Monoid, mempty, mappend)
 import qualified Data.Foldable as F
 import Data.Conduit
+import Data.Conduit.Internal.Conduit (unconsM, unconsEitherM)
 import Data.Conduit.Internal.Fusion
 import Data.Conduit.Internal.List.Stream
 import qualified Data.Conduit.Internal as CI
+import Data.Functor.Identity (Identity (runIdentity))
 import Control.Monad (when, (<=<), liftM, void)
 import Control.Monad.Trans.Class (lift)
 
@@ -180,6 +186,26 @@ unfoldEitherMC f =
             Left r -> return r
 STREAMING(unfoldEitherM, unfoldEitherMC, unfoldEitherMS, f seed)
 
+-- | Split a pure conduit into head and tail.
+-- This is equivalent to @runIdentity . unconsM@.
+--
+-- Note that you have to 'sealConduitT' it first.
+--
+-- Since 1.3.3
+uncons :: SealedConduitT () o Identity ()
+       -> Maybe (o, SealedConduitT () o Identity ())
+uncons = runIdentity . unconsM
+
+-- | Split a pure conduit into head and tail or return its result if it is done.
+-- This is equivalent to @runIdentity . unconsEitherM@.
+--
+-- Note that you have to 'sealConduitT' it first.
+--
+-- Since 1.3.3
+unconsEither :: SealedConduitT () o Identity r
+             -> Either r (o, SealedConduitT () o Identity r)
+unconsEither = runIdentity . unconsEitherM
+
 -- | Yield the values from the list.
 --
 -- Subject to fusion

conduit/test/main.hs

@@ -24,6 +24,7 @@ import qualified Data.List.Split as DLS (chunksOf)
 import Control.Monad.ST (runST)
 import Data.Monoid
 import qualified Data.IORef as I
+import Data.Tuple (swap)
 import Control.Monad.Trans.Resource (allocate, resourceForkIO)
 import Control.Concurrent (threadDelay, killThread)
 import Control.Monad.IO.Class (liftIO)
@@ -52,6 +53,16 @@ equivToList :: Eq b => ([a] -> [b]) -> ConduitT a b Identity () -> [a] -> Bool
 equivToList f conduit xs =
   f xs == runConduitPure (CL.sourceList xs .| conduit .| CL.consume)
 
+-- | Check that two conduits produce the same outputs and return the same result.
+bisimilarTo :: (Eq a, Eq r) => ConduitT () a Identity r -> ConduitT () a Identity r -> Bool
+left `bisimilarTo` right =
+    C.runConduitPure (toListRes left) == C.runConduitPure (toListRes right)
+  where
+    -- | Sink a conduit into a list and return it alongside the result.
+    -- So it is, essentially, @sinkList@ plus result.
+    toListRes :: Monad m => ConduitT () a m r -> ConduitT () Void m ([a], r)
+    toListRes cond = swap <$> C.fuseBoth cond CL.consume
+
 
 main :: IO ()
 main = hspec $ do
@@ -166,6 +177,28 @@ main = hspec $ do
             let y = DL.unfoldr f seed
             x `shouldBe` y
 
+    describe "uncons" $ do
+        prop "folds to list" $ \xs ->
+          let src = C.sealConduitT $ CL.sourceList xs in
+          (xs :: [Int]) == DL.unfoldr CL.uncons src
+
+        prop "works with unfold" $ \xs ->
+          let src = CL.sourceList xs in
+          CL.unfold CL.uncons (C.sealConduitT src) `bisimilarTo` (src :: ConduitT () Int Identity ())
+
+    describe "unconsEither" $ do
+        let
+          eitherToMaybe :: Either l a -> Maybe a
+          eitherToMaybe (Left _) = Nothing
+          eitherToMaybe (Right a) = Just a
+        prop "folds outputs to list" $ \xs ->
+          let src = C.sealConduitT $ CL.sourceList xs in
+          (xs :: [Int]) == DL.unfoldr (eitherToMaybe . CL.unconsEither) src
+
+        prop "works with unfoldEither" $ \(xs, r) ->
+          let src = CL.sourceList xs *> pure r in
+          CL.unfoldEither CL.unconsEither (C.sealConduitT src) `bisimilarTo` (src :: ConduitT () Int Identity Int)
+
     describe "Monoid instance for Source" $ do
         it "mappend" $ do
             x <- runConduitRes $ (CL.sourceList [1..5 :: Int] `mappend` CL.sourceList [6..10]) .| CL.fold (+) 0