A toy category instance for monoids

ListCat.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}

import Overture
import Prelude ()

data Foo m a b where
  Foo :: m -> Foo m a a

instance Show m => Show (Foo m a a) where
  showsPrec p (Foo a) = showParen (p > appP)
                      $ showString "Foo " . showsPrec (appP+1) a
    where appP = 10

instance Monoid m => Category (Foo m) where
  id = Foo mempty
  Foo a . Foo b = Foo (a `mappend` b)