aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJan Sucan <jan@jansucan.com>2023-10-04 20:04:47 +0200
committerJan Sucan <jan@jansucan.com>2023-10-04 20:05:41 +0200
commite8cf8611c11108f30612ea0c14784bb5a9033ea9 (patch)
treef3e1bad9ff17ad50083ea2416f82b044fdd57dd3
parent1bb8a1fb9a13840f96fd395093ae1a8694917ac3 (diff)
9_c_1: Add solution
-rw-r--r--README.md2
-rw-r--r--ch09/9_c_1.hs66
2 files changed, 67 insertions, 1 deletions
diff --git a/README.md b/README.md
index 6e79e6a..2d8b2dc 100644
--- a/README.md
+++ b/README.md
@@ -129,7 +129,7 @@ are prefixed with 'Module_'.
| 9_b_2 | yes | | |
| Module_9_b_3 | yes | | |
| 9_b_4 | yes | | |
-| **_9_c_1_** | | 232 | |
+| **_9_c_1_** | yes | 232 | |
| 9_c_2 | | | |
| 9_c_3 | | | |
| **_9_d_1_** | | 234 | |
diff --git a/ch09/9_c_1.hs b/ch09/9_c_1.hs
new file mode 100644
index 0000000..e259741
--- /dev/null
+++ b/ch09/9_c_1.hs
@@ -0,0 +1,66 @@
+-- Modify foldTree to allow the caller to change the order of traversal of
+-- entries in a directory.
+
+{-- From examples/examples/ch09/FoldDir.hs modified according to the assignment
+ --
+ -- Added missing import of takeBaseName.
+ --}
+import ControlledVisit (Info(..), getInfo, getUsefulContents, isDirectory)
+
+import Control.Monad (liftM)
+import Data.Char (toLower)
+import System.FilePath ((</>), takeFileName, takeExtension, takeBaseName)
+
+data Iterate seed = Done { unwrap :: seed }
+ | Skip { unwrap :: seed }
+ | Continue { unwrap :: seed }
+ deriving (Show)
+
+type Iterator seed = seed -> Info -> Iterate seed
+
+foldTree :: Iterator a -> a -> FilePath -> ([FilePath] -> IO [FilePath]) -> IO a
+
+foldTree iter initSeed path order = do
+ endSeed <- fold initSeed path
+ return (unwrap endSeed)
+ where
+ fold seed subpath = getUsefulContents subpath >>= order >>= walk seed
+
+ walk seed (name:names) = do
+ let path' = path </> name
+ info <- getInfo path'
+ case iter seed info of
+ done@(Done _) -> return done
+ Skip seed' -> walk seed' names
+ Continue seed'
+ | isDirectory info -> do
+ next <- fold seed' path'
+ case next of
+ done@(Done _) -> return done
+ seed'' -> walk (unwrap seed'') names
+ | otherwise -> walk seed' names
+ walk seed _ = return (Continue seed)
+{-- End of code from examples --}
+
+orderId :: [FilePath] -> IO [FilePath]
+orderId fs = return fs
+
+orderReverse :: [FilePath] -> IO [FilePath]
+orderReverse fs = return (reverse fs)
+
+-- Helper iterator that returns the traversed files for easy observing of
+-- effects of the order functions.
+allPaths :: Iterator [FilePath]
+allPaths paths info = Continue ((infoPath info) : paths)
+
+
+-- ghci> :l 9_c_1.hs
+-- [1 of 2] Compiling ControlledVisit ( ControlledVisit.hs, interpreted )
+-- [2 of 2] Compiling Main ( 9_c_1.hs, interpreted )
+-- Ok, two modules loaded.
+
+-- ghci> foldTree allPaths [] "test-9_b_4/" orderId
+-- ["test-9_b_4/C.c","test-9_b_4/E.hs","test-9_b_4/D.hs","test-9_b_4/B.c","test-9_b_4/A.c","test-9_b_4/F.hs"]
+
+-- ghci> foldTree allPaths [] "test-9_b_4/" orderReverse
+-- ["test-9_b_4/F.hs","test-9_b_4/A.c","test-9_b_4/B.c","test-9_b_4/D.hs","test-9_b_4/E.hs","test-9_b_4/C.c"]