Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Software
CoPaR
Commits
89199390
Commit
89199390
authored
Jun 05, 2020
by
Bastian Kauschke
Committed by
Bastian Kauschke
Jun 23, 2020
Browse files
use FunctorDescription precedence
parent
a5d8af4a
Changes
13
Hide whitespace changes
Inline
Side-by-side
src/Copar/FunctorDescription.hs
View file @
89199390
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
module
Copar.FunctorDescription
(
DynFunctorDescription
(
..
)
,
FunctorParser
(
..
)
,
FunctorDescription
(
..
)
,
Suitable
,
ToDynFunctorDescription
(
..
)
,
formatFunctorDescription
,
formatFunctorDescriptions
,
dynPrecedence
,
dynFunctorDescription
,
dynFunctorExprParser
)
where
import
Control.DeepSeq
(
NFData
(
..
))
import
Data.Functor.Classes
import
Data.Text
(
Text
)
import
Data.Text.Prettyprint
(
Doc
,
(
<+>
)
...
...
@@ -22,28 +27,50 @@ import qualified Data.Text.Prettyprint as Doc
import
Data.Proxy
import
Type.Reflection
import
Copar.FunctorExpression.Printable
import
Copar.FunctorExpression.Parser
import
Copar.Functors.SomeFunctor
import
Copar.RefinementInterface
import
Copar.Coalgebra.Parser.Class
import
Copar.PrettyShow
type
Suitable
f
=
(
RefinementInterface
f
,
ParseMorphism
f
,
Printable
f
,
Eq1
f
,
Functor
f
,
FunctorDescription
f
,
Foldable
f
,
Typeable
f
,
Traversable
f
,
Show1
f
,
NFData
(
F1
f
)
,
NFData
(
Label
f
)
,
PrettyShow
(
Label
f
)
,
PrettyShow
(
F1
f
))
class
(
Suitable
f
)
=>
FunctorDescription
f
where
class
FunctorDescription
f
where
name
::
Text
syntaxExample
::
Text
description
::
Maybe
(
Doc
AnsiStyle
)
precedence
::
Int
functorExprParser
::
FunctorParser
f
dynFunctorDescription
::
forall
f
.
FunctorDescription
f
=>
DynFunctorDescription
dynFunctorDescription
::
forall
f
.
Suitable
f
=>
DynFunctorDescription
dynFunctorDescription
=
DynFunctorDescription
(
Proxy
::
Proxy
f
)
class
ToDynFunctorDescription
f
where
toDynFunctorDescription
::
f
a
->
DynFunctorDescription
data
DynFunctorDescription
where
DynFunctorDescription
::
FunctorDescription
f
=>
Proxy
f
->
DynFunctorDescription
DynFunctorDescription
::
Suitable
f
=>
Proxy
f
->
DynFunctorDescription
dynPrecedence
::
DynFunctorDescription
->
Int
dynPrecedence
(
DynFunctorDescription
(
Proxy
::
Proxy
f
))
=
precedence
@
f
dynFunctorExprParser
::
DynFunctorDescription
->
FunctorParser
SomeFunctor
dynFunctorExprParser
(
DynFunctorDescription
(
Proxy
::
Proxy
f
))
=
transParser
SomeFunctor
(
functorExprParser
@
f
)
formatFunctorDescription
::
FunctorDescription
f
=>
Proxy
f
->
Doc
AnsiStyle
formatFunctorDescription
(
Proxy
::
Proxy
f
)
=
Doc
.
vsep
[
Doc
.
annotate
(
Doc
.
bold
<>
Doc
.
underlined
)
(
Doc
.
pretty
(
name
@
f
))
...
...
src/Copar/FunctorExpression/Printable.hs
View file @
89199390
...
...
@@ -38,10 +38,4 @@ defaultPrintConfig = PrintConfig {
}
class
Printable
f
where
-- | The operator precedence of the given functor,
--
-- This is used to elide some unnecessary braces and should
-- be kept up to date with `registeredFunctors`.
precedence
::
f
a
->
Int
printMe
::
PrintConfig
->
f
Build
.
Builder
->
Build
.
Builder
src/Copar/FunctorPrinter.hs
View file @
89199390
...
...
@@ -7,6 +7,7 @@ import Data.Text.Lazy.Builder as Build
import
Copar.FunctorExpression.Printable
import
Copar.FunctorExpression.Sorts
(
Sort
,
formatSortAsScope
)
import
Copar.FunctorExpression.Type
(
FunctorExpression
(
..
))
import
Copar.FunctorDescription
printFunctor
::
(
Printable
f
,
Foldable
f
,
Functor
f
)
=>
FunctorExpression
f
Sort
->
T
.
Text
printFunctor
(
Functor
_
f'
)
=
Lazy
.
toStrict
(
Build
.
toLazyText
(
printTree
inner
f'
))
...
...
@@ -26,19 +27,21 @@ inner f = (foldMap getChild f, print (fmap printChild f))
getChild
Variable
=
[]
getChild
(
Functor
sort
f'
)
=
[(
formatSortAsScope
sort
,
f'
)]
printParseableFunctor
::
(
Printable
f
,
Foldable
f
,
Functor
f
)
=>
FunctorExpression
f
Sort
->
T
.
Text
printParseableFunctor
(
Functor
_
f'
)
=
Lazy
.
toStrict
(
Build
.
toLazyText
(
print
(
fmap
(
printInner
(
p
recedence
f'
))
f'
)))
printParseableFunctor
::
(
ToDynFunctorDescription
f
,
Printable
f
,
Foldable
f
,
Functor
f
)
=>
FunctorExpression
f
Sort
->
T
.
Text
printParseableFunctor
(
Functor
_
f'
)
=
Lazy
.
toStrict
(
Build
.
toLazyText
(
print
(
fmap
(
printInner
(
functorP
recedence
f'
))
f'
)))
where
print
::
forall
f
.
(
Printable
f
)
=>
f
Build
.
Builder
->
Build
.
Builder
print
=
printMe
PrintConfig
{
withName
=
\
_
->
""
}
printInner
::
(
Printable
f
,
Foldable
f
,
Functor
f
)
=>
Int
->
FunctorExpression
f
Sort
->
Build
.
Builder
functorPrecedence
::
ToDynFunctorDescription
f
=>
f
a
->
Int
functorPrecedence
=
dynPrecedence
.
toDynFunctorDescription
printInner
::
(
ToDynFunctorDescription
f
,
Printable
f
,
Foldable
f
,
Functor
f
)
=>
Int
->
FunctorExpression
f
Sort
->
Build
.
Builder
printInner
_
Variable
=
"X"
printInner
prec
(
Functor
_
inner
)
=
let
inner_prec
=
p
recedence
inner
let
inner_prec
=
dynP
recedence
(
toDynFunctorDescription
inner
)
in
if
inner_prec
>
prec
then
print
(
fmap
(
printInner
inner_prec
)
inner
)
else
"("
<>
print
(
fmap
(
printInner
inner_prec
)
inner
)
<>
")"
printParseableFunctor
Variable
=
"X"
src/Copar/Functors/AbsorbingPolynomial.hs
View file @
89199390
...
...
@@ -50,7 +50,9 @@ import Copar.RefinementInterface
import
Copar.Functors.Polynomial
hiding
(
PolyF1
(
..
)
)
import
Copar.FunctorExpression.Type
import
Copar.FunctorExpression.Printable
import
Copar.FunctorDescription
import
Copar.Parser.Types
import
qualified
Data.Vector.Utils
as
V
import
Data.Primitive.SmallArray
...
...
@@ -61,20 +63,24 @@ data Inner f a = Direct a | Absorbed (f a)
$
(
deriveShow1
''Inner
)
$
(
deriveEq1
''Inner
)
newtype
AbsorbingPolynomial
f
a
=
AbsorbingPolynomial
(
Polynomial
(
Inner
f
a
))
deriving
(
Functor
,
Foldable
,
Traversable
)
instance
(
Printable
f
)
=>
Printable
(
AbsorbingPolynomial
f
)
where
precedence
_
=
10
instance
FunctorDescription
(
AbsorbingPolynomial
f
)
where
name
=
"AbsorbingPolynomial"
syntaxExample
=
"2xX + X^3"
description
=
Nothing
-- AbsorbingPolynomial is not relevant for users
precedence
=
10
functorExprParser
=
undefined
-- It is not possible to parse an AbsorbnigPolynomial directly
instance
(
ToDynFunctorDescription
f
,
Printable
f
)
=>
Printable
(
AbsorbingPolynomial
f
)
where
printMe
cfg
(
AbsorbingPolynomial
poly
)
=
let
name
=
withName
cfg
"AbsorbingPolynomial"
in
name
<>
printPolynomial
cfg
((
\
case
Direct
a
->
a
-- We want to always print the surrounding braces in case functor names
-- are printed.
Absorbed
inner
->
if
p
recedence
inner
>
10
&&
name
==
mempty
Absorbed
inner
->
if
dynP
recedence
(
toDynFunctorDescription
inner
)
>
10
&&
name
==
mempty
then
printMe
cfg
inner
else
"("
<>
printMe
cfg
inner
<>
")"
)
<$>
poly
)
...
...
src/Copar/Functors/Bag.hs
View file @
89199390
...
...
@@ -33,8 +33,6 @@ newtype Bag a = Bag a
deriving
(
Functor
,
Foldable
,
Traversable
)
instance
Printable
Bag
where
precedence
_
=
40
printMe
cfg
(
Bag
x
)
=
withName
cfg
"Bag"
<>
"B"
<>
x
instance
FunctorDescription
Bag
where
...
...
src/Copar/Functors/Distribution.hs
View file @
89199390
...
...
@@ -29,8 +29,6 @@ newtype Distribution x = Distribution x
deriving
(
Functor
,
Foldable
,
Traversable
)
instance
Printable
Distribution
where
precedence
_
=
30
printMe
cfg
(
Distribution
x
)
=
withName
cfg
"Distribution"
<>
"D"
<>
x
instance
FunctorDescription
Distribution
where
...
...
src/Copar/Functors/GroupValued.hs
View file @
89199390
...
...
@@ -55,24 +55,16 @@ deriving instance Traversable (GroupValued m)
$
(
deriveShow1
''GroupValued
)
instance
Printable
(
GroupValued
Int
)
where
precedence
_
=
150
printMe
cfg
(
GroupValued
x
)
=
withName
cfg
"Integer-valued"
<>
"Z^"
<>
x
instance
Printable
(
GroupValued
EqDouble
)
where
precedence
_
=
140
printMe
cfg
(
GroupValued
x
)
=
withName
cfg
"Real-valued"
<>
"R^"
<>
x
instance
Printable
(
GroupValued
OrderedComplex
)
where
precedence
_
=
130
printMe
cfg
(
GroupValued
x
)
=
withName
cfg
"Complex-valued"
<>
"C^"
<>
x
instance
Printable
(
GroupValued
(
Ratio
Int
))
where
precedence
_
=
120
printMe
cfg
(
GroupValued
x
)
=
withName
cfg
"Rational-valued"
<>
"Q^"
<>
x
...
...
src/Copar/Functors/MonoidValued.hs
View file @
89199390
...
...
@@ -39,7 +39,6 @@ import Copar.FunctorDescription
import
qualified
Copar.Parser.Lexer
as
L
import
Copar.FunctorExpression.Parser
import
Copar.FunctorExpression.Printable
import
Copar.Functors.SomeFunctor
import
Copar.Coalgebra.Parser
import
Data.Float.Utils
(
MaxDouble
(
..
)
,
MinDouble
(
..
)
...
...
@@ -56,33 +55,21 @@ newtype SlowMonoidValued m a = SlowMonoidValued a
-- TODO Remove Printable in favor of FunctorDescription
instance
Printable
(
SlowMonoidValued
(
Max
Int
))
where
precedence
_
=
250
printMe
cfg
(
SlowMonoidValued
x
)
=
withName
cfg
"Max-valued"
<>
"(Z, max)^"
<>
x
instance
Printable
(
SlowMonoidValued
(
Min
Int
))
where
precedence
_
=
240
printMe
cfg
(
SlowMonoidValued
x
)
=
withName
cfg
"Min-valued"
<>
"(Z, min)^"
<>
x
instance
Printable
(
SlowMonoidValued
MaxDouble
)
where
precedence
_
=
230
printMe
cfg
(
SlowMonoidValued
x
)
=
withName
cfg
"Max-valued"
<>
"(R, max)^"
<>
x
instance
Printable
(
SlowMonoidValued
MinDouble
)
where
precedence
_
=
220
printMe
cfg
(
SlowMonoidValued
x
)
=
withName
cfg
"Min-valued"
<>
"(R, min)^"
<>
x
instance
Printable
(
SlowMonoidValued
(
BitAnd
Word64
))
where
precedence
_
=
210
printMe
cfg
(
SlowMonoidValued
x
)
=
withName
cfg
"BitAnd-valued"
<>
"(Word, and)^"
<>
x
instance
Printable
(
SlowMonoidValued
(
BitOr
Word64
))
where
precedence
_
=
200
printMe
cfg
(
SlowMonoidValued
x
)
=
withName
cfg
"BitOr-valued"
<>
"(Word, or)^"
<>
x
instance
Eq1
(
SlowMonoidValued
m
)
where
...
...
src/Copar/Functors/Polynomial.hs
View file @
89199390
...
...
@@ -95,8 +95,6 @@ $(deriveShow1 ''Factor)
$
(
deriveShow1
''Polynomial
)
instance
Printable
Polynomial
where
precedence
_
=
10
printMe
cfg
poly
=
withName
cfg
"Polynomial"
<>
printPolynomial
cfg
poly
...
...
src/Copar/Functors/Powerset.hs
View file @
89199390
...
...
@@ -36,8 +36,6 @@ $(deriveShow1 ''Powerset)
$
(
deriveEq1
''Powerset
)
instance
Printable
Powerset
where
precedence
_
=
50
printMe
cfg
(
Powerset
x
)
=
withName
cfg
"Powerset"
<>
"P"
<>
x
instance
FunctorDescription
Powerset
where
...
...
src/Copar/Functors/SomeFunctor.hs
View file @
89199390
...
...
@@ -10,6 +10,8 @@ module Copar.Functors.SomeFunctor
(
SomeFunctor
(
..
)
,
Suitable
,
transformInner
,
someFunctorExprParser
,
dynFunctorExprParser
,
SomeWeight
(
..
)
,
SomeLabel
,
SomeF1
...
...
@@ -25,6 +27,7 @@ import Unsafe.Coerce
import
Data.Maybe
(
mapMaybe
)
#
endif
import
Data.Functor.Classes
import
Data.Proxy
import
Control.DeepSeq
(
NFData
(
..
))
import
qualified
Data.Vector
as
V
...
...
@@ -32,23 +35,11 @@ import qualified Data.Text as T
import
Copar.Coalgebra.Parser.Class
import
Copar.FunctorExpression.Printable
import
Copar.FunctorExpression.Parser
import
Copar.PrettyShow
import
Copar.RefinementInterface
type
Suitable
f
=
(
RefinementInterface
f
,
ParseMorphism
f
,
Printable
f
,
Eq1
f
,
Functor
f
,
Foldable
f
,
Typeable
f
,
Traversable
f
,
Show1
f
,
NFData
(
F1
f
)
,
NFData
(
Label
f
)
,
PrettyShow
(
Label
f
)
,
PrettyShow
(
F1
f
))
import
Copar.FunctorDescription
data
SomeFunctor
a
where
...
...
@@ -57,6 +48,15 @@ data SomeFunctor a where
=>
f
a
->
SomeFunctor
a
someFunctorExprParser
::
DynFunctorDescription
->
FunctorParser
SomeFunctor
someFunctorExprParser
(
DynFunctorDescription
(
Proxy
::
Proxy
f
))
=
transParser
SomeFunctor
(
functorExprParser
@
f
)
instance
ToDynFunctorDescription
SomeFunctor
where
toDynFunctorDescription
(
SomeFunctor
(
_
::
f
a
))
=
DynFunctorDescription
(
Proxy
::
Proxy
f
)
dynFunctorExprParser
::
DynFunctorDescription
->
FunctorParser
SomeFunctor
dynFunctorExprParser
(
DynFunctorDescription
(
Proxy
::
Proxy
f
))
=
transParser
SomeFunctor
(
functorExprParser
@
f
)
deriving
instance
Functor
SomeFunctor
deriving
instance
Foldable
SomeFunctor
deriving
instance
Traversable
SomeFunctor
...
...
@@ -78,8 +78,6 @@ instance Eq1 SomeFunctor where
Just
HRefl
->
liftEq
eq'
lhs
rhs
instance
Printable
SomeFunctor
where
precedence
(
SomeFunctor
x
)
=
precedence
x
printMe
cfg
(
SomeFunctor
x
)
=
printMe
cfg
x
-- | Apply a natural transformation under the 'SomeFunctor'.
...
...
src/Copar/Parser.hs
View file @
89199390
...
...
@@ -43,9 +43,12 @@ import Copar.FunctorExpression.Desorting
import
Copar.FunctorExpression.Type
import
Copar.FunctorDescription
import
Copar.Functors.Polynomial
import
Copar.Functors.SomeFunctor
(
SomeFunctor
(
SomeFunctor
)
)
import
Copar.Functors.SomeFunctor
(
SomeFunctor
(
SomeFunctor
)
,
dynFunctorExprParser
)
import
Copar.RewriteFunctors
-- | Creates a functor expression parser for the given list of functor parser,
--
-- This expects the `FunctorParser`s to already be sorted by precedence.
functorExpressionParser
::
(
Traversable
f
,
ParseMorphism
f
)
=>
FunctorExpression
f
Precedence
...
...
tests/Copar/FunctorExpression/SortsSpec.hs
View file @
89199390
...
...
@@ -82,7 +82,6 @@ sortTableSpec = describe "sortTable" $ do
]
instance
Printable
Identity
where
precedence
_
=
0
printMe
cfg
(
Identity
x
)
=
withName
cfg
"Identity"
<>
x
type
instance
Label
Identity
=
()
...
...
@@ -114,7 +113,6 @@ instance Show1 Twice where
liftShowsPrec
=
undefined
instance
Printable
Twice
where
precedence
_
=
0
printMe
cfg
(
Twice
a
b
)
=
withName
cfg
"Twice"
<>
a
<>
" "
<>
b
type
instance
Label
Maybe
=
()
...
...
@@ -128,7 +126,6 @@ instance ParseMorphism Maybe where
parseMorphismPoint
=
undefined
instance
Printable
Maybe
where
precedence
_
=
0
printMe
_
maybe
=
case
maybe
of
Just
x
->
"Just "
<>
x
Nothing
->
"Nothing"
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment