{-# LANGUAGE BangPatterns, OverloadedStrings #-}
module QC.ByteString (tests) where
import Control.Applicative ((<$>), (<*>))
import Data.Char (chr, ord)
import Data.Int (Int64)
import Data.Word (Word8)
import Prelude hiding (take, takeWhile)
import QC.Common (liftOp, parseBS, toStrictBS)
import Test.Framework (Test)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck
import qualified Data.Attoparsec.ByteString as P
import qualified Data.Attoparsec.ByteString.Char8 as P8
import qualified Data.Attoparsec.ByteString.Lazy as PL
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
satisfy :: Word8 -> L.ByteString -> Property
satisfy w s = parseBS (P.satisfy (<=w)) (L.cons w s) === Just w
satisfyWith :: Char -> L.ByteString -> Property
satisfyWith c s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))
(L.cons (fromIntegral (ord c)) s) === Just c
word8 :: Word8 -> L.ByteString -> Property
word8 w s = parseBS (P.word8 w) (L.cons w s) === Just w
skip :: Word8 -> L.ByteString -> Property
skip w s =
case (parseBS (P.skip (<w)) s, L.uncons s) of
(Nothing, mcs) -> maybe (property True) (expectFailure . it) mcs
(Just _, mcs) -> maybe (property False) it mcs
where it cs = liftOp "<" (<) (fst cs) w
anyWord8 :: L.ByteString -> Property
anyWord8 s
| L.null s = p === Nothing
| otherwise = p === Just (L.head s)
where p = parseBS P.anyWord8 s
notWord8 :: Word8 -> NonEmptyList Word8 -> Property
notWord8 w (NonEmpty s) = parseBS (P.notWord8 w) bs === if v == w
then Nothing
else Just v
where v = L.head bs
bs = L.pack s
peekWord8 :: L.ByteString -> Property
peekWord8 s
| L.null s = p === Just (Nothing, s)
| otherwise = p === Just (Just (L.head s), s)
where p = parseBS ((,) <$> P.peekWord8 <*> P.takeLazyByteString) s
peekWord8' :: L.ByteString -> Property
peekWord8' s = parseBS P.peekWord8' s === (fst <$> L.uncons s)
string :: L.ByteString -> L.ByteString -> Property
string s t = parseBS (P.string s') (s `L.append` t) === Just s'
where s' = toStrictBS s
skipWhile :: Word8 -> L.ByteString -> Property
skipWhile w s =
let t = L.dropWhile (<=w) s
in case PL.parse (P.skipWhile (<=w)) s of
PL.Done t' () -> t === t'
_ -> property False
takeCount :: Positive Int -> L.ByteString -> Property
takeCount (Positive k) s =
case parseBS (P.take k) s of
Nothing -> liftOp ">" (>) (fromIntegral k) (L.length s)
Just _s -> liftOp "<=" (<=) (fromIntegral k) (L.length s)
takeWhile :: Word8 -> L.ByteString -> Property
takeWhile w s =
let (h,t) = L.span (==w) s
in case PL.parse (P.takeWhile (==w)) s of
PL.Done t' h' -> t === t' .&&. toStrictBS h === h'
_ -> property False
take :: Int -> L.ByteString -> Property
take n s = maybe (property $ L.length s < fromIntegral n)
(=== B.take n (toStrictBS s)) $
parseBS (P.take n) s
takeByteString :: L.ByteString -> Property
takeByteString s = maybe (property False) (=== toStrictBS s) .
parseBS P.takeByteString $ s
takeLazyByteString :: L.ByteString -> Property
takeLazyByteString s = maybe (property False) (=== s) .
parseBS P.takeLazyByteString $ s
takeWhile1 :: Word8 -> L.ByteString -> Property
takeWhile1 w s =
let s' = L.cons w s
(h,t) = L.span (<=w) s'
in case PL.parse (P.takeWhile1 (<=w)) s' of
PL.Done t' h' -> t === t' .&&. toStrictBS h === h'
_ -> property False
takeTill :: Word8 -> L.ByteString -> Property
takeTill w s =
let (h,t) = L.break (==w) s
in case PL.parse (P.takeTill (==w)) s of
PL.Done t' h' -> t === t' .&&. toStrictBS h === h'
_ -> property False
takeWhile1_empty :: Property
takeWhile1_empty = parseBS (P.takeWhile1 undefined) L.empty === Nothing
endOfInput :: L.ByteString -> Property
endOfInput s = parseBS P.endOfInput s === if L.null s
then Just ()
else Nothing
endOfLine :: L.ByteString -> Property
endOfLine s =
case (parseBS P8.endOfLine s, L8.uncons s) of
(Nothing, mcs) -> maybe (property True) (expectFailure . eol) mcs
(Just _, mcs) -> maybe (property False) eol mcs
where eol (c,s') = c === '\n' .||.
(c, fst <$> L8.uncons s') === ('\r', Just '\n')
scan :: L.ByteString -> Positive Int64 -> Property
scan s (Positive k) = parseBS p s === Just (toStrictBS $ L.take k s)
where p = P.scan k $ \ n _ ->
if n > 0 then let !n' = n - 1 in Just n' else Nothing
tests :: [Test]
tests = [
testProperty "anyWord8" anyWord8
, testProperty "endOfInput" endOfInput
, testProperty "endOfLine" endOfLine
, testProperty "notWord8" notWord8
, testProperty "peekWord8" peekWord8
, testProperty "peekWord8'" peekWord8'
, testProperty "satisfy" satisfy
, testProperty "satisfyWith" satisfyWith
, testProperty "scan" scan
, testProperty "skip" skip
, testProperty "skipWhile" skipWhile
, testProperty "string" string
, testProperty "take" take
, testProperty "takeByteString" takeByteString
, testProperty "takeCount" takeCount
, testProperty "takeLazyByteString" takeLazyByteString
, testProperty "takeTill" takeTill
, testProperty "takeWhile" takeWhile
, testProperty "takeWhile1" takeWhile1
, testProperty "takeWhile1_empty" takeWhile1_empty
, testProperty "word8" word8
]