Add remaining haskell book exercises

1 files changed, 48 insertions, 0 deletions

diff --git a/Haskell-book/15/optional/app/First.hs b/Haskell-book/15/optional/app/First.hs
new file mode 100644
index 0000000..929cd6b
--- /dev/null
+++ b/Haskell-book/15/optional/app/First.hs
@@ -0,0 +1,48 @@
+module Main where
+
+import Data.Monoid
+import Optional
+import Test.QuickCheck
+
+newtype First' a =
+    First' { getFirst' :: Optional a }
+    deriving (Eq, Show)
+
+instance Monoid (First' a) where
+    mempty = First' Nada
+    mappend (First' Nada) x = x
+    mappend x _ = x
+
+instance Arbitrary a => Arbitrary (First' a) where
+    arbitrary = frequency [ (1, return $ First' Nada)
+                          , (1, fmap (First' . Only) arbitrary) ]
+
+firstMappend :: First' a
+             -> First' a
+             -> First' a
+firstMappend = mappend
+
+type FirstMappend =
+    First' String
+  -> First' String
+  -> First' String
+  -> Bool
+
+type FstId =
+    First' String -> Bool
+
+monoidAssoc :: (Eq m, Monoid m) => m -> m -> m -> Bool
+monoidAssoc a b c =
+    (a <> (b <> c)) == ((a <> b) <> c)
+
+monoidLeftIdentity :: (Eq m, Monoid m) => m -> Bool
+monoidLeftIdentity a = (mempty <> a) == a
+
+monoidRightIdentity :: (Eq m, Monoid m) => m -> Bool
+monoidRightIdentity a = (a <> mempty) == a
+
+main :: IO ()
+main = do
+    quickCheck (monoidAssoc :: FirstMappend)
+    quickCheck (monoidLeftIdentity :: FstId)
+    quickCheck (monoidRightIdentity :: FstId)