Browse files

Follow changes in pipes-core 0.2.0.

  • Loading branch information...
1 parent c0a30da commit 43381920e005da21bac4fc0b13b6669124dcf235 @pcapriotti committed Jun 9, 2012
Showing with 58 additions and 135 deletions.
  1. +16 −20 Control/Pipe/Binary.hs
  2. +10 −10 Control/Pipe/Coroutine.hs
  3. +0 −73 Control/Pipe/PutbackPipe.hs
  4. +4 −4 Control/Pipe/Tee.hs
  5. +14 −14 Control/Pipe/Zip.hs
  6. +12 −12 pipes-extra.cabal
  7. +2 −2 tests/Tests.hs
View
36 Control/Pipe/Binary.hs
@@ -19,23 +19,22 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Pipe
import Control.Pipe.Exception
-import Control.Pipe.Combinators (tryAwait, feed)
+import Control.Pipe.Combinators (tryAwait)
import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as BC
import Data.Monoid
import Data.Word
import System.IO
import Prelude hiding (take, takeWhile, dropWhile, lines, catch)
-- | Read data from a file.
-fileReader :: MonadIO m => FilePath -> Pipe () B.ByteString m ()
+fileReader :: MonadIO m => FilePath -> Producer l B.ByteString m ()
fileReader path = bracket
(liftIO $ openFile path ReadMode)
(liftIO . hClose)
handleReader
-- | Read data from an open handle.
-handleReader :: MonadIO m => Handle -> Pipe () B.ByteString m ()
+handleReader :: MonadIO m => Handle -> Producer l B.ByteString m ()
handleReader h = go
where
go = do
@@ -48,27 +47,24 @@ handleReader h = go
-- | Write data to a file.
--
-- The file is only opened if some data arrives into the pipe.
-fileWriter :: MonadIO m => FilePath -> Pipe B.ByteString Void m r
-fileWriter path = do
+fileWriter :: MonadIO m => FilePath -> Consumer l B.ByteString m r
+fileWriter path = runUnawaits $ do
-- receive some data before opening the handle
- input <- await
- -- feed it to the actual worker pipe
- feed input go
- where
- go = bracket
- (liftIO $ openFile path WriteMode)
- (liftIO . hClose)
- handleWriter
+ await >>= unawait
+ bracket
+ (liftIO $ openFile path WriteMode)
+ (liftIO . hClose)
+ handleWriter
-- | Write data to a handle.
-handleWriter:: MonadIO m => Handle -> Pipe B.ByteString Void m r
+handleWriter:: MonadIO m => Handle -> Consumer l B.ByteString m r
handleWriter h = forever $ do
chunk <- await
lift . liftIO . B.hPut h $ chunk
-- | Act as an identity for the first 'n' bytes, then terminate returning the
-- unconsumed portion of the last chunk.
-take :: Monad m => Int -> Pipe B.ByteString B.ByteString m B.ByteString
+take :: Monad m => Int -> Pipe l B.ByteString B.ByteString m B.ByteString
take size = do
chunk <- await
let (chunk', leftover) = B.splitAt size chunk
@@ -79,7 +75,7 @@ take size = do
-- | Act as an identity as long as the given predicate holds, then terminate
-- returning the unconsumed portion of the last chunk.
-takeWhile :: Monad m => (Word8 -> Bool) -> Pipe B.ByteString B.ByteString m B.ByteString
+takeWhile :: Monad m => (Word8 -> Bool) -> Pipe l B.ByteString B.ByteString m B.ByteString
takeWhile p = go
where
go = do
@@ -91,14 +87,14 @@ takeWhile p = go
else return leftover
-- | Drop bytes as long as the given predicate holds, then act as an identity.
-dropWhile :: Monad m => (Word8 -> Bool) -> Pipe B.ByteString B.ByteString m r
+dropWhile :: Monad m => (Word8 -> Bool) -> Pipe l B.ByteString B.ByteString m r
dropWhile p = do
leftover <- takeWhile (not . p) >+> discard
yield leftover
idP
-- | Split the chunked input stream into lines, and yield them individually.
-lines :: Monad m => Pipe B.ByteString B.ByteString m r
+lines :: Monad m => Pipe l B.ByteString B.ByteString m r
lines = go B.empty
where
go leftover = do
@@ -115,5 +111,5 @@ lines = go B.empty
where (line, rest) = B.breakByte 10 chunk
-- | Yield individual bytes of the chunked input stream.
-bytes :: Monad m => Pipe B.ByteString Word8 m r
+bytes :: Monad m => Pipe l B.ByteString Word8 m r
bytes = forever $ await >>= B.foldl (\p c -> p >> yield c) (return ())
View
20 Control/Pipe/Coroutine.hs
@@ -10,36 +10,36 @@ module Control.Pipe.Coroutine (
import Control.Monad
import Control.Pipe
-import Control.Pipe.Exception
-import qualified Control.Exception as E
-import Data.Typeable
+import Control.Pipe.Internal
+import Data.Void
import Prelude hiding (catch)
data Coroutine a b m r = Coroutine
- { resume :: Pipe a b m r
+ { resume :: Pipe Void a b m r
, finalizer :: [m ()]
}
suspend :: Monad m
- => Pipe a b m r
- -> Pipe a x m (Either r (b, Coroutine a b m r))
+ => Pipe Void a b m r
+ -> Pipe l a x m (Either r (b, Coroutine a b m r))
suspend (Pure r w) = Pure (Left r) w
-suspend (Throw e w) = Throw e w
+suspend (Throw e p w) = Throw e (suspend p) w
suspend (Yield x p w) = return (Right (x, Coroutine p w))
suspend (M s m h) = M s (liftM suspend m) (suspend . h)
suspend (Await k h) = Await (suspend . k) (suspend . h)
+suspend (Unawait x _) = absurd x
coroutine :: Monad m
- => Pipe a b m r
+ => Pipe Void a b m r
-> Coroutine a b m r
coroutine p = Coroutine p []
step :: Monad m
=> Coroutine a b m r
- -> Pipe a x m (Either r (b, Coroutine a b m r))
+ -> Pipe l a x m (Either r (b, Coroutine a b m r))
step = suspend . resume
terminate :: Monad m
=> Coroutine a b m r
- -> Pipe a b m ()
+ -> Pipe l a b m ()
terminate p = mapM_ masked (finalizer p)
View
73 Control/Pipe/PutbackPipe.hs
@@ -1,73 +0,0 @@
--- | This module contains an alternative pipe implementation, 'PutbackPipe',
--- providing an additional primitive 'putback', which allows data to be
--- inserted into the input stream of the current pipe.
---
--- PutbackPipes can be used to implement pipes with left-over data, and can be
--- composed vertically (using the Monad instance), but not horizontally.
---
--- To make use of a PutbackPipe within a 'Pipeline', you need to convert it to
--- a regular 'Pipe' using 'runPutback'.
-module Control.Pipe.PutbackPipe (
- PutbackPipe(..),
- fromPipe,
- putback,
- yield,
- await,
- tryAwait,
- runPutback
- ) where
-
-import Control.Applicative
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
-import qualified Control.Pipe as P
-import Control.Pipe ((>+>), Pipe)
-import qualified Control.Pipe.Combinators as PC
-import Control.Pipe.Monoidal
-
--- | The 'PutbackPipe' data type.
-newtype PutbackPipe a b m r = PutbackPipe {
- unPutback :: Pipe (Either a a) (Either b a) m r
- }
-
-instance Monad m => Monad (PutbackPipe a b m) where
- return = PutbackPipe . return
- (PutbackPipe p) >>= f = PutbackPipe (p >>= unPutback . f)
-
-instance MonadTrans (PutbackPipe a b) where
- lift = PutbackPipe . lift
-
-instance Monad m => Functor (PutbackPipe a b m) where
- fmap f (PutbackPipe p) = PutbackPipe (liftM f p)
-
-instance Monad m => Applicative (PutbackPipe a b m) where
- pure = return
- (<*>) = ap
-
-instance MonadIO m => MonadIO (PutbackPipe a b m) where
- liftIO a = PutbackPipe (liftIO a)
-
--- | Create a 'PutbackPipe' from a regular pipe.
-fromPipe :: Monad m => Pipe a b m r -> PutbackPipe a b m r
-fromPipe p = PutbackPipe (joinP >+> p >+> P.pipe Left)
-
--- | Put back an element into the input stream.
-putback :: Monad m => a -> PutbackPipe a b m ()
-putback = PutbackPipe . P.yield . Right
-
--- | Same as 'P.yield' for regular pipes.
-yield :: Monad m => b -> PutbackPipe a b m ()
-yield = PutbackPipe . P.yield . Left
-
--- | Same as 'P.await' for regular pipes.
-await :: Monad m => PutbackPipe a b m a
-await = PutbackPipe $ liftM (either id id) P.await
-
--- | Same as 'PC.tryAwait' for regular pipes.
-tryAwait :: Monad m => PutbackPipe a b m (Maybe a)
-tryAwait = PutbackPipe $ liftM (fmap (either id id)) PC.tryAwait
-
--- | Convert a 'PutbackPipe' to a regular pipe.
-runPutback :: Monad m => PutbackPipe a b m r -> Pipe a b m r
-runPutback = loopP . unPutback
View
8 Control/Pipe/Tee.hs
@@ -24,8 +24,8 @@ import Data.ByteString
-- | Acts like 'idP', but also passes a copy to the supplied consumer.
tee :: (Monad m)
- => Pipe a Void m r -- ^ 'Consumer' that will receive a copy of all the input
- -> Pipe a a m r
+ => Consumer Void a m r -- ^ 'Consumer' that will receive a copy of all the input
+ -> Pipe l a a m r
tee consumer =
splitP >+> firstP consumer >+> discardL
@@ -35,7 +35,7 @@ teeFile :: (MonadIO m)
-- 'ByteString' which can be written to
-- the log
-> FilePath -- ^ file to log to
- -> Pipe a a m ()
+ -> Pipe l a a m ()
teeFile showBS logFile =
tee (pipe showBS >+> fileWriter logFile)
@@ -44,5 +44,5 @@ teeFile showBS logFile =
-- This function is equivalent to @teeFile id@.
teeFileBS :: (MonadIO m)
=> FilePath -- ^ file to log to
- -> Pipe ByteString ByteString m ()
+ -> Pipe l ByteString ByteString m ()
teeFileBS = teeFile id
View
28 Control/Pipe/Zip.hs
@@ -19,8 +19,8 @@ data ProducerControl r
| Error E.SomeException
controllable :: Monad m
- => Producer a m r
- -> Pipe (Either () (ProducerControl r)) a m r
+ => Producer Void a m r
+ -> Pipe l (Either () (ProducerControl r)) a m r
controllable p = do
x <- pipe (const ()) >+> suspend p
case x of
@@ -34,35 +34,35 @@ controllable p = do
(pipe (const ()) >+> terminate p')
controllable_ :: Monad m
- => Producer a m r
- -> Producer a m r
+ => Producer Void a m r
+ -> Producer l a m r
controllable_ p = pipe Left >+> controllable p
data ZipControl r
= LeftZ (ProducerControl r)
| RightZ (ProducerControl r)
zip :: Monad m
- => Producer a m r
- -> Producer b m r
- -> Pipe (Either () (ZipControl r)) (Either a b) m r
+ => Producer Void a m r
+ -> Producer Void b m r
+ -> Pipe l (Either () (ZipControl r)) (Either a b) m r
zip p1 p2 = translate >+> (controllable p1 *+* controllable p2)
where
- translate = forever $ await >>= \c -> case c of
+ translate = forever $ await >>= \z -> case z of
Left () -> (yield . Left . Left $ ()) >> (yield . Right . Left $ ())
Right (LeftZ c) -> (yield . Left . Right $ c) >> (yield . Right . Left $ ())
Right (RightZ c) -> (yield . Left . Left $ ()) >> (yield . Right . Right $ c)
zip_ :: Monad m
- => Producer a m r
- -> Producer b m r
- -> Producer (Either a b) m r
+ => Producer Void a m r
+ -> Producer Void b m r
+ -> Producer l (Either a b) m r
zip_ p1 p2 = pipe Left >+> zip p1 p2
(*+*) :: Monad m
- => Pipe a b m r
- -> Pipe a' b' m r
- -> Pipe (Either a a') (Either b b') m r
+ => Pipe Void a b m r
+ -> Pipe Void a' b' m r
+ -> Pipe Void (Either a a') (Either b b') m r
p1 *+* p2 = (continue p1 *** continue p2) >+> both
where
continue p = do
View
24 pipes-extra.cabal
@@ -1,5 +1,5 @@
Name: pipes-extra
-Version: 0.2.0
+Version: 0.3.0
License: BSD3
License-file: LICENSE
Author: Paolo Capriotti
@@ -24,12 +24,12 @@ Library
Build-Depends:
base (== 4.*),
transformers (>= 0.2 && < 0.4),
- pipes-core (== 0.1.*),
- bytestring (== 0.9.*)
+ pipes-core (== 0.2.*),
+ bytestring (== 0.9.*),
+ void (== 0.5.*)
Exposed-Modules:
Control.Pipe.Binary,
Control.Pipe.Coroutine,
- Control.Pipe.PutbackPipe,
Control.Pipe.Tee,
Control.Pipe.Zip
@@ -38,7 +38,7 @@ benchmark bench-general
hs-source-dirs: . bench
main-is: general.hs
build-depends: base == 4.*
- , pipes-core == 0.1.*
+ , pipes-core == 0.2.*
, bytestring == 0.9.*
, transformers >= 0.2 && < 0.4
, conduit == 0.4.*
@@ -49,7 +49,7 @@ benchmark bench-simple
hs-source-dirs: . bench
main-is: simple.hs
build-depends: base == 4.*
- , pipes-core == 0.1.*
+ , pipes-core == 0.2.*
, transformers >= 0.2 && < 0.4
, criterion == 0.6.*
@@ -58,7 +58,7 @@ benchmark bench-zlib
hs-source-dirs: . bench
main-is: zlib.hs
build-depends: base == 4.*
- , pipes-core == 0.1.*
+ , pipes-core == 0.2.*
, pipes-zlib < 0.2
, bytestring == 0.9.*
, transformers >= 0.2 && < 0.4
@@ -73,7 +73,7 @@ Executable telnet
if flag(examples)
build-depends: base == 4.*
, pipes-core == 0.1.*
- , pipes-extra >= 0.1 && < 0.3
+ , pipes-extra >= 0.1 && < 0.4
, transformers == 0.3.*
, network == 2.3.*
else
@@ -85,7 +85,7 @@ Executable compress
if flag(examples)
build-depends: base == 4.*
, pipes-core == 0.1.*
- , pipes-extra >= 0.1 && < 0.3
+ , pipes-extra >= 0.1 && < 0.4
, pipes-zlib < 0.2
else
buildable: False
@@ -96,7 +96,7 @@ Executable decompress
if flag(examples)
build-depends: base == 4.*
, pipes-core == 0.1.*
- , pipes-extra >= 0.1 && < 0.3
+ , pipes-extra >= 0.1 && < 0.4
, pipes-zlib < 0.2
else
buildable: False
@@ -114,5 +114,5 @@ test-suite tests
, test-framework-hunit == 0.2.*
, test-framework-th-prime == 0.0.*
, mtl == 2.1.*
- , pipes-core == 0.1.*
- , pipes-extra == 0.2.*
+ , pipes-core == 0.2.*
+ , pipes-extra == 0.3.*
View
4 tests/Tests.hs
@@ -52,7 +52,7 @@ close fp h = do
liftIO $ hClose h
saveAction (CloseFile fp)
-reader :: FilePath -> Producer ByteString M ()
+reader :: FilePath -> Producer l ByteString M ()
reader fp = fReader >+> PB.lines
where
fReader = bracket
@@ -61,7 +61,7 @@ reader fp = fReader >+> PB.lines
PB.handleReader
-- line-by-line writer with verbose initializer and finalizer
-writer :: FilePath -> Consumer ByteString M ()
+writer :: FilePath -> Consumer l ByteString M ()
writer fp = pipe (`BC.snoc` '\n') >+> fWriter
where
fWriter = do

0 comments on commit 4338192

Please sign in to comment.