Permalink
Browse files

Convert finalization examples into tests.

Some of the simple finalization examples could be easily converted into
HUnit tests.

We use a `Reader` monad with an `IORef` containing a list of "actions"
like "open file", "close file" and "exception" to keep track of what
happens during pipeline execution.
  • Loading branch information...
1 parent 82fb437 commit 59f6b520118176cb4e55df930a6fbacc61172c39 @pcapriotti committed Jun 3, 2012
Showing with 189 additions and 0 deletions.
  1. +14 −0 pipes-extra.cabal
  2. +175 −0 tests/Tests.hs
View
@@ -102,3 +102,17 @@ Executable decompress
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.*
View
@@ -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)

0 comments on commit 59f6b52

Please sign in to comment.