-- See http://lstephen.wordpress.com/2007/07/29/parsec-parser-testing-with-quickcheck/
-- for more on this approach.

import Test.QuickCheck
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Language (emptyDef)
import Text.ParserCombinators.Parsec.Token
import Text.PrettyPrint.HughesPJ

-- The test is simply that taking a value, pretty-printing it and then
-- parsing it, yields the original value.

checkParser :: Eq a => Parser a -> (a -> Doc) -> a -> Bool
checkParser p pp x = case (parse p "" (render $ pp x)) of
                       Left  _ -> False
                       Right x' -> x == x'

-- The pretty-printer for double is taken care of.

ppDouble :: Double -> Doc
ppDouble = double

-- The parser is a bit more complicated.

parseDouble :: Parser Double
parseDouble = do n <- numParser
                 case n of
                   Left _ -> error "Nooo" -- Naive, for this example.
                   Right x -> return x

numParser :: Parser (Either Integer Double)
numParser = try $ do (symbol toks) "-"
                     n <- naturalOrFloat toks
                     case n of
                       Left i -> return $ Left $ negate i
                       Right f -> return $ Right $ negate f
            <|> naturalOrFloat toks
  where toks = makeTokenParser emptyDef

-- Test runner.
test :: IO ()
test = quickCheck $ checkParser parseDouble ppDouble

-- (x == x) is True
-- (checkParser parseDouble ppDouble) is False (on my machine, anyway)
x :: Double
x = 9.91165677454629