Use existing definitions instead of re-defining stuff in Good.

monoids-in-the-categoy-of-endofunctors.cabal

@@ -4,7 +4,7 @@ cabal-version: 2.2
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 36f59318e1bb608d49a3bb377e2ef94dfa811ad60fe6aae86f7be7ffd276ec93
+-- hash: e99a010593b8627f3cc837fe8d7be68cf98b9e9b486b8a4caef1070e8b62b2d3
 
 name:           monoids-in-the-categoy-of-endofunctors
 version:        0.1.0.0
@@ -27,9 +27,8 @@ source-repository head
 library
   exposed-modules:
       Category
-      Category.Good
-      Category.Neutral.Enriched
-      Category.Subcategory
+      Category.Free
+      Category.Star
       Data.Dict
       Data.Recursive
   other-modules:
@@ -40,4 +39,6 @@ library
   ghc-options: -Weverything -Wno-missing-export-lists -Wno-missing-import-lists
   build-depends:
       base >=4.13 && <5
+    , invariant >=0.5 && <0.6
+    , profunctors >=5.5 && <6
   default-language: Haskell2010

package.yaml

@@ -38,6 +38,8 @@ ghc-options:
 
 dependencies:
 - base >= 4.13 && < 5
+- invariant >= 0.5 && < 0.6
+- profunctors >= 5.5 && < 6
 
 library:
   source-dirs: src

src/Category.hs

@@ -3,7 +3,8 @@
 {-# LANGUAGE UndecidableInstances #-}
 module Category where
 
-import Category.Good qualified as Good
+import Category.Start qualified as Star
+import Control.Category (Category, id, (.))
 import Data.Dict (Dict (Dict), (:-) (Sub), (\\))
 import Data.Kind (Type)
 
@@ -14,94 +15,78 @@ type instance (~>) = (:-)
 
 type Dom (a :: i) = (~>) :: i -> i -> Type
 
--- | An unenriched category.
-class Category cat where
-    identity :: cat a a
-    compose :: cat b c -> cat a b -> cat a c
-
-(.) :: Category cat => cat b c -> cat a b -> cat a c
-(.) = compose
-
-instance Category (->) where
-    identity x = x
-    compose f g x = f (g x)
-
-instance Category (:-) where
-    identity = Sub Dict
-    compose f g = Sub (Dict \\ f \\ g)
-
 -- | An covariant endofunctor in an unenriched category.
 class Category cat => CovariantEndo cat f where
     coendomap :: cat a b -> cat (f a) (f b)
 
-instance {-# OVERLAPPABLE #-} Good.Covariant f => CovariantEndo (->) f where
-    coendomap = Good.comap
+instance {-# OVERLAPPABLE #-} Star.Functor f => CovariantEndo (->) f where
+    coendomap = Star.fmap
 
 -- | A contravariant endofunctor in an unenriched category.
 class Category cat => ContravariantEndo cat f where
     contraendomap :: cat b a -> cat (f a) (f b)
 
-instance Good.Contravariant f => ContravariantEndo (->) f where
-    contraendomap = Good.contramap
+instance Star.Contravariant f => ContravariantEndo (->) f where
+    contraendomap = Star.contramap
 
 -- | An invariant endofunctor (if that's even considered a functor) in an unenriched category.
 class Category cat => InvariantEndo cat f where
     invendomap :: cat a b -> cat b a -> cat (f a) (f b)
 
-instance Good.Invariant f => InvariantEndo (->) f where
-    invendomap = Good.invmap
+instance {-# OVERLAPPABLE #-} Star.Invariant f => InvariantEndo (->) f where
+    invendomap = Star.invmap
 
 -- | A bi-endofunctor in an unenriched category covariant in both arguments.
 class Category cat => BiEndo cat f where
     biendomap :: cat a c -> cat b d -> cat (f a b) (f c d)
 
-instance Good.Bi f => BiEndo (->) f where
-    biendomap = Good.bimap
+instance {-# OVERLAPPABLE #-} Star.Bifunctor f => BiEndo (->) f where
+    biendomap = Star.bimap
 
 -- | A pro-endofunctor in an unenriched category (contravariant in the left argument, covariant in the right).
 class Category cat => ProEndo cat f where
     diendomap :: cat c a -> cat b d -> cat (f a b) (f c d)
 
-instance Good.Pro f => ProEndo (->) f where
-    diendomap = Good.dimap
+instance {-# OVERLAPPABLE #-} Star.Profunctor f => ProEndo (->) f where
+    diendomap = Star.dimap
 
 -- | A covariant functor between unenriched categories.
 class (Category dom, Category cod) => Covariant dom cod f where
     comap :: dom a b -> cod (f a) (f b)
 
-instance CovariantEndo cat f => Covariant cat cat f where
+instance {-# OVERLAPPABLE #-} CovariantEndo cat f => Covariant cat cat f where
     comap = coendomap
 
 -- | A contravariant functor between unenriched categories.
 class (Category dom, Category cod) => Contravariant dom cod f where
     contramap :: dom b a -> cod (f a) (f b)
 
-instance ContravariantEndo cat f => Contravariant cat cat f where
+instance {-# OVERLAPPABLE #-} ContravariantEndo cat f => Contravariant cat cat f where
     contramap = contraendomap
 
 -- | An invariant functor (if that's even considered a functor) between unenriched categories.
 class (Category dom, Category cod) => Invariant dom cod f where
     invmap :: dom a b -> dom b a -> cod (f a) (f b)
 
-instance InvariantEndo cat f => Invariant cat cat f where
+instance {-# OVERLAPPABLE #-} InvariantEndo cat f => Invariant cat cat f where
     invmap = invendomap
 
 -- | A bifunctor in an unenriched category covariant in both arguments.
 class (Category dom, Category cod) => Bi dom cod f where
     bimap :: dom a c -> dom b d -> cod (f a b) (f c d)
 
-instance BiEndo cat f => Bi cat cat f where
+instance {-# OVERLAPPABLE #-} BiEndo cat f => Bi cat cat f where
     bimap = biendomap
 
 -- | A profunctor in an unenriched category (contravariant in the left argument, covariant in the right).
 class (Category dom, Category cod) => Pro dom cod f where
     dimap :: dom c a -> dom b d -> cod (f a b) (f c d)
 
-instance ProEndo cat f => Pro cat cat f where
+instance {-# OVERLAPPABLE #-} ProEndo cat f => Pro cat cat f where
     dimap = diendomap
 
 instance Pro (:-) (->) (:-) where
-    dimap f g h = compose g (compose h f)
+    dimap f g h = g . h . f
 
 class Category cat => Monoidal (cat :: i -> i -> Type) where
     type Unit cat :: i
@@ -129,31 +114,31 @@ instance Monoidal (->) where
 class Monoidal cat => Semigroup cat s where
     append :: Product cat s s `cat` s
 
-instance Good.Semigroup s => Semigroup (->) s where
-    append (x, y) = Good.append x y
+instance {-# OVERLAPPABLE #-} Star.Semigroup s => Semigroup (->) s where
+    append (x, y) = (Star.<>) x y
 
 -- | A monoid object in a monoidal unenriched category.
 class Semigroup cat s => Monoid cat s where
     empty :: Unit cat `cat` s
 
-instance Good.Monoid s => Monoid (->) s where
-    empty () = Good.empty
+instance {-# OVERLAPPABLE #-} Star.Monoid s => Monoid (->) s where
+    empty () = Star.mempty
 
 -- | An applicative functor.
 class (Monoidal cat, CovariantEndo cat f) => Applicative cat f where
     pure :: a `cat` f a
     ap :: Product cat (f (a `cat` b)) (f a) `cat` f b
 
-instance Good.Applicative f => Applicative (->) f where
-    pure = Good.pure
-    ap (f, x) = Good.ap f x
+instance {-# OVERLAPPABLE #-} Star.Applicative f => Applicative (->) f where
+    pure = Star.pure
+    ap (f, x) = (Star.<*>) f x
 
 -- | A monoid object in the category of endofunctors in a monoidal unenriched category.
 class Applicative cat m => Monad cat m where
     join :: m (m a) `cat` m a
 
-instance Good.Monad m => Monad (->) m where
-    join = Good.join
+instance {-# OVERLAPPABLE #-} Star.Monad m => Monad (->) m where
+    join = Star.join
 
 newtype Nat f g = Nat { runNat :: forall a. f a ~> g a }
 
@@ -162,8 +147,8 @@ type instance (~>) = Nat
 type D (hom :: (i -> j) -> (i -> j) -> Type) = (~>) :: j -> j -> Type
 
 instance (nat ~ Nat, Category (D nat)) => Category (nat :: (i -> j) -> (i -> j) -> Type) where
-    identity = Nat identity
-    compose (Nat f) (Nat g) = Nat (compose f g)
+    id = Nat id
+    Nat f . Nat g = Nat (f . g)
 
 class AnyC a
 instance AnyC a

src/Category/Free.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE PolyKinds #-}
+module Category.Free where
+
+import Category
+import Data.Kind (Type)
+
+data FreeCategory (hom :: i -> i -> Type) :: i -> i -> Type where
+    Id :: FreeCategory hom a a
+    Embed :: !(hom a b) -> FreeCategory hom a b
+    Compose :: !(FreeCategory hom b c) -> !(FreeCategory hom a b) -> FreeCategory hom a c
+
+instance Category (FreeCategory hom) where
+    identity = Id
+    compose = Compose

src/Category/Good.hs

@@ -1,47 +0,0 @@
-module Category.Good where
-
-class Irrelevant f where
-    irrmap :: f a -> f b
-
--- | A covariant endofunctor in the category of types.
-class Covariant f where
-    comap :: (a -> b) -> (f a -> f b)
-
--- | A contravariant endofunctor in the category of types.
-class Contravariant f where
-    contramap :: (b -> a) -> (f a -> f b)
-
--- | An invariant endofunctor in the category of types.
-class Invariant f where
-    invmap :: (a -> b) -> (b -> a) -> (f a -> f b)
-
--- | A bifunctor in the category of types covariant in both arguments.
-class Bi f where
-    bimap :: (a -> c) -> (b -> d) -> (f a b -> f c d)
-
-instance Bi (,) where
-    bimap f g (x, y) = (f x, g y)
-
--- | A profunctor in the category of types (contravariant in the left argument, covariant in the right).
-class Pro f where
-    dimap :: (c -> a) -> (b -> d) -> (f a b -> f c d)
-
-instance Pro (->) where
-    dimap f g h x = g (h (f x))
-
--- | An applicative functor.
-class Covariant f => Applicative f where
-    pure :: a -> f a
-    ap :: f (a -> b) -> f a -> f b
-
--- | A monoid object in the category of endofunctors in the category of types.
-class Applicative m => Monad m where
-    join :: m (m a) -> m a
-
--- | A semigroup object in the category of types.
-class Semigroup s where
-    append :: s -> s -> s
-
--- | A monoid object in the category of types.
-class Semigroup m => Monoid m where
-    empty :: m

src/Category/Star.hs

@@ -0,0 +1,23 @@
+-- | Re-export category typeclasses which are specialized to the category of types.
+module Category.Star
+    ( module Control.Applicative
+    , module Control.Monad
+    , module Data.Bifunctor
+    , module Data.Functor
+    , module Data.Functor.Contravariant
+    , module Data.Functor.Invariant
+    , module Data.Monoid
+    , module Data.Profunctor
+    , module Data.Semigroup
+    ) where
+
+import Control.Applicative        (Applicative, pure, (<*>))
+import Control.Category           (Category, id, (.))
+import Control.Monad              (Monad, join)
+import Data.Bifunctor             (Bifunctor, bimap)
+import Data.Functor               (Functor, fmap)
+import Data.Functor.Contravariant (Contravariant, contramap)
+import Data.Functor.Invariant     (Invariant, invmap)
+import Data.Monoid                (Monoid, mempty)
+import Data.Profunctor            (Profunctor, dimap)
+import Data.Semigroup             (Semigroup, (<>))

src/Data/Dict.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE RankNTypes #-}
 module Data.Dict where
 
+import Control.Category (Category, id, (.))
+
 data Dict c where
     Dict :: c => Dict c
 
@@ -8,3 +10,7 @@ newtype a :- b = Sub (a => Dict b)
 
 (\\) :: a => (b => c) -> (a :- b) -> c
 r \\ Sub Dict = r
+
+instance Category (:-) where
+    id = Sub Dict
+    f . g = Sub (Dict \\ f \\ g)