Fix the tests.

Author: robrix

semantic-core/semantic-core.cabal

@@ -84,6 +84,7 @@ test-suite spec
   other-modules:       Generators
   build-depends:       base
                      , semantic-core
+                     , fused-effects
                      , hedgehog ^>= 1
                      , tasty >= 1.2 && <2
                      , tasty-hedgehog ^>= 1.0.0.1

semantic-core/test/Generators.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, TypeOperators #-}
 
 module Generators
   ( literal
@@ -18,6 +18,7 @@ import Hedgehog hiding (Var)
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 
+import Control.Effect.Sum ((:+:))
 import qualified Data.Core as Core
 import Data.Name
 import Data.Term
@@ -29,16 +30,16 @@ name :: MonadGen m => m (Named User)
 name = Gen.prune (named' <$> names) where
   names = Gen.text (Range.linear 1 10) Gen.lower
 
-boolean :: MonadGen m => m (Term Core.Core User)
+boolean :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User)
 boolean = Core.bool <$> Gen.bool
 
-variable :: MonadGen m => m (Term Core.Core User)
+variable :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User)
 variable = pure . namedValue <$> name
 
-ifthenelse :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
+ifthenelse :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User) -> m (Term (Core.Ann :+: Core.Core) User)
 ifthenelse bod = Gen.subterm3 boolean bod bod Core.if'
 
-apply :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
+apply :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User) -> m (Term (Core.Ann :+: Core.Core) User)
 apply gen = go where
   go = Gen.recursive
     Gen.choice
@@ -47,21 +48,21 @@ apply gen = go where
     , Gen.subtermM go (\x -> Core.lam <$> name <*> pure x)
     ]
 
-lambda :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
+lambda :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User) -> m (Term (Core.Ann :+: Core.Core) User)
 lambda bod = do
   arg <- name
   Gen.subterm bod (Core.lam arg)
 
-record :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
+record :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User) -> m (Term (Core.Ann :+: Core.Core) User)
 record bod = Core.record <$> Gen.list (Range.linear 0 5) ((,) . namedValue <$> name <*> bod)
 
-atoms :: MonadGen m => [m (Term Core.Core User)]
+atoms :: MonadGen m => [m (Term (Core.Ann :+: Core.Core) User)]
 atoms = [variable, pure Core.unit, boolean, Core.string <$> Gen.text (Range.linear 1 10) Gen.lower]
 
-literal :: MonadGen m => m (Term Core.Core User)
+literal :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User)
 literal = Gen.recursive Gen.choice atoms [lambda literal, record literal]
 
-expr :: MonadGen m => m (Term Core.Core User)
+expr :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User)
 expr = Gen.recursive Gen.choice atoms
   [ Gen.subtermM expr (\x -> flip Core.rec x <$> name)
   , Gen.subterm2 expr expr (Core.>>>)

semantic-core/test/Spec.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, TypeOperators #-}
 module Main (main) where
 
 import           Data.String
@@ -9,6 +9,7 @@ import           Test.Tasty
 import           Test.Tasty.Hedgehog
 import           Test.Tasty.HUnit
 
+import           Control.Effect.Sum
 import           Data.File
 import qualified Generators as Gen
 import qualified Analysis.Eval as Eval
@@ -20,7 +21,7 @@ import           Data.Term
 
 -- * Helpers
 
-true, false :: Term Core User
+true, false :: Term (Ann :+: Core) User
 true  = bool True
 false = bool False
 
@@ -30,10 +31,10 @@ parseEither p = Trifecta.foldResult (Left . show . Trifecta._errDoc) Right . Tri
 -- * Parser roundtripping properties. Note that parsing and prettyprinting is generally
 -- not a roundtrip, because the parser inserts 'Ann' nodes itself.
 
-prop_roundtrips :: Gen (Term Core User) -> Property
+prop_roundtrips :: Gen (Term (Ann :+: Core) User) -> Property
 prop_roundtrips gen = property $ do
   input <- forAll gen
-  tripping input showCore (parseEither (Parse.core <* Trifecta.eof))
+  tripping input (showCore . stripAnnotations) (parseEither (Parse.core <* Trifecta.eof))
 
 parserProps :: TestTree
 parserProps = testGroup "Parsing: roundtripping"
@@ -46,7 +47,7 @@ parserProps = testGroup "Parsing: roundtripping"
 
 -- * Parser specs
 
-parsesInto :: String -> Term Core User -> Assertion
+parsesInto :: String -> Term (Ann :+: Core) User -> Assertion
 parsesInto str res = case parseEither Parse.core str of
   Right x -> x @?= res
   Left m  -> assertFailure m
@@ -56,7 +57,7 @@ assert_booleans_parse = do
   parseEither Parse.core "#true"  @?= Right true
   parseEither Parse.core "#false" @?= Right false
 
-a, f, g, h :: Term Core User
+a, f, g, h :: Term (Ann :+: Core) User
 (a, f, g, h) = (pure "a", pure "f", pure "g", pure "h")
 
 assert_ifthen_parse :: Assertion
@@ -92,9 +93,9 @@ parserSpecs = testGroup "Parsing: simple specs"
   , testCase "quoted names" assert_quoted_name_parse
   ]
 
-assert_roundtrips :: File (Term Core User) -> Assertion
-assert_roundtrips (File _ core) = case parseEither Parse.core (showCore core) of
-  Right v -> v @?= stripAnnotations core
+assert_roundtrips :: File (Term (Ann :+: Core) User) -> Assertion
+assert_roundtrips (File _ core) = case parseEither Parse.core (showCore (stripAnnotations core)) of
+  Right v -> stripAnnotations v @?= stripAnnotations core
   Left e -> assertFailure e
 
 parserExamples :: TestTree