24_a_2: Add solution

3 files changed, 233 insertions, 1 deletions

diff --git a/README.md b/README.md
index e4219ba..d2eb948 100644
--- a/README.md
+++ b/README.md
@@ -188,7 +188,7 @@ are prefixed with 'Module_'.
 | 23_a_2         | yes, in 23_a_1  |      | |
 | 23_a_3         | yes    |      | |
 | **_24_a_1_**   | yes    | 542  | 24. Concurrent and multicore programming |
-| 24_a_2         |        |      | |
+| 24_a_2         | yes    |      | |
 | **_24_b_1_**   |        | 551  | |
 | 24_b_2         |        |      | |
 | **_26_a_1_**   |        | 610  | 26. Advanced library design: building a Bloom filter |
diff --git a/ch24/Module_24_a_2.hs b/ch24/Module_24_a_2.hs
new file mode 100644
index 0000000..9797a3c
--- /dev/null
+++ b/ch24/Module_24_a_2.hs
@@ -0,0 +1,163 @@
+-- Although we've already mentioned the existence of the strict-concurrency
+-- package in the Hackage repository, try developing your own, as a wrapper
+-- around the built-in MVar type. Following classic Haskell practice, make your
+-- library type safe, so that users cannot accidentally mix uses of strict and
+-- non-strict MVars.
+
+
+-- The strict-concurrency package contains strict MVar and Chan. For simplicity,
+-- I will
+--   - implement only
+--     - newEmptyMVar, newMVar, takeMVar, and putMVar
+--     - newChan, writeChan, and readChan
+
+--   - not mimic the strict-concurrency functions completely, to avoid dealing
+--     with the NFData typeclass and normal forms
+--
+-- I assume that the classic Haskell practice means making sure that the users
+-- cannot just simply change the import from the non-strict versions to strict
+-- ones with the code still compiling.
+
+
+module Module_24_a_2
+    (
+      StrictMVar
+    , Module_24_a_2.newStrictEmptyMVar
+    , Module_24_a_2.newStrictMVar
+    , Module_24_a_2.takeMVar
+    , Module_24_a_2.putMVar
+    , StrictChan
+    , Module_24_a_2.newStrictChan
+    , Module_24_a_2.writeChan
+    , Module_24_a_2.readChan
+    ) where
+
+import Control.Concurrent.MVar as NSM
+import Control.Concurrent.Chan as NSC
+
+
+newtype StrictMVar a = StrictM (MVar a)
+
+unwrapStrictMVar :: StrictMVar a -> MVar a
+unwrapStrictMVar (StrictM m) = m
+
+newStrictEmptyMVar :: IO (StrictMVar a)
+newStrictEmptyMVar = StrictM <$> NSM.newEmptyMVar
+
+newStrictMVar :: a -> IO (StrictMVar a)
+newStrictMVar val = val `seq` StrictM <$> NSM.newMVar val
+
+takeMVar :: StrictMVar a -> IO a
+takeMVar m = NSM.takeMVar $ unwrapStrictMVar m
+
+putMVar :: StrictMVar a -> a -> IO ()
+putMVar m val = val `seq` NSM.putMVar (unwrapStrictMVar m) val
+
+
+newtype StrictChan a = StrictC (Chan a)
+
+unwrapStrictChan :: StrictChan a -> Chan a
+unwrapStrictChan (StrictC c) = c
+
+newStrictChan :: IO (StrictChan a)
+newStrictChan = StrictC <$> NSC.newChan
+
+writeChan :: StrictChan a -> a -> IO ()
+writeChan c val = val `seq` NSC.writeChan (unwrapStrictChan c) val
+
+readChan :: StrictChan a -> IO a
+readChan c = NSC.readChan (unwrapStrictChan c)
+
+
+-- To test this module better (information hiding offered by the export
+-- functionality), it is imported in the test_24_a_2.hs instead of loaded into
+-- ghci. The test source file contains commented-out sections of code I will
+-- uncomment individually (with uncommenting the relevant import statement) when
+-- performing the tests.
+
+
+
+
+-- Tests with non-strict versions (the Control.Concurrent module)
+
+-- ghci> :l test_24_a_2.hs
+-- [1 of 2] Compiling Main             ( test_24_a_2.hs, interpreted )
+-- test_24_a_2.hs:26:8: error: [GHC-88464]
+--     Variable not in scope: newStrictEmptyMVar :: IO (MVar a1)
+--    |
+-- 26 |   x <- newStrictEmptyMVar
+--    |        ^^^^^^^^^^^^^^^^^^
+--
+-- test_24_a_2.hs:32:8: error: [GHC-88464]
+--     Variable not in scope: newStrictChan :: IO (Chan a0)
+--    |
+-- 32 |   x <- newStrictChan
+--    |        ^^^^^^^^^^^^^
+--
+-- Failed, unloaded all modules.
+
+
+-- ghci> :l test_24_a_2.hs
+-- [1 of 2] Compiling Main             ( test_24_a_2.hs, interpreted )
+-- Ok, one module loaded.
+-- ghci> m1NonStrict
+-- ghci> m2NonStrict
+-- ghci> cNonStrict
+
+
+
+
+-- Tests with strict versions (this module)
+
+-- ghci> :l test_24_a_2.hs
+-- [1 of 3] Compiling Module_24_a_2    ( Module_24_a_2.hs, interpreted )
+-- [2 of 3] Compiling Main             ( test_24_a_2.hs, interpreted )
+-- Ok, two modules loaded.
+-- ghci> mTypeConstructorAccessible
+-- ghci> cTypeConstructorAccessible
+
+
+-- ghci> :l test_24_a_2.hs
+-- [1 of 3] Compiling Module_24_a_2    ( Module_24_a_2.hs, interpreted )
+-- [2 of 3] Compiling Main             ( test_24_a_2.hs, interpreted )
+-- test_24_a_2.hs:16:9: error: [GHC-76037]
+--     Not in scope: data constructor ‘StrictM’
+--    |
+-- 16 |         StrictM j -> undefined
+--    |         ^^^^^^^
+--
+-- test_24_a_2.hs:20:9: error: [GHC-76037]
+--     Not in scope: data constructor ‘StrictC’
+--    |
+-- 20 |         StrictC j -> undefined
+--    |         ^^^^^^^
+--
+-- Failed, one module loaded.
+
+
+-- ghci> :l test_24_a_2.hs
+-- [1 of 3] Compiling Module_24_a_2    ( Module_24_a_2.hs, interpreted )
+-- [2 of 3] Compiling Main             ( test_24_a_2.hs, interpreted )
+-- Ok, two modules loaded.
+-- ghci> mStrict
+-- 1
+-- ghci> cStrict
+-- 2
+
+
+-- ghci> :l test_24_a_2.hs
+-- [1 of 3] Compiling Module_24_a_2    ( Module_24_a_2.hs, interpreted )
+-- [2 of 3] Compiling Main             ( test_24_a_2.hs, interpreted )
+-- Ok, two modules loaded.
+-- ghci> m1Strict
+-- *** Exception: Prelude.undefined
+-- CallStack (from HasCallStack):
+--   undefined, called at test_24_a_2.hs:59:14 in main:Main
+-- ghci> m2Strict
+-- *** Exception: Prelude.undefined
+-- CallStack (from HasCallStack):
+--   undefined, called at test_24_a_2.hs:63:23 in main:Main
+-- ghci> cStrict
+-- *** Exception: Prelude.undefined
+-- CallStack (from HasCallStack):
+--   undefined, called at test_24_a_2.hs:68:15 in main:Main
diff --git a/ch24/test_24_a_2.hs b/ch24/test_24_a_2.hs
new file mode 100644
index 0000000..2968d9c
--- /dev/null
+++ b/ch24/test_24_a_2.hs
@@ -0,0 +1,69 @@
+import Module_24_a_2
+--import Control.Concurrent -- Non-strict versions
+
+
+-- Test: The type constructors are accessible
+-- mTypeConstructorAccessible :: IO (StrictMVar Int)
+-- mTypeConstructorAccessible = newStrictEmptyMVar
+
+-- cTypeConstructorAccessible :: IO (StrictChan Char)
+-- cTypeConstructorAccessible = newStrictChan
+
+
+-- Test: The data constructors are not accessible
+-- mDataConstructorNotAccessible :: StrictMVar Int
+-- mDataConstructorNotAccessible x = case x of
+--                                     StrictM j -> undefined
+
+-- cDataConstructorNotAccessible :: StrictChan Int
+-- cDataConstructorNotAccessible x = case x of
+--                                     StrictC j -> undefined
+
+
+-- Test: It is not possible to change the import from the strict versions to
+--       non-strict ones with this test still compiling
+-- mStrict = do
+--   x <- newStrictEmptyMVar
+--   putMVar x 1
+--   v <- takeMVar x
+--   putStrLn $ show v
+
+-- cStrict = do
+--   x <- newStrictChan
+--   writeChan x 2
+--   v <- readChan x
+--   putStrLn $ show v
+
+
+-- Test: The non-strict versions do not evalute the value before placing it into
+--       MVar or Chan
+-- m1NonStrict = do
+--    x <- newEmptyMVar
+--    putMVar x undefined
+--    return ()
+
+-- m2NonStrict = do
+--    x <- newMVar undefined
+--    return ()
+
+-- cNonStrict = do
+--   x <- newChan
+--   writeChan x undefined
+--   return ()
+
+
+-- Test: The strict versions evalute the value before placing it into MVar or
+--       Chan
+-- m1Strict = do
+--    x <- newStrictEmptyMVar
+--    putMVar x undefined
+--    return ()
+
+-- m2Strict = do
+--    x <- newStrictMVar undefined
+--    return ()
+
+-- cStrict = do
+--   x <- newStrictChan
+--   writeChan x undefined
+--   return ()