{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Control.Monad (forM_)
import Data.Maybe (isJust)
import Prelude hiding (takeWhile)
import QCSupport
import Test.Framework (defaultMain, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck hiding (NonEmpty)
import qualified Data.Attoparsec.Text as P
import qualified Data.Text as T
-- Make sure that structures whose types claim they are non-empty
-- really are.
nonEmptyList l = length (nonEmpty l) > 0
where types = l :: NonEmpty [Int]
nonEmptyBS l = T.length (nonEmpty l) > 0
-- Naming.
{-
label (NonEmpty s) = case parse (anyChar <?> s) T.empty of
(_, Left err) -> s `isInfixOf` err
_ -> False
-}
-- Basic byte-level combinators.
maybeP p s = case P.parse p s `P.feed` T.empty of
P.Done _ i -> Just i
_ -> Nothing
defP p s = P.parse p s `P.feed` T.empty
satisfy w s = maybeP (P.satisfy (<=w)) (T.cons w s) == Just w
char w s = maybeP (P.char w) (T.cons w s) == Just w
anyChar s = maybeP P.anyChar s == if T.null s
then Nothing
else Just (T.head s)
notChar w (NonEmpty s) = maybeP (P.notChar w) s == if v == w
then Nothing
else Just v
where v = T.head s
string s = maybeP (P.string s) s == Just s
skipWhile w s =
let t = T.dropWhile (<=w) s
in case defP (P.skipWhile (<=w)) s of
P.Done t' () -> t == t'
_ -> False
takeCount (Positive k) s =
case maybeP (P.take k) s of
Nothing -> k > T.length s
Just s' -> k <= T.length s
takeWhile w s =
let (h,t) = T.spanBy (==w) s
in case defP (P.takeWhile (==w)) s of
P.Done t' h' -> t == t' && h == h'
_ -> False
takeWhile1 w s =
let s' = T.cons w s
(h,t) = T.spanBy (<=w) s'
in case defP (P.takeWhile1 (<=w)) s' of
P.Done t' h' -> t == t' && h == h'
_ -> False
takeTill w s =
let (h,t) = T.breakBy (==w) s
in case defP (P.takeTill (==w)) s of
P.Done t' h' -> t == t' && h == h'
_ -> False
ensure n s = case defP (P.ensure m) s of
P.Done _ () -> T.length s >= m
_ -> T.length s < m
where m = (n `mod` 220) - 20
takeWhile1_empty = maybeP (P.takeWhile1 undefined) T.empty == Nothing
endOfInput s = maybeP P.endOfInput s == if T.null s
then Just ()
else Nothing
main = defaultMain tests
tests = [
testGroup "fnord" [
testProperty "nonEmptyList" nonEmptyList,
testProperty "nonEmptyBS" nonEmptyBS,
testProperty "satisfy" satisfy,
testProperty "char" char,
testProperty "notChar" notChar,
testProperty "anyChar" anyChar,
testProperty "string" string,
testProperty "skipWhile" skipWhile,
testProperty "takeCount" takeCount,
testProperty "takeWhile" takeWhile,
testProperty "takeWhile1" takeWhile1,
testProperty "takeWhile1_empty" takeWhile1_empty,
testProperty "takeTill" takeTill,
testProperty "endOfInput" endOfInput,
testProperty "ensure" ensure
]
]