1> {-# LANGUAGE ScopedTypeVariables #-} 2> 3> module FileNameUtils ( extension 4> , expandPath 5> , chaseFile 6> , readTextFile 7> , openOutputFile 8> , modifySearchPath 9> , deep, env 10> , absPath 11> , module System.FilePath 12> ) where 13> 14> import Prelude 15> import System.IO ( openFile, IOMode(..), hPutStrLn, stderr, 16> hSetEncoding, hGetContents, utf8, Handle() ) 17> import System.IO.Error ( isDoesNotExistError, isPermissionError ) 18> import System.Directory 19> import System.Environment 20> import Data.List 21> import Control.Monad (filterM) 22> import Control.Exception as E 23> ( try, catch, IOException ) 24> import System.FilePath 25> import System.Info 26> 27> import Auxiliaries 28 29A searchpath can be added to the front or to the back of the current path 30by pre- or postfixing it with a path separator. Otherwise the new search 31path replaces the current one. 32 33> modifySearchPath :: [FilePath] -> String -> [FilePath] 34> modifySearchPath p np 35> | isSearchPathSeparator (head np) = p ++ split 36> | isSearchPathSeparator (last np) = split ++ p 37> | otherwise = split 38> where split = splitOn isSearchPathSeparator np 39 40> -- relPath = joinpath 41 42> -- absPath ps = directorySeparator : relPath ps 43 44> isWindows :: Bool 45> isWindows = "win" `isPrefixOf` os || "Win" `isPrefixOf` os || "mingw" `isPrefixOf` os 46 47> absPath :: FilePath -> FilePath 48> absPath = if isWindows then 49> (("C:" ++ [pathSeparator]) ++) 50> else 51> (pathSeparator :) 52 53> deep :: FilePath -> FilePath 54> deep = (++(replicate 2 pathSeparator)) 55 56> env :: String -> FilePath 57> env x = "{" ++ x ++ "}" 58 59> extension :: FilePath -> Maybe String 60> extension fn = case takeExtension fn of 61> "" -> Nothing 62> (_:ext) -> Just ext 63 64> -- dirname = takeDirectory 65> -- filename = takeFilePath 66> -- basename = takeBaseName 67 68|expandPath| does two things: it replaces curly braced strings with 69environment entries, if present; furthermore, if the path ends with 70more than one directory separator, all subpaths are added ... 71 72> expandPath :: [String] -> IO [String] 73> expandPath s = do let s' = concatMap splitSearchPath s 74> s'' <- mapM expandEnvironment s' 75> s''' <- mapM findSubPaths (concat s'') 76> return (nub $ concat s''') 77 78> findSubPaths :: String -> IO [String] 79> findSubPaths "" = return [] 80> findSubPaths s = let rs = reverse s 81> (sep,rs') = span isPathSeparator rs 82> s' = reverse rs' 83> sep' = reverse sep 84> in if null s' 85> then return [[head sep']] {- we don't descend from root -} 86> else if length sep < 2 87> then return [s] 88> else descendFrom s' 89 90> descendFrom :: String -> IO [String] 91> descendFrom s = E.catch (do d <- getDirectoryContents s 92> {- no hidden files, no parents -} 93> let d' = map (\x -> s </> x) 94> . filter ((/='.') . head) . filter (not . null) $ d 95> d'' <- filterM doesDirectoryExist d' 96> d''' <- mapM descendFrom d'' 97> return (s : concat d''') 98> ) 99> (\ (_ :: IOException) -> return [s]) 100 101> expandEnvironment :: String -> IO [String] 102> expandEnvironment s = case break (=='{') s of 103> (_s',"") -> return [s] 104> (s','{':r) -> case break (=='}') r of 105> (_e,"") -> return [s] 106> (e,'}':r') -> findEnvironment e s' r' 107> _ -> impossible "expandEnvironment" 108> _ -> impossible "expandEnvironment" 109> where findEnvironment :: String -> String -> String -> IO [String] 110> findEnvironment e a o = do er <- try (getEnv e) 111> return $ either (\ (_ :: IOException) -> []) 112> (map (\x -> a ++ x ++ o) . splitOn isSearchPathSeparator) 113> er 114 115> readTextFile :: FilePath -> IO String 116> readTextFile f = do h <- openFile f ReadMode 117> hSetEncoding h utf8 118> hGetContents h 119 120> openOutputFile :: FilePath -> IO Handle 121> openOutputFile f = do h <- openFile f WriteMode 122> hSetEncoding h utf8 123> return h 124 125> chaseFile :: [String] {- search path -} 126> -> FilePath -> IO (String,FilePath) 127> chaseFile p fn | isAbsolute fn= E.catch (t fn) (handle fn (err ".")) 128> | p == [] = chaseFile ["."] fn 129> | otherwise = s $ map (\ d -> md d ++ fn) p 130> where 131> md cs | isPathSeparator (last cs) 132> = cs 133> | otherwise = addTrailingPathSeparator cs 134> t f = readTextFile f >>= \x -> return (x,f) 135> s [] = err $ " in search path:\n" ++ showpath 136> s (x:xs) = E.catch (t x) (handle x (s xs)) 137> err extra = ioError 138> $ userError $ "File `" ++ fn ++ "' not found or not readable" ++ extra 139> handle :: FilePath -> IO (String,FilePath) -> IOException -> IO (String,FilePath) 140> handle x k e = 141> if isDoesNotExistError e then k 142> else if isPermissionError e then do 143> hPutStrLn stderr $ "Warning: could not access " ++ x ++ " due to permission error." 144> k 145> else ioError e 146> showpath = concatMap (\x -> " " ++ x ++ "\n") p 147