Commit 0480c31a authored by Bastian Kauschke's avatar Bastian Kauschke
Browse files

update PrettyTests

parent 7beb23c9
......@@ -151,7 +151,6 @@ test-suite spec
, Copar.Functors.MonoidValuedSpec
, Copar.Functors.AbsorbingPolynomialSpec
, Copar.FunctorExpression.ParserSpec
, Copar.FunctorExpression.PrettySpec
, Copar.FunctorExpression.SortsSpec
, Copar.FunctorPrinterSpec
, Copar.Coalgebra.ParserSpec
......
......@@ -61,10 +61,16 @@ deriving instance Functor SomeFunctor
deriving instance Foldable SomeFunctor
deriving instance Traversable SomeFunctor
instance Show a => Show (SomeFunctor a) where
showsPrec = showsPrec1
instance Show1 SomeFunctor where
liftShowsPrec shows' showsList' pred (SomeFunctor f) =
liftShowsPrec shows' showsList' pred f
instance Eq a => Eq (SomeFunctor a) where
(==) = eq1
instance Eq1 SomeFunctor where
liftEq eq' (SomeFunctor (lhs :: f' a)) (SomeFunctor (rhs :: f'' b)) =
case eqTypeRep (typeRep @f') (typeRep @f'') of
......
{-# LANGUAGE EmptyCase #-}
module Copar.FunctorExpression.PrettySpec (spec) where
import Test.Hspec
import Data.Semigroup
import Copar.FunctorExpression.Type
import Copar.FunctorExpression.Pretty
spec :: Spec
spec = prettySpec
data Void1 a
instance PrettyPrint Void1 where
prettyPrint x = case x of
instance Functor Void1 where
fmap f x = case x of
data Powerset a = Powerset a
deriving (Functor)
instance PrettyPrint Powerset where
prettyPrint (Powerset inner) = "P " <> inner
data Distri a = Distri a
deriving (Functor)
instance PrettyPrint Distri where
prettyPrint (Distri inner) = "D " <> inner
data Quad a = Quad a
deriving (Functor)
instance PrettyPrint Quad where
prettyPrint (Quad inner) = inner <> "^2"
data SomeFunctor a where
SomeFunctor :: (PrettyPrint f, Functor f) => f a -> SomeFunctor a
instance PrettyPrint SomeFunctor where
prettyPrint (SomeFunctor f) = prettyPrint f
deriving instance Functor SomeFunctor
prettySpec :: Spec
prettySpec = describe "pretty" $ do
it "correctly prints a variable as X" $
pretty @Void1 Variable `shouldBe` "X"
it "correctly prints an expression with one prefix functor" $
pretty (Functor 1 (SomeFunctor (Powerset Variable))) `shouldBe` "P X"
it "correctly prints an expression with one suffix functor" $
pretty (Functor 1 (SomeFunctor (Quad Variable))) `shouldBe` "X^2"
it "handles nested functors of the same type" $
pretty
(Functor
1
(SomeFunctor (Powerset (Functor 1 (SomeFunctor (Powerset Variable)))))) `shouldBe`
"P (P X)"
it "gets precedence right" $ do
pretty
(Functor
1
(SomeFunctor (Powerset (Functor 2 (SomeFunctor (Distri Variable)))))) `shouldBe`
"P D X"
pretty
(Functor
2
(SomeFunctor (Powerset (Functor 1 (SomeFunctor (Distri Variable)))))) `shouldBe`
"P (D X)"
it "allows mixing prefix and suffix functors" $ do
pretty
(Functor
1
(SomeFunctor (Powerset (Functor 2 (SomeFunctor (Quad Variable)))))) `shouldBe`
"P X^2"
pretty
(Functor
2
(SomeFunctor (Quad (Functor 1 (SomeFunctor (Powerset Variable)))))) `shouldBe`
"(P X)^2"
......@@ -10,9 +10,13 @@ import Type.Reflection
import qualified Data.Vector as V
import Copar.Coalgebra.Parser
import Copar.FunctorExpression.Sorts
import Copar.FunctorExpression.Type
import Copar.FunctorExpression.Pretty
import Copar.FunctorExpression.Printable
import Copar.RefinementInterface
import Copar.Functors.SomeFunctor
spec :: Spec
spec = do
......@@ -35,23 +39,23 @@ annotateSortsSpec = describe "annotateSorts" $ do
it "correctly annotates an expression with different functors" $
annotateSorts
(Functor () (Some (Identity (Functor () (Some (Just Variable)))))) `shouldBe`
(Functor 1 (Some (Identity (Functor 2 (Some (Just Variable))))))
(Functor () (SomeFunctor (Identity (Functor () (SomeFunctor (Just Variable)))))) `shouldBe`
(Functor 1 (SomeFunctor (Identity (Functor 2 (SomeFunctor (Just Variable))))))
it "correctly annotates an expression with two argument functors" $
annotateSorts
(Functor
()
(Some
(SomeFunctor
(Twice
(Functor () (Some (Identity Variable)))
(Functor () (Some (Identity Variable)))))) `shouldBe`
(Functor () (SomeFunctor (Identity Variable)))
(Functor () (SomeFunctor (Identity Variable)))))) `shouldBe`
(Functor
1
(Some
(SomeFunctor
(Twice
(Functor 2 (Some (Identity Variable)))
(Functor 3 (Some (Identity Variable))))))
(Functor 2 (SomeFunctor (Identity Variable)))
(Functor 3 (SomeFunctor (Identity Variable))))))
sortTableSpec :: Spec
sortTableSpec = describe "sortTable" $ do
......@@ -69,11 +73,14 @@ sortTableSpec = describe "sortTable" $ do
sortTable
(Functor
1
(Some
(SomeFunctor
(Twice
(Functor 3 (Some (Identity Variable)))
(Functor 2 (Some (Just Variable)))))) `shouldBe`
V.fromList [Some (Twice () ()), Some (Just ()), Some (Identity ())]
(Functor 3 (SomeFunctor (Identity Variable)))
(Functor 2 (SomeFunctor (Just Variable)))))) `shouldBe`
V.fromList [ SomeFunctor (Twice () ())
, SomeFunctor (Just ())
, SomeFunctor (Identity ())
]
showSortsSpec :: Spec
showSortsSpec = describe "showSorts" $ do
......@@ -91,38 +98,28 @@ showSortsSpec = describe "showSorts" $ do
showSorts
(Functor
1
(Some
(SomeFunctor
(Twice
(Functor 2 (Some (Identity Variable)))
(Functor 3 (Some (Identity Variable)))))) `shouldBe`
(Functor 2 (SomeFunctor (Identity Variable)))
(Functor 3 (SomeFunctor (Identity Variable)))))) `shouldBe`
"1: Twice X X\n2: Identity X\n3: Identity X"
-- helpers
data SomeFunctor a where
Some
:: (Traversable f, Typeable f, Eq1 f, Show1 f, PrettyPrint f)
=> f a
-> SomeFunctor a
deriving instance Functor SomeFunctor
deriving instance Foldable SomeFunctor
deriving instance Traversable SomeFunctor
instance Show1 SomeFunctor where
liftShowsPrec show' showList' prec (Some f) = liftShowsPrec show' showList' prec f
instance Show a => Show (SomeFunctor a) where
showsPrec = showsPrec1
instance Eq a => Eq (SomeFunctor a) where
(==) = eq1
instance Printable Identity where
precedence _ = 0
printMe cfg (Identity x) = withName cfg "Identity" <> x
instance Eq1 SomeFunctor where
liftEq eq (Some (f1 :: tf1 a)) (Some (f2 :: tf2 b)) =
case eqTypeRep (typeRep @tf1) (typeRep @tf2) of
Nothing -> False -- different types
Just HRefl -> liftEq eq f1 f2
type instance Label Identity = ()
type instance Weight Identity = ()
type instance F1 Identity = ()
type instance F3 Identity = ()
instance RefinementInterface Identity where
init = undefined
update = undefined
instance ParseMorphism Identity where
parseMorphismPoint = undefined
data Twice a = Twice a a
deriving (Functor, Foldable, Traversable)
......@@ -130,20 +127,34 @@ data Twice a = Twice a a
instance Eq1 Twice where
liftEq f (Twice a1 b1) (Twice a2 b2) = f a1 a2 && f b1 b2
type instance Label Twice = ()
type instance Weight Twice = ()
type instance F1 Twice = ()
type instance F3 Twice = ()
instance RefinementInterface Twice where
init = undefined
update = undefined
instance ParseMorphism Twice where
parseMorphismPoint = undefined
instance Show1 Twice where
liftShowsPrec show' _ prec (Twice a b) rest
| prec > 10 = "(Twice " ++ show' 11 a (" " ++ show' 11 b (rest ++ ")"))
| otherwise = "Twice " ++ show' 11 a (" " ++ show' 11 b rest)
instance PrettyPrint Identity where
prettyPrint (Identity x) = "Identity " <> x
instance PrettyPrint SomeFunctor where
prettyPrint (Some f) = prettyPrint f
instance PrettyPrint Twice where
prettyPrint (Twice a b) = "Twice " <> a <> " " <> b
instance PrettyPrint Maybe where
prettyPrint (Just a) = "Maybe" <> a
prettyPrint Nothing = "Nothing"
liftShowsPrec = undefined
instance Printable Twice where
precedence _ = 0
printMe cfg (Twice a b) = withName cfg "Twice" <> a <> " " <> b
type instance Label Maybe = ()
type instance Weight Maybe = ()
type instance F1 Maybe = ()
type instance F3 Maybe = ()
instance RefinementInterface Maybe where
init = undefined
update = undefined
instance ParseMorphism Maybe where
parseMorphismPoint = undefined
instance Printable Maybe where
precedence _ = 0
printMe _ maybe = case maybe of
Just x -> "Just " <> x
Nothing -> "Nothing"
......@@ -41,7 +41,15 @@ printParseableFunctorSpec = describe "printParseableFunctor" $ do
it_is_id "D({f,n}xPX)"
it_is_id "D({f,n}xP(DX)^{a, b, c}+({f, n}xX + (Z, min)^({f ,n})))"
it_is_id "(Z, min)^X"
it_is_id "X^2"
it_is_id "P(PX)"
it_is_id "PX^2"
it_is_id "P(X^2)"
it_is_eq "DPX" "DPX"
it_is_eq "D({f,n}xP(DX)^{a, b, c}+({f, n}xX + (Z, min)^({f ,n})))" "D({f, n}xP(DX)^{a, b, c} + ({f, n}xX + (Z, min)^({f, n})))"
it_is_eq "(Z, min)^((R, min)^(Z, min)^({f, n} x DX))" "(Z, min)^((R, min)^(Z, min)^({f, n}xDX))"
it_is_eq "P(PX)" "P(PX)"
it "correctly prints a variable as X" $
printParseableFunctor @SomeFunctor Variable `shouldBe` "X"
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment