msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Allow both slash and backslash as separators.

Browse Source
This commit is contained in:
bringert
2005-05-20 12:31:28 +00:00
parent 058bc27936
commit e10c1bea53
1 changed files with 15 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
src/GF/Infra/UseIO.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/05/20 13:12:33 $ -- > CVS $Date: 2005/05/20 13:31:28 $
-- > CVS $Author: bringert $ -- > CVS $Author: bringert $
-- > CVS $Revision: 1.13 $ -- > CVS $Revision: 1.14 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -80,6 +80,12 @@ type FileName = String
type InitPath = String type InitPath = String
type FullPath = String type FullPath = String
isPathSep :: Char -> Bool
isPathSep c = c == ':' || c == ';'
isSep :: Char -> Bool
isSep c = c == '/' || c == '\\'
getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) getFilePath :: [FilePath] -> String -> IO (Maybe FilePath)
getFilePath paths file = get paths where getFilePath paths file = get paths where
get [] = putStrLnFlush ("file" +++ file +++ "not found") >> return Nothing get [] = putStrLnFlush ("file" +++ file +++ "not found") >> return Nothing
@@ -107,30 +113,26 @@ extendPathEnv var ps = do
let fs = pFilePaths s let fs = pFilePaths s
return $ ps ++ fs return $ ps ++ fs
-- FIXME: unix-specific, : is ; on Windows
pFilePaths :: String -> [FilePath] pFilePaths :: String -> [FilePath]
pFilePaths s = case span (/=':') s of pFilePaths s = case break isPathSep s of
(f,_:cs) -> f : pFilePaths cs (f,_:cs) -> f : pFilePaths cs
(f,_) -> [f] (f,_) -> [f]
-- FIXME: unix-specific, / is \ on Windows
prefixPathName :: String -> FilePath -> FilePath prefixPathName :: String -> FilePath -> FilePath
prefixPathName p f = case f of prefixPathName p f = case f of
'/':_ -> f -- do not prefix [Unix style] absolute paths c:_ | isSep c -> f -- do not prefix [Unix style] absolute paths
_ -> case p of _ -> case p of
"" -> f "" -> f
_ -> p ++ "/" ++ f _ -> p ++ "/" ++ f -- / actually works on windows
-- FIXME: unix-specific, / is \ on Windows
justInitPath :: FilePath -> FilePath justInitPath :: FilePath -> FilePath
justInitPath = reverse . drop 1 . dropWhile (/='/') . reverse justInitPath = reverse . drop 1 . dropWhile (not . isSep) . reverse
-- FIXME: unix-specific, / is \ on Windows
nameAndSuffix :: FilePath -> (String,String) nameAndSuffix :: FilePath -> (String,String)
nameAndSuffix file = case span (/='.') (reverse file) of nameAndSuffix file = case span (/='.') (reverse file) of
(_,[]) -> (file,[]) (_,[]) -> (file,[])
(xet,deman) -> if elem '/' xet (xet,deman) -> if any isSep xet
then (file,[]) then (file,[]) -- cover cases like "foo.bar/baz"
else (reverse $ drop 1 deman,reverse xet) else (reverse $ drop 1 deman,reverse xet)
unsuffixFile, fileBody :: FilePath -> String unsuffixFile, fileBody :: FilePath -> String
@@ -140,9 +142,8 @@ fileBody = unsuffixFile
fileSuffix :: FilePath -> String fileSuffix :: FilePath -> String
fileSuffix = snd . nameAndSuffix fileSuffix = snd . nameAndSuffix
-- FIXME: unix-specific, / is \ on Windows
justFileName :: FilePath -> String justFileName :: FilePath -> String
justFileName = reverse . takeWhile (/='/') . reverse justFileName = reverse . takeWhile (not . isSep) . reverse
suffixFile :: String -> FilePath -> FilePath suffixFile :: String -> FilePath -> FilePath
suffixFile suff file = file ++ "." ++ suff suffixFile suff file = file ++ "." ++ suff