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
|
> module FileNameUtils ( extension
> , expandPath
> , chaseFile
> , modifySearchPath
> , deep, env
> , absPath
> , module System.FilePath
> ) where
>
> import Prelude hiding ( catch, readFile )
> import System.IO.UTF8
> import System.Directory
> import System.Environment
> import Data.List
> import Control.Monad (filterM)
> import Control.Exception ( try, catch )
> import System.FilePath
> import System.Info
A searchpath can be added to the front or to the back of the current path
by pre- or postfixing it with a path separator. Otherwise the new search
path replaces the current one.
> modifySearchPath :: [FilePath] -> String -> [FilePath]
> modifySearchPath p np
> | isSearchPathSeparator (head np) = p ++ split
> | isSearchPathSeparator (last np) = split ++ p
> | otherwise = split
> where split = splitOn isSearchPathSeparator np
> -- relPath = joinpath
> -- absPath ps = directorySeparator : relPath ps
> isWindows = "win" `isPrefixOf` os || "Win" `isPrefixOf` os || "mingw" `isPrefixOf` os
> absPath :: FilePath -> FilePath
> absPath = if isWindows then
> (("C:" ++ [pathSeparator]) ++)
> else
> (pathSeparator :)
> deep :: FilePath -> FilePath
> deep = (++(replicate 2 pathSeparator))
> env :: String -> FilePath
> env x = "{" ++ x ++ "}"
> extension :: FilePath -> Maybe String
> extension fn = case takeExtension fn of
> "" -> Nothing
> (_:ext) -> Just ext
> -- dirname = takeDirectory
> -- filename = takeFilePath
> -- basename = takeBaseName
|expandPath| does two things: it replaces curly braced strings with
environment entries, if present; furthermore, if the path ends with
more than one directory separator, all subpaths are added ...
> expandPath :: [String] -> IO [String]
> expandPath s = do let s' = concatMap splitSearchPath s
> s'' <- mapM expandEnvironment s'
> s''' <- mapM findSubPaths (concat s'')
> return (nub $ concat s''')
> findSubPaths :: String -> IO [String]
> findSubPaths "" = return []
> findSubPaths s = let rs = reverse s
> (sep,rs') = span isPathSeparator rs
> s' = reverse rs'
> sep' = reverse sep
> in if null s'
> then return [[head sep']] {- we don't descend from root -}
> else if length sep < 2
> then return [s]
> else descendFrom s'
> descendFrom :: String -> IO [String]
> descendFrom s = catch (do d <- getDirectoryContents s
> {- no hidden files, no parents -}
> let d' = map (\x -> s </> x)
> . filter ((/='.') . head) . filter (not . null) $ d
> d'' <- filterM doesDirectoryExist d'
> d''' <- mapM descendFrom d''
> return (s : concat d''')
> )
> (const $ return [s])
> expandEnvironment :: String -> IO [String]
> expandEnvironment s = case break (=='{') s of
> (s',"") -> return [s]
> (s','{':r) -> case break (=='}') r of
> (e,"") -> return [s]
> (e,'}':r') -> findEnvironment e s' r'
> where findEnvironment :: String -> String -> String -> IO [String]
> findEnvironment e a o = do er <- try (getEnv e)
> return $ either (const [])
> (map (\x -> a ++ x ++ o) . splitOn isSearchPathSeparator)
> er
> splitOn :: (Char -> Bool) -> String -> [String]
> splitOn p s = case dropWhile p s of
> "" -> []
> s' -> w : splitOn p s''
> where (w,s'') = break p s'
> chaseFile :: [String] {- search path -}
> -> FilePath -> IO (String,FilePath)
> chaseFile p fn | isAbsolute fn= t fn
> | p == [] = chaseFile ["."] fn
> | otherwise = s $ map (\d -> t (md d ++ fn)) p
> where
> md cs | isPathSeparator (last cs)
> = cs
> | otherwise = addTrailingPathSeparator cs
> t f = catch (readFile f >>= \x -> return (x,f))
> (\_ -> ioError $ userError $ "File `" ++ fn ++ "' not found.\n")
> s [] = ioError
> $ userError $ "File `" ++ fn ++ "' not found in search path:\n" ++ showpath
> s (x:xs) = catch x (\_ -> s xs)
> showpath = concatMap (\x -> " " ++ x ++ "\n") p
|