From b801218e7627f98556ab7d1acbefbbf8daafd851 Mon Sep 17 00:00:00 2001
From: Jan Sucan <jan@jansucan.com>
Date: Wed, 30 Jul 2025 10:29:40 +0200
Subject: 15_a_1 and 15_a_2: Add solutions

---
 ch15/15_a_1.hs | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 84 insertions(+)
 create mode 100644 ch15/15_a_1.hs

(limited to 'ch15/15_a_1.hs')

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):
+-- ""
-- 
cgit v1.2.3