Commit ab6f7674 authored by Bastian Kauschke's avatar Bastian Kauschke
Browse files

update functors

parent 0f864c7a
......@@ -22,6 +22,9 @@ 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"
......
......@@ -64,10 +64,9 @@ newtype AbsorbingPolynomial f a = AbsorbingPolynomial (Polynomial (Inner f a))
deriving (Functor, Foldable, Traversable)
instance (Printable f) => Printable (AbsorbingPolynomial f) where
printMe (AbsorbingPolynomial poly) = "AbsorbingPolynomial "
<> printPolynomial ((\case
printMe cfg (AbsorbingPolynomial poly) = withName cfg "AbsorbingPolynomial" <> printPolynomial cfg ((\case
Direct a -> a
Absorbed inner -> "(" <> printMe inner <> ")"
Absorbed inner -> "(" <> printMe cfg inner <> ")"
) <$> poly)
$(deriveShow1 ''AbsorbingPolynomial)
......
......@@ -36,7 +36,7 @@ newtype Bag a = Bag a
deriving (Functor,Foldable,Traversable)
instance Printable Bag where
printMe (Bag x) = "Bag B" <> x
printMe cfg (Bag x) = withName cfg "Bag" <> "B" <> x
bag :: FunctorDescription Bag
bag = FunctorDescription
......
......@@ -32,7 +32,7 @@ newtype Distribution x = Distribution x
deriving (Functor, Foldable, Traversable)
instance Printable Distribution where
printMe (Distribution x) ="Distribution D" <> x
printMe cfg (Distribution x) = withName cfg "Distribution" <> "D" <> x
distribution :: FunctorDescription Distribution
distribution = FunctorDescription
......
......@@ -55,18 +55,17 @@ deriving instance Traversable (GroupValued m)
$(deriveShow1 ''GroupValued)
instance Printable (GroupValued Int) where
printMe (GroupValued x) = "Integer-valued Z^" <> x
printMe cfg (GroupValued x) = withName cfg "Integer-valued" <> "Z^" <> x
instance Printable (GroupValued EqDouble) where
printMe (GroupValued x) = "Real-valued R^" <> x
printMe cfg (GroupValued x) = withName cfg "Real-valued" <> "R^" <> x
instance Printable (GroupValued (Ratio Int)) where
printMe (GroupValued x) = "Rational-valued Q^" <> x
printMe cfg (GroupValued x) = withName cfg "Rational-valued" <> "Q^" <> x
instance Printable (GroupValued OrderedComplex) where
printMe (GroupValued x) = "Complex-valued C^" <> x
printMe cfg (GroupValued x) = withName cfg "Complex-valued" <> "C^" <> x
intValued :: FunctorDescription (GroupValued Int)
intValued = FunctorDescription
......
......@@ -53,22 +53,22 @@ newtype SlowMonoidValued m a = SlowMonoidValued a
-- TODO We may want to change MonoidValuedDiscription to a type class,
-- this would allow us to simplify these instances.
instance Printable (SlowMonoidValued (Max Int)) where
printMe (SlowMonoidValued x) = "Max-valued (Z, max)^" <> x
printMe cfg (SlowMonoidValued x) = withName cfg "Max-valued" <> "(Z, max)^" <> x
instance Printable (SlowMonoidValued (Min Int)) where
printMe (SlowMonoidValued x) = "Min-valued (Z, min)^" <> x
printMe cfg (SlowMonoidValued x) = withName cfg "Min-valued" <> "(Z, min)^" <> x
instance Printable (SlowMonoidValued MaxDouble) where
printMe (SlowMonoidValued x) = "Max-valued (R, max)^" <> x
printMe cfg (SlowMonoidValued x) = withName cfg "Max-valued" <> "(R, max)^" <> x
instance Printable (SlowMonoidValued MinDouble) where
printMe (SlowMonoidValued x) = "Min-valued (R, min)^" <> x
printMe cfg (SlowMonoidValued x) = withName cfg "Min-valued" <> "(R, min)^" <> x
instance Printable (SlowMonoidValued (BitAnd Word64)) where
printMe (SlowMonoidValued x) = "BitAnd-valued (Word, and)^" <> x
printMe cfg (SlowMonoidValued x) = withName cfg "BitAnd-valued" <> "(Word, and)^" <> x
instance Printable (SlowMonoidValued (BitOr Word64)) where
printMe (SlowMonoidValued x) = "BitOr-valued (Word, or)^" <> x
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
......
......@@ -97,26 +97,26 @@ $(deriveShow1 ''Factor)
$(deriveShow1 ''Polynomial)
instance Printable Polynomial where
printMe poly = "Polynomial " <> printPolynomial poly
printMe cfg poly = withName cfg "Polynomial" <> printPolynomial cfg poly
printPolynomial :: Polynomial Build.Builder -> Build.Builder
printPolynomial (Polynomial (Sum (prods))) = fold (NonEmpty.intersperse " + " (fmap printProduct prods))
printPolynomial :: PrintConfig -> Polynomial Build.Builder -> Build.Builder
printPolynomial cfg (Polynomial (Sum (prods))) = fold (NonEmpty.intersperse " + " (fmap (printProduct cfg) prods))
printProduct :: Product Build.Builder -> Build.Builder
printProduct (Product (factors)) = fold (NonEmpty.intersperse "x" (fmap printFactor factors))
printProduct :: PrintConfig -> Product Build.Builder -> Build.Builder
printProduct cfg (Product (factors)) = fold (NonEmpty.intersperse "x" (fmap (printFactor cfg) factors))
printFactor :: Factor Build.Builder -> Build.Builder
printFactor (Const IntSet) = "Z"
printFactor (Const NatSet) = "N"
printFactor (Const (FiniteNatSet v)) = Build.decimal v
printFactor (Const (ExplicitSet elems)) =
printFactor :: PrintConfig -> Factor Build.Builder -> Build.Builder
printFactor _ (Const IntSet) = "Z"
printFactor _ (Const NatSet) = "N"
printFactor _ (Const (FiniteNatSet v)) = Build.decimal v
printFactor _ (Const (ExplicitSet elems)) =
(V.foldl
(\s e -> s <> ", " <> Build.fromText e)
("{" <> Build.fromText (V.head elems)) (V.tail elems)
) <> "}"
printFactor (Identity a) = a
printFactor (Exponential a exp) = a <> "^" <> printExp exp
printFactor _ (Identity a) = a
printFactor _ (Exponential a exp) = a <> "^" <> printExp exp
printExp :: Exponent -> Build.Builder
printExp (FiniteNatExp v) = Build.decimal v
......
......@@ -35,7 +35,7 @@ newtype Powerset a = Powerset a
$(deriveShow1 ''Powerset)
instance Printable Powerset where
printMe (Powerset x) = "Powerset P" <> x
printMe cfg (Powerset x) = withName cfg "Powerset" <> "P" <> x
powerset :: FunctorDescription Powerset
powerset = FunctorDescription
......
......@@ -65,7 +65,7 @@ instance Show1 SomeFunctor where
liftShowsPrec shows' showsList' pred f
instance Printable SomeFunctor where
printMe (SomeFunctor x) = printMe x
printMe cfg (SomeFunctor x) = printMe cfg x
-- | Apply a natural transformation under the 'SomeFunctor'.
......
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