Skip to content

Instantly share code, notes, and snippets.

@michaelt
Last active August 29, 2015 14:26
Show Gist options
  • Save michaelt/c8789970e8f096e56fff to your computer and use it in GitHub Desktop.
Save michaelt/c8789970e8f096e56fff to your computer and use it in GitHub Desktop.
Pipes.splitAt defined with and without `next`
{-#LANGUAGE RankNTypes #-}
import Lens.Simple
-- import Control.Lens (view)
import Control.Monad
import qualified Data.List as L
import Data.Vector (Vector)
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Generic.Mutable as VM
import Pipes
import Pipes.Group hiding (chunksOf)
import qualified Pipes.Group as PG
import qualified Pipes.Parse as PP
import qualified Control.Foldl as L
import qualified Pipes.Prelude as P
chunks__ :: Producer (Chunk Int) IO ()
chunks__ = L.impurely foldsM (fmap Chunk L.vector) (view (chunksOf 10) nums)
nums = each $ L.replicate 10000001 (1 :: Int)
main =
runEffect $ chunks__ >-> inspectChunk
where
inspectChunk
= forever
$ do Chunk v <- await
V.mapM_ (($!) const (return ())) v
newtype Chunk a = Chunk { chunkVec :: Vector a }
chunksOf
:: Monad m => Int -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x)
chunksOf n0 k p0 = fmap concats (k (_chunksOf p0))
where
_chunksOf p = FreeT $ do
x <- next p
return $ case x of
Left r -> Pure r
Right (a, p') -> Free $ fmap _chunksOf (split n0 (yield a >> p'))
{-# INLINABLE chunksOf #-}
split :: Monad m => Int -> Producer a m r -> Producer a m (Producer a m r)
split 0 p = return p
split n p = do
x <- lift (next p)
case x of
Left r -> return (return r)
Right (a, p') -> do
yield a
split (n - 1) p'
{-#LANGUAGE RankNTypes #-}
import Lens.Simple
-- import Control.Lens (view)
import Control.Monad
import qualified Data.List as L
import Data.Vector (Vector)
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Generic.Mutable as VM
import Pipes
import Pipes.Group hiding (chunksOf)
import qualified Pipes.Group as PG
import qualified Pipes.Parse as PP
import qualified Control.Foldl as L
import qualified Pipes.Prelude as P
import qualified Pipes.Internal as I
chunks__ :: Producer (Chunk Int) IO ()
chunks__ = L.impurely foldsM (fmap Chunk L.vector) (view (chunksOf 10) nums)
nums = each $ L.replicate 10000001 (1 :: Int)
main =
runEffect $ chunks__ >-> inspectChunk
where
inspectChunk
= forever
$ do Chunk v <- await
V.mapM_ (($!) const (return ())) v
newtype Chunk a = Chunk { chunkVec :: Vector a }
chunksOf
:: Monad m => Int -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x)
chunksOf n0 k p0 = fmap concats (k (_chunksOf_ p0))
where
_chunksOf_ p = case p of
I.Pure r -> return r
I.Request v _ -> I.closed v
I.M m -> FreeT $ m >>= runFreeT . _chunksOf_
x -> FreeT $ return $ Free (fmap _chunksOf_ (split n0 x))
{-# INLINABLE chunksOf #-}
split :: Monad m => Int -> Producer a m r -> Producer a m (Producer a m r)
split 0 p = return p
split n p = case p of
I.Pure r -> return (return r)
I.Request v _ -> I.closed v
I.M m -> I.M $ liftM (split n) m
I.Respond a f -> I.Respond a (split (n-1) . f)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment