Skip to content
Snippets Groups Projects
Commit 9c877832 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

Refactor MonoidValuedSpec 

Removes lots of code duplication
parent 74c8b14e
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
tests/Copar/Functors/MonoidValuedSpec.hs
+ 86
− 182
View file @ 9c877832
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Copar.Functors.MonoidValuedSpec (spec) where
......@@ -11,8 +13,12 @@ import Data.Semigroup ( Max(..)
)
import Control.Monad.ST
import Data.Proxy
import Data.Void
import Test.Hspec.Megaparsec
import Data.Text ( Text )
import qualified Data.Text as T
import Text.Megaparsec ( ParseErrorBundle )
import Copar.FunctorExpression.Parser
import Copar.Functors.MonoidValued
......@@ -25,6 +31,8 @@ import qualified Data.Partition as Part
import Copar.Algorithm
import Data.Float.Utils
import Data.Bits.Monoid
import Data.MorphismEncoding ( Encoding )
import Copar.RefinementInterface ( Label, F1 )
spec :: Spec
spec = do
......@@ -44,36 +52,11 @@ spec = do
maxIntParseSpec :: Spec
maxIntParseSpec = describe "maxInt parsing" $ do
it "can parse (Z, max)^X as functor expression"
$ parseFunctorExpression [[functorExprParser maxIntValued]] "" "(Z, max)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
it "can parse (ℤ, max)^X as functor expression"
$ parseFunctorExpression [[functorExprParser maxIntValued]] "" "(ℤ, max)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
it "nests correctly in functor expressions"
$ parseFunctorExpression [[functorExprParser maxIntValued]]
""
"(Z, max)^((Z, max)^X)"
`shouldParse` (Functor
1
(SlowMonoidValued (Functor 1 (SlowMonoidValued Variable)))
)
it "still parses parenthesis in functor expressions correctly" $ do
parseFunctorExpression [[functorExprParser maxIntValued]] "" "((Z, max)^X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
parseFunctorExpression [[functorExprParser maxIntValued]] "" "(Z, max)^(X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
makeFunctorParseSpec maxIntValued ("Z", "ℤ") "max"
let p = fmap snd
. parseMorphisms (Functor 1 (SlowMonoidValued @(Max Int) Variable)) EnableSanityChecks ""
let p = makeMorphParser @(Max Int)
it "parses an empty successor list"
$ p "x: {}"
`shouldParse` encoding [Sorted 1 minBound] []
itParsesEmpty @(Max Int)
it "parses a simple example"
$ p "x: {x: 2, y: 3}\ny: {}"
......@@ -86,36 +69,11 @@ maxIntParseSpec = describe "maxInt parsing" $ do
minIntParseSpec :: Spec
minIntParseSpec = describe "minIntParse" $ do
it "can parse (Z, min)^X as functor expression"
$ parseFunctorExpression [[functorExprParser minIntValued]] "" "(Z, min)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
it "can parse (ℤ, min)^X as functor expression"
$ parseFunctorExpression [[functorExprParser minIntValued]] "" "(ℤ, min)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
it "nests correctly in functor expressions"
$ parseFunctorExpression [[functorExprParser minIntValued]]
""
"(Z, min)^((Z, min)^X)"
`shouldParse` (Functor
1
(SlowMonoidValued (Functor 1 (SlowMonoidValued Variable)))
)
it "still parses parenthesis in functor expressions correctly" $ do
parseFunctorExpression [[functorExprParser minIntValued]] "" "((Z, min)^X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
parseFunctorExpression [[functorExprParser minIntValued]] "" "(Z, min)^(X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
makeFunctorParseSpec minIntValued ("Z", "ℤ") "min"
let p = makeMorphParser @(Min Int)
let p = fmap snd
. parseMorphisms (Functor 1 (SlowMonoidValued @(Min Int) Variable)) EnableSanityChecks ""
it "parses an empty successor list"
$ p "x: {}"
`shouldParse` encoding [Sorted 1 maxBound] []
itParsesEmpty @(Min Int)
it "parses a simple example"
$ p "x: {x: 2, y: 3}\ny: {}"
......@@ -129,8 +87,7 @@ minIntParseSpec = describe "minIntParse" $ do
maxIntRefineSpec :: Spec
maxIntRefineSpec = describe "maxInt refine" $ do
let p = fmap snd
. parseMorphisms (Functor 1 (SlowMonoidValued @(Max Int) Variable)) EnableSanityChecks ""
let p = makeMorphParser @(Max Int)
proxy = Proxy @(Desorted (SlowMonoidValued (Max Int)))
it "it distinguishes different maximas with equal sums" $ do
......@@ -146,8 +103,7 @@ maxIntRefineSpec = describe "maxInt refine" $ do
minIntRefineSpec :: Spec
minIntRefineSpec = describe "minInt refine" $ do
let p = fmap snd
. parseMorphisms (Functor 1 (SlowMonoidValued @(Min Int) Variable)) EnableSanityChecks ""
let p = makeMorphParser @(Min Int)
proxy = Proxy @(Desorted (SlowMonoidValued (Min Int)))
it "it distinguishes different minimas with equal sums" $ do
......@@ -163,36 +119,11 @@ minIntRefineSpec = describe "minInt refine" $ do
maxRealParseSpec :: Spec
maxRealParseSpec = describe "maxReal parsing" $ do
it "can parse (R, max)^X as functor expression"
$ parseFunctorExpression [[functorExprParser maxRealValued]] "" "(R, max)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
it "can parse (ℝ, max)^X as functor expression"
$ parseFunctorExpression [[functorExprParser maxRealValued]] "" "(ℝ, max)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
makeFunctorParseSpec maxRealValued ("R", "ℝ") "max"
it "nests correctly in functor expressions"
$ parseFunctorExpression [[functorExprParser maxRealValued]]
""
"(R, max)^((R, max)^X)"
`shouldParse` (Functor
1
(SlowMonoidValued (Functor 1 (SlowMonoidValued Variable)))
)
it "still parses parenthesis in functor expressions correctly" $ do
parseFunctorExpression [[functorExprParser maxRealValued]] "" "((R, max)^X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
parseFunctorExpression [[functorExprParser maxRealValued]] "" "(R, max)^(X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
let p = makeMorphParser @MaxDouble
let p = fmap snd
. parseMorphisms (Functor 1 (SlowMonoidValued @MaxDouble Variable)) EnableSanityChecks ""
it "parses an empty successor list"
$ p "x: {}"
`shouldParse` encoding [Sorted 1 mempty] []
itParsesEmpty @MaxDouble
it "parses a simple example"
$ p "x: {x: 2.5, y: 3.7}\ny: {}"
......@@ -206,36 +137,11 @@ maxRealParseSpec = describe "maxReal parsing" $ do
minRealParseSpec :: Spec
minRealParseSpec = describe "minReal parsing" $ do
it "can parse (R, min)^X as functor expression"
$ parseFunctorExpression [[functorExprParser minRealValued]] "" "(R, min)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
makeFunctorParseSpec minRealValued ("R", "ℝ") "min"
it "can parse (ℝ, min)^X as functor expression"
$ parseFunctorExpression [[functorExprParser minRealValued]] "" "(ℝ, min)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
let p = makeMorphParser @MinDouble
it "nests correctly in functor expressions"
$ parseFunctorExpression [[functorExprParser minRealValued]]
""
"(R, min)^((R, min)^X)"
`shouldParse` (Functor
1
(SlowMonoidValued (Functor 1 (SlowMonoidValued Variable)))
)
it "still parses parenthesis in functor expressions correctly" $ do
parseFunctorExpression [[functorExprParser minRealValued]] "" "((R, min)^X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
parseFunctorExpression [[functorExprParser minRealValued]] "" "(R, min)^(X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
let p = fmap snd
. parseMorphisms (Functor 1 (SlowMonoidValued @MinDouble Variable)) EnableSanityChecks ""
it "parses an empty successor list"
$ p "x: {}"
`shouldParse` encoding [Sorted 1 mempty] []
itParsesEmpty @MinDouble
it "parses a simple example"
$ p "x: {x: 2.5, y: 3.7}\ny: {}"
......@@ -249,8 +155,7 @@ minRealParseSpec = describe "minReal parsing" $ do
maxRealRefineSpec :: Spec
maxRealRefineSpec = describe "maxReal refine" $ do
let p = fmap snd
. parseMorphisms (Functor 1 (SlowMonoidValued @MaxDouble Variable)) EnableSanityChecks ""
let p = makeMorphParser @MaxDouble
proxy = Proxy @(Desorted (SlowMonoidValued MaxDouble))
it "it distinguishes different maximas with equal sums" $ do
......@@ -266,8 +171,7 @@ maxRealRefineSpec = describe "maxReal refine" $ do
minRealRefineSpec :: Spec
minRealRefineSpec = describe "minReal refine" $ do
let p = fmap snd
. parseMorphisms (Functor 1 (SlowMonoidValued @MinDouble Variable)) EnableSanityChecks ""
let p = makeMorphParser @MinDouble
proxy = Proxy @(Desorted (SlowMonoidValued MinDouble))
it "it distinguishes different minimas with equal sums" $ do
......@@ -283,37 +187,11 @@ minRealRefineSpec = describe "minReal refine" $ do
andWordParseSpec :: Spec
andWordParseSpec = describe "bit-and parsing" $ do
it "can parse (N, and)^X as functor expression"
$ parseFunctorExpression [[functorExprParser andWordValued]] "" "(N, and)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
makeFunctorParseSpec andWordValued ("N", "ℕ") "and"
it "can parse (ℕ, and)^X as functor expression"
$ parseFunctorExpression [[functorExprParser andWordValued]] "" "(ℕ, and)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
let p = makeMorphParser @(BitAnd Word)
it "nests correctly in functor expressions"
$ parseFunctorExpression [[functorExprParser andWordValued]]
""
"(N, and)^((N, and)^X)"
`shouldParse` (Functor
1
(SlowMonoidValued (Functor 1 (SlowMonoidValued Variable)))
)
it "still parses parenthesis in functor expressions correctly" $ do
parseFunctorExpression [[functorExprParser andWordValued]] "" "((N, and)^X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
parseFunctorExpression [[functorExprParser andWordValued]] "" "(N, and)^(X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
let p = fmap snd . parseMorphisms
(Functor 1 (SlowMonoidValued @(BitAnd Word) Variable))
EnableSanityChecks
""
it "parses an empty successor list"
$ p "x: {}"
`shouldParse` encoding [Sorted 1 mempty] []
itParsesEmpty @(BitAnd Word)
it "parses a simple example"
$ p "x: {x: 0xA0, y: 0x0A}\ny: {}"
......@@ -325,8 +203,7 @@ andWordParseSpec = describe "bit-and parsing" $ do
andWordRefineSpec :: Spec
andWordRefineSpec = describe "andWord refine" $ do
let p = fmap snd
. parseMorphisms (Functor 1 (SlowMonoidValued @(BitAnd Word) Variable)) EnableSanityChecks ""
let p = makeMorphParser @(BitAnd Word)
proxy = Proxy @(Desorted (SlowMonoidValued (BitAnd Word)))
it "it distinguishes different meets with equal sums" $ do
......@@ -342,37 +219,11 @@ andWordRefineSpec = describe "andWord refine" $ do
orWordParseSpec :: Spec
orWordParseSpec = describe "bit-or parsing" $ do
it "can parse (N, or)^X as functor expression"
$ parseFunctorExpression [[functorExprParser orWordValued]] "" "(N, or)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
it "can parse (ℕ, or)^X as functor expression"
$ parseFunctorExpression [[functorExprParser orWordValued]] "" "(ℕ, or)^X"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
it "nests correctly in functor expressions"
$ parseFunctorExpression [[functorExprParser orWordValued]]
""
"(N, or)^((N, or)^X)"
`shouldParse` (Functor
1
(SlowMonoidValued (Functor 1 (SlowMonoidValued Variable)))
)
makeFunctorParseSpec orWordValued ("N", "ℕ") "or"
it "still parses parenthesis in functor expressions correctly" $ do
parseFunctorExpression [[functorExprParser orWordValued]] "" "((N, or)^X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
parseFunctorExpression [[functorExprParser orWordValued]] "" "(N, or)^(X)"
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
let p = makeMorphParser @(BitOr Word)
let p = fmap snd . parseMorphisms
(Functor 1 (SlowMonoidValued @(BitOr Word) Variable))
EnableSanityChecks
""
it "parses an empty successor list"
$ p "x: {}"
`shouldParse` encoding [Sorted 1 mempty] []
itParsesEmpty @(BitOr Word)
it "parses a simple example"
$ p "x: {x: 0xA0, y: 0x0A}\ny: {}"
......@@ -384,8 +235,7 @@ orWordParseSpec = describe "bit-or parsing" $ do
orWordRefineSpec :: Spec
orWordRefineSpec = describe "orWord refine" $ do
let p = fmap snd
. parseMorphisms (Functor 1 (SlowMonoidValued @(BitOr Word) Variable)) EnableSanityChecks ""
let p = makeMorphParser @(BitOr Word)
proxy = Proxy @(Desorted (SlowMonoidValued (BitOr Word)))
it "it distinguishes different joins with equal sums" $ do
......@@ -397,3 +247,57 @@ orWordRefineSpec = describe "orWord refine" $ do
let Right enc = p "x: {x: 0xA0, y: 0x0A}\ny: {x: 0xAA, y: 0x00}"
part <- stToIO (refine proxy enc True)
(Part.toBlocks part) `shouldMatchList` [[0, 1]]
makeFunctorParseSpec :: FunctorDescription (SlowMonoidValued m)
-> (Text, Text)
-> Text
-> Spec
makeFunctorParseSpec functor (setAscii, setUnicode) operation = do
let expr = syntax setAscii operation "X"
it ("can parse " <> T.unpack expr <> " as functor expression")
$ parseFunctorExpression [[functorExprParser functor]] "" expr
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
let expr = syntax setUnicode operation "X"
it ("can parse " <> T.unpack expr <> " as functor expression")
$ parseFunctorExpression [[functorExprParser functor]] "" expr
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
it "nests correctly in functor expressions"
$ parseFunctorExpression [[functorExprParser functor]]
""
(syntax setAscii operation ("(" <> syntax setAscii operation "X" <> ")"))
`shouldParse` (Functor
1
(SlowMonoidValued (Functor 1 (SlowMonoidValued Variable)))
)
it "still parses parenthesis in functor expressions correctly" $ do
parseFunctorExpression [[functorExprParser functor]] "" ("(" <> syntax setAscii operation "X" <> ")")
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
parseFunctorExpression [[functorExprParser functor]] "" (syntax setAscii operation "(X)")
`shouldParse` (Functor 1 (SlowMonoidValued Variable))
where syntax set op power = "(" <> set <> ", " <> op <> ")^" <> power
makeMorphParser
:: ParseMorphism (SlowMonoidValued m)
=> Text
-> ( Either
(ParseErrorBundle Text Void)
( Encoding
(Label (Desorted (SlowMonoidValued m)))
(F1 (Desorted (SlowMonoidValued m)))
)
)
makeMorphParser = fmap snd . parseMorphisms
(Functor 1 (SlowMonoidValued Variable))
EnableSanityChecks
""
itParsesEmpty :: forall m. (Show m, Eq m, Monoid m, ParseMorphism (SlowMonoidValued m)) => Spec
itParsesEmpty =
it "parses an empty successor list"
$ makeMorphParser @m "x: {}"
`shouldParse` encoding [Sorted 1 mempty] []
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment