Endofunction as Monoid

十年热恋 提交于 2019-12-01 07:37:37

This will need {-# OVERLAPPING #-} pragma since GHC.Base has an instance for Monoid (a -> b) when b is a Monoid:

{-# LANGUAGE FlexibleInstances #-}
import Data.Monoid (Monoid, mempty, mappend, (<>))

instance {-# OVERLAPPING #-} Monoid (a -> a) where
    mempty = id
    mappend f g = f . g

then, above instance will be invoked for a -> a, even if a is a Monoid:

\> (id <> id) 1
1
\> (id <> id) [1]
[1]

whereas with Monoid b => a -> b the instance from GHC.Base will be invoked:

\> ((:[]) <> (:[])) 1
[1,1]

Note that Data.Monoid provides an exact same instance as yours for a -> a but there the overlap is bypassed using newtype Endo a.

The Haskell Category class offers methods to work with categories whose objects are precisely the Haskell types of some kind. Specifically,

class Category c where
  id :: c x x
  (.) :: c y z -> c x y -> c x z

The names of the methods should look very familiar. Notably,

instance Category (->) where
  id x = x
  f . g = \x -> f (g x)

You probably know that monoids are semigroups with identities, expressed in Haskell using

class Monoid a where
  mappend :: a -> a -> a
  mempty :: a

But another mathematical perspective is that they're categories with exactly one object. If we have a monoid, we can easily turn it into a category:

-- We don't really need this extension, but
-- invoking it will make the code below more useful.
{-# LANGUAGE PolyKinds #-}

import Control.Category
import Data.Monoid
import Prelude hiding ((.), id)

newtype Mon m a b = Mon m

instance Monoid m => Category (Mon m) where
  id = Mon mempty
  Mon x . Mon y = Mon (x `mappend` y)

Going the other way is a little bit trickier. One way to do it is to choose a kind with exactly one type, and look at categories whose sole object is that type (prepare for yucky code, which you can skip if you like; the bit below is less scary). This shows that we can freely convert between a Category whose object is the type '() in the () kind and a Monoid. The arrows of the category become the elements of the monoid.

{-# LANGUAGE DataKinds, GADTs, PolyKinds #-}

data Cat (c :: () -> () -> *) where
  Cat :: c '() '() -> Cat c
instance Category c => Monoid (Cat c) where
  mempty = Cat id
  Cat f `mappend` Cat g = Cat (f . g)

But this is yucky! Ew! And pinning things down so tightly doesn't usually accomplish anything from a practical perspective. But we can get the functionality without so much mess, by playing a little trick!

{-# LANGUAGE GADTs, PolyKinds #-} 

import Control.Category
import Data.Monoid
import Prelude hiding ((.), id)

newtype Cat' (c :: k -> k -> *) (a :: k) (b :: k) = Cat' (c a b)

instance (a ~ b, Category c) => Monoid (Cat' c a b) where
  mempty = Cat' id
  Cat' f `mappend` Cat' g = Cat' (f . g)

Instead of confining ourselves to a Category that really only has one object, we simply confine ourselves to looking at one object at a time.

The existing Monoid instance for functions makes me sad. I think it would be much more natural to use a Monoid instance for functions based on their Category instance, using the Cat' approach:

instance a ~ b => Monoid (a -> b) where
  mempty = id
  mappend = (.)

Since there's already a Monoid instance, and overlapping instances are evil, we have to make do with a newtype. We could just use

newtype Morph a b = Morph {appMorph :: a -> b}

and then write

instance a ~ b => Monoid (Morph a b) where
  mempty = Morph id
  Morph f `mappend` Morph g = Morph (f . g)

and for some purposes maybe this is the way to go, but since we're using a newtype already we usually might as well drop the non-standard equality context and use Data.Monoid.Endo, which builds that equality into the type:

newtype Endo a = Endo {appEndo :: a -> a}

instance Monoid (Endo a) where
  mempty = Endo id
  Endo f `mappend` Endo g = Endo (f . g)
标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!