Property.hs

module Tests.Property where

import Control.Applicative ((<*))
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.HUnit (assert)
import Test.QuickCheck
import Text.Parsec.Combinator (eof)
import Text.PrettyPrint as P

import SourceSyntax.Literal as Lit
import SourceSyntax.Pattern as Pat
import SourceSyntax.PrettyPrint  (Pretty, pretty)
import Parse.Helpers             (IParser, iParse)
import Parse.Literal             (literal)
import qualified Parse.Pattern as Pat (expr)
import qualified Parse.Type as Type (expr)
import Tests.Property.Arbitrary

propertyTests :: Test
propertyTests =
  testGroup "Parse/Print Agreement Tests"
  [
    testCase "Long Pattern test" $ assert (prop_parse_print Pat.expr longPat)
  , testProperty "Literal test" $ prop_parse_print literal
  , testProperty "Pattern test" $ prop_parse_print Pat.expr
  , testProperty "Type test" $ prop_parse_print Type.expr
  ]

  where
    -- This test was autogenerated from the Pattern test and should be
    -- left in all its ugly glory.
    longPat = Pat.PData "I" [ Pat.PLiteral (Lit.Chr '+')
                            , Pat.PRecord [
                                 "q7yclkcm7k_ikstrczv_"
                                 , "wQRv6gKsvvkjw4b5F"
                                 ,"c9'eFfhk9FTvsMnwF_D"
                                 ,"yqxhEkHvRFwZ"
                                 ,"o"
                                 ,"nbUlCn3y3NnkVoxhW"
                                 ,"iJ0MNy3KZ_lrs"
                                 ,"ug"
                                 ,"sHHsX"
                                 ,"mRKs9d"
                                 ,"o2KiCX5'ZRzHJfRi8" ]
                            , Pat.PVar "su'BrrbPUK6I33Eq" ]

prop_parse_print :: (Pretty a, Arbitrary a, Eq a) => IParser a -> a -> Bool
prop_parse_print p x =
  either (const False) (== x) . parse_print p $ x

parse_print :: (Pretty a) => IParser a -> a -> Either String a
parse_print p = either (Left . show) (Right) . iParse (p <* eof) . P.renderStyle P.style {mode=P.LeftMode} . pretty