gistfile1.hs

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeOperators #-}

module Monoid where

import Data.Monoid (Monoid, Sum, Product)
import qualified Data.Monoid as M
import Control.Category

class Category (-->) => CategoricalMonoid (-->) m  where
  mempty :: m
  (<>)   :: m --> (m --> m)

class (CategoricalMonoid (-->) m, CategoricalMonoid (-->) n)
      => MonoidHomomorphism (-->) f m n  where
  mapMH :: f (m --> m --> m) (n --> n --> n)

instance Monoid m => CategoricalMonoid (->) m where
  mempty = M.mempty
  (<>)   = (M.<>)

newtype Pow a b = Pow ((a -> (a -> a)) ->
                       (b -> (b -> b)))

instance Integral a => MonoidHomomorphism (->) Pow (Sum a) (Product a) where
  mapMH  = Pow $ const (<>)