Skip to content

GitLab

Commit 9c877832 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢
Browse files
Options

Refactor MonoidValuedSpec 

Removes lots of code duplication
parent 74c8b14e
Hide whitespace changes
Inline Side-by-side
Showing with 86 additions and 182 deletions
tests/Copar/Functors/MonoidValuedSpec.hs
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] []
Markdown is supported
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