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

------------------------------------------------------------------------------
--- A collection of useful operations when dealing with files.
---
--- @author Michael Hanus, Bernd Brassel
--- @version June 2009
--- @category general
------------------------------------------------------------------------------

module FileGoodies(separatorChar,pathSeparatorChar,suffixSeparatorChar,
                   isAbsolute,dirName,baseName,splitDirectoryBaseName,
                   stripSuffix,fileSuffix,splitBaseName,splitPath,
                   lookupFileInPath,getFileInPath) where

import Directory
import List(intersperse)

--- The character for separating hierarchies in file names.
--- On UNIX systems the value is '/'.
separatorChar :: Char
separatorChar = '/'

--- The character for separating names in path expressions.
--- On UNIX systems the value is ':'.
pathSeparatorChar :: Char
pathSeparatorChar = ':'

--- The character for separating suffixes in file names.
--- On UNIX systems the value is '.'.
suffixSeparatorChar :: Char
suffixSeparatorChar = '.'

--- Is the argument an absolute name?
isAbsolute :: String -> Bool
isAbsolute (c:_) = c == separatorChar
isAbsolute [] = False

--- Extracts the directoy prefix of a given (Unix) file name.
--- Returns "." if there is no prefix.
dirName :: String -> String
dirName name = fst (splitDirectoryBaseName name)

--- Extracts the base name without directoy prefix of a given (Unix) file name.
baseName :: String -> String
baseName name = snd (splitDirectoryBaseName name)

--- Splits a (Unix) file name into the directory prefix and the base name.
--- The directory prefix is "." if there is no real prefix in the 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)

--- Strips a suffix (the last suffix starting with a dot) from a file name.
stripSuffix :: String -> String
stripSuffix = fst . splitBaseName

--- Yields the suffix (the last suffix starting with a dot) from given file name.
fileSuffix :: String -> String
fileSuffix = snd . splitBaseName

--- Splits a file name into prefix and suffix (the last suffix starting with a dot 
--- and the rest).
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)

--- Splits a path string into list of directory names.
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)

--- Looks up the first file with a possible suffix in a list of directories.
--- Returns Nothing if such a file does not exist.
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

--- Gets the first file with a possible suffix in a list of directories.
--- An error message is delivered if there is no such file.
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