Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
C
CoPaR
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Deploy
Releases
Container Registry
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
This is an archived project. Repository and other project resources are read-only.
Show more breadcrumbs
Informatik 8
CoPaR
Commits
9c877832
Commit
9c877832
authored
6 years ago
by
Hans-Peter Deifel
Browse files
Options
Downloads
Patches
Plain Diff
Refactor MonoidValuedSpec
Removes lots of code duplication
parent
74c8b14e
No related branches found
No related tags found
No related merge requests found
Changes
1
Pipelines
2
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
tests/Copar/Functors/MonoidValuedSpec.hs
+86
-182
86 additions, 182 deletions
tests/Copar/Functors/MonoidValuedSpec.hs
with
86 additions
and
182 deletions
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}
\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
]
[]
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment