Merge branch 'master' of github.com:mukeshsoni/haskell-programming-book

Author: mukeshsoni

chapter15/exercises/monoid/1_trivial.hs

@@ -0,0 +1,17 @@
+import Data.Monoid
+import Test.QuickCheck (quickCheck, Arbitrary, arbitrary)
+import MonoidLaws
+
+data Trivial = Trivial deriving (Eq, Show)
+
+instance Monoid Trivial where
+    mempty = Trivial
+    mappend _ _ = Trivial
+
+instance Arbitrary Trivial where
+    arbitrary = return Trivial
+
+main = do
+    quickCheck (monoidAssoc :: (Trivial -> Trivial -> Trivial -> Bool))
+    quickCheck (monoidLeftIdentity :: (Trivial -> Bool))
+    quickCheck (monoidRightIdentity :: (Trivial -> Bool))

chapter15/exercises/monoid/2_identity.hs

@@ -0,0 +1,17 @@
+import Data.Monoid
+import Test.QuickCheck (quickCheck, Arbitrary, arbitrary)
+import MonoidLaws
+
+data Identity a = Identity a deriving (Eq, Show)
+
+instance (Monoid a) => Monoid (Identity a) where
+    mempty = Identity mempty
+    mappend (Identity a) (Identity b) = Identity (a <> b)
+
+instance (Arbitrary a) => Arbitrary (Identity a) where
+    arbitrary = fmap Identity arbitrary
+
+main = do
+    quickCheck (monoidAssoc :: (Identity String -> Identity String -> Identity String -> Bool))
+    quickCheck (monoidLeftIdentity :: (Identity String -> Bool))
+    quickCheck (monoidRightIdentity :: (Identity String -> Bool))

chapter15/exercises/monoid/3_two.hs

@@ -0,0 +1,20 @@
+import Data.Monoid
+import Test.QuickCheck (quickCheck, Arbitrary, arbitrary)
+import MonoidLaws
+
+data Two a b = Two a b deriving (Eq, Show)
+
+instance (Monoid a, Monoid b) => Monoid (Two a b) where
+    mempty = Two mempty mempty
+    mappend (Two a b) (Two x y) = Two (a <> x) (b <> y)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where
+    arbitrary = do
+        a <- arbitrary
+        b <- arbitrary
+        return (Two a b)
+
+main = do
+    quickCheck (monoidAssoc :: (Two String String -> Two String String -> Two String String -> Bool))
+    quickCheck (monoidLeftIdentity :: (Two String String -> Bool))
+    quickCheck (monoidRightIdentity :: (Two String String -> Bool))

chapter15/exercises/monoid/4_bool_conj.hs

@@ -0,0 +1,19 @@
+import Data.Monoid
+import Test.QuickCheck (quickCheck, Arbitrary, arbitrary)
+import MonoidLaws
+
+newtype BoolConj = BoolConj Bool deriving (Eq, Show)
+
+instance Monoid BoolConj where
+    mempty = BoolConj True
+    mappend (BoolConj False) _ = BoolConj False
+    mappend _ (BoolConj False) = BoolConj False
+    mappend _ _ = BoolConj True
+
+instance Arbitrary BoolConj where
+    arbitrary = fmap BoolConj arbitrary
+
+main = do
+    quickCheck (monoidAssoc :: (BoolConj -> BoolConj -> BoolConj -> Bool))
+    quickCheck (monoidLeftIdentity :: (BoolConj -> Bool))
+    quickCheck (monoidRightIdentity :: (BoolConj -> Bool))

chapter15/exercises/monoid/MonoidLaws.hs

@@ -0,0 +1,14 @@
+module MonoidLaws where
+
+import Data.Monoid
+import Control.Monad
+import Test.QuickCheck
+
+monoidAssoc :: (Eq a, Monoid a) => a -> a -> a -> Bool
+monoidAssoc a b c = a <> (b <> c) == (a <> b) <> c
+
+monoidLeftIdentity :: (Eq a, Monoid a) => a -> Bool
+monoidLeftIdentity a = mempty <> a == a
+
+monoidRightIdentity :: (Eq a, Monoid a) => a -> Bool
+monoidRightIdentity a = a <> mempty == a