@@ -5,7 +5,7 @@ module QC.Text (tests) where
55import Control.Applicative ((<$>), (<*>))
66import Data.Int (Int64)
77import Prelude hiding (take, takeWhile)
8−import QC.Common (parseT)
8+import QC.Common (liftOp, parseT)
99import Test.Framework (Test)
1010import Test.Framework.Providers.QuickCheck2 (testProperty)
1111import Test.QuickCheck
@@ -17,50 +17,50 @@ import qualified Data.Text.Lazy as L
1717
1818-- Basic byte-level combinators.
1919
20−satisfy :: Char -> L.Text -> Bool
21−satisfy w s = parseT (P.satisfy (<=w)) (L.cons w s) == Just w
20+satisfy :: Char -> L.Text -> Property
21+satisfy w s = parseT (P.satisfy (<=w)) (L.cons w s) === Just w
2222
23−satisfyWith :: Char -> L.Text -> Bool
24−satisfyWith c s = parseT (P.satisfyWith id (<=c)) (L.cons c s) == Just c
23+satisfyWith :: Char -> L.Text -> Property
24+satisfyWith c s = parseT (P.satisfyWith id (<=c)) (L.cons c s) === Just c
2525
26−char :: Char -> L.Text -> Bool
27−char w s = parseT (P.char w) (L.cons w s) == Just w
26+char :: Char -> L.Text -> Property
27+char w s = parseT (P.char w) (L.cons w s) === Just w
2828
29−skip :: Char -> L.Text -> Bool
29+skip :: Char -> L.Text -> Property
3030skip w s =
3131 case (parseT (P.skip (<w)) s, L.uncons s) of
32− (Nothing, mcs) -> maybe True (not . it) mcs
33− (Just _, mcs) -> maybe False it mcs
34− where it cs = fst cs < w
32+ (Nothing, mcs) -> maybe (property True) (expectFailure . it) mcs
33+ (Just _, mcs) -> maybe (property False) it mcs
34+ where it cs = liftOp "<" (<) (fst cs) w
3535
36−anyChar :: L.Text -> Bool
36+anyChar :: L.Text -> Property
3737anyChar s
38− | L.null s = p == Nothing
39− | otherwise = p == Just (L.head s)
38+ | L.null s = p === Nothing
39+ | otherwise = p === Just (L.head s)
4040 where p = parseT P.anyChar s
4141
42−notChar :: Char -> NonEmptyList Char -> Bool
43−notChar w (NonEmpty s) = parseT (P.notChar w) bs == if v == w
42+notChar :: Char -> NonEmptyList Char -> Property
43+notChar w (NonEmpty s) = parseT (P.notChar w) bs === if v == w
4444 then Nothing
4545 else Just v
4646 where v = L.head bs
4747 bs = L.pack s
4848
49−peekChar :: L.Text -> Bool
49+peekChar :: L.Text -> Property
5050peekChar s
51− | L.null s = p == Just (Nothing, s)
52− | otherwise = p == Just (Just (L.head s), s)
51+ | L.null s = p === Just (Nothing, s)
52+ | otherwise = p === Just (Just (L.head s), s)
5353 where p = parseT ((,) <$> P.peekChar <*> P.takeLazyText) s
5454
55−peekChar' :: L.Text -> Bool
56−peekChar' s = parseT P.peekChar' s == (fst <$> L.uncons s)
55+peekChar' :: L.Text -> Property
56+peekChar' s = parseT P.peekChar' s === (fst <$> L.uncons s)
5757
58−string :: L.Text -> L.Text -> Bool
59−string s t = parseT (P.string s') (s `L.append` t) == Just s'
58+string :: L.Text -> L.Text -> Property
59+string s t = parseT (P.string s') (s `L.append` t) === Just s'
6060 where s' = toStrict s
6161
62−stringCI :: T.Text -> Bool
63−stringCI s = P.parseOnly (P.stringCI fs) s == Right s
62+stringCI :: T.Text -> Property
63+stringCI s = P.parseOnly (P.stringCI fs) s === Right s
6464 where fs = T.toCaseFold s
6565
6666asciiCI :: T.Text -> Gen Bool
@@ -76,68 +76,70 @@ asciiCI x =
7676toStrict :: L.Text -> T.Text
7777toStrict = T.concat . L.toChunks
7878
79−skipWhile :: Char -> L.Text -> Bool
79+skipWhile :: Char -> L.Text -> Property
8080skipWhile w s =
8181 let t = L.dropWhile (<=w) s
8282 in case PL.parse (P.skipWhile (<=w)) s of
83− PL.Done t' () -> t == t'
84− _ -> False
83+ PL.Done t' () -> t === t'
84+ _ -> property False
8585
86−take :: Int -> L.Text -> Bool
87−take n s = maybe (L.length s < fromIntegral n) (== T.take n (toStrict s)) $
86+take :: Int -> L.Text -> Property
87+take n s = maybe (liftOp "<" (<) (L.length s) (fromIntegral n))
88+ (=== T.take n (toStrict s)) $
8889 parseT (P.take n) s
8990
90−takeText :: L.Text -> Bool
91−takeText s = maybe False (== toStrict s) . parseT P.takeText $ s
91+takeText :: L.Text -> Property
92+takeText s = maybe (property False) (=== toStrict s) . parseT P.takeText $ s
9293
93−takeLazyText :: L.Text -> Bool
94−takeLazyText s = maybe False (== s) . parseT P.takeLazyText $ s
94+takeLazyText :: L.Text -> Property
95+takeLazyText s = maybe (property False) (=== s) . parseT P.takeLazyText $ s
9596
96−takeCount :: Positive Int -> L.Text -> Bool
97+takeCount :: Positive Int -> L.Text -> Property
9798takeCount (Positive k) s =
9899 case parseT (P.take k) s of
99− Nothing -> fromIntegral k > L.length s
100− Just _s -> fromIntegral k <= L.length s
100+ Nothing -> liftOp ">" (>) (fromIntegral k) (L.length s)
101+ Just _s -> liftOp "<=" (<=) (fromIntegral k) (L.length s)
101102
102−takeWhile :: Char -> L.Text -> Bool
103+takeWhile :: Char -> L.Text -> Property
103104takeWhile w s =
104105 let (h,t) = L.span (==w) s
105106 in case PL.parse (P.takeWhile (==w)) s of
106− PL.Done t' h' -> t == t' && toStrict h == h'
107− _ -> False
107+ PL.Done t' h' -> t === t' .&&. toStrict h === h'
108+ _ -> property False
108109
109−takeWhile1 :: Char -> L.Text -> Bool
110+takeWhile1 :: Char -> L.Text -> Property
110111takeWhile1 w s =
111112 let s' = L.cons w s
112113 (h,t) = L.span (<=w) s'
113114 in case PL.parse (P.takeWhile1 (<=w)) s' of
114− PL.Done t' h' -> t == t' && toStrict h == h'
115− _ -> False
115+ PL.Done t' h' -> t === t' .&&. toStrict h === h'
116+ _ -> property False
116117
117−takeTill :: Char -> L.Text -> Bool
118+takeTill :: Char -> L.Text -> Property
118119takeTill w s =
119120 let (h,t) = L.break (==w) s
120121 in case PL.parse (P.takeTill (==w)) s of
121− PL.Done t' h' -> t == t' && toStrict h == h'
122− _ -> False
122+ PL.Done t' h' -> t === t' .&&. toStrict h === h'
123+ _ -> property False
123124
124−takeWhile1_empty :: Bool
125−takeWhile1_empty = parseT (P.takeWhile1 undefined) L.empty == Nothing
125+takeWhile1_empty :: Property
126+takeWhile1_empty = parseT (P.takeWhile1 undefined) L.empty === Nothing
126127
127−endOfInput :: L.Text -> Bool
128−endOfInput s = parseT P.endOfInput s == if L.null s
129− then Just ()
130− else Nothing
128+endOfInput :: L.Text -> Property
129+endOfInput s = parseT P.endOfInput s === if L.null s
130+ then Just ()
131+ else Nothing
131132
132−endOfLine :: L.Text -> Bool
133+endOfLine :: L.Text -> Property
133134endOfLine s =
134135 case (parseT P.endOfLine s, L.uncons s) of
135− (Nothing, mcs) -> maybe True (not . eol) mcs
136− (Just _, mcs) -> maybe False eol mcs
137− where eol (c,s') = c == '\n' || (c, fst <$> L.uncons s') == ('\r', Just '\n')
136+ (Nothing, mcs) -> maybe (property True) (expectFailure . eol) mcs
137+ (Just _, mcs) -> maybe (property False) eol mcs
138+ where eol (c,s') = c === '\n' .||.
139+ (c, fst <$> L.uncons s') === ('\r', Just '\n')
138140
139−scan :: L.Text -> Positive Int64 -> Bool
140−scan s (Positive k) = parseT p s == (Just $ toStrict $ L.take k s)
141+scan :: L.Text -> Positive Int64 -> Property
142+scan s (Positive k) = parseT p s === Just (toStrict $ L.take k s)
141143 where p = P.scan k $ \ n _ ->
142144 if n > 0 then let !n' = n - 1 in Just n' else Nothing
143145