ES: now QC only generates semantically correct programs for conversion

Author: Anabra

grin/src/Test/ExtendedSyntax/Old/Test.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric, LambdaCase, TypeApplications, StandaloneDeriving, RankNTypes #-}
-{-# LANGUAGE QuasiQuotes, ViewPatterns, OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes, ViewPatterns, OverloadedStrings, GeneralizedNewtypeDeriving #-}
 module Test.ExtendedSyntax.Old.Test where
 
 import Prelude hiding (GT)
@@ -41,6 +41,7 @@ import Data.List
 
 import Debug.Trace
 import Data.Text (pack)
+import Grin.Pretty (Pretty(..))
 import Grin.ExtendedSyntax.Pretty (PP(..))
 import Grin.TH
 import Grin.ExtendedSyntax.TypeEnv (TypeEnv, emptyTypeEnv)  -- NOTE: might become problematic later
@@ -941,3 +942,10 @@ instance Solve G.Prog where
 
 changed :: (Testable prop) => Exp -> Exp -> prop -> Property
 changed old new = cover (old /= new) 1 "Transformation has effect"
+
+
+newtype SemanticallyCorrectProgram = SC { correctProg :: Exp }
+  deriving (Eq, Ord, Show, Pretty)
+
+instance Arbitrary SemanticallyCorrectProgram where
+  arbitrary = SC <$> genProg

grin/test/Transformations/ExtendedSyntax/ConversionSpec.hs

@@ -12,8 +12,7 @@ import Test.QuickCheck
 import Test.Hspec.QuickCheck
 
 import Test.Assertions
-import Test.ExtendedSyntax.Old.Test()
-import qualified Test.ExtendedSyntax.Old.Grammar as G
+import Test.ExtendedSyntax.Old.Test (SemanticallyCorrectProgram(..))
 
 runTests :: IO ()
 runTests = hspec spec
@@ -28,11 +27,11 @@ spec = describe "Syntax transformation QuickCheck tests" $ do
 -- NOTE: The conversion itself is the proof that it is convertible
 -- QUESTION: There must be a better way to do this
 -- ANSWER: The conversion function could an Either
-convertibleToNew :: G.Exp -> Bool
-convertibleToNew exp = force (convertToNew $ G.asExp exp) `seq` True
+convertibleToNew :: SemanticallyCorrectProgram -> Bool
+convertibleToNew exp = force (convertToNew $ correctProg exp) `seq` True
 
-roundtripConvertibleOld :: G.Exp -> Bool
-roundtripConvertibleOld exp = force (convertToOld $ convertToNew $ G.asExp exp) `seq` True where
+roundtripConvertibleOld :: SemanticallyCorrectProgram -> Bool
+roundtripConvertibleOld exp = force (convertToOld $ convertToNew $ correctProg exp) `seq` True where
 
   convertToOld :: New.Exp -> Exp
   convertToOld = convert