summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authoraarne <unknown>2005-05-27 07:13:35 +0000
committeraarne <unknown>2005-05-27 07:13:35 +0000
commit276a08a0d7b4b53a382c471a92a1084f1718c34a (patch)
tree7ec26676ec5c25260e7c3737ccfbf6602f27f8c3 /src
parentf77c9c86ae7a927c6bc10a5224145e49d166e821 (diff)
paths
Diffstat (limited to 'src')
-rw-r--r--src/GF/Compile/Compile.hs16
-rw-r--r--src/GF/Infra/UseIO.hs48
2 files changed, 45 insertions, 19 deletions
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index 0b2748b0f..a95c11599 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/04/21 16:46:00 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.37 $
+-- > CVS $Date: 2005/05/27 08:13:35 $
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.38 $
--
-- The top-level compilation chain from source file to gfc\/gfr.
-----------------------------------------------------------------------------
@@ -52,7 +52,7 @@ import GF.System.Arch
import Control.Monad
-- | environment variable for grammar search path
-gfGrammarPathVar = "GF_LIB_PATH"
+gfGrammarPathVar = "GF_GRAMMAR_PATH"
-- | in batch mode: write code in a file
batchCompile f = liftM fst $ compileModule defOpts emptyShellState f
@@ -101,12 +101,12 @@ compileModule opts1 st0 file = do
let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
let opts = addOptions opts1 opts0
let fpath = justInitPath file
- let ps0 = pathListOpts opts fpath
+ ps0 <- ioeIO $ pathListOpts opts fpath
let ps1 = if (useFileOpt && not useLineOpt)
then (map (prefixPathName fpath) ps0)
else ps0
- ps <- ioeIO $ extendPathEnv gfGrammarPathVar ps1
+ 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 st = st0 --- if useFileOpt then emptyShellState else st0
@@ -134,8 +134,8 @@ compileEnvShSt st fs = ((0,sgr,cgr),fts) where
notIns i = notElem (prt i) $ map fileBody fs
fts = readFiles st
-pathListOpts :: Options -> FileName -> [InitPath]
-pathListOpts opts file = maybe [file] pFilePaths $ getOptVal opts pathList
+pathListOpts :: Options -> FileName -> IO [InitPath]
+pathListOpts opts file = maybe (return [file]) getFilePaths $ getOptVal opts pathList
reverseModules (MGrammar ms) = MGrammar $ reverse ms
diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs
index e5a9ef428..487ad1fba 100644
--- a/src/GF/Infra/UseIO.hs
+++ b/src/GF/Infra/UseIO.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/20 13:31:28 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.14 $
+-- > CVS $Date: 2005/05/27 08:13:35 $
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.15 $
--
-- (Description of the module)
-----------------------------------------------------------------------------
@@ -18,6 +18,7 @@ import GF.Data.Operations
import GF.System.Arch (prCPU)
import GF.Infra.Option
+import System.Directory
import System.IO
import System.IO.Error
import System.Environment
@@ -106,18 +107,41 @@ doesFileExistPath paths file = do
mpfile <- ioeIO $ getFilePath paths file
return $ maybe False (const True) mpfile
+-- | first var is lib prefix, second is like class path
-- | path in environment variable has lower priority
-extendPathEnv :: String -> [FilePath] -> IO [FilePath]
-extendPathEnv var ps = do
- s <- catch (getEnv var) (const (return ""))
- let fs = pFilePaths s
- return $ ps ++ fs
+extendPathEnv :: String -> String -> [FilePath] -> IO [FilePath]
+extendPathEnv lib var ps = do
+ b <- catch (getEnv lib) (const (return "")) -- e.g. GF_LIB_PATH
+ s <- catch (getEnv var) (const (return "")) -- e.g. GF_GRAMMAR_PATH
+ fs <- getFilePaths s
+ let ss = ps ++ fs
+ return $ ss ++ [b ++ "/" ++ s | s <- ss]
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
+
+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
@@ -266,6 +290,8 @@ putPointE opts msg act = do
putPointEVerb :: Options -> String -> IOE a -> IOE a
putPointEVerb opts = putPointE (addOption beVerbose opts)
+gfLibraryPath = "GF_LIB_PATH"
+
-- ((do {s <- readFile f; return (return s)}) )
readFileIOE :: FilePath -> IOE (String)
readFileIOE f = ioe $ catch (readFile f >>= return . return)
@@ -292,13 +318,13 @@ readFileLibraryIOE ini f =
initPath = addInitFilePath ini f
getLibPath :: IO String
getLibPath = do {
- lp <- getEnv "GF_LIB_PATH";
- return (if last lp == '/' then lp else lp ++ ['/']);
+ lp <- getEnv gfLibraryPath;
+ 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
- '/':_ -> file -- absolute path name
+ c:_ | isSep c -> file -- absolute path name
_ -> ini ++ file -- relative path name