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)