Introduction

Some very brief notes summarizing Haskell’s monoids. It’s my crib sheet, written partly to straighten matters in my own mind and partly for future reference.

Most of the information here comes from elsewhere: see a list at the end of the article. I’m also indebted to Dominic Prior for many helpful discussions. Dominic is collecting useful and interesting code1 on Google Docs.

Groups

Many people are familiar with groups.2 Every group has:

For example, consider the integers under addition.

We have:

Semigroups

Now, consider instead the positive integers under addition. We still have an interesting structure, but because the set of elements does not include 0 there’s no identity element. Similarly the lack of negative numbers means there’s no inverse.

Such a structure is called a semigroup3

Moving away from the integers, the set of strings of finite, non-zero length forms a semigroup under concatenation.

Monoids

Perhaps throwing away both the inverses and the identity is too much. If we have inverses we must have the identity, but the converse isn’t true. So, let’s consider a group without inverses. This is a monoid.

Three examples come easily to mind:

SetOperationIdentity
Natural Numbers+0
Positive Integers*1
Strings++""

Given that such basic things admit a monoidal structure, it is not surprising to find more complicated things do too. For example, Brent Yorgey’s fine diagrams4 package provides a monoidal instance5 for diagrams. In words, we can combine two diagrams to make a new diagram.

Data.Monoid

In Haskell the monoid typeclass lives in Data.Monoid6 which gives us:

both are subject to laws:

Note that you really ought to use mappend when implementing your own monoids, but it’s just too ugly for me.

Further, there is a mconcat method which combines a list of elements. There’s a default implementation which simply folds <>, but instances might be able to implement it more efficiently.

You can see that the function names are somewhat inspired by the list instance:

instance Monoid [a] where
   mempty  = []
   mappend = ++

So we can concatenate lists more abstractly:

> "the " <> "quick"
"the quick"
> mempty <> "quick"
"quick"
> mconcat [ "the ", "quick ", "brown " ]
"the quick brown "

Now let’s turn to the integers. Recall that there are two different monoids: one under multiplication and the other under addition. Haskell handles this with two different classes: Product and Sum respectively.

> Product 2 <> Product 3	
Product {getProduct = 6}		
> Product 2 <> mempty		
Product {getProduct = 2}		
					
> Sum 2 <> Sum 3		
Sum {getSum = 5}			
> Sum 2 <> Sum 0		
Sum {getSum = 2}			
> Sum 2 <> mempty		
Sum {getSum = 2}			
					
> mconcat $ map Sum [1..10]	
Sum {getSum = 55}			
> mconcat $ map Product [1..10]	
Product {getProduct = 3628800}

The instance implementation looks like this:

newtype Product a = Product { getProduct :: a }
        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)

instance Num a => Monoid (Product a) where
        mempty = Product 1
        Product x <> Product y = Product $ x * y

The Maybe monoid

We can often think of the Maybe type as being a special case of lists with at most one element, and so unsurprisingly there’s a monoid instance for Maybe too:

> Just "a" <> Just "b"					
Just "ab"						
> Nothing <> Just "b"					
Just "b"						
> mempty <> Just "b"					
Just "b"						
> mconcat $ map ((\x -> Just [x]) ['a' .. 'f']	
Just "abcdef"						

An implementation is straightforward:

instance Monoid a => Monoid (Maybe a) where
  mempty = Nothing
  Just a  <> Just b  = Just $ a <> b
  Just a  <> Nothing = Just a
  Nothing <> Just b  = Just b
  Nothing <> Nothing = Nothing

Assuming that mempty = Nothing the last three equations follow from the monoid laws, but we have more freedom when evaluating

  Just a <> Just b

Ignoring Just $ a <> b there are only two choices:

and it turns out that both choices have been instantiated as First and Last. We’ll consider First in more detail:

newtype First a = First { getFirst :: Maybe a }
    deriving (Eq, Ord, Read, Show, Generic, Generic1,
                          Functor, Applicative, Monad)

instance Monoid (First a) where
  mempty = First Nothing
  First (Just a)  <> First (Just b)  = First $ Just a
  First (Just a)  <> First (Nothing) = First $ Just a
  First (Nothing) <> First (Just b)  = First $ Just b
  First (Nothing) <> First (Nothing) = First   Nothing

So we have a way of picking out the first or last interesting entry. For example, let’s set up a little database with just a couple of interesting characters in it: a and b:

> let interesting = [ 'a', 'b' ]
> let q c = if c `elem` interesting then Just c else Nothing
> q 'a'
Just 'a'
> q 'c'
Nothing

Now let’s look at the monoids:

> mconcat $ map (First . q) "cabinet"
First {getFirst = Just 'a'}
> mconcat $ map (Last .  q) "cabinet"
Last {getLast = Just 'b'}
> mconcat $ map (Last .  q) "desk"
Last {getLast = Nothing}

Note that because we are selecting one of the existing values and not creating one, we don’t need the underlying data type to be a monoid inself. This isn’t the case with the plain Maybe monoid.

Maximum, AND, OR

Given a set of numbers we could form another monoid over maximum. There’s no standard instance, but it’s easy to write one. In fact, it’s easy to write two!

The key decision is mempty. We could just reuse Maybe:

newtype MaxM a = MaxM { getMaxM :: Maybe a }
   deriving (Eq, Ord, Read, Show)

instance Monoid (MaxM a) where
    mempty = MaxM Nothing
    a <> MaxM Nothing = a
    MaxM Nothing <> b = b
    MaxM (Just a) <> MaxM (Just b) = MaxM . Just $ max a b

Alternatively we could make mempty the lower bound for the type in question (if such a thing exists):

newtype MaxB a = MaxB { getMaxB :: a }
    deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)

instance Num a => Monoid (MaxB a) where
    mempty  = minBound
    mappend = max

Note that because minBound depends on the type, we’ll often have to explicit supply one:

> MaxB 1 <> MaxB 2 :: MaxB Int
MaxB {getMaxB = 2}

We can play games with different types:

> import Data.Int
> import Data.Word

> mempty :: MaxB Int16
MaxB {getMaxB = -32768}
> mempty :: MaxB Word16
MaxB {getMaxB = 0}
> mempty :: MaxB Int
MaxB {getMaxB = -9223372036854775808}

But not Integer: being unbounded it doesn’t have a bound!

> mempty :: MaxB Integer

<interactive>:...:
    No instance for (Bounded Integer) arising from a use of ‘mempty’
    In the expression: mempty :: MaxB Integer
    In an equation for ‘it’: it = mempty :: MaxB Integer

At the other end of the size scale, consider 1-bit integers. With the usual equivalences, 0 ≡ False and 1 ≡ True, we find max|| and min&&. These instances are standard ones: Any and All:

> Any True <> Any True
Any {getAny = True}
> Any True <> Any False
Any {getAny = True}

> All True <> All True
All {getAll = True}
> All True <> All False
All {getAll = False}

Ordering

Haskell defines a comparison function for the Ord typeclass. a `compare` b will return:

If we define a monoid instance akin to First, where EQ plays the role of Nothing, then we’ll get first-is-most-significant comparisons.

instance Monoid Ordering where
   mempty = EQ
   EQ <> b = b
   a  <> _ = a

> mconcat $ zipWith compare [1,8,9] [3,4,5]
LT

However, the real trick, which I first saw on reddit7 is to append two comparison functions:

> :t comparing length
comparing length :: [a] -> [a] -> Ordering
> :t compare
compare :: Ord a => a -> a -> Ordering

> :t comparing length <> compare
comparing length <> compare :: Ord a => [a] -> [a] -> Ordering

> sortBy (comparing length <> compare) $ words "the quick brown fox"
["fox","the","brown","quick"]

The Writer Monad

Finally, a common use for monoids is the Writer monad: the things we log must be monoidal. In modern parlance we should refer to the MonadWriter class.8

Following Chris Taylor on StackOverflow,9 let’s define as toy action, parameterized by the logging method:

import Control.Monad.Writer
> let toyAction l = do { a <- l 3; b <- l 5; return (a*b) }

Let’s start with a fairly traditional log:

> let logS x = writer (x, "Got " ++ show x ++ "\n")
> runWriter $ toyAction logS
(15,"Got 3\nGot 5\n")

or a list of numbers encountered:

> let logN x = writer (x, [x])
> runWriter $ toyAction logN
(15,[3,5])

or just a count of them:

> let logA x = writer (x, Sum 1)
> runWriter $ toyAction logA
(15,Sum {getSum = 2})

Endo

Endomorphisms10 are maps from a thing to itself, which in Haskell terms means functions of type (a -> a). You can make a monoid from these under function composition:

> (+2) . (+3) $ 10
15
> (appEndo $ Endo (+2) <> Endo (+3)) 10
15

Foldable

The Foldable typeclass models reducing a set of things to a single value. The minimal implementation is either foldr or foldMap. The latter is perhaps most interesting here:

foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m

If we specialize to a list to get an intuitive picture:

foldMap :: (Monoid m) => (a -> m) -> [a] -> m
foldMap f = mconcat . fmap f

In other words to apply foldMap, first map things into a Monoid, and then collapse the structure with mconcat. We used exactly this construction above, and so those examples can be expressed more succinctly with foldMap. For example:

> foldMap Sum [1..10]			
Sum {getSum = 55}			
> foldMap Product [1..10]		
Product {getProduct = 3628800}

The trick to expressing foldr in terms of foldr in terms of foldMap is to note that the step function in foldr has type:

(a -> b -> b) = (a -> (b -> b))

and that (b -> b) forms a monoid under composition (see Endo above). So to foldr on a list of [a]:

You can read a fuller explanation of this in the Haskell wikibook11.

Other discussions

Most of the material here has been stolen from other pages. If you want to consult these primary sources I recommend: