Merge branch 'fixes/monod-valued-de-GADT'

bench/MA/Functors/BenchMonoidValued.hs

@@ -25,7 +25,7 @@ benchmarks = bgroup "MA.Functors.Monoid"
 
 benchIntValued :: Benchmark
 benchIntValued = bgroup "IntValued" $
-  let f = IntValued ()
+  let f = MonoidValued @Int ()
   in
     [ benchParseMorphPoint "single successor" f "{x: 1}"
     , benchParseMorphPoint "ten successors" f "{x: 1, x: 2, x: 3, x: 4, x: 5, x: 6, x: 7, x: 8, x: 9, x: 10}"

src/MA/Functors/Distribution.hs

@@ -46,7 +46,7 @@ deriving instance Show (Distribution ())
 
 instance ParseMorphism Distribution where
   parseMorphismPoint (Distribution inner) = do
-    (h1, succs) <- parseMorphismPoint (RealValued inner)
+    (h1, succs) <- parseMorphismPoint (MonoidValued @ADouble inner)
 
     when (h1 /= 1) $
       fail "distribution: Sum of outgoing labels is not 1"

src/MA/Functors/MonoidValued.hs

@@ -31,9 +31,7 @@ import qualified MA.Parser.Lexer as L
 import           MA.Parser.Types
 import           MA.FunctorDescription
 
-data MonoidValued m a where
-  RealValued :: a -> MonoidValued ADouble a
-  IntValued  :: a -> MonoidValued Int a
+data MonoidValued m a = MonoidValued a
 
 deriving instance Show (MonoidValued m ())
 deriving instance Functor (MonoidValued m)
@@ -45,7 +43,7 @@ intValued = FunctorDescription
   { name = "Integer-valued"
   , syntaxExample = "Z^X | ℤ^X"
   , functorExprParser =
-      prefix ((L.symbol "Z" <|> L.symbol "ℤ") >> L.symbol "^" >> pure IntValued)
+      prefix ((L.symbol "Z" <|> L.symbol "ℤ") >> L.symbol "^" >> pure MonoidValued)
   }
 
 realValued :: FunctorDescription (MonoidValued ADouble)
@@ -53,7 +51,7 @@ realValued = FunctorDescription
   { name = "Real-valued"
   , syntaxExample = "R^X | ℝ^X"
   , functorExprParser = prefix
-    ((L.symbol "R" <|> L.symbol "ℝ") >> L.symbol "^" >> pure RealValued)
+    ((L.symbol "R" <|> L.symbol "ℝ") >> L.symbol "^" >> pure MonoidValued)
   }
 
 data MonoidWeight m = MonoidWeight !m !m
@@ -88,10 +86,10 @@ parseMorphismPointHelper inner weightParser = do
 {-# SPECIALIZE parseMorphismPointHelper :: MorphParser l h1 Int -> MorphParser l h1 ADouble -> MorphParser l h1 (ADouble, Vector (Int, ADouble)) #-}
 
 instance ParseMorphism (MonoidValued Int) where
-  parseMorphismPoint (IntValued inner) = parseMorphismPointHelper inner L.decimal
+  parseMorphismPoint (MonoidValued inner) = parseMorphismPointHelper inner L.decimal
 
 instance ParseMorphism (MonoidValued ADouble) where
-  parseMorphismPoint (RealValued inner) = parseMorphismPointHelper inner L.adouble
+  parseMorphismPoint (MonoidValued inner) = parseMorphismPointHelper inner L.adouble
 
 instance (Num m, Ord m) => RefinementInterface (MonoidValued m) where
   init :: H1 (MonoidValued m) -> [Label (MonoidValued m)] -> Weight (MonoidValued m)

tests/MA/Functors/MonoidValuedSpec.hs

@@ -11,6 +11,7 @@ import qualified Data.MorphismEncoding as Encoding
 import           MA.Coalgebra.Parser
 import           MA.FunctorExpression.Type
 import           MA.FunctorExpression.Sorts (Sorted(..))
+import           Data.AFloat
 
 spec :: Spec
 spec = do
@@ -20,34 +21,34 @@ spec = do
 parseMorphismPointIntSpec :: Spec
 parseMorphismPointIntSpec = describe "parseMorphismPoint (Int)" $ do
   it "parses an empty successor list" $
-    (snd <$> parseMorphisms (Functor 1 (IntValued Variable)) "" "x: {}")
+    (snd <$> parseMorphisms (Functor 1 (MonoidValued @Int Variable)) "" "x: {}")
     `shouldParse`
     (encoding [(Sorted 1 0)] [])
 
   it "parses a simple example" $
     (snd <$>
-     parseMorphisms (Functor 1 (IntValued Variable)) "" "x: {x: 2, y: 3}\ny: {}") `shouldParse`
+     parseMorphisms (Functor 1 (MonoidValued @Int Variable)) "" "x: {x: 2, y: 3}\ny: {}") `shouldParse`
     (encoding
        [(Sorted 1 5), (Sorted 1 0)]
        [(0, (Sorted 1 2), 0), (0, (Sorted 1 3), 1)])
 
   it "fails on duplicate edges" $
-    parseMorphisms (Functor 1 (IntValued Variable)) "" `shouldFailOn` "x: {x: 2, x: 3}"
+    parseMorphisms (Functor 1 (MonoidValued @Int Variable)) "" `shouldFailOn` "x: {x: 2, x: 3}"
 
   it "works with negative numbers" $
-    parseMorphisms (Functor 1 (IntValued Variable)) "" `shouldSucceedOn` "x: {x: -2}"
+    parseMorphisms (Functor 1 (MonoidValued @Int Variable)) "" `shouldSucceedOn` "x: {x: -2}"
 
 parseMorphismPointDoubleSpec :: Spec
 parseMorphismPointDoubleSpec = describe "parseMorphismPoint (Double)" $ do
   it "parses an empty successor list" $
-    (snd <$> parseMorphisms (Functor 1 (RealValued Variable)) "" "x: {}")
+    (snd <$> parseMorphisms (Functor 1 (MonoidValued @ADouble Variable)) "" "x: {}")
     `shouldParse`
     (encoding [(Sorted 1 0)] [])
 
   it "parses a simple example" $
     (snd <$>
      parseMorphisms
-       (Functor 1 (RealValued Variable))
+       (Functor 1 (MonoidValued @ADouble Variable))
        ""
        "x: {x: 0.5, y: 3.7}\ny: {}") `shouldParse`
     (encoding
@@ -55,10 +56,10 @@ parseMorphismPointDoubleSpec = describe "parseMorphismPoint (Double)" $ do
        [(0, (Sorted 1 0.5), 0), (0, (Sorted 1 3.7), 1)])
 
   it "fails on duplicate edges" $
-    parseMorphisms (Functor 1 (RealValued Variable)) "" `shouldFailOn` "x: {x: 0.5, x: 3.7}"
+    parseMorphisms (Functor 1 (MonoidValued @ADouble Variable)) "" `shouldFailOn` "x: {x: 0.5, x: 3.7}"
 
   it "works with negative numbers" $
-    parseMorphisms (Functor 1 (RealValued Variable)) "" `shouldSucceedOn` "x: {x: -2.3}"
+    parseMorphisms (Functor 1 (MonoidValued @ADouble Variable)) "" `shouldSucceedOn` "x: {x: -2.3}"
 
 -- FIXME: Remove duplicate definition of this function
 encoding :: [h1] -> [(Int, l, Int)] -> Encoding l h1