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 qualified SourceSyntax.Pattern as P
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 = P.Data "I" [ P.Literal (Lit.Chr '+')
                         , P.Record
                           [ "q7yclkcm7k_ikstrczv_"
                           , "wQRv6gKsvvkjw4b5F"
                           ,"c9'eFfhk9FTvsMnwF_D"
                           ,"yqxhEkHvRFwZ"
                           ,"o"
                           ,"nbUlCn3y3NnkVoxhW"
                           ,"iJ0MNy3KZ_lrs"
                           ,"ug"
                           ,"sHHsX"
                           ,"mRKs9d"
                           ,"o2KiCX5'ZRzHJfRi8" ]
                         , P.Var "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