15_a_1 and 15_a_2: Add solutions

4 files changed, 114 insertions, 2 deletions

diff --git a/README.md b/README.md
index a9e4701..92ada8f 100644
--- a/README.md
+++ b/README.md
@@ -146,8 +146,8 @@ are prefixed with 'Module_'.
 | 12_a_3         | yes, in 12_a_1  |      | |
 | **_13_a_1_**   | yes    | 316  | 13. Data structures |
 | **_14_a_1_**   | yes    | 352  | 14. Monads |
-| **_15_a_1_**   |        | 382  | 15. Programming with monads |
-| 15_a_2         |        |      | |
+| **_15_a_1_**   | yes    | 382  | 15. Programming with monads |
+| 15_a_2         | yes, in 15_a_1  |      | |
 | 15_a_3         |        |      | |
 | **_16_a_1_**   |        | 403  | 16. The Parsec parsing library |
 | 16_a_2         |        |      | |
diff --git a/ch15/15_a_1.hs b/ch15/15_a_1.hs
new file mode 100644
index 0000000..66d13d9
--- /dev/null
+++ b/ch15/15_a_1.hs
@@ -0,0 +1,84 @@
+-- 1. Using QuickCheck, write a test for an action in the MonadHandle monad, to
+--    see if it tries to write to a file handle that is not open. Try it out on
+--    safeHello.
+--
+-- 2. Write an action that tries to write to a file handle that it has
+--    closed. Does your test catch this bug?
+
+
+{-- From examples/examples/ch15/WriterIO.hs and modified --}
+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses,
+  TypeSynonymInstances #-}
+
+import Control.Monad.Writer
+import MonadHandle
+import System.IO (IOMode(..))
+import SafeHello
+
+import Test.QuickCheck
+
+data Event = Close
+           | Open
+           | Write
+           deriving (Show)
+
+-- Added missing Functor and Applicative instance derivation
+newtype WriterIO a = W { runW :: Writer [Event] a }
+    deriving (Functor, Applicative, Monad, MonadWriter [Event])
+
+runWriterIO :: WriterIO a -> (a, [Event])
+runWriterIO = runWriter . runW
+
+instance MonadHandle FilePath WriterIO where
+    openFile path mode = tell [Open] >> return path
+    hPutStr h str = tell [Write]
+    hClose h = tell [Close]
+    hGetContents h = return ""
+{-- End of code from examples --}
+
+
+{-- From examples/examples/ch15/SafeHello.hs and modified --}
+writeAfterCloseHello :: MonadHandle h m => FilePath -> m ()
+writeAfterCloseHello path = do
+  h <- openFile path WriteMode
+  hClose h
+  hPutStrLn h "hello world"
+  hClose h
+{-- End of code from examples --}
+
+
+data State = Closed
+           | Opened
+           | None
+
+-- Analyze the logged events for containing write of a closed file handle
+hasWriteAfterClose :: [Event] -> Bool
+hasWriteAfterClose es = hasWriteAfterClose' es None
+  where
+    hasWriteAfterClose' (Write:_) Closed = True
+    hasWriteAfterClose' [] _ = False
+    hasWriteAfterClose' (Close:es) state = hasWriteAfterClose' es Closed
+    hasWriteAfterClose' (Open:es) state = hasWriteAfterClose' es Opened
+    hasWriteAfterClose' (_:es) state = hasWriteAfterClose' es state
+
+
+
+runSafeHello filePath = runWriterIO (safeHello filePath)
+runWriteAfterCloseHello filePath = runWriterIO (writeAfterCloseHello filePath)
+
+prop_noWriteAfterClose :: (FilePath -> ((), [Event])) -> FilePath -> Bool
+prop_noWriteAfterClose action filePath = hasWriteAfterClose (snd (action filePath)) == False
+
+
+-- ghci> :l 15_a_1.hs
+-- [1 of 4] Compiling MonadHandle      ( MonadHandle.hs, interpreted )
+-- [2 of 4] Compiling SafeHello        ( SafeHello.hs, interpreted )
+-- [3 of 4] Compiling Main             ( 15_a_1.hs, interpreted )
+-- Ok, three modules loaded.
+
+-- ghci> quickCheck(prop_noWriteAfterClose runSafeHello)
+-- +++ OK, passed 100 tests.
+
+-- ghci> quickCheck(prop_noWriteAfterClose runWriteAfterCloseHello)
+-- *** Failed! Falsified (after 1 test):
+-- ""
diff --git a/ch15/MonadHandle.hs b/ch15/MonadHandle.hs
new file mode 100644
index 0000000..209728d
--- /dev/null
+++ b/ch15/MonadHandle.hs
@@ -0,0 +1,16 @@
+{-- snippet MonadHandle --}

+{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}

+

+module MonadHandle (MonadHandle(..)) where

+

+import System.IO (IOMode(..))

+

+class Monad m => MonadHandle h m | m -> h where

+    openFile :: FilePath -> IOMode -> m h

+    hPutStr :: h -> String -> m ()

+    hClose :: h -> m ()

+    hGetContents :: h -> m String

+

+    hPutStrLn :: h -> String -> m ()

+    hPutStrLn h s = hPutStr h s >> hPutStr h "\n"

+{-- /snippet MonadHandle --}

diff --git a/ch15/SafeHello.hs b/ch15/SafeHello.hs
new file mode 100644
index 0000000..91a7ff1
--- /dev/null
+++ b/ch15/SafeHello.hs
@@ -0,0 +1,12 @@
+module SafeHello where

+

+import MonadHandle

+import System.IO (IOMode(..))

+

+{-- snippet safeHello --}

+safeHello :: MonadHandle h m => FilePath -> m ()

+safeHello path = do

+  h <- openFile path WriteMode

+  hPutStrLn h "hello world"

+  hClose h

+{-- /snippet safeHello --}