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