Merge branch 'FunctorDescription' [#28]

bench/Copar/Coalgebra/BenchParser.hs

@@ -18,8 +18,8 @@ import           Copar.FunctorExpression.Sorts
 import           Copar.FunctorExpression.Type
 import           Copar.FunctorExpression.Parser
 import           Copar.Functors.Polynomial
+import           Copar.Functors.SomeFunctor (someFunctorExprParser)
 import           Copar.Functors
-import           Copar.FunctorDescription
 
 benchmarks :: Benchmark
 benchmarks = bgroup "Morphism Parser"
@@ -38,7 +38,7 @@ benchIdentity = bgroup "Identity" $
 benchMarkov :: Benchmark
 benchMarkov = bgroup "Ax(R^X)" $
   let
-    functors = map dynFunctorExprParser registeredFunctors
+    functors = map someFunctorExprParser registeredFunctors
     Right f = annotateSorts <$> parseFunctorExpression functors "" "{a,b,c,d,e}x(R^X)"
   in
     [ benchParser "simple" f

copar.cabal

@@ -56,7 +56,6 @@ library
                      , Copar.Algorithm.Split
                      , Copar.FunctorExpression.Type
                      , Copar.FunctorExpression.Parser
-                     , Copar.FunctorExpression.Printable
                      , Copar.FunctorExpression.Sorts
                      , Copar.FunctorExpression.Desorting
                      , Copar.FunctorExpression.Transform

doc/Pair.hs

@@ -22,16 +22,12 @@ data Pair a = Pair a a
 
 $(deriveShow1 ''Pair)
 
-instance Printable Distribution where
-  printMe cfg (Pair lhs rhs) = withName cfg "Pair" <> lhs <> " x " <> rhs
-
-pair :: FunctorDescription Pair
-pair = FunctorDescription
-  { name = "Pair"
-  , syntaxExample = "{f, n} x PX"
-  , description = Just "A pair of functors"
-  , functorExprParser = pairp
-  }
+instance FunctorDescription Pair where
+  name = "Pair"
+  syntaxExample = "{f, n} x PX"
+  description = Just "A pair of functors"
+  functorExprParser = pairp
+  functorExprPrinter cfg (Pair lhs rhs) = withName cfg "Pair" <> lhs <> " x " <> rhs
 
 pairp :: FunctorParser Pair
 pairp = FunctorParser $ \inner ->

src/Copar/FunctorDescription.hs

 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
 
 module Copar.FunctorDescription
   ( DynFunctorDescription(..)
   , FunctorParser(..)
   , FunctorDescription(..)
+  , PrintConfig(..)
+  , Suitable
   , formatFunctorDescription
   , formatFunctorDescriptions
   , dynPrecedence
   , dynFunctorDescription
-  , dynFunctorExprParser
   )
 where
 
+import           Control.DeepSeq (NFData(..))
+
+import           Data.Functor.Classes
 import           Data.Text                      ( Text )
 import           Data.Text.Prettyprint          ( Doc
                                                 , (<+>)
                                                 , AnsiStyle
                                                 )
 import qualified Data.Text.Prettyprint         as Doc
+import qualified Data.Text.Lazy.Builder as Build
 
 import           Data.Proxy
 
+import           Type.Reflection
+
 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
   syntaxExample :: Text
   description :: Maybe (Doc AnsiStyle)
   precedence :: Int
   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)
 
+data PrintConfig = PrintConfig { withName :: Build.Builder -> Build.Builder }
+
 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

-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

src/Copar/FunctorPrinter.hs

-module Copar.FunctorPrinter (printFunctor, printParseableFunctor, Printable) where
+module Copar.FunctorPrinter (printFunctor, printParseableFunctor) where
 
-import           Data.Text as T
-import           Data.Text.Lazy as Lazy
-import           Data.Text.Lazy.Builder as Build
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as Lazy
+import qualified Data.Text.Lazy.Builder as Build
 
-import           Copar.FunctorExpression.Printable
 import           Copar.FunctorExpression.Sorts (Sort, formatSortAsScope)
 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 Variable = "Variable X"
 
-inner :: (Printable f, Foldable f, Functor f)
-    => f (FunctorExpression f Sort)
+inner :: SomeFunctor (FunctorExpression SomeFunctor Sort)
     -- ([('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))
   where
-    print = printMe PrintConfig { withName = \name -> name <> " " }
+    print = printSomeFunctorExpr PrintConfig { withName = \name -> name <> " " }
 
     printChild Variable = "X"
     printChild (Functor sort _) = formatSortAsScope sort
@@ -26,19 +26,44 @@ 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 (precedence f')) f')))
+printParseableFunctor :: FunctorExpression SomeFunctor Sort -> T.Text
+printParseableFunctor (Functor _ f') = Lazy.toStrict (Build.toLazyText (print (fmap (printInner (functorPrecedence f')) f')))
   where
-    print :: forall f. (Printable f) => f Build.Builder -> Build.Builder
-    print = printMe PrintConfig { withName = \_ -> "" }
+    print :: SomeFunctor Build.Builder -> Build.Builder
+    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 prec (Functor _ inner) = 
-      let inner_prec = precedence inner
+      let inner_prec = dynPrecedence (someFunctorDescription inner)
       in if inner_prec > prec 
         then print (fmap (printInner inner_prec) inner)
         else "(" <> print (fmap (printInner inner_prec) inner) <> ")"
 
 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

src/Copar/Functors/AbsorbingPolynomial.hs

 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -45,12 +46,14 @@ import           Data.Text                      ( Text )
 import           Text.Megaparsec
 
 import           Copar.Coalgebra.Parser
-import qualified Copar.Parser.Lexer               as L
+import qualified Copar.Parser.Lexer            as L
 import           Copar.RefinementInterface
 import           Copar.Functors.Polynomial  hiding ( PolyF1(..) )
+import qualified Copar.Functors.SomeFunctor    as SF
 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,22 +64,26 @@ 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 SF.SomeFunctor) 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
 
-  printMe cfg (AbsorbingPolynomial poly) =
-    let name = withName cfg "AbsorbingPolynomial" 
+  functorExprPrinter 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 precedence inner > 10 && name == mempty
-          then printMe cfg inner
-          else "(" <> printMe cfg inner <> ")"
+        Absorbed inner -> 
+          if dynPrecedence (SF.someFunctorDescription inner) > 10 && name == mempty
+          then SF.printSomeFunctorExpr cfg inner
+          else "(" <> SF.printSomeFunctorExpr cfg inner <> ")"
       ) <$> poly)
 
 $(deriveShow1 ''AbsorbingPolynomial)

src/Copar/Functors/Bag.hs

@@ -24,7 +24,6 @@ import           Data.Text.Prettyprint     ((<+>))
 import           Copar.RefinementInterface
 import qualified Copar.Parser.Lexer as L
 import           Copar.FunctorExpression.Parser
-import           Copar.FunctorExpression.Printable
 import           Copar.Coalgebra.Parser
 import           Copar.Functors.GroupValued
 import           Copar.FunctorDescription
@@ -32,11 +31,6 @@ import           Copar.FunctorDescription
 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
   name = "Bag"
   syntaxExample = "BX | ƁX"
@@ -44,6 +38,8 @@ instance FunctorDescription Bag where
   precedence = 40
   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.reflow "This is like the Powerset functor, except that states can have \

src/Copar/Functors/Distribution.hs

@@ -19,7 +19,6 @@ import           Data.Float.Utils (EqDouble)
 import           Copar.Coalgebra.Parser
 import           Copar.FunctorDescription
 import           Copar.FunctorExpression.Parser
-import           Copar.FunctorExpression.Printable
 import           Copar.Functors.GroupValued
 import qualified Copar.Parser.Lexer as L
 import           Copar.RefinementInterface
@@ -28,11 +27,6 @@ import           Copar.RefinementInterface
 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
   name = "Distribution"
   syntaxExample = "DX | ƊX"
@@ -41,6 +35,8 @@ instance FunctorDescription Distribution where
   functorExprParser = prefix ((L.symbol "D" <|> L.symbol "Ɗ")
                               >> pure Distribution)
 
+  functorExprPrinter cfg (Distribution x) = withName cfg "Distribution" <> "D" <> x
+
 distHelp :: Doc.Doc Doc.AnsiStyle
 distHelp =
   Doc.reflow "Coalgebras for the distribution functor correspond to markov \

src/Copar/Functors/GroupValued.hs

@@ -37,7 +37,6 @@ import qualified Data.Vector.Utils as V
 import           Copar.RefinementInterface
 import           Copar.Coalgebra.Parser
 import           Copar.FunctorExpression.Parser
-import           Copar.FunctorExpression.Printable
 import qualified Copar.Parser.Lexer as L
 import           Copar.Parser.Types
 import           Copar.FunctorDescription
@@ -54,27 +53,6 @@ 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
-
 
 type IntValued = GroupValued Int
 instance FunctorDescription (GroupValued Int) where
@@ -84,6 +62,7 @@ instance FunctorDescription (GroupValued Int) where
   precedence = 150
   functorExprParser =
       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 =
@@ -103,6 +82,7 @@ instance FunctorDescription (GroupValued EqDouble) where
   precedence = 140
   functorExprParser = prefix
     ((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 =
@@ -122,6 +102,7 @@ instance FunctorDescription (GroupValued (Ratio Int)) where
   precedence = 120
   functorExprParser = prefix
     ((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 =
@@ -151,6 +132,7 @@ instance FunctorDescription (GroupValued OrderedComplex) where
   precedence = 130
   functorExprParser = prefix
     ((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 =

src/Copar/Functors/MonoidValued.hs

@@ -32,14 +32,13 @@ import           Text.Megaparsec
 import qualified Data.Text.Prettyprint         as Doc
 import           Data.Text.Prettyprint          ( (<+>) )
 import           Data.Text                      ( Text )
+import qualified Data.Text.Lazy.Builder        as Build
 
 import qualified Data.Vector.Utils             as V
 import           Copar.RefinementInterface
 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(..)
@@ -54,37 +53,6 @@ import           Data.Proxy
 
 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
   liftEq f (SlowMonoidValued a1) (SlowMonoidValued a2) = f a1 a2
 
@@ -125,6 +93,11 @@ instance MonoidValuedDescription m => FunctorDescription (SlowMonoidValued m) wh
         >> pure SlowMonoidValued
       )
 
+  functorExprPrinter cfg  (SlowMonoidValued x) =
+    withName cfg (Build.fromText (name @(SlowMonoidValued m))) <>
+    "(" <> Build.fromText (head (mvSet @m)) <> ", " <> Build.fromText (mvOperation @m) <> ")^"
+    <> x
+
 functorSyntax :: Text -> Text -> Text
 functorSyntax s o = "(" <> s <> ", " <> o <> ")^X"
 

src/Copar/Functors/Polynomial.hs

@@ -55,7 +55,6 @@ import qualified Copar.Parser.Lexer as L
 import           Copar.Parser.Types
 import           Copar.RefinementInterface
 import           Copar.FunctorExpression.Parser
-import           Copar.FunctorExpression.Printable
 import           Copar.FunctorDescription
 
 
@@ -94,12 +93,6 @@ $(deriveEq1 ''Polynomial)
 $(deriveShow1 ''Factor)
 $(deriveShow1 ''Polynomial)
 
-instance Printable Polynomial where
-  precedence _ = 10
-
-  printMe cfg poly = withName cfg "Polynomial" <> printPolynomial cfg poly
-    
-
 printPolynomial :: PrintConfig -> Polynomial Build.Builder -> Build.Builder
 printPolynomial cfg (Polynomial (Sum (prods))) = fold (NonEmpty.intersperse " + " (fmap (printProduct cfg) prods))
 
@@ -150,6 +143,7 @@ instance FunctorDescription Polynomial where
   description = Just polynomialHelp
   precedence = 10
   functorExprParser = polynomialp
+  functorExprPrinter cfg poly = withName cfg "Polynomial" <> printPolynomial cfg poly
 
 polynomialHelp :: Doc.Doc Doc.AnsiStyle
 polynomialHelp =

src/Copar/Functors/Powerset.hs

@@ -25,7 +25,6 @@ import           Data.Text.Prettyprint ((<+>))
 import           Copar.RefinementInterface
 import qualified Copar.Parser.Lexer as L
 import           Copar.FunctorExpression.Parser
-import           Copar.FunctorExpression.Printable
 import           Copar.Coalgebra.Parser
 import           Copar.FunctorDescription
 
@@ -35,11 +34,6 @@ newtype Powerset a = Powerset a
 $(deriveShow1 ''Powerset)
 $(deriveEq1 ''Powerset)
 
-instance Printable Powerset where
-  precedence _ = 50
-
-  printMe cfg (Powerset x) = withName cfg "Powerset" <> "P" <> x
-
 instance FunctorDescription Powerset where
   name = "Powerset"
   syntaxExample = "PX | ƤX"
@@ -47,6 +41,7 @@ instance FunctorDescription Powerset where
   precedence = 50
   functorExprParser =
     prefix ((L.symbol "P" <|> L.symbol "Ƥ") >> pure Powerset)
+  functorExprPrinter cfg (Powerset x) = withName cfg "Powerset" <> "P" <> x
 
 powersetHelp :: Doc.Doc Doc.AnsiStyle
 powersetHelp =

src/Copar/Functors/SomeFunctor.hs

@@ -10,6 +10,9 @@ module Copar.Functors.SomeFunctor
   ( SomeFunctor(..)
   , Suitable
   , transformInner
+  , someFunctorExprParser
+  , someFunctorDescription
+  , printSomeFunctorExpr
   , SomeWeight(..)
   , SomeLabel
   , SomeF1
@@ -25,30 +28,19 @@ 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
 import qualified Data.Text as T
+import qualified Data.Text.Lazy.Builder as Build
 
 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