From 1bb8a1fb9a13840f96fd395093ae1a8694917ac3 Mon Sep 17 00:00:00 2001
From: Jan Sucan <jan@jansucan.com>
Date: Wed, 27 Sep 2023 15:59:19 +0200
Subject: 9_b_4: Add solution

---
 README.md               |   4 +--
 ch09/9_b_3.hs           |  68 -----------------------------------
 ch09/9_b_4.hs           |  94 ++++++++++++++++++++++++++++++++++++++++++++++++
 ch09/ControlledVisit.hs |   1 +
 ch09/Module_9_b_3.hs    |  66 ++++++++++++++++++++++++++++++++++
 ch09/test-9_b_4/A.c     | Bin 0 -> 1 bytes
 ch09/test-9_b_4/B.c     | Bin 0 -> 2 bytes
 ch09/test-9_b_4/C.c     | Bin 0 -> 3 bytes
 ch09/test-9_b_4/D.hs    | Bin 0 -> 4 bytes
 ch09/test-9_b_4/E.hs    | Bin 0 -> 5 bytes
 ch09/test-9_b_4/F.hs    | Bin 0 -> 6 bytes
 11 files changed, 163 insertions(+), 70 deletions(-)
 delete mode 100644 ch09/9_b_3.hs
 create mode 100644 ch09/9_b_4.hs
 create mode 100644 ch09/Module_9_b_3.hs
 create mode 100644 ch09/test-9_b_4/A.c
 create mode 100644 ch09/test-9_b_4/B.c
 create mode 100644 ch09/test-9_b_4/C.c
 create mode 100644 ch09/test-9_b_4/D.hs
 create mode 100644 ch09/test-9_b_4/E.hs
 create mode 100644 ch09/test-9_b_4/F.hs

diff --git a/README.md b/README.md
index 9893c65..6e79e6a 100644
--- a/README.md
+++ b/README.md
@@ -127,8 +127,8 @@ are prefixed with 'Module_'.
 | **_9_a_1_**    | yes    | 221  | 9. I/O case study: a library for searching the filesystem |
 | **_9_b_1_**    | yes    | 228  | |
 | 9_b_2          | yes    |      | |
-| 9_b_3          | yes    |      | |
-| 9_b_4          |        |      | |
+| Module_9_b_3   | yes    |      | |
+| 9_b_4          | yes    |      | |
 | **_9_c_1_**    |        | 232  | |
 | 9_c_2          |        |      | |
 | 9_c_3          |        |      | |
diff --git a/ch09/9_b_3.hs b/ch09/9_b_3.hs
deleted file mode 100644
index 882f7db..0000000
--- a/ch09/9_b_3.hs
+++ /dev/null
@@ -1,68 +0,0 @@
--- Take the predicates and combinators from "Gluing predicates together" on page
--- 224 and make them work with our new Info type.
-
-{-- From examples/examples/ch09/BetterPredicate.hs modified according to the assignment --}
-import Data.Time (UTCTime(..))
-import System.Directory (Permissions(..))
-import System.FilePath (takeExtension)
-
-
-data Info = Info {
-      infoPath :: FilePath
-    , infoPerms :: Maybe Permissions
-    , infoSize :: Maybe Integer
-    , infoModTime :: Maybe UTCTime
-    } deriving (Eq, Ord, Show)
-
-type InfoF a = Info -> a
-
-
-equalP :: (Eq a) => InfoF a -> a -> (InfoF Bool)
-equalP f k = (\info -> f info == k)
-
-equalP' :: (Eq a) => (InfoF a) -> a -> (InfoF Bool)
-equalP' f k info = (f info == k)
-
-liftP :: (a -> b -> Bool) -> (InfoF a) -> b -> (InfoF Bool)
-liftP q f k info = f info `q` k
-
-greaterP, lesserP :: (Ord a) => (InfoF a) -> a -> (InfoF Bool)
-greaterP = liftP (>)
-lesserP = liftP (<)
-
-simpleAndP :: (InfoF Bool) -> (InfoF Bool) -> (InfoF Bool)
-simpleAndP f g info = f info && g info
-
-liftP2 :: (a -> b -> Bool) -> (InfoF a) -> (InfoF b) -> (InfoF Bool)
-liftP2 q f g info = f info `q` g info
-
-andP = liftP2 (&&)
-orP = liftP2 (||)
-
-constP :: a -> (InfoF a)
-constP k _ = k
-
-liftP' q f k info = f info `q` constP k info
-
-liftPath :: (FilePath -> a) -> (InfoF a)
-liftPath f info = f (infoPath info)
-
-myTest2 = (liftPath takeExtension `equalP` ".cpp") `andP`
-          (infoSize `greaterP` (Just 131072))
-{-- End of code from examples --}
-
--- ghci> :l 9_b_3.hs
--- [1 of 1] Compiling Main             ( 9_b_3.hs, interpreted )
--- Ok, one module loaded.
-
--- ghci> infoA = Info "asdf.cpp" Nothing (Just 131072) Nothing
--- ghci> myTest2 infoA
--- False
-
--- ghci> infoB = Info "asdf.hs" Nothing (Just 131073) Nothing
--- ghci> myTest2 infoB
--- False
-
--- ghci> infoC = Info "asdf.cpp" Nothing (Just 131073) Nothing
--- ghci> myTest2 infoC
--- True
diff --git a/ch09/9_b_4.hs b/ch09/9_b_4.hs
new file mode 100644
index 0000000..b771271
--- /dev/null
+++ b/ch09/9_b_4.hs
@@ -0,0 +1,94 @@
+-- Write a wrapper for 'traverse' that lets you control traversal using one
+-- predicate and filter results using another.
+
+-- From the assignment it's not completely clear what controlling traversal
+-- means.
+--
+-- Let's assume that it means visiting files for which the control predicate is
+-- true first.
+
+import ControlledVisit (traverse', Info(..))
+-- Use predicates for the new Info type from the previous exercise
+import Module_9_b_3
+
+import Data.List
+import System.FilePath (takeExtension)
+
+traverseWrapper :: (Info -> Bool) -> (Info -> Bool) -> FilePath -> IO [Info]
+traverseWrapper orderP filterP path = do
+  res <- traverse' (order orderP) path
+  return (filterResults filterP res)
+
+compareInfos :: (Info -> Bool) -> Info -> Info -> Ordering
+compareInfos p infoA infoB = if a && (not b)
+                             then LT -- "greater" Info should appear in the sorted list first
+                             else if (not a) && b
+                                  then GT
+                                  else EQ
+  where a = p infoA
+        b = p infoB
+
+order :: (Info -> Bool) -> ([Info] -> [Info])
+order p = sortBy (compareInfos p)
+
+filterResults :: (Info -> Bool) -> [Info] -> [Info]
+filterResults p infos = filter p infos
+
+
+-- > ls -l
+-- total 24
+-- -rw-r--r-- 1 jan users 1 Sep 27 15:28 A.c
+-- -rw-r--r-- 1 jan users 2 Sep 27 15:28 B.c
+-- -rw-r--r-- 1 jan users 3 Sep 27 15:28 C.c
+-- -rw-r--r-- 1 jan users 4 Sep 27 15:28 D.hs
+-- -rw-r--r-- 1 jan users 5 Sep 27 15:28 E.hs
+-- -rw-r--r-- 1 jan users 6 Sep 27 15:28 F.hs
+
+idTest :: Info -> Bool
+idTest _ = True
+
+-- ghci> :l 9_b_4.hs
+-- [1 of 3] Compiling ControlledVisit  ( ControlledVisit.hs, interpreted )
+-- [2 of 3] Compiling Module_9_b_3     ( Module_9_b_3.hs, interpreted )
+-- [3 of 3] Compiling Main             ( 9_b_4.hs, interpreted )
+-- Ok, three modules loaded.
+
+sizeTest1 = infoSize `lesserP` (Just 3)
+
+sizeTest2 = infoSize `greaterP` (Just 2)
+
+nameTest = (liftPath takeExtension) `equalP` ".c"
+
+complexTest1 = (infoSize `lesserP` (Just 4)) `andP` ((liftPath takeExtension) `equalP` ".hs")
+
+complexTest2 = (infoSize `greaterP` (Just 4)) `andP` (infoSize `lesserP` (Just 6))
+               `andP` ((liftPath takeExtension) `equalP` ".hs")
+
+-- ghci> traverseWrapper idTest idTest "test-9_b_4/"
+-- [Info {infoPath = "test-9_b_4/", ..., infoSize = Nothing, ...},
+--  Info {infoPath = "test-9_b_4/F.hs", ..., infoSize = Just 6, ...},
+--  Info {infoPath = "test-9_b_4/A.c", ..., infoSize = Just 1, ...},
+--  Info {infoPath = "test-9_b_4/B.c", ..., infoSize = Just 2, ...},
+--  Info {infoPath = "test-9_b_4/D.hs", ..., infoSize = Just 4, ...},
+--  Info {infoPath = "test-9_b_4/E.hs", ..., infoSize = Just 5, ...},
+--  Info {infoPath = "test-9_b_4/C.c", ..., infoSize = Just 3, ...}]
+
+-- ghci> traverseWrapper sizeTest1 idTest "test-9_b_4/"
+-- [Info {infoPath = "test-9_b_4/", ..., infoSize = Nothing, ...},
+--  Info {infoPath = "test-9_b_4/A.c", ..., infoSize = Just 1, ...},
+--  Info {infoPath = "test-9_b_4/B.c", ..., infoSize = Just 2, ...},
+--  Info {infoPath = "test-9_b_4/F.hs", ..., infoSize = Just 6, ...},
+--  Info {infoPath = "test-9_b_4/D.hs", ..., infoSize = Just 4, ...},
+--  Info {infoPath = "test-9_b_4/E.hs", ..., infoSize = Just 5, ...},
+--  Info {infoPath = "test-9_b_4/C.c", ..., infoSize = Just 3, ...}]
+
+-- ghci> traverseWrapper sizeTest2 nameTest "test-9_b_4/"
+-- [Info {infoPath = "test-9_b_4/C.c", ..., infoSize = Just 3, ...},
+--  Info {infoPath = "test-9_b_4/A.c", ..., infoSize = Just 1, ...},
+--  Info {infoPath = "test-9_b_4/B.c", ..., infoSize = Just 2, ...}]
+
+-- ghci> traverseWrapper idTest complexTest1 "test-9_b_4/"
+-- []
+
+-- ghci> traverseWrapper idTest complexTest2 "test-9_b_4/"
+-- [Info {infoPath = "test-9_b_4/E.hs", ..., infoSize = Just 5, ...}]
diff --git a/ch09/ControlledVisit.hs b/ch09/ControlledVisit.hs
index 9793cdd..52f4e9a 100644
--- a/ch09/ControlledVisit.hs
+++ b/ch09/ControlledVisit.hs
@@ -4,6 +4,7 @@ module ControlledVisit
     , getInfo
     , getUsefulContents
     , isDirectory
+    , traverse'
     ) where
 
 import Control.Exception
diff --git a/ch09/Module_9_b_3.hs b/ch09/Module_9_b_3.hs
new file mode 100644
index 0000000..ce38717
--- /dev/null
+++ b/ch09/Module_9_b_3.hs
@@ -0,0 +1,66 @@
+-- Take the predicates and combinators from "Gluing predicates together" on page
+-- 224 and make them work with our new Info type.
+
+module Module_9_b_3 where
+
+{-- From examples/examples/ch09/BetterPredicate.hs modified according to the assignment --}
+import Data.Time (UTCTime(..))
+import System.Directory (Permissions(..))
+import System.FilePath (takeExtension)
+
+import ControlledVisit (Info(..))
+
+
+type InfoF a = Info -> a
+
+
+equalP :: (Eq a) => InfoF a -> a -> (InfoF Bool)
+equalP f k = (\info -> f info == k)
+
+equalP' :: (Eq a) => (InfoF a) -> a -> (InfoF Bool)
+equalP' f k info = (f info == k)
+
+liftP :: (a -> b -> Bool) -> (InfoF a) -> b -> (InfoF Bool)
+liftP q f k info = f info `q` k
+
+greaterP, lesserP :: (Ord a) => (InfoF a) -> a -> (InfoF Bool)
+greaterP = liftP (>)
+lesserP = liftP (<)
+
+simpleAndP :: (InfoF Bool) -> (InfoF Bool) -> (InfoF Bool)
+simpleAndP f g info = f info && g info
+
+liftP2 :: (a -> b -> Bool) -> (InfoF a) -> (InfoF b) -> (InfoF Bool)
+liftP2 q f g info = f info `q` g info
+
+andP = liftP2 (&&)
+orP = liftP2 (||)
+
+constP :: a -> (InfoF a)
+constP k _ = k
+
+liftP' q f k info = f info `q` constP k info
+
+liftPath :: (FilePath -> a) -> (InfoF a)
+liftPath f info = f (infoPath info)
+
+myTest2 = (liftPath takeExtension `equalP` ".cpp") `andP`
+          (infoSize `greaterP` (Just 131072))
+{-- End of code from examples --}
+
+-- ghci> :l Module_9_b_3.hs
+-- [1 of 2] Compiling ControlledVisit  ( ControlledVisit.hs, interpreted )
+-- [2 of 2] Compiling Module_9_b_3     ( Module_9_b_3.hs, interpreted )
+-- Ok, two modules loaded.
+
+-- ghci> infoA = Info "asdf.cpp" Nothing (Just 131072) Nothing
+-- ghci> myTest2 infoA
+-- False
+
+-- ghci> infoB = Info "asdf.hs" Nothing (Just 131073) Nothing
+-- ghci> myTest2 infoB
+-- False
+
+-- ghci> infoC = Info "asdf.cpp" Nothing (Just 131073) Nothing
+-- ghci> myTest2 infoC
+-- True
diff --git a/ch09/test-9_b_4/A.c b/ch09/test-9_b_4/A.c
new file mode 100644
index 0000000..f76dd23
Binary files /dev/null and b/ch09/test-9_b_4/A.c differ
diff --git a/ch09/test-9_b_4/B.c b/ch09/test-9_b_4/B.c
new file mode 100644
index 0000000..09f370e
Binary files /dev/null and b/ch09/test-9_b_4/B.c differ
diff --git a/ch09/test-9_b_4/C.c b/ch09/test-9_b_4/C.c
new file mode 100644
index 0000000..4227ca4
Binary files /dev/null and b/ch09/test-9_b_4/C.c differ
diff --git a/ch09/test-9_b_4/D.hs b/ch09/test-9_b_4/D.hs
new file mode 100644
index 0000000..593f470
Binary files /dev/null and b/ch09/test-9_b_4/D.hs differ
diff --git a/ch09/test-9_b_4/E.hs b/ch09/test-9_b_4/E.hs
new file mode 100644
index 0000000..40b450d
Binary files /dev/null and b/ch09/test-9_b_4/E.hs differ
diff --git a/ch09/test-9_b_4/F.hs b/ch09/test-9_b_4/F.hs
new file mode 100644
index 0000000..ab2c684
Binary files /dev/null and b/ch09/test-9_b_4/F.hs differ
-- 
cgit v1.2.3