io-streams-1.5.0.0: test/System/IO/Streams/Tests/ByteString.hs
{-# LANGUAGE OverloadedStrings #-}
module System.IO.Streams.Tests.ByteString (tests) where
------------------------------------------------------------------------------
import Control.Concurrent
import Control.Monad
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import Data.List hiding (lines, takeWhile, unlines, unwords, words)
import Data.Maybe (isJust)
import Data.Monoid
import Prelude hiding (lines, read, take, takeWhile, unlines, unwords, words)
import qualified Prelude
import System.IO.Streams hiding (filter, intersperse, mapM_)
import System.IO.Streams.Tests.Common
import System.Timeout
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
------------------------------------------------------------------------------
tests :: [Test]
tests = [ testBoyerMoore
, testBoyerMoore2
, testCountInput
, testCountInput2
, testCountOutput
, testThrowIfTooSlow
, testReadExactly
, testTakeWhile
, testTakeBytes
, testTakeBytes2
, testTakeBytes3
, testTakeBytes4
, testTakeExactly
, testTakeExactly2
, testTakeExactly3
, testThrowIfProducesMoreThan
, testThrowIfProducesMoreThan2
, testThrowIfProducesMoreThan3
, testThrowIfConsumesMoreThan
, testThrowIfConsumesMoreThan2
, testTrivials
, testWriteLazyByteString
, testGiveBytes
, testGiveExactly
, testLines
, testWords
]
------------------------------------------------------------------------------
testCountInput :: Test
testCountInput = testProperty "bytestring/countInput" $
monadicIO $
forAllM arbitrary prop
where
prop :: [ByteString] -> PropertyM IO ()
prop l = liftQ $ do
is <- fromList l
(is', grab) <- countInput is
x <- toList is'
n <- grab
assertEqual "countInput1" (L.length $ L.fromChunks l) n
assertEqual "countInput2" (L.length $ L.fromChunks x) n
read is' >>= assertEqual "eof" Nothing
unRead "ok" is'
peek is >>= assertEqual "peek" (Just "ok")
read is' >>= assertEqual "read" (Just "ok")
------------------------------------------------------------------------------
testCountInput2 :: Test
testCountInput2 = testCase "bytestring/countInput2" $ do
is <- fromList txt
(is', getCount) <- countInput is
(Just x) <- read is'
unRead "0, " is'
getCount >>= assertEqual "count1" 5
peek is >>= assertEqual "pushback propagates" (Just "0, ")
(liftM (L.fromChunks . (x:)) $ toList is') >>=
assertEqual "output" expectedOutput
getCount >>= assertEqual "count2" (L.length $ L.fromChunks txt)
where
txt = ["testing ", "1, ", "2, ", "3"]
expectedOutput = "testing 0, 1, 2, 3"
------------------------------------------------------------------------------
testCountOutput :: Test
testCountOutput = testProperty "bytestring/countOutput" $
monadicIO $
forAllM arbitrary prop
where
prop :: [ByteString] -> PropertyM IO ()
prop l = liftQ $ do
is <- fromList l
(os0, grab) <- listOutputStream
(os, grabLen) <- countOutput os0
connect is os
xs <- grab
n <- grabLen
assertEqual "countOutput1" l xs
assertEqual "countOutput2" (L.length $ L.fromChunks l) n
------------------------------------------------------------------------------
testTakeBytes :: Test
testTakeBytes = testProperty "bytestring/takeBytes" $
monadicIO $
forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop l = pre (L.length l > 5) >> liftQ (do
let (a,b) = L.splitAt 4 l
is <- fromList (L.toChunks l)
is' <- takeBytes 4 is
x <- liftM L.fromChunks $ toList is'
y <- liftM L.fromChunks $ toList is
assertEqual "take1" a x
assertEqual "take2" b y
)
------------------------------------------------------------------------------
testTakeBytes2 :: Test
testTakeBytes2 = testProperty "bytestring/takeBytes2" $
monadicIO $
forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop l = liftQ $ do
is <- fromList (L.toChunks l)
is2 <- takeBytes 0 is
x <- toList is2
y <- liftM L.fromChunks $ toList is
assertEqual "takeBytes3" [] x
assertEqual "takeBytes4" l y
-- Test that pushback makes it back to the source inputstream
is3 <- takeBytes 20 is
void $ toList is3
unRead "ok2" is3
unRead "ok1" is3
z <- toList is
assertEqual "takeBytes5" ["ok1", "ok2"] z
------------------------------------------------------------------------------
testTakeBytes3 :: Test
testTakeBytes3 = testCase "bytestring/takeBytes3" $ do
is <- fromLazyByteString (L.fromChunks ["The", "quick", "brown", "fox"]) >>=
takeBytes 100
_ <- toList is
m <- read is
assertEqual "takeBytes3" Nothing m
------------------------------------------------------------------------------
testTakeBytes4 :: Test
testTakeBytes4 = testCase "bytestring/takeBytes4" $ do
is <- makeInputStream (threadDelay 20000000 >> return Nothing)
>>= takeBytes 0
mb <- timeout 100000 $ toList is
assertBool "takeBytes4" $ isJust mb
------------------------------------------------------------------------------
testTakeExactly :: Test
testTakeExactly = testProperty "bytestring/takeExactly" $
monadicIO $
forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop l = pre (L.length l > 5) >> liftQ (do
let (a,b) = L.splitAt 4 l
is <- fromList (L.toChunks l)
is' <- takeExactly 4 is
x <- liftM L.fromChunks $ toList is'
y <- liftM L.fromChunks $ toList is
assertEqual "take1" a x
assertEqual "take2" b y
)
------------------------------------------------------------------------------
testTakeExactly2 :: Test
testTakeExactly2 = testProperty "bytestring/takeExactly2" $
monadicIO $
forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop l = pre (L.length l < 10) >> liftQ (do
is <- fromList (L.toChunks l)
is' <- takeExactly 10 is
expectExceptionH $ toList is'
)
------------------------------------------------------------------------------
testTakeExactly3 :: Test
testTakeExactly3 = testCase "bytestring/takeExactly3" $ do
is <- fromList ["one", "two"]
is' <- takeExactly 7 is
expectExceptionH $ toList is'
------------------------------------------------------------------------------
testThrowIfProducesMoreThan :: Test
testThrowIfProducesMoreThan =
testProperty "bytestring/throwIfProducesMoreThan" $
monadicIO $ forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop l = do
pre (L.length l > 5)
liftQ $ do
is <- fromList $ L.toChunks l
is' <- throwIfProducesMoreThan 4 is
expectExceptionH $ toList is'
------------------------------------------------------------------------------
testThrowIfProducesMoreThan2 :: Test
testThrowIfProducesMoreThan2 =
testProperty "bytestring/throwIfProducesMoreThan2" $
monadicIO $ forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop l = do
let n = L.length l
liftQ $ do
is <- fromList $ L.toChunks l
is' <- throwIfProducesMoreThan (n + 1) is
l' <- liftM L.fromChunks $ toList is'
assertEqual "throwIfProducesMoreThan2" l l'
m <- read is'
assertEqual "throwIfProducesMoreThan2-2" Nothing m
unRead "ok2" is'
unRead "ok1" is'
z <- toList is
assertEqual "throwIfProducesMoreThan2-3" ["ok1", "ok2"] z
------------------------------------------------------------------------------
testThrowIfProducesMoreThan3 :: Test
testThrowIfProducesMoreThan3 =
testCase "bytestring/throwIfProducesMoreThan3" $ do
is <- fromList ["lo", "ngstring"] >>= throwIfProducesMoreThan 4
s <- readExactly 4 is
assertEqual "throwIfProducesMoreThan split" "long" s
l <- fromList ["ok", "", "", "", ""] >>= throwIfProducesMoreThan 2 >>=
toList
assertEqual "throwIfProducesMoreThan3" ["ok", "", "", "", ""] l
------------------------------------------------------------------------------
testThrowIfConsumesMoreThan :: Test
testThrowIfConsumesMoreThan =
testProperty "bytestring/throwIfConsumesMoreThan" $
monadicIO $
forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop l = do
let n = L.length l
pre (n > 0)
liftQ $ do
is <- fromList (L.toChunks l)
(os, _) <- listOutputStream
os' <- throwIfConsumesMoreThan (n-1) os
expectExceptionH $ connect is os'
------------------------------------------------------------------------------
testThrowIfConsumesMoreThan2 :: Test
testThrowIfConsumesMoreThan2 =
testProperty "bytestring/throwIfConsumesMoreThan2" $
monadicIO $
forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop l = do
let n = L.length l
liftQ $ do
is <- fromList (L.toChunks l)
(os, grab) <- listOutputStream
os' <- throwIfConsumesMoreThan n os
connect is os'
l' <- liftM L.fromChunks grab
assertEqual "throwIfConsumesMoreThan" l l'
------------------------------------------------------------------------------
testGiveExactly :: Test
testGiveExactly = testCase "bytestring/giveExactly" $ do
f 2 >>= assertEqual "ok" ["ok"]
expectExceptionH $ f 1
expectExceptionH $ f 3
where
f n = do
is <- fromByteString "ok"
outputToList (giveExactly n >=> connect is)
------------------------------------------------------------------------------
testGiveBytes :: Test
testGiveBytes = testProperty "bytestring/giveBytes" $
monadicIO $
forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop l = do
pre (L.length l > 5)
let a = L.take 4 l
liftQ $ do
is <- fromList (L.toChunks l)
(os, grab) <- listOutputStream
os' <- giveBytes 4 os
connect is os'
write Nothing os'
x <- liftM L.fromChunks grab
assertEqual "giveBytes1" a x
liftQ $ do
is <- fromList $ L.toChunks a
(os, grab) <- listOutputStream
os' <- giveBytes 10 os
connect is os'
write Nothing os'
x <- liftM L.fromChunks grab
assertEqual "giveBytes2" a x
------------------------------------------------------------------------------
testThrowIfTooSlow :: Test
testThrowIfTooSlow = testCase "bytestring/throwIfTooSlow" $ do
is <- mkList
expectExceptionH $ trickleFrom is
is' <- mkList
void $ toList is'
x <- read is'
assertEqual "throwIfTooSlow" Nothing x
src <- mkSrc
src' <- throwIfTooSlow (return ()) 10 2 src
void $ toList src'
unRead "ok2" src'
unRead "ok1" src'
l <- toList src
assertEqual "throwIfTooSlow/pushback" ["ok1", "ok2"] l
where
mkSrc = fromList $ Prelude.take 100 $ cycle $
intersperse " " ["the", "quick", "brown", "fox"]
mkList = mkSrc >>= throwIfTooSlow (return ()) 10 2
trickleFrom is = go
where
go = read is >>= maybe (return ())
(\x -> x `seq` (threadDelay 2000000 >> go))
------------------------------------------------------------------------------
testBoyerMoore :: Test
testBoyerMoore = testProperty "bytestring/boyerMoore" $
monadicIO $ forAllM gen prop
where
genBS range = liftM S.pack $ listOf $ choose range
gen :: Gen (ByteString, [ByteString])
gen = do
needle <- genBS ('a', 'z')
n <- choose (0, 10)
hay <- replicateM n $ genBS ('A', 'Z')
return (needle, hay)
prop :: (ByteString, [ByteString]) -> PropertyM IO ()
prop (needle, haystack') = do
let lneedle = L.fromChunks [needle]
let lhaystack = L.fromChunks haystack'
pre ((not $ S.null needle) &&
(not $ L.null lhaystack) &&
(not $ S.isInfixOf needle $ S.concat haystack'))
(lhay, toklist0) <- insertNeedle lneedle lhaystack
let stream = L.toChunks $ L.concat [lneedle, lhay]
let toklist = (Match needle) : toklist0
-- there should be exactly three matches
out <- liftQ (fromList stream >>= search needle >>= toList)
let nMatches = length $ filter isMatch out
let out' = concatAdj Nothing id out
when (nMatches /= 3 || out' /= toklist) $ liftQ $ do
putStrLn "got wrong output!!"
putStrLn "needle:\n"
putStrLn $ show lneedle
putStrLn "\nhaystack:\n"
mapM_ (putStrLn . show) stream
putStrLn "\noutput stream:"
mapM_ (putStrLn . show) out
putStrLn "\noutput stream (minified):"
mapM_ (putStrLn . show) out'
putStrLn "\nexpected output:"
mapM_ (putStrLn . show) toklist
putStrLn ""
liftQ $ do
assertEqual "boyer-moore matches" 3 nMatches
assertEqual "boyer-moore output" toklist out'
isMatch (Match _) = True
isMatch _ = False
concatAdj :: Maybe MatchInfo
-> ([MatchInfo] -> [MatchInfo])
-> [MatchInfo]
-> [MatchInfo]
concatAdj prefix dl [] = dl $ maybe [] (:[]) prefix
concatAdj prefix dl (x:xs) =
maybe (concatAdj (Just x) dl xs)
(\p -> maybe (concatAdj (Just x) (dl . (p:)) xs)
(\x' -> concatAdj (Just x') dl xs)
(merge p x))
prefix
where
merge (NoMatch z) y
| S.null z = Just y
| otherwise = case y of
NoMatch x' -> Just $ NoMatch $ z `mappend` x'
_ -> Nothing
merge (Match _) _ = Nothing
insertNeedle lneedle lhaystack = do
idxL <- pick $ choose (0, lenL-1)
idxN <- pick $ choose (0, lenN-1)
idxN2 <- pick $ choose (0, lenN-1)
let (l1, l2) = L.splitAt (toEnum idxL) lhaystack
let (n1, n2) = L.splitAt (toEnum idxN) lneedle
let (n3, n4) = L.splitAt (toEnum idxN2) lneedle
let out1 = L.concat [ l1, n1, n2, l2, n3, n4 ]
let res = concatAdj Nothing id
[ NoMatch $ strict l1
, Match $ strict lneedle
, NoMatch $ strict l2
, Match $ strict lneedle
]
return (out1, res)
where
strict = S.concat . L.toChunks
lenN = fromEnum $ L.length lneedle
lenL = fromEnum $ L.length lhaystack
------------------------------------------------------------------------------
testBoyerMoore2 :: Test
testBoyerMoore2 = testCase "bytestring/boyerMoore2" $ do
fromList ["bork", "no", "bork", "bor"]
>>= search "bork"
>>= toList
>>= assertEqual "bork!" [ Match "bork", NoMatch "no", Match "bork"
, NoMatch "bor" ]
fromList [] >>= search "bork" >>= toList >>= assertEqual "nothing" []
fromList ["borkbo", "r"] >>= search "bork" >>= toList
>>= assertEqual "borkbo" [Match "bork", NoMatch "bor"]
fromList ["borkborkborkb", "o", "r", "k", "b", "o"]
>>= search "borkborkbork"
>>= toList
>>= assertEqual "boooooork" [Match "borkborkbork", NoMatch "borkbo"]
fromList ["bbbbb", "o", "r", "k", "bork"]
>>= search "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
>>= toList
>>= assertEqual "bbbbbbbbb" [NoMatch "bbbbborkbork"]
fromList ["bbbbbbbbb", "o", "r", "k"]
>>= search "bbbbbbbb"
>>= toList
>>= assertEqual "bbb2" [Match "bbbbbbbb", NoMatch "bork"]
fromList ["bababa", "bo", "rk", "bz", "z", "z", "z"] >>= search "babababork"
>>= toList
>>= assertEqual "zzz" [Match "babababork", NoMatch "bzzzz"]
fromList ["bab", "a", "b"] >>= search "bababa"
>>= toList
>>= assertEqual "bab" [NoMatch "babab"]
fromList ["xxx", "xxxzx", "xx"] >>= search "xxxx" >>= toList
>>= assertEqual "xxxx" [Match "xxxx", NoMatch "xxzxxx"]
------------------------------------------------------------------------------
testWriteLazyByteString :: Test
testWriteLazyByteString = testProperty "bytestring/writeLazy" $
monadicIO $
forAllM arbitrary prop
where
prop :: [ByteString] -> PropertyM IO ()
prop l0 = liftQ $ do
let l = filter (not . S.null) l0
let s = L.fromChunks l
(os, grab) <- listOutputStream
writeLazyByteString s os
l' <- grab
assertEqual "writeLazy" l l'
------------------------------------------------------------------------------
testReadExactly :: Test
testReadExactly = testProperty "bytestring/readExactly" $
monadicIO $
forAllM arbitrary prop
where
prop l0 = liftQ $ do
let l = filter (not . S.null) l0
is <- fromList l
let s = L.fromChunks l
let n = fromEnum $ L.length s
t <- readExactly n is
assertEqual "eq" s $ L.fromChunks [t]
unRead t is
expectExceptionH $ readExactly (n+1) is
when (n > 0) $ do
is' <- fromList l
u <- readExactly (n-1) is'
assertEqual "eq2" (L.take (toEnum $ n-1) s) (L.fromChunks [u])
v <- readExactly 1 is'
assertEqual "eq3" (L.drop (toEnum $ n-1) s) (L.fromChunks [v])
------------------------------------------------------------------------------
testTakeWhile :: Test
testTakeWhile = testCase "bytestring/takeBytesWhile" $ do
is <- fromList ["test", "ing\n", "1-2-3\n1-2-3"]
takeBytesWhile (/= '\n') is >>=
assertEqual "takeBytesWhile1" (Just "testing")
takeBytesWhile (/= '\n') is >>=
assertEqual "takeBytesWhile2" (Just "")
readExactly 1 is >>= assertEqual "readExactly" "\n"
takeBytesWhile (/= '\n') is >>=
assertEqual "takeBytesWhile3" (Just "1-2-3")
readExactly 1 is >>= assertEqual "readExactly" "\n"
takeBytesWhile (/= '\n') is >>=
assertEqual "takeBytesWhile4" (Just "1-2-3")
takeBytesWhile (/= '\n') is >>= assertEqual "takeBytesWhile4" Nothing
------------------------------------------------------------------------------
testLines :: Test
testLines = testCase "bytestring/testLines" $ do
fromList ["th", "e\nquick\nbrown", "\n", "", "fox"] >>= lines >>=
toList >>= assertEqual "lines" ["the", "quick", "brown", "fox"]
fromList [] >>= lines >>= toList >>= assertEqual "empty lines" []
fromList ["a\nb\nc\n"] >>= lines >>= toList
>>= assertEqual "ending in delimiter" ["a","b","c"]
fromList ["ok", "cool"] >>=
\is -> outputToList (\os -> unlines os >>= connect is) >>=
assertEqual "unlines" ["ok", "\n", "cool", "\n"]
------------------------------------------------------------------------------
testWords :: Test
testWords = testCase "bytestring/testWords" $ do
fromList ["the quick brown \n\tfox"] >>= words >>=
toList >>= assertEqual "words" ["the", "quick", "brown", "fox"]
fromList ["ok", "cool"] >>=
\is -> outputToList (\os -> unwords os >>= connect is) >>=
assertEqual "unlines" ["ok", " ", "cool"]
------------------------------------------------------------------------------
testTrivials :: Test
testTrivials = testCase "bytestring/testTrivials" $ do
coverTypeableInstance (undefined :: TooManyBytesReadException)
coverShowInstance (undefined :: TooManyBytesReadException)
coverTypeableInstance (undefined :: TooFewBytesWrittenException)
coverShowInstance (undefined :: TooFewBytesWrittenException)
coverTypeableInstance (undefined :: TooManyBytesWrittenException)
coverShowInstance (undefined :: TooManyBytesWrittenException)
coverTypeableInstance (undefined :: RateTooSlowException)
coverShowInstance (undefined :: RateTooSlowException)
coverTypeableInstance (undefined :: ReadTooShortException)
coverEqInstance $ Match ""
coverShowInstance $ Match ""
coverShowInstance $ NoMatch ""