module Main where import Test.QuickCheck{- (Arbitrary(arbitrary), Gen, sized, elements, frequency, quickCheck, sample) -} import Control.Monad(liftM, liftM2) import ParseUtil -- (P, symbol, pfail, (+++), parse, ...) import Lemmas -- | A very simple expression type. data Expr = Lit Int | Plus Expr Expr deriving Eq -- | A parser for expressions. exprP :: P Char Expr exprP = chainLeft plusP termP where -- Parse the plus sign. Returns the 'Plus' function. plusP :: P Char (Expr -> Expr -> Expr) plusP = this '+' >> return Plus termP :: P Char Expr termP = liftM Lit digitP +++ do this '(' e <- exprP this ')' return e -- | We test that showing and then parsing is the identity and -- that the parse is unambiguous. prop_parse :: Expr -> Bool prop_parse e = [e] == parseAll (show e) where -- Throw away incomplete parses parseAll :: String -> [Expr] parseAll s = [ x | (x, "") <- parse exprP s ] -- Bad: -- parseAll s = [ x | (x, _) <- parse exprP s ] runTests = quickCheck prop_parse main = runTests -- quickCheck (\(Blind f) s -> concatMapSingletonLemma f s) --------------------------- -- * Testing infrastructure instance Show Expr where showsPrec p (Lit n) = shows n showsPrec p (Plus e1 e2) = showParen (p > 0) $ shows e1 . showString "+" . showsPrec 1 e2 -- | For reference: -- > shows = showsPrec 0 type Size = Int -- | Generating arbitrary expressions. instance Arbitrary Expr where arbitrary = sized arb where digit :: Gen Int digit = elements [0..9] arb :: Size -> Gen Expr arb 0 = liftM Lit digit arb n = frequency $ (1, arb 0) : [ (4, liftM2 Plus arb2 arb2) | n > 0 ] where arb2 :: Gen Expr arb2 = arb (n `div` 2)