aboutsummaryrefslogtreecommitdiff
path: root/ch09/9_c_1.hs
blob: e25974135f64371f54d869ce5ab7e3ab9a9c413f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
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"]