@@ -0,0 +1,112 @@
1+module Main (main) where
2+
3+import Control.Applicative
4+import Data.Attoparsec as P
5+import Data.List (isInfixOf)
6+import Data.Maybe (isJust)
7+import Data.Word (Word8)
8+import Control.Monad (forM_)
9+import Debug.Trace
10+import System.IO
11+import Test.QuickCheck
12+import qualified Data.ByteString as S
13+import qualified Data.ByteString.Lazy as L
14+import System.Environment
15+import QCSupport
16+
17+-- Make sure that structures whose types claim they are non-empty
18+-- really are.
19+
20+prop_nonEmptyList l = length (nonEmpty l) > 0
21+ where types = l :: NonEmpty [Int]
22+prop_nonEmptyBS l = S.length (nonEmpty l) > 0
23+prop_nonEmptyLBS l = L.length (nonEmpty l) > 0
24+
25+-- Naming.
26+
27+prop_label (NonEmpty s) = case parse (anyWord8 <?> s) L.empty of
28+ (_, Left err) -> s `isInfixOf` err
29+ _ -> False
30+
31+-- Basic byte-level combinators.
32+
33+prop_word8 (NonEmpty s) = maybeP (word8 w) s == Just w
34+ where w = L.head s
35+
36+prop_anyWord8 (NonEmpty s) = isJust $ maybeP anyWord8 s
37+
38+prop_notWord8 (w, NonEmpty s) = v /= w ==> maybeP (notWord8 w) s == Just v
39+ where v = L.head s
40+
41+prop_string s = maybeP (string s) s == Just s
42+
43+prop_skipWhile (w,s) =
44+ let (h,t) = L.span (==w) s
45+ in case parse (skipWhile (==w)) s of
46+ (t',Right ()) -> t == t'
47+ _ -> False
48+
49+prop_takeCount (k,s) =
50+ k >= 0 ==>
51+ case maybeP (takeCount k) s of
52+ Nothing -> j > L.length s
53+ Just s' -> j <= L.length s
54+ where j = fromIntegral k
55+
56+prop_takeWhile (w,s) =
57+ let (h,t) = L.span (==w) s
58+ in case parse (P.takeWhile (==w)) s of
59+ (t',Right h') -> t == t' && h == h'
60+ _ -> False
61+
62+prop_takeWhile1 (w, NonEmpty s) =
63+ let (h,t) = L.span (==w) s
64+ in case parse (P.takeWhile (==w)) s of
65+ (t',Right h') -> t == t' && h == h'
66+ _ -> False
67+
68+prop_takeTill (w, s) =
69+ let (h,t) = L.break (==w) s
70+ in case parse (P.takeTill (==w)) s of
71+ (t',Right h') -> t == t' && h == h'
72+ _ -> False
73+
74+prop_takeWhile1_empty = maybeP (P.takeWhile1 undefined) L.empty == Nothing
75+
76+prop_notEmpty_string s = case maybeP (notEmpty (string s)) s of
77+ Nothing -> L.null s
78+ Just s' -> not (L.null s) && s == s'
79+
80+main :: IO ()
81+main = do
82+ args <- getArgs
83+ let n = case args of
84+ [] -> 500
85+ [k] -> read k
86+ _ -> error "too many arguments"
87+ forM_ tests $ \(name,prop) -> do
88+ putStr name
89+ putStr (replicate (40 - length name) ' ')
90+ hFlush stdout
91+ prop n
92+
93+p :: Testable a => a -> Int -> IO ()
94+p prop count = limCheck count prop
95+
96+tests :: [(String, Int -> IO ())]
97+tests = [
98+ ("nonEmptyList", p prop_nonEmptyList),
99+ ("nonEmptyBS", p prop_nonEmptyBS),
100+ ("nonEmptyLBS", p prop_nonEmptyLBS),
101+ ("word8", p prop_word8),
102+ ("notWord8", p prop_notWord8),
103+ ("anyWord8", p prop_anyWord8),
104+ ("string", p prop_string),
105+ ("skipWhile", p prop_skipWhile),
106+ ("takeCount", p prop_takeCount),
107+ ("takeWhile", p prop_takeWhile),
108+ ("takeWhile1", p prop_takeWhile1),
109+ ("takeWhile1_empty", p prop_takeWhile1_empty),
110+ ("takeTill", p prop_takeTill),
111+ ("notEmpty_string", p prop_notEmpty_string)
112+ ]