io-streams-1.5.2.2: test/System/IO/Streams/Tests/Combinators.hs
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module System.IO.Streams.Tests.Combinators (tests) where
------------------------------------------------------------------------------
import Control.Applicative
import Control.Monad hiding (filterM, mapM,
mapM_)
import qualified Control.Monad as CM
import Data.IORef
import Data.List hiding (drop, filter,
take, unzip, zip,
zipWith)
import Prelude hiding (drop, filter,
mapM, mapM_, read,
take, unzip, zip,
zipWith)
import qualified Prelude
import System.IO.Streams hiding (all, any,
maximum, minimum)
import qualified System.IO.Streams as S
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.HUnit hiding (Test)
import Test.QuickCheck hiding (output)
import Test.QuickCheck.Monadic
------------------------------------------------------------------------------
import System.IO.Streams.Tests.Common
------------------------------------------------------------------------------
tests :: [Test]
tests = [ testFilter
, testFilterM
, testFilterOutput
, testFilterOutputM
, testFoldMWorksTwice
, testFold
, testFoldM
, testFold_
, testFoldM_
, testUnfoldM
, testPredicates
, testMap
, testContramap
, testMapM
, testMapM_
, testMapMaybe
, testContramapM_
, testContramapMaybe
, testSkipToEof
, testZip
, testZipWith
, testZipWithM
, testUnzip
, testContraunzip
, testTake
, testDrop
, testGive
, testIgnore
, testIgnoreEof
, testAtEnd
]
------------------------------------------------------------------------------
testFoldMWorksTwice :: Test
testFoldMWorksTwice = testCase "combinators/foldMWorksTwice" $ do
(os, grab) <- nullOutput >>= outputFoldM f (0::Int)
let l = [1,2,3]
fromList l >>= supplyTo os
m <- grab
assertEqual "foldm1" (sum l) m
let l2 = [4,5,6]
fromList l2 >>= supplyTo os
m2 <- grab
assertEqual "foldm2" (sum l2) m2
(is, grab2) <- fromList l >>= inputFoldM f (0::Int)
_ <- read is
x <- grab2
assertEqual "foldm3" 1 x
_ <- read is >> read is
y <- grab2
assertEqual "foldm4" 5 y
read is >>= assertEqual "eof" Nothing
where
f a b = return (a+b)
------------------------------------------------------------------------------
testMapM :: Test
testMapM = testCase "combinators/mapM" $ do
is <- fromList [1,2,3::Int] >>= mapM (return . (1+))
l <- toList is
assertEqual "mapM" [2,3,4] l
------------------------------------------------------------------------------
testMap :: Test
testMap = testCase "combinators/map" $ do
is <- fromList [1,2,3::Int] >>= S.map (1+)
l <- toList is
assertEqual "map" [2,3,4] l
------------------------------------------------------------------------------
testContramap :: Test
testContramap = testCase "combinators/contramap" $ do
is <- fromList [1,2,3::Int]
l <- outputToList (contramap (+1) >=> connect is)
assertEqual "contramap" [2,3,4] l
------------------------------------------------------------------------------
testMapM_ :: Test
testMapM_ = testCase "combinators/mapM_" $ do
ref <- newIORef 0
is <- fromList [1,2,3::Int] >>= mapM_ (modifyIORef ref . (+))
_ <- toList is
readIORef ref >>= assertEqual "mapM_" 6
------------------------------------------------------------------------------
testMapMaybe :: Test
testMapMaybe = testCase "combinators/mapMaybe" $ do
is <- fromList [1,2,3::Int] >>= S.mapMaybe (\x -> if odd x then Just (x * x) else Nothing)
l <- toList is
assertEqual "mapMaybe" [1,9] l
------------------------------------------------------------------------------
testContramapM_ :: Test
testContramapM_ = testCase "combinators/contramapM_" $ do
ref <- newIORef 0
is <- fromList [1,2,3::Int]
_ <- outputToList (contramapM_ (modifyIORef ref . (+)) >=> connect is)
readIORef ref >>= assertEqual "contramapM_" 6
------------------------------------------------------------------------------
testContramapMaybe :: Test
testContramapMaybe = testCase "combinators/contramapMaybe" $ do
is <- fromList [1,2,3::Int]
l <- outputToList (contramapMaybe f >=> connect is)
assertEqual "contramapMaybe" [1,9] l
where f x = if even x then Nothing else Just $ x * x
------------------------------------------------------------------------------
testSkipToEof :: Test
testSkipToEof = testCase "combinators/skipToEof" $ do
is <- fromList [1,2,3::Int]
!_ <- skipToEof is
x <- read is
assertEqual "skipToEof" Nothing x
------------------------------------------------------------------------------
testFilter :: Test
testFilter = testCase "combinators/filter" $ do
is <- fromList [1..10::Int]
is' <- filter even is
read is' >>= assertEqual "read1" (Just 2)
unRead 3 is'
peek is >>= assertEqual "pushback" (Just 3)
toList is' >>= assertEqual "rest" [4,6..10]
unRead 20 is'
peek is >>= assertEqual "pushback2" (Just 20)
toList is' >>= assertEqual "rest2" [20]
toList is' >>= assertEqual "eof" []
------------------------------------------------------------------------------
testFilterM :: Test
testFilterM = testCase "combinators/filterM" $ do
is <- fromList [1..10::Int]
is' <- filterM (return . even) is
read is' >>= assertEqual "read1" (Just 2)
unRead 3 is'
peek is >>= assertEqual "pushback" (Just 3)
toList is' >>= assertEqual "rest" [4,6..10]
unRead 20 is'
peek is >>= assertEqual "pushback2" (Just 20)
toList is' >>= assertEqual "rest2" [20]
toList is' >>= assertEqual "eof" []
------------------------------------------------------------------------------
testFilterOutput :: Test
testFilterOutput = testCase "combinators/filterOutput" $ do
is <- fromList [1..10::Int]
l <- outputToList (\os -> filterOutput even os >>= connect is)
assertEqual "filterOutput" (Prelude.filter even [1..10]) l
------------------------------------------------------------------------------
testFilterOutputM :: Test
testFilterOutputM = testCase "combinators/filterOutputM" $ do
is <- fromList [1..10::Int]
l <- outputToList (\os -> filterOutputM (return . even) os >>= connect is)
assertEqual "filterOutputM" (Prelude.filter even [1..10]) l
------------------------------------------------------------------------------
testFold :: Test
testFold = testCase "combinators/fold" $ do
fromList [1..10::Int] >>= S.fold (+) 0
>>= assertEqual "fold1" (sum [1..10])
------------------------------------------------------------------------------
testFoldM :: Test
testFoldM = testCase "combinators/foldM" $ do
fromList [1..10::Int] >>= S.foldM ((return .) . (+)) 0
>>= assertEqual "fold2" (sum [1..10])
------------------------------------------------------------------------------
testFold_ :: Test
testFold_ = testCase "combinators/fold_" $ do
fromList [1..10::Int] >>= S.fold_ (+) 0 id
>>= assertEqual "fold_1" (sum [1..10])
------------------------------------------------------------------------------
testFoldM_ :: Test
testFoldM_ = testCase "combinators/foldM_" $ do
fromList [1..10::Int] >>= S.foldM_ ((return .) . (+)) (return 0) return
>>= assertEqual "fold_2" (sum [1..10])
------------------------------------------------------------------------------
testUnfoldM :: Test
testUnfoldM = testCase "combinators/unfoldM" $ do
S.unfoldM gen 0 >>= toList >>= assertEqual "unfold" result
where
gen !n = return $! if n < 10 then Just (n, n + 1) else Nothing
result = [0, 1 .. 9 :: Int]
------------------------------------------------------------------------------
data StreamPred = forall c . (Eq c, Show c) =>
P ([Int] -> c, InputStream Int -> IO c, String)
testPredicates :: Test
testPredicates = testProperty "combinators/predicates" $ monadicIO $ forAllM arbitrary prop
where
predicates :: [StreamPred]
predicates = [ P (all even , S.all even , "all" )
, P (any even , S.any even , "any" )
, P (nl maximum , S.maximum , "maximum" )
, P (nl minimum , S.minimum , "minimum" )
]
nl f l = if null l then Nothing else Just (f l)
prop :: [Int] -> PropertyM IO ()
prop l = liftQ $ CM.mapM_ (p l) predicates
p :: [Int] -> StreamPred -> IO ()
p l (P (pPred, pStream, name)) =
fromList l >>= pStream >>= assertEqual name (pPred l)
------------------------------------------------------------------------------
testZipWithM :: Test
testZipWithM = testCase "combinators/zipWithM" $ do
let l1 = [1 .. 10 :: Int]
let l2 = [2 .. 10 :: Int]
(join $ S.zipWithM ((return .) . (+)) <$> fromList l1 <*> fromList l2)
>>= toList >>= assertEqual "zipWith1" (Prelude.zipWith (+) l1 l2)
(join $ S.zipWithM ((return .) . (+)) <$> fromList l2 <*> fromList l1)
>>= toList >>= assertEqual "zipWith1" (Prelude.zipWith (+) l2 l1)
is1 <- fromList l1
is2 <- fromList l2
isZip <- S.zipWithM ((return .) . (+)) is1 is2
_ <- toList isZip
read is1 >>= assertEqual "remainder" (Just 10)
------------------------------------------------------------------------------
testZipWith :: Test
testZipWith = testCase "combinators/zipWith" $ do
let l1 = [1 .. 10 :: Int]
let l2 = [2 .. 10 :: Int]
(join $ S.zipWith (+) <$> fromList l1 <*> fromList l2)
>>= toList >>= assertEqual "zipWith1" (Prelude.zipWith (+) l1 l2)
(join $ S.zipWith (+) <$> fromList l2 <*> fromList l1)
>>= toList >>= assertEqual "zipWith1" (Prelude.zipWith (+) l2 l1)
is1 <- fromList l1
is2 <- fromList l2
isZip <- S.zipWith (+) is1 is2
_ <- toList isZip
read is1 >>= assertEqual "remainder" (Just 10)
------------------------------------------------------------------------------
testZip :: Test
testZip = testCase "combinators/zip" $ do
let l1 = [1 .. 10 :: Int]
let l2 = [2 .. 10 :: Int]
(join $ zip <$> fromList l1 <*> fromList l2) >>= toList
>>= assertEqual "zip1" (Prelude.zip l1 l2)
(join $ zip <$> fromList l2 <*> fromList l1) >>= toList
>>= assertEqual "zip2" (Prelude.zip l2 l1)
is1 <- fromList l1
is2 <- fromList l2
isZip <- zip is1 is2
_ <- toList isZip
read is1 >>= assertEqual "remainder" (Just 10)
------------------------------------------------------------------------------
testUnzip :: Test
testUnzip = testCase "combinators/unzip" $ do
let l1 = [1 .. 10 :: Int]
l2 = [2 .. 10 :: Int]
l = Prelude.zip l1 l2
(is1, is2) <- fromList l >>= unzip
toList is1 >>= assertEqual "unzip1-a" (fst $ Prelude.unzip l)
toList is2 >>= assertEqual "unzip1-b" (snd $ Prelude.unzip l)
read is1 >>= assertEqual "unzip1-read-a" Nothing
read is2 >>= assertEqual "unzip1-read-b" Nothing
(is3, is4) <- fromList l >>= unzip
toList is4 >>= assertEqual "unzip2-b" (snd $ Prelude.unzip l)
toList is3 >>= assertEqual "unzip2-a" (fst $ Prelude.unzip l)
read is4 >>= assertEqual "unzip2-read-b" Nothing
read is3 >>= assertEqual "unzip2-read" Nothing
------------------------------------------------------------------------------
testContraunzip :: Test
testContraunzip = testProperty "combinators/contrazip" $ monadicIO $ forAllM arbitrary prop
where
prop :: [Int] -> PropertyM IO ( )
prop xs = liftQ $ do
let ys = fmap show xs
xsStream <- fromList xs
ysStream <- fromList ys
(xsSink, getXs') <- listOutputStream
(ysSink, getYs') <- listOutputStream
xysStream <- zip xsStream ysStream
xysSink <- contraunzip xsSink ysSink
connect xysStream xysSink
xs' <- getXs'
ys' <- getYs'
assertEqual "numbers" xs xs'
assertEqual "strings" ys ys'
------------------------------------------------------------------------------
testTake :: Test
testTake = testCase "combinators/take" $ do
fromList ([]::[Int]) >>= take 0 >>= toList >>= assertEqual "empty 0" []
fromList ([]::[Int]) >>= take 10 >>= toList >>= assertEqual "empty 10" []
forM_ [0..4] $ \n -> fromList [1,2,3::Int] >>=
take n >>=
toList >>=
assertEqual ("for " ++ show n)
(Prelude.take (fromEnum n) [1..3])
is <- fromList [1,2,3::Int]
is' <- take 2 is
void $ read is'
unRead 0 is'
peek is >>= assertEqual "pb" (Just 0)
toList is' >>= assertEqual "toList" [0,2]
unRead 7 is'
peek is >>= assertEqual "pb2" (Just 7)
toList is' >>= assertEqual "toList2" [7]
------------------------------------------------------------------------------
testDrop :: Test
testDrop = testCase "combinators/drop" $ do
fromList ([]::[Int]) >>= take 0 >>= toList >>= assertEqual "empty 0" []
fromList ([]::[Int]) >>= take 10 >>= toList >>= assertEqual "empty 10" []
forM_ [0..4] $ \n -> fromList [1,2,3::Int] >>=
drop n >>=
toList >>=
assertEqual ("for " ++ show n)
(Prelude.drop (fromEnum n) [1..3])
is <- fromList [1,2,3::Int]
is' <- drop 1 is
read is' >>= assertEqual "read" (Just 2)
unRead 0 is'
peek is >>= assertEqual "pb" (Just 0)
toList is' >>= assertEqual "toList" [0,3]
unRead 7 is'
peek is >>= assertEqual "pb2" (Just 7)
toList is' >>= assertEqual "toList2" [7]
toList is' >>= assertEqual "toList2_empty" []
is2 <- fromList [1,2,3::Int]
is2' <- drop 1 is2
read is2' >>= assertEqual "read2" (Just 2)
unRead 2 is2'
unRead 1 is2'
unRead 0 is2'
toList is2' >>= assertEqual "toList3" [2,3]
------------------------------------------------------------------------------
testGive :: Test
testGive = testCase "combinators/give" $ forM_ [0..12] tgive
where
tgive n = fromList [1..10::Int] >>= \is ->
outputToList (\os -> give n os >>= connect is) >>=
assertEqual ("give" ++ show n)
(Prelude.take (fromEnum n) [1..10])
------------------------------------------------------------------------------
testIgnore :: Test
testIgnore = testCase "combinators/ignore" $ forM_ [0..12] tign
where
tign n = fromList [1..10::Int] >>= \is ->
outputToList (\os -> ignore n os >>= connect is) >>=
assertEqual ("ignore" ++ show n)
(Prelude.drop (fromEnum n) [1..10])
------------------------------------------------------------------------------
testIgnoreEof :: Test
testIgnoreEof = testCase "combinators/ignoreEof" $ do
eofRef <- newIORef 0
chunkRef <- newIORef []
str0 <- S.makeOutputStream $ f eofRef chunkRef
str <- S.ignoreEof str0
S.write (Just 0) str
S.write Nothing str
readIORef eofRef >>= assertEqual "eof ignored" (0::Int)
readIORef chunkRef >>= assertEqual "input propagated" [0::Int]
where
f ref _ Nothing = modifyIORef ref (+1)
f _ chunk (Just x) = modifyIORef chunk (++ [x])
------------------------------------------------------------------------------
testAtEnd :: Test
testAtEnd = testCase "combinators/atEndOfInput" $ do
boolRef <- newIORef False
is <- fromList [1,2,3::Int] >>= atEndOfInput (writeIORef boolRef True)
unRead 0 is
toList is >>= assertEqual "list" [0,1,2,3]
readIORef boolRef >>= assertBool "ran"
toList is >>= assertEqual "list 2" []
unRead 0 is
toList is >>= assertEqual "list 3" [0]