diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs index 964165148..95a05dc09 100644 --- a/src/compiler/GF/Compile.hs +++ b/src/compiler/GF/Compile.hs @@ -14,7 +14,7 @@ import GF.Infra.UseIO(IOE,FullPath,liftIO,getLibraryDirectory,putIfVerb, justModuleName,extendPathEnv,putStrE,putPointE) import GF.Data.Operations(raise,(+++),err) -import Control.Monad(foldM,when,(<=<)) +import Control.Monad(foldM,when,(<=<),filterM,liftM) import GF.System.Directory(doesFileExist,getModificationTime) import System.FilePath((),isRelative,dropFileName) import qualified Data.Map as Map(empty,insert,elems) --lookup @@ -78,10 +78,14 @@ compileModule opts1 env@(_,rfs) file = do file <- getRealFile file opts0 <- getOptionsFromFile file let curr_dir = dropFileName file - lib_dir <- getLibraryDirectory (addOptions opts0 opts1) - let opts = addOptions (fixRelativeLibPaths curr_dir lib_dir opts0) opts1 + lib_dirs <- getLibraryDirectory (addOptions opts0 opts1) + let opts = addOptions (fixRelativeLibPaths curr_dir lib_dirs opts0) opts1 +-- putIfVerb opts $ "curr_dir:" +++ show curr_dir ---- +-- putIfVerb opts $ "lib_dir:" +++ show lib_dirs ---- ps0 <- extendPathEnv opts let ps = nub (curr_dir : ps0) +-- putIfVerb opts $ "options from file: " ++ show opts0 +-- putIfVerb opts $ "augmented options: " ++ show opts putIfVerb opts $ "module search path:" +++ show ps ---- files <- getAllFiles opts ps rfs file putIfVerb opts $ "files to read:" +++ show files ---- @@ -94,13 +98,17 @@ compileModule opts1 env@(_,rfs) file = if exists then return file else if isRelative file - then do lib_dir <- getLibraryDirectory opts1 - let file1 = lib_dir file - exists <- doesFileExist file1 - if exists - then return file1 - else raise (render ("None of these files exists:" $$ nest 2 (file $$ file1))) - else raise (render ("File" <+> file <+> "does not exist.")) + then do + lib_dirs <- getLibraryDirectory opts1 + let candidates = [ lib_dir file | lib_dir <- lib_dirs ] + putIfVerb opts1 (render ("looking for: " $$ nest 2 candidates)) + file1s <- filterM doesFileExist candidates + case length file1s of + 0 -> raise (render ("Unable to find: " $$ nest 2 candidates)) + 1 -> do return $ head file1s + _ -> do putIfVerb opts1 ("matched multiple candidates: " +++ show file1s) + return $ head file1s + else raise (render ("File" <+> file <+> "does not exist")) compileOne' :: Options -> CompileEnv -> FullPath -> IOE CompileEnv compileOne' opts env@(gr,_) = extendCompileEnv env <=< compileOne opts gr diff --git a/src/compiler/GF/CompileInParallel.hs b/src/compiler/GF/CompileInParallel.hs index 8420b1771..fecce0a68 100644 --- a/src/compiler/GF/CompileInParallel.hs +++ b/src/compiler/GF/CompileInParallel.hs @@ -34,8 +34,11 @@ import qualified Data.ByteString.Lazy as BS parallelBatchCompile jobs opts rootfiles0 = do setJobs jobs rootfiles <- mapM canonical rootfiles0 - lib_dir <- canonical =<< getLibraryDirectory opts - filepaths <- mapM (getPathFromFile lib_dir opts) rootfiles + lib_dirs1 <- getLibraryDirectory opts + lib_dirs2 <- mapM canonical lib_dirs1 + let lib_dir = head lib_dirs2 + when (length lib_dirs2 >1) $ ePutStrLn ("GF_LIB_PATH defines more than one directory; using the first, " ++ show lib_dir) + filepaths <- mapM (getPathFromFile [lib_dir] opts) rootfiles let groups = groupFiles lib_dir filepaths n = length groups when (n>1) $ ePutStrLn "Grammar mixes present and alltenses, dividing modules into two groups" diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs index f68c7d121..27aa1c256 100644 --- a/src/compiler/GF/Infra/Option.hs +++ b/src/compiler/GF/Infra/Option.hs @@ -153,7 +153,7 @@ data Flags = Flags { optLiteralCats :: Set Ident, optGFODir :: Maybe FilePath, optOutputDir :: Maybe FilePath, - optGFLibPath :: Maybe FilePath, + optGFLibPath :: Maybe [FilePath], optDocumentRoot :: Maybe FilePath, -- For --server mode optRecomp :: Recomp, optProbsFile :: Maybe FilePath, @@ -208,9 +208,10 @@ parseModuleOptions args = do then return opts else errors $ map ("Non-option among module options: " ++) nonopts -fixRelativeLibPaths curr_dir lib_dir (Options o) = Options (fixPathFlags . o) +fixRelativeLibPaths curr_dir lib_dirs (Options o) = Options (fixPathFlags . o) where - fixPathFlags f@(Flags{optLibraryPath=path}) = f{optLibraryPath=concatMap (\dir -> [curr_dir dir, lib_dir dir]) path} + fixPathFlags f@(Flags{optLibraryPath=path}) = f{optLibraryPath=concatMap (\dir -> [parent dir + | parent <- curr_dir : lib_dirs]) path} -- Showing options @@ -423,7 +424,7 @@ optDescr = literalCat x = set $ \o -> o { optLiteralCats = foldr Set.insert (optLiteralCats o) ((map identS . splitBy (==',')) x) } lexicalCat x = set $ \o -> o { optLexicalCats = foldr Set.insert (optLexicalCats o) (splitBy (==',') x) } outDir x = set $ \o -> o { optOutputDir = Just x } - gfLibPath x = set $ \o -> o { optGFLibPath = Just x } + gfLibPath x = set $ \o -> o { optGFLibPath = Just $ splitInModuleSearchPath x } gfDocuRoot x = set $ \o -> o { optDocumentRoot = Just x } recomp x = set $ \o -> o { optRecomp = x } probsFile x = set $ \o -> o { optProbsFile = Just x } diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs index ad0c75fd5..e27b6e075 100644 --- a/src/compiler/GF/Infra/UseIO.hs +++ b/src/compiler/GF/Infra/UseIO.hs @@ -38,6 +38,7 @@ import Control.Monad(when,liftM,foldM) import Control.Monad.Trans(MonadIO(..)) import Control.Monad.State(StateT,lift) import Control.Exception(evaluate) +import Data.List (nub) --putIfVerb :: MonadIO io => Options -> String -> io () putIfVerb opts msg = when (verbAtLeast opts Verbose) $ putStrLnE msg @@ -51,28 +52,32 @@ type FullPath = String gfLibraryPath = "GF_LIB_PATH" gfGrammarPathVar = "GF_GRAMMAR_PATH" -getLibraryDirectory :: MonadIO io => Options -> io FilePath +getLibraryDirectory :: MonadIO io => Options -> io [FilePath] getLibraryDirectory opts = case flag optGFLibPath opts of Just path -> return path - Nothing -> liftIO $ catch (getEnv gfLibraryPath) - (\ex -> fmap ( "lib") getDataDir) + Nothing -> liftM splitSearchPath $ liftIO (catch (getEnv gfLibraryPath) + (\ex -> fmap ( "lib") getDataDir)) -getGrammarPath :: MonadIO io => FilePath -> io [FilePath] -getGrammarPath lib_dir = liftIO $ do +getGrammarPath :: MonadIO io => [FilePath] -> io [FilePath] +getGrammarPath lib_dirs = liftIO $ do catch (fmap splitSearchPath $ getEnv gfGrammarPathVar) - (\_ -> return [lib_dir "alltenses",lib_dir "prelude"]) -- e.g. GF_GRAMMAR_PATH + (\_ -> return $ concat [[lib_dir "alltenses", lib_dir "prelude"] + | lib_dir <- lib_dirs ]) -- e.g. GF_GRAMMAR_PATH -- | extends the search path with the -- 'gfLibraryPath' and 'gfGrammarPathVar' -- environment variables. Returns only existing paths. extendPathEnv :: MonadIO io => Options -> io [FilePath] extendPathEnv opts = liftIO $ do - let opt_path = flag optLibraryPath opts -- e.g. paths given as options - lib_dir <- getLibraryDirectory opts -- e.g. GF_LIB_PATH - grm_path <- getGrammarPath lib_dir -- e.g. GF_GRAMMAR_PATH - let paths = opt_path ++ [lib_dir] ++ grm_path - ps <- liftM concat $ mapM allSubdirs paths + let opt_path = nub $ flag optLibraryPath opts -- e.g. paths given as options + lib_dirs <- getLibraryDirectory opts -- e.g. GF_LIB_PATH + grm_path <- getGrammarPath lib_dirs -- e.g. GF_GRAMMAR_PATH + let paths = opt_path ++ lib_dirs ++ grm_path + when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: opt_path is "++ show opt_path) + when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: lib_dirs is "++ show lib_dirs) + when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: grm_path is "++ show grm_path) + ps <- liftM (nub . concat) $ mapM allSubdirs (nub paths) mapM canonicalizePath ps where allSubdirs :: FilePath -> IO [FilePath] @@ -80,11 +85,15 @@ extendPathEnv opts = liftIO $ do allSubdirs p = case last p of '*' -> do let path = init p fs <- getSubdirs path - return [path f | f <- fs] + let starpaths = [path f | f <- fs] + when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: * found "++show starpaths) + return starpaths _ -> do exists <- doesDirectoryExist p if exists - then return [p] - else do when (verbAtLeast opts Verbose) $ putStrLn ("ignore path "++p) + then do + when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: found path "++show p) + return [p] + else do when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: ignore path "++ show p) return [] getSubdirs :: FilePath -> IO [FilePath]