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
|
-- Although the file finding code we described in this chapter is a good vehicle
-- for learning, it's not ideal for real systems programming tasks, because
-- Haskell's portable I/O libraries don't expose enough information to let us
-- write interesting and complicated queries.
--
-- Port the code from this chapter to your platform's native API, either
-- System.Posix or System.Win32.
{-- 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 Control.Exception
import Control.Monad (liftM)
import Data.Char (toLower)
import System.FilePath ((</>), takeFileName, takeExtension, takeBaseName)
import System.Posix.Directory (DirStream, openDirStream, readDirStream, closeDirStream)
import System.Posix.Types (EpochTime, FileOffset, FileMode)
import System.Posix.Files (getFileStatus, fileSize, modificationTime, fileMode, isDirectory)
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'
| infoIsDirectory 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
| infoIsDirectory 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 --}
{-- From examples/examples/ch09/ControlledVisit.hs modified according to the assignment --}
data Info = Info {
infoPath :: FilePath
, infoIsDirectory :: Bool
, infoPerms :: Maybe FileMode
, infoSize :: Maybe FileOffset
, infoModTime :: Maybe EpochTime
} deriving (Eq, Ord, Show)
getInfo :: FilePath -> IO Info
maybeIO :: IO a -> IO (Maybe a)
maybeIO act = handle (\(SomeException _) -> return Nothing) (Just `liftM` act)
getInfo path = do
fileStatus <- getFileStatus path
let isDir = isDirectory fileStatus
perms <- maybeIO (return (fileMode fileStatus))
size <- maybeIO (return (fileSize fileStatus))
modified <- maybeIO (return (modificationTime fileStatus))
return (Info path isDir perms size modified)
getDirContents :: FilePath -> IO [String]
getDirContents path = do
entries <- bracket (openDirStream path) closeDirStream (readStream [])
return entries
where
readStream :: [String] -> DirStream -> IO [String]
readStream entries ds = do
e <- readDirStream ds
if e == ""
then return entries
else readStream (entries ++ [e]) ds
getUsefulContents :: FilePath -> IO [String]
getUsefulContents path = do
names <- handle (\(SomeException _) -> return []) (getDirContents path)
return (filter (`notElem` [".", ".."]) names)
{-- End of code from examples --}
allFiles :: Iterator [FilePath]
allFiles paths info = Continue ((infoPath info) : paths)
-- Contents of the test directory (reused from the 9_c_3 exercise):
-- 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_d_1.hs
-- [1 of 1] Compiling Main ( 9_d_1.hs, interpreted )
-- Ok, one module 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 allFiles [] "test-9_c_3/"
-- ["test-9_c_3/dirB/c.jpg",
-- "test-9_c_3/dirB/d.png",
-- "test-9_c_3/dirB",
-- "test-9_c_3/.svn/svn.jpg",
-- "test-9_c_3/.svn",
-- "test-9_c_3/dirA/a.png",
-- "test-9_c_3/dirA/b.jpg",
-- "test-9_c_3/dirA",
-- "test-9_c_3/e.jpg"]
|
