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