lhs2tex-1.12: FileNameUtils.lhs
> module FileNameUtils ( extension
> , filename
> , basename
> , dirname
> , expandPath
> , chaseFile
> , modifySearchPath
> , deep, absPath, relPath, env
> ) where
>
> import Prelude hiding ( catch )
> import System.IO
> import System.Directory
> import System.Environment
> import Data.List
> import Control.Monad (filterM)
> import Control.Exception ( try, catch )
> type FileName = String
> directorySeparators = "/"
> directorySeparator = '/'
> environmentSeparators = ";:"
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 :: [FileName] -> String -> [FileName]
> modifySearchPath p np
> | any (\x -> x == head np) environmentSeparators = p ++ split
> | any (\x -> x == last np) environmentSeparators = split ++ p
> | otherwise = split
> where split = splitOn environmentSeparators np
> relPath :: [String] -> FileName
> relPath ps = concat (intersperse [directorySeparator] ps)
> absPath :: [String] -> FileName
> absPath ps = directorySeparator : relPath ps
> isAbsolute :: FileName -> Bool
> isAbsolute [] = False
> isAbsolute xs = head xs `elem` directorySeparators
> isRelative :: FileName -> Bool
> isRelative = not . isAbsolute
> deep :: FileName -> FileName
> deep = (++(replicate 2 directorySeparator))
> env :: String -> FileName
> env x = "{" ++ x ++ "}"
> extension :: FileName -> Maybe String
> extension fn = f False [] fn
> where
> f found acc [] | found = Just (reverse acc)
> | not found = Nothing
> f found acc ('.':cs) = f True [] cs
> f found acc (c :cs) = f found (c:acc) cs
> dirname :: FileName -> String
> dirname fn = f [] [] fn
> where
> f res acc [] = reverse res
> f res acc (c:cs)
> | c `elem` directorySeparators
> = f (c : acc ++ res) [] cs
> | otherwise = f res (c : acc) cs
> filename :: FileName -> String
> filename fn = f [] fn
> where
> f acc [] = reverse acc
> f acc (c:cs)
> | c `elem` directorySeparators
> = f [] cs
> | otherwise = f (c:acc) cs
> basename :: FileName -> String
> basename fn = takeWhile (/= '.') (filename fn)
|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 (splitOn environmentSeparators) 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 (`elem` directorySeparators) 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 ++ [directorySeparator] ++ 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 environmentSeparators)
> er
> splitOn :: String -> String -> [String]
> splitOn b s = case dropWhile (`elem` b) s of
> "" -> []
> s' -> w : splitOn b s''
> where (w,s'') = break (`elem` b) s'
> chaseFile :: [String] {- search path -}
> -> FileName -> IO (String,FileName)
> chaseFile p fn | isAbsolute fn= t fn
> | p == [] = chaseFile ["."] fn
> | otherwise = s $ map (\d -> t (md d ++ fn)) p
> where
> md cs | last cs `elem` directorySeparators
> = cs
> | otherwise = cs ++ [directorySeparator]
> 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