Commit 632f9f24 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢
Browse files

Merge branch 'FunctorDescription' [#28]

parents cabf9b4c 92a63e1b
...@@ -18,8 +18,8 @@ import Copar.FunctorExpression.Sorts ...@@ -18,8 +18,8 @@ import Copar.FunctorExpression.Sorts
import Copar.FunctorExpression.Type import Copar.FunctorExpression.Type
import Copar.FunctorExpression.Parser import Copar.FunctorExpression.Parser
import Copar.Functors.Polynomial import Copar.Functors.Polynomial
import Copar.Functors.SomeFunctor (someFunctorExprParser)
import Copar.Functors import Copar.Functors
import Copar.FunctorDescription
benchmarks :: Benchmark benchmarks :: Benchmark
benchmarks = bgroup "Morphism Parser" benchmarks = bgroup "Morphism Parser"
...@@ -38,7 +38,7 @@ benchIdentity = bgroup "Identity" $ ...@@ -38,7 +38,7 @@ benchIdentity = bgroup "Identity" $
benchMarkov :: Benchmark benchMarkov :: Benchmark
benchMarkov = bgroup "Ax(R^X)" $ benchMarkov = bgroup "Ax(R^X)" $
let let
functors = map dynFunctorExprParser registeredFunctors functors = map someFunctorExprParser registeredFunctors
Right f = annotateSorts <$> parseFunctorExpression functors "" "{a,b,c,d,e}x(R^X)" Right f = annotateSorts <$> parseFunctorExpression functors "" "{a,b,c,d,e}x(R^X)"
in in
[ benchParser "simple" f [ benchParser "simple" f
......
...@@ -56,7 +56,6 @@ library ...@@ -56,7 +56,6 @@ library
, Copar.Algorithm.Split , Copar.Algorithm.Split
, Copar.FunctorExpression.Type , Copar.FunctorExpression.Type
, Copar.FunctorExpression.Parser , Copar.FunctorExpression.Parser
, Copar.FunctorExpression.Printable
, Copar.FunctorExpression.Sorts , Copar.FunctorExpression.Sorts
, Copar.FunctorExpression.Desorting , Copar.FunctorExpression.Desorting
, Copar.FunctorExpression.Transform , Copar.FunctorExpression.Transform
......
...@@ -22,16 +22,12 @@ data Pair a = Pair a a ...@@ -22,16 +22,12 @@ data Pair a = Pair a a
$(deriveShow1 ''Pair) $(deriveShow1 ''Pair)
instance Printable Distribution where instance FunctorDescription Pair where
printMe cfg (Pair lhs rhs) = withName cfg "Pair" <> lhs <> " x " <> rhs name = "Pair"
syntaxExample = "{f, n} x PX"
pair :: FunctorDescription Pair description = Just "A pair of functors"
pair = FunctorDescription functorExprParser = pairp
{ name = "Pair" functorExprPrinter cfg (Pair lhs rhs) = withName cfg "Pair" <> lhs <> " x " <> rhs
, syntaxExample = "{f, n} x PX"
, description = Just "A pair of functors"
, functorExprParser = pairp
}
pairp :: FunctorParser Pair pairp :: FunctorParser Pair
pairp = FunctorParser $ \inner -> pairp = FunctorParser $ \inner ->
......
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
module Copar.FunctorDescription module Copar.FunctorDescription
( DynFunctorDescription(..) ( DynFunctorDescription(..)
, FunctorParser(..) , FunctorParser(..)
, FunctorDescription(..) , FunctorDescription(..)
, PrintConfig(..)
, Suitable
, formatFunctorDescription , formatFunctorDescription
, formatFunctorDescriptions , formatFunctorDescriptions
, dynPrecedence , dynPrecedence
, dynFunctorDescription , dynFunctorDescription
, dynFunctorExprParser
) )
where where
import Control.DeepSeq (NFData(..))
import Data.Functor.Classes
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Text.Prettyprint ( Doc import Data.Text.Prettyprint ( Doc
, (<+>) , (<+>)
, AnsiStyle , AnsiStyle
) )
import qualified Data.Text.Prettyprint as Doc import qualified Data.Text.Prettyprint as Doc
import qualified Data.Text.Lazy.Builder as Build
import Data.Proxy import Data.Proxy
import Type.Reflection
import Copar.FunctorExpression.Parser 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
, 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 name :: Text
syntaxExample :: Text syntaxExample :: Text
description :: Maybe (Doc AnsiStyle) description :: Maybe (Doc AnsiStyle)
precedence :: Int precedence :: Int
functorExprParser :: FunctorParser f functorExprParser :: FunctorParser f
functorExprPrinter :: PrintConfig -> f Build.Builder -> Build.Builder
dynFunctorDescription :: forall f. FunctorDescription f => DynFunctorDescription dynFunctorDescription :: forall f. Suitable f => DynFunctorDescription
dynFunctorDescription = DynFunctorDescription (Proxy :: Proxy f) dynFunctorDescription = DynFunctorDescription (Proxy :: Proxy f)
data PrintConfig = PrintConfig { withName :: Build.Builder -> Build.Builder }
data DynFunctorDescription where data DynFunctorDescription where
DynFunctorDescription :: FunctorDescription f => Proxy f -> DynFunctorDescription DynFunctorDescription :: Suitable f => Proxy f -> DynFunctorDescription
dynPrecedence :: DynFunctorDescription -> Int dynPrecedence :: DynFunctorDescription -> Int
dynPrecedence (DynFunctorDescription (Proxy :: Proxy f)) = precedence @f 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 :: FunctorDescription f => Proxy f -> Doc AnsiStyle
formatFunctorDescription (Proxy :: Proxy f)= Doc.vsep formatFunctorDescription (Proxy :: Proxy f)= Doc.vsep
[ Doc.annotate (Doc.bold <> Doc.underlined) (Doc.pretty (name @f)) [ Doc.annotate (Doc.bold <> Doc.underlined) (Doc.pretty (name @f))
......
module Copar.FunctorExpression.Printable
( Printable (..)
, PrintConfig (..)
, printTree
, defaultPrintConfig
) where
import Data.Text.Lazy.Builder as Build
-- | Print the required skeleton for the current scope.
--
-- The current scope has already been popped of the stack.
printSkeleton :: [a] -> [[a]] -> Build.Builder
printSkeleton h xs =
foldl (\str e -> (if null e then " " else "│ ") <> str)
(if null h then "└ " else "├ ")
xs
printTree :: (a -> ([(Build.Builder, a)], Build.Builder)) -> a -> Build.Builder
printTree f head =
let (children, functor) = f head
in functor <> printInner f [children]
printInner :: (a -> ([(Build.Builder, a)], Build.Builder)) -> [[(Build.Builder, a)]] -> Build.Builder
printInner f (((scope, v):h):rs) =
"\n" <> printSkeleton h rs <> scope <> ": "
<> functor <> (printInner f (children:h:rs))
where
(children, functor) = f v
printInner f ([]:rs) = printInner f rs
printInner _ [] = mempty
data PrintConfig = PrintConfig { withName :: Build.Builder -> Build.Builder }
defaultPrintConfig :: PrintConfig
defaultPrintConfig = PrintConfig {
withName = \name -> name <> " "
}
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
module Copar.FunctorPrinter (printFunctor, printParseableFunctor, Printable) where module Copar.FunctorPrinter (printFunctor, printParseableFunctor) where
import Data.Text as T import qualified Data.Text as T
import Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder as Build import qualified Data.Text.Lazy.Builder as Build
import Copar.FunctorExpression.Printable
import Copar.FunctorExpression.Sorts (Sort, formatSortAsScope) import Copar.FunctorExpression.Sorts (Sort, formatSortAsScope)
import Copar.FunctorExpression.Type (FunctorExpression (..)) import Copar.FunctorExpression.Type (FunctorExpression (..))
import Copar.FunctorDescription
import Copar.Functors.SomeFunctor
printFunctor :: (Printable f, Foldable f, Functor f) => FunctorExpression f Sort -> T.Text printFunctor :: FunctorExpression SomeFunctor Sort -> T.Text
printFunctor (Functor _ f') = Lazy.toStrict (Build.toLazyText (printTree inner f')) printFunctor (Functor _ f') = Lazy.toStrict (Build.toLazyText (printTree inner f'))
printFunctor Variable = "Variable X" printFunctor Variable = "Variable X"
inner :: (Printable f, Foldable f, Functor f) inner :: SomeFunctor (FunctorExpression SomeFunctor Sort)
=> f (FunctorExpression f Sort)
-- ([('sort, subfunctor)], functor) -- ([('sort, subfunctor)], functor)
-> ([(Build.Builder, f (FunctorExpression f Sort))], Build.Builder) -> ([(Build.Builder, SomeFunctor (FunctorExpression SomeFunctor Sort))], Build.Builder)
inner f = (foldMap getChild f, print (fmap printChild f)) inner f = (foldMap getChild f, print (fmap printChild f))
where where
print = printMe PrintConfig { withName = \name -> name <> " " } print = printSomeFunctorExpr PrintConfig { withName = \name -> name <> " " }
printChild Variable = "X" printChild Variable = "X"
printChild (Functor sort _) = formatSortAsScope sort printChild (Functor sort _) = formatSortAsScope sort
...@@ -26,19 +26,44 @@ inner f = (foldMap getChild f, print (fmap printChild f)) ...@@ -26,19 +26,44 @@ inner f = (foldMap getChild f, print (fmap printChild f))
getChild Variable = [] getChild Variable = []
getChild (Functor sort f') = [(formatSortAsScope sort, f')] getChild (Functor sort f') = [(formatSortAsScope sort, f')]
printParseableFunctor :: (Printable f, Foldable f, Functor f) => FunctorExpression f Sort -> T.Text printParseableFunctor :: FunctorExpression SomeFunctor Sort -> T.Text
printParseableFunctor (Functor _ f') = Lazy.toStrict (Build.toLazyText (print (fmap (printInner (precedence f')) f'))) printParseableFunctor (Functor _ f') = Lazy.toStrict (Build.toLazyText (print (fmap (printInner (functorPrecedence f')) f')))
where where
print :: forall f. (Printable f) => f Build.Builder -> Build.Builder print :: SomeFunctor Build.Builder -> Build.Builder
print = printMe PrintConfig { withName = \_ -> "" } print = printSomeFunctorExpr PrintConfig { withName = \_ -> "" }
printInner :: (Printable f, Foldable f, Functor f) => Int -> FunctorExpression f Sort -> Build.Builder functorPrecedence :: SomeFunctor a -> Int
functorPrecedence = dynPrecedence . someFunctorDescription
printInner :: Int -> FunctorExpression SomeFunctor Sort -> Build.Builder
printInner _ Variable = "X" printInner _ Variable = "X"
printInner prec (Functor _ inner) = printInner prec (Functor _ inner) =
let inner_prec = precedence inner let inner_prec = dynPrecedence (someFunctorDescription inner)
in if inner_prec > prec in if inner_prec > prec
then print (fmap (printInner inner_prec) inner) then print (fmap (printInner inner_prec) inner)
else "(" <> print (fmap (printInner inner_prec) inner) <> ")" else "(" <> print (fmap (printInner inner_prec) inner) <> ")"
printParseableFunctor Variable = "X" printParseableFunctor Variable = "X"
-- | Print the required skeleton for the current scope.
--
-- The current scope has already been popped of the stack.
printSkeleton :: [a] -> [[a]] -> Build.Builder
printSkeleton h xs =
foldl (\str e -> (if null e then " " else "│ ") <> str)
(if null h then "└ " else "├ ")
xs
printTree :: (a -> ([(Build.Builder, a)], Build.Builder)) -> a -> Build.Builder
printTree f head =
let (children, functor) = f head
in functor <> printInner f [children]
printInner :: (a -> ([(Build.Builder, a)], Build.Builder)) -> [[(Build.Builder, a)]] -> Build.Builder
printInner f (((scope, v):h):rs) =
"\n" <> printSkeleton h rs <> scope <> ": "
<> functor <> (printInner f (children:h:rs))
where
(children, functor) = f v
printInner f ([]:rs) = printInner f rs
printInner _ [] = mempty
\ No newline at end of file
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
...@@ -45,12 +46,14 @@ import Data.Text ( Text ) ...@@ -45,12 +46,14 @@ import Data.Text ( Text )
import Text.Megaparsec import Text.Megaparsec
import Copar.Coalgebra.Parser import Copar.Coalgebra.Parser
import qualified Copar.Parser.Lexer as L import qualified Copar.Parser.Lexer as L
import Copar.RefinementInterface import Copar.RefinementInterface
import Copar.Functors.Polynomial hiding ( PolyF1(..) ) import Copar.Functors.Polynomial hiding ( PolyF1(..) )
import qualified Copar.Functors.SomeFunctor as SF
import Copar.FunctorExpression.Type import Copar.FunctorExpression.Type
import Copar.FunctorExpression.Printable import Copar.FunctorDescription
import Copar.Parser.Types import Copar.Parser.Types
import qualified Data.Vector.Utils as V import qualified Data.Vector.Utils as V
import Data.Primitive.SmallArray import Data.Primitive.SmallArray
...@@ -61,22 +64,26 @@ data Inner f a = Direct a | Absorbed (f a) ...@@ -61,22 +64,26 @@ data Inner f a = Direct a | Absorbed (f a)
$(deriveShow1 ''Inner) $(deriveShow1 ''Inner)
$(deriveEq1 ''Inner) $(deriveEq1 ''Inner)
newtype AbsorbingPolynomial f a = AbsorbingPolynomial (Polynomial (Inner f a)) newtype AbsorbingPolynomial f a = AbsorbingPolynomial (Polynomial (Inner f a))
deriving (Functor, Foldable, Traversable) deriving (Functor, Foldable, Traversable)
instance (Printable f) => Printable (AbsorbingPolynomial f) where instance FunctorDescription (AbsorbingPolynomial SF.SomeFunctor) where
precedence _ = 10 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
printMe cfg (AbsorbingPolynomial poly) = functorExprPrinter cfg (AbsorbingPolynomial poly) =
let name = withName cfg "AbsorbingPolynomial" let name = withName cfg "AbsorbingPolynomial"
in name <> printPolynomial cfg ((\case in name <> printPolynomial cfg ((\case
Direct a -> a Direct a -> a
-- We want to always print the surrounding braces in case functor names -- We want to always print the surrounding braces in case functor names
-- are printed. -- are printed.
Absorbed inner -> if precedence inner > 10 && name == mempty Absorbed inner ->
then printMe cfg inner if dynPrecedence (SF.someFunctorDescription inner) > 10 && name == mempty
else "(" <> printMe cfg inner <> ")" then SF.printSomeFunctorExpr cfg inner
else "(" <> SF.printSomeFunctorExpr cfg inner <> ")"
) <$> poly) ) <$> poly)
$(deriveShow1 ''AbsorbingPolynomial) $(deriveShow1 ''AbsorbingPolynomial)
......
...@@ -24,7 +24,6 @@ import Data.Text.Prettyprint ((<+>)) ...@@ -24,7 +24,6 @@ import Data.Text.Prettyprint ((<+>))
import Copar.RefinementInterface import Copar.RefinementInterface
import qualified Copar.Parser.Lexer as L import qualified Copar.Parser.Lexer as L
import Copar.FunctorExpression.Parser import Copar.FunctorExpression.Parser
import Copar.FunctorExpression.Printable
import Copar.Coalgebra.Parser import Copar.Coalgebra.Parser
import Copar.Functors.GroupValued import Copar.Functors.GroupValued
import Copar.FunctorDescription import Copar.FunctorDescription
...@@ -32,11 +31,6 @@ import Copar.FunctorDescription ...@@ -32,11 +31,6 @@ import Copar.FunctorDescription
newtype Bag a = Bag a newtype Bag a = Bag a
deriving (Functor,Foldable,Traversable) deriving (Functor,Foldable,Traversable)
instance Printable Bag where
precedence _ = 40
printMe cfg (Bag x) = withName cfg "Bag" <> "B" <> x
instance FunctorDescription Bag where instance FunctorDescription Bag where
name = "Bag" name = "Bag"
syntaxExample = "BX | ƁX" syntaxExample = "BX | ƁX"
...@@ -44,6 +38,8 @@ instance FunctorDescription Bag where ...@@ -44,6 +38,8 @@ instance FunctorDescription Bag where
precedence = 40 precedence = 40
functorExprParser = prefix ((L.symbol "B" <|> L.symbol "Ɓ") >> pure Bag) functorExprParser = prefix ((L.symbol "B" <|> L.symbol "Ɓ") >> pure Bag)
functorExprPrinter cfg (Bag x) = withName cfg "Bag" <> "B" <> x
bagHelp :: Doc.Doc Doc.AnsiStyle bagHelp :: Doc.Doc Doc.AnsiStyle
bagHelp = bagHelp =
Doc.reflow "This is like the Powerset functor, except that states can have \ Doc.reflow "This is like the Powerset functor, except that states can have \
......
...@@ -19,7 +19,6 @@ import Data.Float.Utils (EqDouble) ...@@ -19,7 +19,6 @@ import Data.Float.Utils (EqDouble)
import Copar.Coalgebra.Parser import Copar.Coalgebra.Parser
import Copar.FunctorDescription import Copar.FunctorDescription
import Copar.FunctorExpression.Parser import Copar.FunctorExpression.Parser
import Copar.FunctorExpression.Printable
import Copar.Functors.GroupValued import Copar.Functors.GroupValued
import qualified Copar.Parser.Lexer as L import qualified Copar.Parser.Lexer as L
import Copar.RefinementInterface import Copar.RefinementInterface
...@@ -28,11 +27,6 @@ import Copar.RefinementInterface ...@@ -28,11 +27,6 @@ import Copar.RefinementInterface
newtype Distribution x = Distribution x newtype Distribution x = Distribution x
deriving (Functor, Foldable, Traversable) deriving (Functor, Foldable, Traversable)
instance Printable Distribution where
precedence _ = 30
printMe cfg (Distribution x) = withName cfg "Distribution" <> "D" <> x
instance FunctorDescription Distribution where instance FunctorDescription Distribution where
name = "Distribution" name = "Distribution"
syntaxExample = "DX | ƊX" syntaxExample = "DX | ƊX"
...@@ -41,6 +35,8 @@ instance FunctorDescription Distribution where ...@@ -41,6 +35,8 @@ instance FunctorDescription Distribution where
functorExprParser = prefix ((L.symbol "D" <|> L.symbol "Ɗ") functorExprParser = prefix ((L.symbol "D" <|> L.symbol "Ɗ")
>> pure Distribution) >> pure Distribution)
functorExprPrinter cfg (Distribution x) = withName cfg "Distribution" <> "D" <> x
distHelp :: Doc.Doc Doc.AnsiStyle distHelp :: Doc.Doc Doc.AnsiStyle
distHelp = distHelp =
Doc.reflow "Coalgebras for the distribution functor correspond to markov \ Doc.reflow "Coalgebras for the distribution functor correspond to markov \
......
...@@ -37,7 +37,6 @@ import qualified Data.Vector.Utils as V ...@@ -37,7 +37,6 @@ import qualified Data.Vector.Utils as V
import Copar.RefinementInterface import Copar.RefinementInterface
import Copar.Coalgebra.Parser import Copar.Coalgebra.Parser
import Copar.FunctorExpression.Parser import Copar.FunctorExpression.Parser
import Copar.FunctorExpression.Printable
import qualified Copar.Parser.Lexer as L import qualified Copar.Parser.Lexer as L
import Copar.Parser.Types import Copar.Parser.Types
import Copar.FunctorDescription import Copar.FunctorDescription
...@@ -54,27 +53,6 @@ deriving instance Traversable (GroupValued m) ...@@ -54,27 +53,6 @@ deriving instance Traversable (GroupValued m)
$(deriveShow1 ''GroupValued) $(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
type IntValued = GroupValued Int type IntValued = GroupValued Int
instance FunctorDescription (GroupValued Int) where instance FunctorDescription (GroupValued Int) where
...@@ -84,6 +62,7 @@ instance FunctorDescription (GroupValued Int) where ...@@ -84,6 +62,7 @@ instance FunctorDescription (GroupValued Int) where
precedence = 150 precedence = 150
functorExprParser = functorExprParser =
prefix ((L.symbol "Z" <|> L.symbol "ℤ") >> L.symbol "^" >> pure GroupValued) prefix ((L.symbol "Z" <|> L.symbol "ℤ") >> L.symbol "^" >> pure GroupValued)
functorExprPrinter cfg (GroupValued x) = withName cfg "Integer-valued" <> "Z^" <> x
intHelp :: Doc.Doc Doc.AnsiStyle intHelp :: Doc.Doc Doc.AnsiStyle
intHelp = intHelp =
...@@ -103,6 +82,7 @@ instance FunctorDescription (GroupValued EqDouble) where ...@@ -103,6 +82,7 @@ instance FunctorDescription (GroupValued EqDouble) where
precedence = 140 precedence = 140
functorExprParser = prefix functorExprParser = prefix
((L.symbol "R" <|> L.symbol "ℝ") >> L.symbol "^" >> pure GroupValued) ((L.symbol "R" <|> L.symbol "ℝ") >> L.symbol "^" >> pure GroupValued)
functorExprPrinter cfg (GroupValued x) = withName cfg "Real-valued" <> "R^" <> x
realHelp :: Doc.Doc Doc.AnsiStyle realHelp :: Doc.Doc Doc.AnsiStyle
realHelp = realHelp =
...@@ -122,6 +102,7 @@ instance FunctorDescription (GroupValued (Ratio Int)) where ...@@ -122,6 +102,7 @@ instance FunctorDescription (GroupValued (Ratio Int)) where
precedence = 120 precedence = 120
functorExprParser = prefix functorExprParser = prefix
((L.symbol "Q" <|> L.symbol "ℚ") >> L.symbol "^" >> pure GroupValued) ((L.symbol "Q" <|> L.symbol "ℚ") >> L.symbol "^" >> pure GroupValued)
functorExprPrinter cfg (GroupValued x) = withName cfg "Rational-valued" <> "Q^" <> x
rationalHelp :: Doc.Doc Doc.AnsiStyle rationalHelp :: Doc.Doc Doc.AnsiStyle
rationalHelp = rationalHelp =
...@@ -151,6 +132,7 @@ instance FunctorDescription (GroupValued OrderedComplex) where ...@@ -151,6 +132,7 @@ instance FunctorDescription (GroupValued OrderedComplex) where
precedence = 130 precedence = 130
functorExprParser = prefix functorExprParser = prefix
((L.symbol "C" <|> L.symbol "ℂ") >> L.symbol "^" >> pure GroupValued) ((L.symbol "C" <|> L.symbol "ℂ") >> L.symbol "^" >> pure GroupValued)
functorExprPrinter cfg (GroupValued x) = withName cfg "Complex-valued" <> "C^" <> x
complexHelp :: Doc.Doc Doc.AnsiStyle complexHelp :: Doc.Doc Doc.AnsiStyle
complexHelp = complexHelp =
......
...@@ -32,14 +32,13 @@ import Text.Megaparsec ...@@ -32,14 +32,13 @@ import Text.Megaparsec
import qualified Data.Text.Prettyprint as Doc