f289912ec6c120b305709ed6c8c8d3cbc07803fe
1 -- From a blog post: http://www.jonmsterling.com/posts/2012-01-12-unifying-monoids-and-monads-with-polymorphic-kinds.html
3 {-# LANGUAGE PolyKinds #-}
4 {-# LANGUAGE MultiParamTypeClasses #-}
5 {-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
6 {-# LANGUAGE UndecidableInstances #-}
7 {-# LANGUAGE FunctionalDependencies #-}
8 {-# LANGUAGE RankNTypes #-}
9 {-# LANGUAGE TypeOperators #-}
10 {-# LANGUAGE DeriveFunctor #-}
11 {-# LANGUAGE UnicodeSyntax #-}
12 {-# LANGUAGE TypeFamilies #-}
14 module Main where
16 import Data.Monoid (Monoid(..))
18 -- First we define the type class Monoidy:
20 class Monoidy (to :: k0 -> k1 -> *) (m :: k1) where
21 type MComp to m :: k1 -> k1 -> k0
22 type MId to m :: k0
23 munit :: MId to m `to` m
24 mjoin :: MComp to m m m `to` m
26 -- We use functional dependencies to help the typechecker understand that
27 -- m and ~> uniquely determine comp (times) and id.
29 -- This kind of type class would not have been possible in previous
30 -- versions of GHC; with the new kind system, however, we can abstract
31 -- over kinds!2 Now, let’s create types for the additive and
32 -- multiplicative monoids over the natural numbers:
34 newtype Sum a = Sum a deriving Show
35 newtype Product a = Product a deriving Show
36 instance Num a ⇒ Monoidy () (Sum a) where
37 type MComp () (Sum a) = (,)
38 type MId () (Sum a) = ()
39 munit _ = Sum 0
40 mjoin (Sum x, Sum y) = Sum \$ x + y
42 instance Num a ⇒ Monoidy () (Product a) where
43 type MComp () (Product a) = (,)
44 type MId () (Product a) = ()
45 munit _ = Product 1
46 mjoin (Product x, Product y) = Product \$ x * y
48 -- It will be slightly more complicated to make a monadic instance with
49 -- Monoidy. First, we need to define the identity functor, a type for
50 -- natural transformations, and a type for functor composition:
52 data Id α = Id { runId :: α } deriving Functor
54 -- A natural transformation (Λ f g α. (f α) → (g α)) may be encoded in Haskell as follows:
56 data NT f g = NT { runNT :: ∀ α. f α → g α }
58 -- Functor composition (Λ f g α. f (g α)) is encoded as follows:
60 data FC f g α = FC { runFC :: f (g α) }
62 -- Now, let us define some type T which should be a monad:
64 data Wrapper a = Wrapper { runWrapper :: a } deriving (Show, Functor)
65 instance Monoidy NT Wrapper where
66 type MComp NT Wrapper = FC
67 type MId NT Wrapper = Id
68 munit = NT \$ Wrapper . runId
69 mjoin = NT \$ runWrapper . runFC
72 -- With these defined, we can use them as follows:
74 test1 = do { print (mjoin (munit (), Sum 2))
75 -- Sum 2
76 ; print (mjoin (Product 2, Product 3))
77 -- Product 6
78 ; print (runNT mjoin \$ FC \$ Wrapper (Wrapper "hello, world"))
79 -- Wrapper {runWrapper = "hello, world" }
80 }
82 -- We can even provide a special binary operator for the appropriate monoids as follows:
84 (<+>) :: (Monoidy () m, MId () m ~ (), MComp () m ~ (,))
85 ⇒ m → m → m
86 (<+>) = curry mjoin
88 test2 = print (Sum 1 <+> Sum 2 <+> Sum 4) -- Sum 7
90 -- Now, all the extra wrapping that Haskell requires for encoding this is
91 -- rather cumbersome in actual use. So, we can give traditional Monad and
92 -- Monoid instances for instances of Monoidy:
94 instance (MId () m ~ (), MComp () m ~ (,), Monoidy () m)
95 ⇒ Monoid m where
96 mempty = munit ()
97 mappend = curry mjoin
100 return x = runNT munit \$ Id x
101 x >>= f = runNT mjoin \$ FC (f `fmap` x)
103 -- And so the following works:
105 test3
106 = do { print (mappend mempty (Sum 2))
107 -- Sum 2
108 ; print (mappend (Product 2) (Product 3))
109 -- Product 6
110 ; print (join \$ Wrapper \$ Wrapper "hello")
111 -- Wrapper {runWrapper = "hello" }
112 ; print (Wrapper "hello, world" >>= return)
113 -- Wrapper {runWrapper = "hello, world" }
114 }
116 main = test1 >> test2 >> test3