pipes-extra 0.1.0 → 0.2.0

raw patch · 9 files changed

+418/−6 lines, 9 filesdep +HUnitdep +conduitdep +criteriondep ~transformersnew-component:exe:compressnew-component:exe:decompressnew-component:exe:telnetPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, conduit, criterion, enumerator, mtl, network, pipes-extra, pipes-zlib, test-framework, test-framework-hunit, test-framework-th-prime, zlib, zlib-conduit, zlib-enum

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

• Control/Pipe/Binary.hs +2/−4
• bench/general.hs +21/−0
• bench/simple.hs +23/−0
• bench/zlib.hs +60/−0
• examples/compress.hs +8/−0
• examples/decompress.hs +8/−0
• examples/telnet.hs +31/−0
• pipes-extra.cabal +90/−2
• tests/Tests.hs +175/−0

@@ -42,14 +42,13 @@       eof <- lift . liftIO $ hIsEOF h       unless eof $ do         chunk <- lift . liftIO $ B.hGetSome h 4096-        -- lift . liftIO . putStrLn $ "chunk size " ++ show (B.length chunk)         yield chunk         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 ()+fileWriter :: MonadIO m => FilePath -> Pipe B.ByteString Void m r fileWriter path = do   -- receive some data before opening the handle   input <- await@@ -62,10 +61,9 @@       handleWriter  -- | Write data to a handle.-handleWriter:: MonadIO m => Handle -> Pipe B.ByteString Void m ()+handleWriter:: MonadIO m => Handle -> Pipe B.ByteString Void m r handleWriter h = forever $ do   chunk <- await-  -- lift . liftIO . putStrLn $ "writing chunk " ++ show (B.length chunk)   lift . liftIO . B.hPut h $ chunk  -- | Act as an identity for the first 'n' bytes, then terminate returning the

@@ -0,0 +1,21 @@+import Criterion.Main+import qualified Data.Conduit as C+import qualified Data.Conduit.List as CL+import qualified Data.Conduit.Binary as CB++import Control.Pipe.Binary+import Control.Pipe.Combinators+import Control.Pipe++testFile :: FilePath+testFile = "bench/general.hs"++main :: IO ()+main = defaultMain+    [ bench "bigsum-pipes" (whnfIO $ runPipe $ (mapM_ yield [1..1000 :: Int] >> return 0) >+> fold (+) 0)+    , bench "bigsum-conduit" (whnfIO $ C.runResourceT $ CL.sourceList [1..1000 :: Int] C.$$ CL.fold (+) 0)+    , bench "fileread-pipes" (whnfIO $ runPipe $ fileReader testFile >+> discard)+    , bench "fileread-conduit" (whnfIO $ C.runResourceT $ CB.sourceFile testFile C.$$ CL.sinkNull)+    , bench "map-pipes" (whnfIO $ runPipe $ (mapM_ yield [1..1000 :: Int] >> return 0) >+> pipe (+1) >+> fold (+) 0)+    , bench "map-conduit" (whnfIO $ C.runResourceT $ CL.sourceList [1..1000 :: Int] C.$= CL.map (+ 1) C.$$ CL.fold (+) 0)+    ]

@@ -0,0 +1,23 @@+import Criterion.Main++import Control.Monad+import Control.Monad.Trans.Class+import Control.Pipe+import System.IO++printer :: Show a => Handle -> Pipe a x IO r+printer h = forever $ await >>= lift . hPutStrLn h . show++devnull :: IO Handle+devnull = openFile "/dev/null" WriteMode++main :: IO ()+main = do+    h <- devnull+    defaultMain+      [ bench "list >+> printer (1000)" (whnfIO $ runPipe $ mapM_ yield [1..1000 :: Int] >+> printer h)+      , bench "mapM_ print (1000)" (whnfIO $ mapM_ (hPutStrLn h . show) [1..1000 :: Int])+      , bench "list >+> printer (100000)" (whnfIO $ runPipe $ mapM_ yield [1..100000 :: Int] >+> printer h)+      , bench "mapM_ print (100000)" (whnfIO $ mapM_ (hPutStrLn h . show) [1..100000 :: Int])+      ]+

@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+import qualified Data.ByteString.Lazy as L+import qualified Codec.Compression.GZip as GZip+import Criterion.Main+import qualified Data.Conduit as C+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.Zlib as CZ+import qualified Data.Enumerator as E+import qualified Data.Enumerator.Binary as EB+import qualified Codec.Zlib.Enum as EZ+import qualified System.IO as SIO++import Control.Pipe+import qualified Control.Pipe.Binary as PB+import qualified Control.Pipe.Zlib as PZ++filePath :: FilePath+filePath = "bench/sample.gz"++tmpFile :: FilePath+tmpFile = "dist/build/autogen/bench-tmp"++lazyIO :: IO ()+lazyIO = do+    compressed <- L.readFile filePath+    L.writeFile tmpFile $ GZip.decompress compressed++conduits1 :: IO ()+conduits1 = C.runResourceT+    $ CB.sourceFile filePath+    C.$$ CZ.ungzip+    C.=$ CB.sinkFile tmpFile++conduits2 :: IO ()+conduits2 = C.runResourceT+    $ CB.sourceFile filePath+    C.$= CZ.ungzip+    C.$$ CB.sinkFile tmpFile++enumerator :: IO ()+enumerator = SIO.withBinaryFile tmpFile SIO.WriteMode $ \h -> E.run_+    $ EB.enumFile filePath+    E.$$ EZ.ungzip+    E.=$ EB.iterHandle h++pipes :: IO ()+pipes = runPipe+  $ PB.fileReader filePath+  >+> PZ.gunzip+  >+> PB.fileWriter tmpFile++main :: IO ()+main = defaultMain+    [ bench "pipes" pipes+    , bench "conduits1" conduits1+    , bench "conduits2" conduits2+    , bench "enumerator1" enumerator+    , bench "lazyIO" lazyIO+    ]+

@@ -0,0 +1,8 @@+import Control.Pipe+import Control.Pipe.Binary+import Control.Pipe.Zlib+import System.IO++main :: IO ()+main = runPipe $+  handleReader stdin >+> gzip >+> handleWriter stdout

@@ -0,0 +1,8 @@+import Control.Pipe+import Control.Pipe.Binary+import Control.Pipe.Zlib+import System.IO++main :: IO ()+main = runPipe $+  handleReader stdin >+> gunzip >+> handleWriter stdout

@@ -0,0 +1,31 @@+import Control.Concurrent (forkIO)+import qualified Control.Exception as E+import Control.Pipe+import Control.Pipe.Binary+import Network (connectTo, PortID (..))+import System.Environment (getArgs, getProgName)+import System.IO+++main :: IO ()+main = do+    args <- getArgs+    case args of+        [host, port] -> telnet host (read port :: Int)+        _ -> usageExit+  where+    usageExit = do+        name <- getProgName+        putStrLn $ "Usage : " ++ name ++ " host port"++hConnect :: Handle -> Handle -> IO ()+hConnect h1 h2 = runPipe $ handleReader h1 >+> handleWriter h2++telnet :: String -> Int -> IO ()+telnet host port = E.bracket+    (connectTo host (PortNumber (fromIntegral port)))+    hClose+    (\hsock -> do+      mapM_ (`hSetBuffering` LineBuffering) [ stdin, stdout, hsock ]+      _ <- forkIO $ hConnect stdin hsock+      hConnect hsock stdout)

@@ -1,5 +1,5 @@ Name: pipes-extra-Version: 0.1.0+Version: 0.2.0 License: BSD3 License-file: LICENSE Author: Paolo Capriotti@@ -10,12 +10,16 @@ Build-type: Simple Synopsis: Various basic utilities for Pipes. Description: This module contains basic utilities for Pipes to deal with files and chunked binary data, as well as extra combinators like 'zip' and 'tee'.-Cabal-version: >=1.8+Cabal-version: >= 1.8  Source-Repository head     Type: git     Location: https://github.com/pcapriotti/pipes-extra +flag examples+    description: Build executables for the examples+    default: False+ Library     Build-Depends:         base (== 4.*),@@ -28,3 +32,87 @@         Control.Pipe.PutbackPipe,         Control.Pipe.Tee,         Control.Pipe.Zip++benchmark bench-general+    type: exitcode-stdio-1.0+    hs-source-dirs: . bench+    main-is: general.hs+    build-depends: base == 4.*+                 , pipes-core == 0.1.*+                 , bytestring == 0.9.*+                 , transformers >= 0.2 && < 0.4+                 , conduit == 0.4.*+                 , criterion == 0.6.*++benchmark bench-simple+    type: exitcode-stdio-1.0+    hs-source-dirs: . bench+    main-is: simple.hs+    build-depends: base == 4.*+                 , pipes-core == 0.1.*+                 , transformers >= 0.2 && < 0.4+                 , criterion == 0.6.*++benchmark bench-zlib+    type: exitcode-stdio-1.0+    hs-source-dirs: . bench+    main-is: zlib.hs+    build-depends: base == 4.*+                 , pipes-core == 0.1.*+                 , pipes-zlib < 0.2+                 , bytestring == 0.9.*+                 , transformers >= 0.2 && < 0.4+                 , enumerator == 0.4.*+                 , zlib-enum == 0.2.*+                 , conduit == 0.4.*+                 , zlib-conduit == 0.4.*+                 , zlib == 0.5.*+                 , criterion == 0.6.*++Executable telnet+    if flag(examples)+        build-depends: base == 4.*+                     , pipes-core == 0.1.*+                     , pipes-extra >= 0.1 && < 0.3+                     , transformers == 0.3.*+                     , network == 2.3.*+    else+        buildable: False+    hs-source-dirs: examples+    main-is: telnet.hs++Executable compress+    if flag(examples)+        build-depends: base == 4.*+                     , pipes-core == 0.1.*+                     , pipes-extra >= 0.1 && < 0.3+                     , pipes-zlib < 0.2+    else+        buildable: False+    hs-source-dirs: examples+    main-is: compress.hs++Executable decompress+    if flag(examples)+        build-depends: base == 4.*+                     , pipes-core == 0.1.*+                     , pipes-extra >= 0.1 && < 0.3+                     , pipes-zlib < 0.2+    else+        buildable: False+    hs-source-dirs: examples+    main-is: decompress.hs++test-suite tests+  type: exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is: Tests.hs+  build-depends: base >= 4 && < 5+               , HUnit == 1.2.*+               , bytestring == 0.9.*+               , test-framework == 0.6.*+               , test-framework-hunit == 0.2.*+               , test-framework-th-prime == 0.0.*+               , mtl == 2.1.*+               , pipes-core == 0.1.*+               , pipes-extra == 0.2.*

@@ -0,0 +1,175 @@+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Control.Exception (SomeException)+import qualified Control.Exception as E+import Control.Monad.Reader hiding (reader)+import Control.Pipe+import Control.Pipe.Combinators+import Control.Pipe.Exception+import qualified Control.Pipe.Binary as PB+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BC+import Data.IORef+import Data.List+import Prelude hiding (catch)++import Test.HUnit+import Test.Framework.Providers.HUnit+import Test.Framework.TH.Prime++import System.IO++data Action+  = OpenFile FilePath IOMode+  | CloseFile FilePath+  | CaughtException E.IOException+  deriving (Eq, Show)++type Report = IORef [Action]++type M = ReaderT Report IO++runPipeM :: Pipeline M r -> IO (Either SomeException r, [Action])+runPipeM p = do+  r <- newIORef []+  result <- E.try $ runReaderT (runPipe p) r+  acts <- readIORef r+  return (result, reverse acts)++saveAction :: Action -> M ()+saveAction act = do+  r <- ask+  liftIO . modifyIORef r $ (act:)++open :: FilePath -> IOMode -> M Handle+open fp mode = do+  saveAction (OpenFile fp mode)+  liftIO $ openFile fp mode++close :: FilePath -> Handle -> M ()+close fp h = do+  liftIO $ hClose h+  saveAction (CloseFile fp)++reader :: FilePath -> Producer ByteString M ()+reader fp = fReader >+> PB.lines+  where+    fReader = bracket+      (open fp ReadMode)+      (close fp)+      PB.handleReader++-- line-by-line writer with verbose initializer and finalizer+writer :: FilePath -> Consumer ByteString M ()+writer fp = pipe (`BC.snoc` '\n') >+> fWriter+  where+    fWriter = do+      x <- await+      feed x $+        bracket+          (open fp WriteMode)+          (close fp)+          PB.handleWriter++equalFiles :: FilePath -> FilePath -> Assertion+equalFiles fp1 fp2 = do+  content1 <- readFile fp1+  content2 <- readFile fp2+  content1 @=? content2++assertLeft :: Show b => Either a b -> (a -> Assertion) -> Assertion+assertLeft x f = either f err x+  where+    err b = assertFailure $ "expected Left, got " ++ show b++assertRight :: Show a => Either a b -> (b -> Assertion) -> Assertion+assertRight x f = either err f x+  where+    err a = assertFailure $ "expected Right, got " ++ show a++tmpOutput :: FilePath+tmpOutput = "dist/build/testtmp"++case_cp :: Assertion+case_cp = do+  let input = "README.md"+  (r, acts) <- runPipeM $ reader input >+> writer tmpOutput+  assertRight r $ \_ -> return ()++  acts @=?+    [ OpenFile input ReadMode+    , OpenFile tmpOutput WriteMode+    , CloseFile input+    , CloseFile tmpOutput ]++  equalFiles input tmpOutput++isNonexistingException :: SomeException -> Assertion+isNonexistingException e =+  "does not exist" `isInfixOf` show e @?+     "expected 'no such file' exception, "+           ++ "got " ++ show e++case_unopenable :: Assertion+case_unopenable = do+  let input = "README.md"+      output = "/unopenable/file"+  (result, acts) <- runPipeM $ reader input >+> writer output+  assertLeft result isNonexistingException++  acts @=?+    [ OpenFile input ReadMode+    , OpenFile output WriteMode+    , CloseFile input ]++case_join :: Assertion+case_join = do+  let input1 = "README.md"+      input2 = "LICENSE"+  (r, acts) <- runPipeM $+        (reader input1 >> reader input2)+    >+> writer tmpOutput+  assertRight r $ \_ -> return ()++  acts @=?+    [ OpenFile input1 ReadMode+    , OpenFile tmpOutput WriteMode+    , CloseFile input1+    , OpenFile input2 ReadMode+    , CloseFile input2+    , CloseFile tmpOutput ]++  content1 <- readFile input1+  content2 <- readFile input2+  content3 <- readFile tmpOutput+  content3 @=? content1 ++ content2++case_recover :: Assertion+case_recover = do+  let+    input1 = "README.md"+    input2 = "/nonexistent/file"+    safeReader fp = catch (reader fp) $ \e ->+      lift $ saveAction (CaughtException e)++    isException (CaughtException e) = isNonexistingException (E.toException e)+    isException x = assertFailure $ "expected exception, got " ++ show x++  (r, acts) <- runPipeM $+        (safeReader input1 >> safeReader input2)+    >+> writer tmpOutput+  assertRight r $ \_ -> return ()++  zipWithM_ (flip ($)) acts+    [ (@=? OpenFile input1 ReadMode)+    , (@=? OpenFile tmpOutput WriteMode)+    , (@=? CloseFile input1)+    , (@=? OpenFile input2 ReadMode)+    , isException+    , (@=? CloseFile tmpOutput) ]++  equalFiles input1 tmpOutput++main :: IO ()+main = $(defaultMainGenerator)