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
|
module ControlledVisit
(
Info(..)
, getInfo
, getUsefulContents
, isDirectory
, traverse'
) where
import Control.Exception
import Control.Monad (filterM, forM, liftM)
import Data.List (partition)
import Data.Maybe (isJust)
import System.Directory (Permissions(..), getDirectoryContents,
getModificationTime, getPermissions)
import Data.Time (UTCTime(..))
import System.FilePath (takeExtension, (</>))
import Control.Exception (bracket, handle)
import System.IO (IOMode(..), hClose, hFileSize, openFile)
{-- snippet Info --}
data Info = Info {
infoPath :: FilePath
, infoPerms :: Maybe Permissions
, infoSize :: Maybe Integer
, infoModTime :: Maybe UTCTime
} deriving (Eq, Ord, Show)
getInfo :: FilePath -> IO Info
{-- /snippet Info --}
{-- snippet getInfo --}
maybeIO :: IO a -> IO (Maybe a)
maybeIO act = handle (\(SomeException _) -> return Nothing) (Just `liftM` act)
getInfo path = do
perms <- maybeIO (getPermissions path)
size <- maybeIO (bracket (openFile path ReadMode) hClose hFileSize)
modified <- maybeIO (getModificationTime path)
return (Info path perms size modified)
{-- /snippet getInfo --}
{-- snippet traverse.type --}
traverse' :: ([Info] -> [Info]) -> FilePath -> IO [Info]
{-- /snippet traverse.type --}
{-- snippet traverse --}
traverse' order path = do
names <- getUsefulContents path
contents <- mapM getInfo (path : map (path </>) names)
liftM concat $ forM (order contents) $ \info -> do
if isDirectory info && infoPath info /= path
then traverse' order (infoPath info)
else return [info]
getUsefulContents :: FilePath -> IO [String]
getUsefulContents path = do
names <- getDirectoryContents path
return (filter (`notElem` [".", ".."]) names)
isDirectory :: Info -> Bool
isDirectory = maybe False searchable . infoPerms
{-- /snippet traverse --}
{-- snippet traverseVerbose --}
traverseVerbose order path = do
names <- getDirectoryContents path
let usefulNames = filter (`notElem` [".", ".."]) names
contents <- mapM getEntryName ("" : usefulNames)
recursiveContents <- mapM recurse (order contents)
return (concat recursiveContents)
where getEntryName name = getInfo (path </> name)
isDirectory info = case infoPerms info of
Nothing -> False
Just perms -> searchable perms
recurse info = do
if isDirectory info && infoPath info /= path
then traverseVerbose order (infoPath info)
else return [info]
{-- /snippet traverseVerbose --}
|
