Add Test.Injection (#1865)

* Add Test.Injection

* Test.Injection: Export module Hedgehog

* Test Injection instances of SomeVariableName

Author: ttuegel

kore/test/Test/Injection.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Test.Injection
+    ( hpropInjection
+    , hprop_Injection_Maybe
+    , hprop_Injection_Dynamic
+    -- * Re-exports
+    , module Hedgehog
+    , Int8
+    , genInt8
+    ) where
+
+import Prelude
+
+import Hedgehog hiding
+    ( test
+    )
+import qualified Hedgehog.Gen as Gen
+
+import Data.Dynamic
+    ( Dynamic
+    )
+import Data.Int
+    ( Int8
+    )
+
+import Injection
+
+{- | Create a property test for an 'Injection' instance.
+
+Only the "left identity" property is tested; as long as the instance is not
+partial, this property implies all others.
+
+Note: The @into@ type parameter *must* be specified by type application.
+
+ -}
+hpropInjection
+    :: forall into from
+    .  (Eq from, Show from)
+    => Injection into from
+    => Gen from -> Property
+hpropInjection genFrom =
+    property $ do
+        from <- forAll genFrom
+        let into = inject @into from
+        retract into === Just from
+
+genInt8 :: MonadGen m => m Int8
+genInt8 = Gen.enumBounded
+
+hprop_Injection_Maybe :: Property
+hprop_Injection_Maybe = hpropInjection @(Maybe Int8) genInt8
+
+hprop_Injection_Dynamic :: Property
+hprop_Injection_Dynamic = hpropInjection @Dynamic genInt8

kore/test/Test/Kore/Syntax/Variable.hs

@@ -1,6 +1,8 @@
 module Test.Kore.Syntax.Variable
     ( test_isSetVariable
     , test_isElementVariable
+    , hprop_instance_Injection_SomeVariableName_ElementVariableName
+    , hprop_instance_Injection_SomeVariableName_SetVariableName
     -- * Re-exports
     , module Kore.Syntax.Variable
     ) where
@@ -11,6 +13,7 @@ import Test.Tasty
 
 import Kore.Syntax.Variable
 
+import Test.Injection
 import Test.Kore
     ( testId
     )
@@ -54,3 +57,11 @@ test_isElementVariable =
         testCase name $ do
             let actual = isElementVariable input
             assertEqual "" expect actual
+
+hprop_instance_Injection_SomeVariableName_ElementVariableName :: Property
+hprop_instance_Injection_SomeVariableName_ElementVariableName =
+    hpropInjection @(SomeVariableName Int8) (ElementVariableName <$> genInt8)
+
+hprop_instance_Injection_SomeVariableName_SetVariableName :: Property
+hprop_instance_Injection_SomeVariableName_SetVariableName =
+    hpropInjection @(SomeVariableName Int8) (SetVariableName <$> genInt8)