1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
module Main
( main
) where
import Control.Applicative
#ifdef MIN_VERSION_attoparsec
import Data.Attoparsec.Text (parseOnly)
#endif
import Data.String
#if MIN_VERSION_base(4,7,0)
import Data.Either
#endif
import Test.QuickCheck
import Test.QuickCheck.Instances ()
#ifdef MIN_VERSION_parsec
import Text.Parsec.Prim as P (parse)
#endif
import Text.Parser.Char
import Text.Parser.Combinators
import Text.ParserCombinators.ReadP (readP_to_S)
import System.Exit
-- -------------------------------------------------------------------------- --
-- Run tests with different parser frameworks
-- Instead of letting quick check pick the parser framework as a test parameter
-- it may be better to just run all tests for each parser framework.
newtype P a = P (forall m. (Monad m, CharParsing m) => m a)
data TestParser a = TestParser String (P a -> String -> Either String a)
instance Show (TestParser a) where show (TestParser n _) = n
#ifdef MIN_VERSION_attoparsec
pAtto :: TestParser a
pAtto = TestParser "attoparsec" $ \(P p) -> parseOnly p . fromString
#endif
#ifdef MIN_VERSION_parsec
pParsec :: TestParser a
pParsec = TestParser "parsec" $ \(P p) -> either (Left . show) Right . parse p "test input"
#endif
pReadP :: TestParser a
pReadP = TestParser "ReadP" $ \(P p) s -> case readP_to_S p s of
[] -> Left "parseFailed"
(a,_):_ -> Right a
instance Arbitrary (TestParser a) where
arbitrary = elements ps
where
ps = [pReadP]
#ifdef MIN_VERSION_attoparsec
++ [pAtto]
#endif
#ifdef MIN_VERSION_parsec
++ [pParsec]
#endif
-- -------------------------------------------------------------------------- --
-- Main
main :: IO ()
main = mapM quickCheckResult tests >>= \x -> case filter (not . passed) x of
[] -> exitSuccess
_ -> exitFailure
where
passed Success{} = True
passed _ = False
-- -------------------------------------------------------------------------- --
-- Tests
tests :: [Property]
tests =
[ property prop_notFollowedBy0
, property prop_notFollowedBy1
, property prop_notFollowedBy2
, property prop_notFollowedBy3
]
-- -------------------------------------------------------------------------- --
-- Properties
prop_notFollowedBy0 :: TestParser Char -> Char -> Char -> Bool
prop_notFollowedBy0 (TestParser _ p) x y = either (\_ -> x == y) (/= y)
$ p (P (notFollowedBy (char y) *> anyChar)) [x]
prop_notFollowedBy1 :: TestParser Char -> Char -> Bool
prop_notFollowedBy1 (TestParser _ p) x = either (\_ -> x == x) (/= x)
$ p (P (notFollowedBy (char x) *> anyChar)) [x]
prop_notFollowedBy2 :: TestParser Char -> String -> Char -> Bool
prop_notFollowedBy2 (TestParser _ p) x y = isLeft
$ p (P (anyChar *> notFollowedBy (char y) *> char y)) x
prop_notFollowedBy3 :: TestParser () -> Char -> Bool
prop_notFollowedBy3 (TestParser _ p) x = isRight
$ p (P (notFollowedBy (char x) <|> char x *> pure ())) [x]
-- -------------------------------------------------------------------------- --
-- Utils
#if !MIN_VERSION_base(4,7,0)
isLeft :: Either a b -> Bool
isLeft = either (const True) (const False)
isRight :: Either a b -> Bool
isRight = either (const False) (const True)
#endif
|
