paths

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
 

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