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