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

use the standard System.FilePath module instead of our own broken file path manipulation functions

Browse Source
This commit is contained in:
krasimir
2008-04-22 11:39:46 +00:00
parent 7a6adbf359
commit fc111c1a79
20 changed files with 191 additions and 274 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
src/GF/Devel/Compile.hs
View File

@@ -29,6 +29,7 @@ import GF.Devel.Arch
import Control.Monad
import System.Directory
import System.FilePath
batchCompile :: Options -> [FilePath] -> IOE SourceGrammar
batchCompile opts files = do
@@ -64,24 +65,24 @@ compileModule opts1 env file = do
let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
let opts = addOptions opts1 opts0
let fpath = justInitPath file
let fpath = dropFileName file
ps0 <- ioeIO $ pathListOpts opts fpath
let ps1 = if (useFileOpt && not useLineOpt)
then (ps0 ++ map (prefixPathName fpath) ps0)
then (ps0 ++ map (combine fpath) ps0)
else ps0
ps <- ioeIO $ extendPathEnv gfLibraryPath gfGrammarPathVar ps1
let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
let sgr = snd env
let rfs = [] ---- files already in memory and their read times
let file' = if useFileOpt then justFileName file else file -- to find file itself
let file' = if useFileOpt then takeFileName file else file -- to find file itself
files <- getAllFiles opts ps rfs file'
ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
let names = map justModuleName files
ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
let sgr2 = MGrammar [m | m@(i,_) <- modules sgr,
notElem (prt i) $ map fileBody names]
notElem (prt i) $ map dropExtension names]
foldM (compileOne opts) (0,sgr2) files
@@ -95,16 +96,16 @@ compileOne opts env@(_,srcgr) file = do
| oElem beSilent opts = putpp v act
| otherwise = ioeIO (putStrFlush ("\n" ++ m)) >> act
let gf = fileSuffix file
let path = justInitPath file
let name = fileBody file
let gf = takeExtensions file
let path = dropFileName file
let name = dropExtension file
let mos = modules srcgr
case gf of
-- for compiled gf, read the file and update environment
-- also undo common subexp optimization, to enable normal computations
"gfo" -> do
".gfo" -> do
sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
let sm1 = unsubexpModule sm0
sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
@@ -113,7 +114,7 @@ compileOne opts env@(_,srcgr) file = do
-- for gf source, do full compilation and generate code
_ -> do
let modu = unsuffixFile file
let modu = dropExtension file
b1 <- ioeIO $ doesFileExist file
if not b1
then compileOne opts env $ gfoFile $ modu
@@ -174,7 +175,7 @@ compileSourceModule opts env@(k,gr) mo@(i,mi) = do
generateModuleCode :: Options -> InitPath -> SourceModule -> IOE SourceModule
generateModuleCode opts path minfo@(name,info) = do
let pname = prefixPathName path (prt name)
let pname = path </> prt name
let minfo0 = minfo
let minfo1 = subexpModule minfo0
let minfo2 = minfo1
@@ -191,7 +192,7 @@ generateModuleCode opts path minfo@(name,info) = do
-- auxiliaries
pathListOpts :: Options -> FileName -> IO [InitPath]
pathListOpts opts file = return $ maybe [file] pFilePaths $ getOptVal opts pathList
pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
reverseModules (MGrammar ms) = MGrammar $ reverse ms

22
src/GF/Devel/Compile/Compile.hs
View File

@@ -61,24 +61,24 @@ compileModule opts1 env file = do
let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
let opts = addOptions opts1 opts0
let fpath = justInitPath file
let fpath = dropFileName file
ps0 <- ioeIO $ pathListOpts opts fpath
let ps1 = if (useFileOpt && not useLineOpt)
then (ps0 ++ map (prefixPathName fpath) ps0)
then (ps0 ++ map (combine fpath) ps0)
else ps0
ps <- ioeIO $ extendPathEnv gfLibraryPath gfGrammarPathVar ps1
let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
let sgr = snd env
let rfs = [] ---- files already in memory and their read times
let file' = if useFileOpt then justFileName file else file -- find file itself
let file' = if useFileOpt then takeFileName file else file -- find file itself
files <- getAllFiles opts ps rfs file'
ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
let names = map justModuleName files
ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
let sgr2 = sgr ----MGrammar [m | m@(i,_) <- modules sgr,
---- notElem (prt i) $ map fileBody names]
---- notElem (prt i) $ map dropExtension names]
let env0 = (0,sgr2)
(e,mm) <- foldIOE (compileOne opts) env0 files
maybe (return ()) putStrLnE mm
@@ -95,9 +95,9 @@ compileOne opts env@(_,srcgr) file = do
| oElem beSilent opts = putpp v act
| otherwise = ioeIO (putStrFlush ("\n" ++ m)) >> act
let gf = fileSuffix file
let path = justInitPath file
let name = fileBody file
let gf = takeExtensions file
let path = dropFileName file
let name = dropExtension file
let mos = gfmodules srcgr
case gf of
@@ -105,7 +105,7 @@ compileOne opts env@(_,srcgr) file = do
-- for compiled gf, read the file and update environment
-- also undo common subexp optimization, to enable normal computations
"gfn" -> do
".gfn" -> do
sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
let sm1 = unsubexpModule sm0
sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule srcgr sm1
@@ -114,7 +114,7 @@ compileOne opts env@(_,srcgr) file = do
-- for gf source, do full compilation and generate code
_ -> do
let modu = unsuffixFile file
let modu = dropExtension file
b1 <- ioeIO $ doesFileExist file
if not b1
then compileOne opts env $ gfoFile $ modu
@@ -178,7 +178,7 @@ compileSourceModule opts env@(k,gr) mo@(i,mi) = do
generateModuleCode :: Options -> InitPath -> SourceModule -> IOE ()
generateModuleCode opts path minfo@(name,info) = do
let pname = prefixPathName path (prt name)
let pname = combine path (prt name)
let minfo0 = minfo
let minfo1 = subexpModule minfo0
let minfo2 = minfo1
@@ -194,7 +194,7 @@ generateModuleCode opts path minfo@(name,info) = do
-- auxiliaries
pathListOpts :: Options -> FileName -> IO [InitPath]
pathListOpts opts file = return $ maybe [file] pFilePaths $ getOptVal opts pathList
pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
----reverseModules (MGrammar ms) = MGrammar $ reverse ms

2
src/GF/Devel/Compile/GFC.hs
View File

@@ -32,7 +32,7 @@ mainGFC xx = do
mapM_ (alsoPrint opts target gc) printOptions
-- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc
_ | all ((=="gfcc") . fileSuffix) fs -> do
_ | all ((==".gfcc") . takeExtensions) fs -> do
gfccs <- mapM file2gfcc fs
let gfcc = foldl1 unionGFCC gfccs
let abs = printCId $ absname gfcc

4
src/GF/Devel/GFC.hs
View File

@@ -12,6 +12,8 @@ import GF.Infra.Option
import GF.GFCC.API
import GF.Data.ErrM
import System.FilePath
mainGFC :: [String] -> IO ()
mainGFC xx = do
let (opts,fs) = getOptions "-" xx
@@ -24,7 +26,7 @@ mainGFC xx = do
mapM_ (alsoPrint opts gfcc) printOptions
-- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc
_ | all ((=="gfcc") . fileSuffix) fs -> do
_ | all ((==".gfcc") . takeExtensions) fs -> do
gfccs <- mapM file2gfcc fs
let gfcc = foldl1 unionGFCC gfccs
let gfccFile = targetNameGFCC opts (absname gfcc)

16
src/GF/Devel/Infra/ReadFiles.hs
View File

@@ -58,7 +58,7 @@ getAllFiles opts ps env file = do
let paths = [(f,p) | ((f,_),p) <- ds]
let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]]
if oElem fromSource opts
then return [gfFile (prefixPathName p f) | (p,f) <- pds1]
then return [gfFile (p </> f) | (p,f) <- pds1]
else do
@@ -84,7 +84,7 @@ selectFormat :: Options -> ModEnv -> (InitPath,ModName) ->
IO (ModName,(InitPath,(CompStatus,Maybe ModTime)))
selectFormat opts env (p,f) = do
let pf = prefixPathName p f
let pf = p </> f
let mtenv = lookup f env -- Nothing if f is not in env
let rtenv = lookup (resModName f) env
let fromComp = oElem isCompiled opts -- i -gfo
@@ -177,20 +177,20 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
-- construct list of paths to read
paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]]
mkName f p st = mk $ prefixPathName p f where
mkName f p st = mk (p </> f) where
mk = case st of
CSComp -> gfFile
CSRead -> gfoFile
CSRes -> gfoFile ---- gfr
isGFO :: FilePath -> Bool
isGFO = (== "gfn") . fileSuffix
isGFO = (== ".gfn") . takeExtensions
gfoFile :: FilePath -> FilePath
gfoFile = suffixFile "gfn"
gfoFile f = addExtension f "gfn"
gfFile :: FilePath -> FilePath
gfFile = suffixFile "gf"
gfFile f = addExtension f "gf"
resModName :: ModName -> ModName
resModName = ('#':)
@@ -200,10 +200,10 @@ resModName = ('#':)
getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)]
getImports ps = get [] where
get ds file0 = do
let name = justModuleName file0 ---- fileBody file0
let name = dropExtension file0 ---- dropExtension file0
(p,s) <- tryRead name
let ((typ,mname),imps) = importsOfFile s
let namebody = justFileName name
let namebody = takeFileName name
ioeErr $ testErr (mname == namebody) $
"module name" +++ mname +++ "differs from file name" +++ namebody
case imps of

2
src/GF/Devel/Options.hs
View File

@@ -178,7 +178,7 @@ moduleOptDescr =
]
where
addLibDir x o = return $ o { optLibraryPath = x:optLibraryPath o }
setLibPath x o = return $ o { optLibraryPath = splitSearchPath x }
setLibPath x o = return $ o { optLibraryPath = splitInModuleSearchPath x }
preproc x o = return $ o { optPreprocessors = optPreprocessors o ++ [x] }
optimize x b o = return $ o { optOptimizations = (if b then (x:) else delete x) (optOptimizations o) }
parser x o = return $ o { optBuildParser = x }

21
src/GF/Devel/ReadFiles.hs
View File

@@ -30,16 +30,17 @@ import GF.Infra.Option
import GF.Data.Operations
import GF.Devel.UseIO
import System
import Data.Char
import Control.Monad
import Data.List
import System.Directory
import qualified Data.ByteString.Char8 as BS
import GF.Source.AbsGF hiding (FileName)
import GF.Source.LexGF
import GF.Source.ParGF
import System
import System.Directory
import System.FilePath
type ModName = String
type ModEnv = [(ModName,ModTime)]
@@ -63,7 +64,7 @@ getAllFiles opts ps env file = do
let paths = [(f,p) | ((f,_),p) <- ds]
let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]]
if oElem fromSource opts
then return [gfFile (prefixPathName p f) | (p,f) <- pds1]
then return [gfFile (p </> f) | (p,f) <- pds1]
else do
@@ -89,7 +90,7 @@ selectFormat :: Options -> ModEnv -> (InitPath,ModName) ->
IO (ModName,(InitPath,(CompStatus,Maybe ModTime)))
selectFormat opts env (p,f) = do
let pf = prefixPathName p f
let pf = p </> f
let mtenv = lookup f env -- Nothing if f is not in env
let rtenv = lookup (resModName f) env
let fromComp = oElem isCompiled opts -- i -gfo
@@ -182,20 +183,20 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
-- construct list of paths to read
paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]]
mkName f p st = mk $ prefixPathName p f where
mkName f p st = mk (p </> f) where
mk = case st of
CSComp -> gfFile
CSRead -> gfoFile
CSRes -> gfoFile ---- gfr
isGFO :: FilePath -> Bool
isGFO = (== "gfo") . fileSuffix
isGFO = (== ".gfo") . takeExtensions
gfoFile :: FilePath -> FilePath
gfoFile = suffixFile "gfo"
gfoFile f = addExtension f "gfo"
gfFile :: FilePath -> FilePath
gfFile = suffixFile "gf"
gfFile f = addExtension f "gf"
resModName :: ModName -> ModName
resModName = ('#':)
@@ -205,10 +206,10 @@ resModName = ('#':)
getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)]
getImports ps = get [] where
get ds file0 = do
let name = justModuleName file0 ---- fileBody file0
let name = justModuleName file0 ---- dropExtension file0
(p,s) <- tryRead name
((typ,mname),imps) <- ioeErr (importsOfFile s)
let namebody = justFileName name
let namebody = takeFileName name
ioeErr $ testErr (mname == namebody) $
"module name" +++ mname +++ "differs from file name" +++ namebody
case imps of

133
src/GF/Devel/UseIO.hs
View File

@@ -21,6 +21,7 @@ import GF.Infra.Option
import GF.Today (libdir)
import System.Directory
import System.FilePath
import System.IO
import System.IO.Error
import System.Environment
@@ -95,12 +96,6 @@ type FileName = String
type InitPath = 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 ps file = getFilePathMsg ("file" +++ file +++ "not found\n") ps file
@@ -108,7 +103,7 @@ getFilePathMsg :: String -> [FilePath] -> String -> IO (Maybe FilePath)
getFilePathMsg msg paths file = get paths where
get [] = putStrFlush msg >> return Nothing
get (p:ps) = do
let pfile = prefixPathName p file
let pfile = p </> file
exist <- doesFileExist pfile
if exist then return (Just pfile) else get ps
--- catch (readFileStrict pfile >> return (Just pfile)) (\_ -> get ps)
@@ -119,7 +114,7 @@ readFileIfPath paths file = do
case mpfile of
Just pfile -> do
s <- ioeIO $ BS.readFile pfile
return (justInitPath pfile,s)
return (dropFileName pfile,s)
_ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.")
doesFileExistPath :: [FilePath] -> String -> IOE Bool
@@ -145,67 +140,37 @@ extendPathEnv :: String -> String -> [FilePath] -> IO [FilePath]
extendPathEnv lib var ps = do
b <- getLibraryPath -- e.g. GF_LIB_PATH
s <- catch (getEnv var) (const (return "")) -- e.g. GF_GRAMMAR_PATH
let fs = pFilePaths s
let ss = ps ++ fs
liftM concat $ mapM allSubdirs $ ss ++ [b ++ "/" ++ s | s <- ss ++ ["prelude"]]
pFilePaths :: String -> [FilePath]
pFilePaths s = case break isPathSep s of
(f,_:cs) -> f : pFilePaths cs
(f,_) -> [f]
getFilePaths :: String -> IO [FilePath]
getFilePaths s = do
let ps = pFilePaths s
liftM concat $ mapM allSubdirs ps
let ss = ps ++ splitSearchPath s
liftM concat $ mapM allSubdirs $ ss ++ [b </> s | s <- ss ++ ["prelude"]]
where
allSubdirs :: FilePath -> IO [FilePath]
allSubdirs [] = return [[]]
allSubdirs p = case last p of
'*' -> do
let path = init p
fs <- getSubdirs path
return [path </> f | f <- fs]
_ -> return [p]
getSubdirs :: FilePath -> IO [FilePath]
getSubdirs p = do
fs <- catch (getDirectoryContents p) (const $ return [])
fps <- mapM getPermissions (map (prefixPathName p) fs)
let ds = [f | (f,p) <- zip fs fps, searchable p, not (take 1 f==".")]
return ds
allSubdirs :: FilePath -> IO [FilePath]
allSubdirs [] = return [[]]
allSubdirs p = case last p of
'*' -> do
fs <- getSubdirs (init p)
return [prefixPathName (init p) f | f <- fs]
_ -> return [p]
prefixPathName :: String -> FilePath -> FilePath
prefixPathName p f = case f of
c:_ | isSep c -> f -- do not prefix [Unix style] absolute paths
_ -> case p of
"" -> f
_ -> p ++ "/" ++ f -- note: / actually works on windows
justInitPath :: FilePath -> FilePath
justInitPath = reverse . drop 1 . dropWhile (not . isSep) . reverse
nameAndSuffix :: FilePath -> (String,String)
nameAndSuffix file = case span (/='.') (reverse file) of
(_,[]) -> (file,[])
(xet,deman) -> if any isSep xet
then (file,[]) -- cover cases like "foo.bar/baz"
else (reverse $ drop 1 deman,reverse xet)
unsuffixFile, fileBody :: FilePath -> String
unsuffixFile = fst . nameAndSuffix
fileBody = unsuffixFile
fileSuffix :: FilePath -> String
fileSuffix = snd . nameAndSuffix
justFileName :: FilePath -> String
justFileName = reverse . takeWhile (not . isSep) . reverse
suffixFile :: String -> FilePath -> FilePath
suffixFile suff file = file ++ "." ++ suff
getSubdirs dir = do
fs <- catch (getDirectoryContents dir) (const $ return [])
foldM (\fs f -> do let fpath = dir </> f
p <- getPermissions fpath
if searchable p && not (take 1 f==".")
then return (fpath:fs)
else return fs ) [] fs
justModuleName :: FilePath -> String
justModuleName = fileBody . justFileName
justModuleName = dropExtension . takeFileName
splitInModuleSearchPath :: String -> [FilePath]
splitInModuleSearchPath s = case break isPathSep s of
(f,_:cs) -> f : splitInModuleSearchPath cs
(f,_) -> [f]
where
isPathSep :: Char -> Bool
isPathSep c = c == ':' || c == ';'
--
@@ -318,39 +283,25 @@ gfLibraryPath = "GF_LIB_PATH"
-- ((do {s <- readFile f; return (return s)}) )
readFileIOE :: FilePath -> IOE BS.ByteString
readFileIOE f = ioe $ catch (BS.readFile f >>= return . return)
(\_ -> return (Bad (reportOn f))) where
reportOn f = "File " ++ f ++ " not found."
(\e -> return (Bad (show e)))
-- | like readFileIOE but look also in the GF library if file not found
--
-- intended semantics: if file is not found, try @\$GF_LIB_PATH\/file@
-- (even if file is an absolute path, but this should always fail)
-- it returns not only contents of the file, but also the path used
--
-- FIXME: unix-specific, \/ is \\ on Windows
readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, BS.ByteString)
readFileLibraryIOE ini f =
ioe $ catch (do {s <- BS.readFile initPath; return (return (initPath,s))})
(\_ -> tryLibrary ini f) where
tryLibrary :: String -> FilePath -> IO (Err (FilePath, BS.ByteString))
tryLibrary ini f =
catch (do {
lp <- getLibPath;
s <- BS.readFile (lp ++ f);
return (return (lp ++ f, s))
}) (\_ -> return (Bad (reportOn f)))
initPath = addInitFilePath ini f
getLibPath :: IO String
getLibPath = do {
lp <- catch (getEnv gfLibraryPath) (const (return libdir)) ;
return (if isSep (last lp) then lp else lp ++ ['/']);
}
reportOn f = "File " ++ f ++ " not found."
libPath ini f = f
addInitFilePath ini file = case file of
c:_ | isSep c -> file -- absolute path name
_ -> ini ++ file -- relative path name
readFileLibraryIOE ini f = ioe $ do
lp <- getLibraryPath
tryRead ini $ \_ ->
tryRead lp $ \e ->
return (Bad (show e))
where
tryRead path onError =
catch (BS.readFile fpath >>= \s -> return (return (fpath,s)))
onError
where
fpath = path </> f
-- | example
koeIOE :: IO ()