Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
Software
CoPaR
Commits
9c877832
Commit
9c877832
authored
Mar 13, 2019
by
Hans-Peter Deifel
🐢
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Refactor MonoidValuedSpec
Removes lots of code duplication
parent
74c8b14e
Changes
1
Pipelines
2
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
86 additions
and
182 deletions
+86
-182
tests/Copar/Functors/MonoidValuedSpec.hs
tests/Copar/Functors/MonoidValuedSpec.hs
+86
-182
No files found.
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}
\n
y: {}"
...
...
@@ -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}
\n
y: {}"
...
...
@@ -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}
\n
y: {}"
...
...
@@ -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}
\n
y: {}"
...
...
@@ -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}
\n
y: {}"
...
...
@@ -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}
\n
y: {}"
...
...
@@ -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}
\n
y: {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
]
[]
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment