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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
-- Write a combinator library that makes it possible to express the kinds of
-- iterators that foldTree accepts. Does it make the iterators you write any
-- more succinct?
-- From the assignment it's not clear how the combinators for the iterators
-- should work.
--
-- The operators from the previous exercises in this chapter (>, <, ==, &&, ||)
-- cannot be directly transferred here because this iterator returns three
-- values (Done, Skip, Continue) instead just two (True, False). We would have
-- to define three-value logic system for the Iterate type.
--
-- Let's just define a simple (A `andIter` B) combinator for chaining the
-- iterators as:
-- 1. Evaluate (A seed info) to resultA
-- 2. If the resultA is Skip or Done, then return the result
-- 3. Else if the resultA is (Continue resultSeed) and (resultSeed /= seed),
-- then return the resultA
-- 4. Return the result of evaluating (B seed info)
{-- From examples/examples/ch09/FoldDir.hs modified according to the assignment
--
-- Added missing import of takeBaseName.
-- Fixed appending correct root path to directory entries when constructing
-- their full paths.
--}
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 -> IO a
foldTree iter initSeed path = do
endSeed <- fold initSeed path
return (unwrap endSeed)
where
fold seed subpath = getUsefulContents subpath >>= walk seed subpath
walk seed root (name:names) = do
let path' = root </> name
info <- getInfo path'
case iter seed info of
done@(Done _) -> return done
Skip seed' -> walk seed' root names
Continue seed'
| isDirectory info -> do
next <- fold seed' path'
case next of
done@(Done _) -> return done
seed'' -> walk (unwrap seed'') root names
| otherwise -> walk seed' root names
walk seed _ _ = return (Continue seed)
atMostThreePictures :: Iterator [FilePath]
atMostThreePictures paths info
| length paths == 3
= Done paths
| isDirectory info && takeFileName path == ".svn"
= Skip paths
| extension `elem` [".jpg", ".png"]
= Continue (path : paths)
| otherwise
= Continue paths
where extension = map toLower (takeExtension path)
path = infoPath info
{-- End of code from examples --}
andIter :: (Eq a) => Iterator a -> Iterator a -> Iterator a
andIter a b seed info = case resA of
Done _ -> resA
Skip _ -> resA
cont@(Continue newSeed) -> if newSeed /= seed
then cont
else resB
where resA = a seed info
resB = b seed info
threePaths :: Iterator [FilePath]
threePaths paths info
| length paths == 3
= Done paths
| otherwise
= Continue paths
where path = infoPath info
skipSvn :: Iterator [FilePath]
skipSvn paths info
| isDirectory info && takeFileName path == ".svn"
= Skip paths
| otherwise
= Continue paths
where path = infoPath info
includePictures :: Iterator [FilePath]
includePictures paths info
| extension `elem` [".jpg", ".png"]
= Continue (path : paths)
| otherwise
= Continue paths
where extension = map toLower (takeExtension path)
path = infoPath info
myThreePictures :: Iterator [FilePath]
myThreePictures = (threePaths `andIter` skipSvn) `andIter` includePictures
-- Contents of the test directory:
-- test-9_c_3/
-- test-9_c_3/e.jpg
-- test-9_c_3/dirA
-- test-9_c_3/dirA/b.jpg
-- test-9_c_3/dirA/a.png
-- test-9_c_3/.svn
-- test-9_c_3/.svn/svn.jpg
-- test-9_c_3/dirB
-- test-9_c_3/dirB/d.png
-- test-9_c_3/dirB/c.jpg
-- ghci> :l 9_c_3.hs
-- [1 of 2] Compiling ControlledVisit ( ControlledVisit.hs, interpreted )
-- [2 of 2] Compiling Main ( 9_c_3.hs, interpreted )
-- Ok, two modules loaded.
-- ghci> foldTree atMostThreePictures [] "test-9_c_3/"
-- ["test-9_c_3/dirA/a.png","test-9_c_3/dirA/b.jpg","test-9_c_3/e.jpg"]
-- ghci> foldTree myThreePictures [] "test-9_c_3/"
-- ["test-9_c_3/dirA/a.png","test-9_c_3/dirA/b.jpg","test-9_c_3/e.jpg"]
-- It doesn't make the iterators more succinct.
--
-- The compound iterator (e.g., myThreePictures) is more readable thanks to
-- hiding the individual iterators in well-named functions, but because the
-- individual iterators cannot share common parts (the 'where' clause) the code
-- duplication cancels the positives.
|
