1{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}
2module QC.ByteString (tests) where
3
4#if !MIN_VERSION_base(4,8,0)
5import Control.Applicative ((<*>), (<$>))
6#endif
7import Data.Char (chr, ord, toUpper)
8import Data.Int (Int64)
9import Data.Word (Word8)
10import Prelude hiding (take, takeWhile)
11import QC.Common (ASCII(..), liftOp, parseBS, toStrictBS)
12import Test.Tasty (TestTree)
13import Test.Tasty.QuickCheck (testProperty)
14import Test.QuickCheck
15import qualified Data.Attoparsec.ByteString as P
16import qualified Data.Attoparsec.ByteString.Char8 as P8
17import qualified Data.Attoparsec.ByteString.FastSet as S
18import qualified Data.Attoparsec.ByteString.Lazy as PL
19import qualified Data.ByteString as B
20import qualified Data.ByteString.Char8 as B8
21import qualified Data.ByteString.Lazy as L
22import qualified Data.ByteString.Lazy.Char8 as L8
23
24-- Basic byte-level combinators.
25
26satisfy :: Word8 -> L.ByteString -> Property
27satisfy w s = parseBS (P.satisfy (<=w)) (L.cons w s) === Just w
28
29satisfyWith :: Word8 -> L.ByteString -> Property
30satisfyWith w s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))
31                         (L.cons (fromIntegral (ord c)) s) === Just c
32  where
33    c = chr (fromIntegral w)
34
35word8 :: Word8 -> L.ByteString -> Property
36word8 w s = parseBS (P.word8 w) (L.cons w s) === Just w
37
38skip :: Word8 -> L.ByteString -> Property
39skip w s =
40  case (parseBS (P.skip (<w)) s, L.uncons s) of
41    (Nothing, mcs) -> maybe (property True) (expectFailure . it) mcs
42    (Just _,  mcs) -> maybe (property False) it mcs
43  where it cs = liftOp "<" (<) (fst cs) w
44
45anyWord8 :: L.ByteString -> Property
46anyWord8 s
47    | L.null s  = p === Nothing
48    | otherwise = p === Just (L.head s)
49  where p = parseBS P.anyWord8 s
50
51notWord8 :: Word8 -> NonEmptyList Word8 -> Property
52notWord8 w (NonEmpty s) = parseBS (P.notWord8 w) bs === if v == w
53                                                        then Nothing
54                                                        else Just v
55    where v = L.head bs
56          bs = L.pack s
57
58peekWord8 :: L.ByteString -> Property
59peekWord8 s
60    | L.null s  = p === Just (Nothing, s)
61    | otherwise = p === Just (Just (L.head s), s)
62  where p = parseBS ((,) <$> P.peekWord8 <*> P.takeLazyByteString) s
63
64peekWord8' :: L.ByteString -> Property
65peekWord8' s = parseBS P.peekWord8' s === (fst <$> L.uncons s)
66
67string :: L.ByteString -> L.ByteString -> Property
68string s t = parseBS (P.string s') (s `L.append` t) === Just s'
69  where s' = toStrictBS s
70
71stringCI :: ASCII L.ByteString -> ASCII L.ByteString -> Property
72stringCI (ASCII s) (ASCII t) =
73    parseBS (P8.stringCI up) (s `L.append` t) === Just s'
74  where s' = toStrictBS s
75        up = B8.map toUpper s'
76
77strings :: L.ByteString -> L.ByteString -> L.ByteString -> Property
78strings s t u =
79    parseBS (P.string (toStrictBS s) >> P.string t') (L.concat [s,t,u])
80    === Just t'
81  where t' = toStrictBS t
82
83skipWhile :: Word8 -> L.ByteString -> Property
84skipWhile w s =
85    let t = L.dropWhile (<=w) s
86    in case PL.parse (P.skipWhile (<=w)) s of
87         PL.Done t' () -> t === t'
88         _             -> property False
89
90takeCount :: Positive Int -> L.ByteString -> Property
91takeCount (Positive k) s =
92    case parseBS (P.take k) s of
93      Nothing -> liftOp ">" (>) (fromIntegral k) (L.length s)
94      Just _s -> liftOp "<=" (<=) (fromIntegral k) (L.length s)
95
96takeWhile :: Word8 -> L.ByteString -> Property
97takeWhile w s =
98    let (h,t) = L.span (==w) s
99    in case PL.parse (P.takeWhile (==w)) s of
100         PL.Done t' h' -> t === t' .&&. toStrictBS h === h'
101         _             -> property False
102
103take :: Int -> L.ByteString -> Property
104take n s = maybe (property $ L.length s < fromIntegral n)
105           (=== B.take n (toStrictBS s)) $
106           parseBS (P.take n) s
107
108takeByteString :: L.ByteString -> Property
109takeByteString s = maybe (property False) (=== toStrictBS s) .
110                   parseBS P.takeByteString $ s
111
112takeLazyByteString :: L.ByteString -> Property
113takeLazyByteString s = maybe (property False) (=== s) .
114                       parseBS P.takeLazyByteString $ s
115
116takeWhile1 :: Word8 -> L.ByteString -> Property
117takeWhile1 w s =
118    let s'    = L.cons w s
119        (h,t) = L.span (<=w) s'
120    in case PL.parse (P.takeWhile1 (<=w)) s' of
121         PL.Done t' h' -> t === t' .&&. toStrictBS h === h'
122         _             -> property False
123
124takeTill :: Word8 -> L.ByteString -> Property
125takeTill w s =
126    let (h,t) = L.break (==w) s
127    in case PL.parse (P.takeTill (==w)) s of
128         PL.Done t' h' -> t === t' .&&. toStrictBS h === h'
129         _             -> property False
130
131takeWhile1_empty :: Property
132takeWhile1_empty = parseBS (P.takeWhile1 undefined) L.empty === Nothing
133
134endOfInput :: L.ByteString -> Property
135endOfInput s = parseBS P.endOfInput s === if L.null s
136                                          then Just ()
137                                          else Nothing
138
139endOfLine :: L.ByteString -> Property
140endOfLine s =
141  case (parseBS P8.endOfLine s, L8.uncons s) of
142    (Nothing, mcs) -> maybe (property True) (expectFailure . eol) mcs
143    (Just _,  mcs) -> maybe (property False) eol mcs
144  where eol (c,s') = c === '\n' .||.
145                     (c, fst <$> L8.uncons s') === ('\r', Just '\n')
146
147scan :: L.ByteString -> Positive Int64 -> Property
148scan s (Positive k) = parseBS p s === Just (toStrictBS $ L.take k s)
149  where p = P.scan k $ \ n _ ->
150            if n > 0 then let !n' = n - 1 in Just n' else Nothing
151
152members :: [Word8] -> Property
153members s = property $ all (`S.memberWord8` set) s
154    where set = S.fromList s
155
156nonmembers :: [Word8] -> [Word8] -> Property
157nonmembers s s' = property . not . any (`S.memberWord8` set) $ filter (not . (`elem` s)) s'
158    where set = S.fromList s
159
160tests :: [TestTree]
161tests = [
162      testProperty "anyWord8" anyWord8
163    , testProperty "endOfInput" endOfInput
164    , testProperty "endOfLine" endOfLine
165    , testProperty "notWord8" notWord8
166    , testProperty "peekWord8" peekWord8
167    , testProperty "peekWord8'" peekWord8'
168    , testProperty "satisfy" satisfy
169    , testProperty "satisfyWith" satisfyWith
170    , testProperty "scan" scan
171    , testProperty "skip" skip
172    , testProperty "skipWhile" skipWhile
173    , testProperty "string" string
174    , testProperty "stringCI" stringCI
175    , testProperty "strings" strings
176    , testProperty "take" take
177    , testProperty "takeByteString" takeByteString
178    , testProperty "takeCount" takeCount
179    , testProperty "takeLazyByteString" takeLazyByteString
180    , testProperty "takeTill" takeTill
181    , testProperty "takeWhile" takeWhile
182    , testProperty "takeWhile1" takeWhile1
183    , testProperty "takeWhile1_empty" takeWhile1_empty
184    , testProperty "word8" word8
185    , testProperty "members" members
186    , testProperty "nonmembers" nonmembers
187  ]
188