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
|
module FileGoodies(separatorChar,pathSeparatorChar,suffixSeparatorChar,
isAbsolute,dirName,baseName,splitDirectoryBaseName,
stripSuffix,fileSuffix,splitBaseName,splitPath,
lookupFileInPath,getFileInPath) where
import Directory
import List(intersperse)
separatorChar :: Char
separatorChar = '/'
pathSeparatorChar :: Char
pathSeparatorChar = ':'
suffixSeparatorChar :: Char
suffixSeparatorChar = '.'
isAbsolute :: String -> Bool
isAbsolute (c:_) = c == separatorChar
isAbsolute [] = False
dirName :: String -> String
dirName name = fst (splitDirectoryBaseName name)
baseName :: String -> String
baseName name = snd (splitDirectoryBaseName name)
splitDirectoryBaseName :: String -> (String,String)
splitDirectoryBaseName name =
let (rbase,rdir) = break (==separatorChar) (reverse name) in
if null rdir then (".",reverse rbase)
else (reverse (tail rdir), reverse rbase)
stripSuffix :: String -> String
stripSuffix = fst . splitBaseName
fileSuffix :: String -> String
fileSuffix = snd . splitBaseName
splitBaseName :: String -> (String,String)
splitBaseName name = let (rsuffix,rbase) = break (==suffixSeparatorChar) (reverse name) in
if null rbase || elem separatorChar rsuffix
then (name,"")
else (reverse (tail rbase),reverse rsuffix)
splitPath :: String -> [String]
splitPath [] = []
splitPath (x:xs) = let (ys,zs) = break (==pathSeparatorChar) (x:xs)
in if null zs then [ys]
else ys : splitPath (tail zs)
lookupFileInPath :: String -> [String] -> [String] -> IO (Maybe String)
lookupFileInPath file suffixes path =
if isAbsolute file
then lookupFirstFileWithSuffix file suffixes
else lookupFirstFile path
where
lookupFirstFile [] = return Nothing
lookupFirstFile (dir:dirs) = do
mbfile <- lookupFirstFileWithSuffix (dir++separatorChar:file) suffixes
maybe (lookupFirstFile dirs) (return . Just) mbfile
lookupFirstFileWithSuffix _ [] = return Nothing
lookupFirstFileWithSuffix f (suf:sufs) = do
let fsuf = f++suf
exfile <- doesFileExist fsuf
if exfile then return (Just fsuf)
else lookupFirstFileWithSuffix f sufs
getFileInPath :: String -> [String] -> [String] -> IO String
getFileInPath file suffixes path = do
mbfile <- lookupFileInPath file suffixes path
maybe (error $ "File "++file++" not found in path "++
concat (intersperse [pathSeparatorChar] path))
return
mbfile
|