Make Applicative a superclass of Monad
[ghc.git] / testsuite / tests / polykinds / MonoidsTF.hs
1 -- From a blog post: http://www.jonmsterling.com/posts/2012-01-12-unifying-monoids-and-monads-with-polymorphic-kinds.html
2
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 #-}
13
14 module Main where
15 import Control.Monad (Monad(..), join, ap, liftM)
16 import Data.Monoid (Monoid(..))
17
18 -- First we define the type class Monoidy:
19
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
25
26 -- We use functional dependencies to help the typechecker understand that
27 -- m and ~> uniquely determine comp (times) and id.
28
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:
33
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
41
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
47
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:
51
52 data Id α = Id { runId :: α } deriving Functor
53
54 -- A natural transformation (Λ f g α. (f α) → (g α)) may be encoded in Haskell as follows:
55
56 data NT f g = NT { runNT :: ∀ α. f α → g α }
57
58 -- Functor composition (Λ f g α. f (g α)) is encoded as follows:
59
60 data FC f g α = FC { runFC :: f (g α) }
61
62 -- Now, let us define some type T which should be a monad:
63
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
70
71
72 -- With these defined, we can use them as follows:
73
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 }
81
82 -- We can even provide a special binary operator for the appropriate monoids as follows:
83
84 (<+>) :: (Monoidy () m, MId () m ~ (), MComp () m ~ (,))
85 ⇒ m → m → m
86 (<+>) = curry mjoin
87
88 test2 = print (Sum 1 <+> Sum 2 <+> Sum 4) -- Sum 7
89
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:
93
94 instance (MId () m ~ (), MComp () m ~ (,), Monoidy () m)
95 ⇒ Monoid m where
96 mempty = munit ()
97 mappend = curry mjoin
98
99 instance Applicative Wrapper where
100 pure = return
101 (<*>) = ap
102
103 instance Monad Wrapper where
104 return x = runNT munit $ Id x
105 x >>= f = runNT mjoin $ FC (f `fmap` x)
106
107 -- And so the following works:
108
109 test3
110 = do { print (mappend mempty (Sum 2))
111 -- Sum 2
112 ; print (mappend (Product 2) (Product 3))
113 -- Product 6
114 ; print (join $ Wrapper $ Wrapper "hello")
115 -- Wrapper {runWrapper = "hello" }
116 ; print (Wrapper "hello, world" >>= return)
117 -- Wrapper {runWrapper = "hello, world" }
118 }
119
120 main = test1 >> test2 >> test3