diff --git a/src/GF.hs b/src/GF.hs index 451cff9f9..32a95ca1f 100644 --- a/src/GF.hs +++ b/src/GF.hs @@ -26,9 +26,10 @@ main = do setConsoleOutputCP codepage #endif args <- getArgs - cdir <- getCurrentDirectory - case parseOptions cdir args of - Ok (opts,files) -> mainOpts opts files + case parseOptions args of + Ok (opts,files) -> do curr_dir <- getCurrentDirectory + lib_dir <- getLibraryDirectory opts + mainOpts (fixRelativeLibPaths curr_dir lib_dir opts) files Bad err -> do hPutStrLn stderr err hPutStrLn stderr "You may want to try --help." exitFailure diff --git a/src/GF/Compile.hs b/src/GF/Compile.hs index 0b928d430..ce9a051fd 100644 --- a/src/GF/Compile.hs +++ b/src/GF/Compile.hs @@ -114,9 +114,11 @@ compileModule :: Options -- ^ Options from program command line and shell comman compileModule opts1 env file = do file <- getRealFile file opts0 <- getOptionsFromFile file - let opts = addOptions opts0 opts1 - let fdir = dropFileName file - ps <- ioeIO $ extendPathEnv opts fdir + curr_dir <- return $ dropFileName file + lib_dir <- ioeIO $ getLibraryDirectory (addOptions opts0 opts1) + let opts = addOptions (fixRelativeLibPaths curr_dir lib_dir opts0) opts1 + ps0 <- ioeIO $ extendPathEnv opts + let ps = nub (curr_dir : ps0) ioeIO $ putIfVerb opts $ "module search path:" +++ show ps ---- let (_,sgr,rfs) = env files <- getAllFiles opts ps rfs file @@ -125,13 +127,13 @@ compileModule opts1 env file = do ioeIO $ putIfVerb opts $ "modules to include:" +++ show names ---- foldM (compileOne opts) (0,sgr,rfs) files where - getRealFile file1 = do - exists <- ioeIO $ doesFileExist file1 + getRealFile file = do + exists <- ioeIO $ doesFileExist file if exists then return file else if isRelative file - then do libpath <- ioeIO $ getLibraryPath opts1 - let file1 = libpath file + then do lib_dir <- ioeIO $ getLibraryDirectory opts1 + let file1 = lib_dir file exists <- ioeIO $ doesFileExist file1 if exists then return file1 diff --git a/src/GF/Compile/ReadFiles.hs b/src/GF/Compile/ReadFiles.hs index da06f2789..b96d3127b 100644 --- a/src/GF/Compile/ReadFiles.hs +++ b/src/GF/Compile/ReadFiles.hs @@ -205,7 +205,7 @@ getOptionsFromFile file = do (\_ -> return (Bad $ "File " ++ file ++ " does not exist")) let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls - ioeErr $ parseModuleOptions (dropFileName file) fs + ioeErr $ parseModuleOptions fs getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) getFilePath paths file = get paths diff --git a/src/GF/Grammar/Binary.hs b/src/GF/Grammar/Binary.hs index 142ca4063..e22e1dc87 100644 --- a/src/GF/Grammar/Binary.hs +++ b/src/GF/Grammar/Binary.hs @@ -82,7 +82,7 @@ instance Binary ModuleStatus where instance Binary Options where put = put . optionsGFO get = do opts <- get - case parseModuleOptions "." ["--" ++ flag ++ "=" ++ value | (flag,value) <- opts] of + case parseModuleOptions ["--" ++ flag ++ "=" ++ value | (flag,value) <- opts] of Ok x -> return x Bad msg -> fail msg diff --git a/src/GF/Grammar/Parser.y b/src/GF/Grammar/Parser.y index bb30e5075..1c6b51e77 100644 --- a/src/GF/Grammar/Parser.y +++ b/src/GF/Grammar/Parser.y @@ -276,7 +276,7 @@ TermDef FlagDef :: { Options } FlagDef - : Posn Ident '=' Ident Posn {% case parseModuleOptions "." ["--" ++ showIdent $2 ++ "=" ++ showIdent $4] of + : Posn Ident '=' Ident Posn {% case parseModuleOptions ["--" ++ showIdent $2 ++ "=" ++ showIdent $4] of Ok x -> return x Bad msg -> failLoc $1 msg } diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index 8c3d4d267..2963da609 100644 --- a/src/GF/Infra/Option.hs +++ b/src/GF/Infra/Option.hs @@ -7,7 +7,7 @@ module GF.Infra.Option SISRFormat(..), Optimization(..), CFGTransform(..), HaskellOption(..), Dump(..), Printer(..), Recomp(..), BuildParser(..), -- * Option parsing - parseOptions, parseModuleOptions, + parseOptions, parseModuleOptions, fixRelativeLibPaths, -- * Option pretty-printing optionsGFO, optionsPGF, @@ -186,29 +186,27 @@ instance Show Options where -- Option parsing -parseOptions :: FilePath -- ^ if there are relative file paths they will be interpreted as relative to this path - -> [String] -- ^ list of string arguments +parseOptions :: [String] -- ^ list of string arguments -> Err (Options, [FilePath]) -parseOptions root args +parseOptions args | not (null errs) = errors errs | otherwise = do opts <- liftM concatOptions $ sequence optss - return (fixRelativeLibPaths opts, files) + return (opts, files) where (optss, files, errs) = getOpt RequireOrder optDescr args - - fixRelativeLibPaths (Options o) = Options (fixPathFlags . o) - where - fixPathFlags f@(Flags{optLibraryPath=path}) = f{optLibraryPath=map (root ) path} -parseModuleOptions :: FilePath -- ^ if there are relative file paths they will be interpreted as relative to this path - -> [String] -- ^ list of string arguments +parseModuleOptions :: [String] -- ^ list of string arguments -> Err Options -parseModuleOptions root args = do - (opts,nonopts) <- parseOptions root args +parseModuleOptions args = do + (opts,nonopts) <- parseOptions args if null nonopts then return opts else errors $ map ("Non-option among module options: " ++) nonopts +fixRelativeLibPaths curr_dir lib_dir (Options o) = Options (fixPathFlags . o) + where + fixPathFlags f@(Flags{optLibraryPath=path}) = f{optLibraryPath=concatMap (\dir -> [curr_dir dir, lib_dir dir]) path} + -- Showing options -- | Pretty-print the options that are preserved in .gfo files. diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs index 687e5c212..bb1a75b6e 100644 --- a/src/GF/Infra/UseIO.hs +++ b/src/GF/Infra/UseIO.hs @@ -57,8 +57,8 @@ type FullPath = String gfLibraryPath = "GF_LIB_PATH" gfGrammarPathVar = "GF_GRAMMAR_PATH" -getLibraryPath :: Options -> IO FilePath -getLibraryPath opts = +getLibraryDirectory :: Options -> IO FilePath +getLibraryDirectory opts = case flag optGFLibPath opts of Just path -> return path Nothing -> catch @@ -66,19 +66,19 @@ getLibraryPath opts = (\ex -> getDataDir >>= \path -> return (path "lib")) getGrammarPath :: FilePath -> IO [FilePath] -getGrammarPath lib_path = do - catch (fmap splitSearchPath $ getEnv gfGrammarPathVar) (\_ -> return [lib_path "prelude"]) -- e.g. GF_GRAMMAR_PATH +getGrammarPath lib_dir = do + catch (fmap splitSearchPath $ getEnv gfGrammarPathVar) (\_ -> return [lib_dir "prelude"]) -- e.g. GF_GRAMMAR_PATH -- | extends the search path with the -- 'gfLibraryPath' and 'gfGrammarPathVar' -- environment variables. Returns only existing paths. -extendPathEnv :: Options -> FilePath -> IO [FilePath] -extendPathEnv opts fdir = do - opt_paths <- return $ flag optLibraryPath opts -- e.g. paths given as options - lib_path <- getLibraryPath opts -- e.g. GF_LIB_PATH - grm_paths <- getGrammarPath lib_path -- e.g. GF_GRAMMAR_PATH - let paths = opt_paths ++ [lib_path] ++ grm_paths - ps <- liftM (nub . concat) $ mapM allSubdirs paths +extendPathEnv :: Options -> IO [FilePath] +extendPathEnv opts = do + opt_path <- return $ 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 mapM canonicalizePath ps where allSubdirs :: FilePath -> IO [FilePath] diff --git a/src/GFI.hs b/src/GFI.hs index edf4ada5f..7b98f0ff8 100644 --- a/src/GFI.hs +++ b/src/GFI.hs @@ -130,10 +130,11 @@ loop opts gfenv0 = do putStrLn "wrote graph in file _gfdepgraph.dot" loopNewCPU gfenv "i":args -> do - cdir <- getCurrentDirectory - gfenv' <- case parseOptions cdir args of - Ok (opts',files) -> - importInEnv gfenv (addOptions opts opts') files + gfenv' <- case parseOptions args of + Ok (opts',files) -> do + curr_dir <- getCurrentDirectory + lib_dir <- getLibraryDirectory (addOptions opts opts') + importInEnv gfenv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files Bad err -> do putStrLn $ "Command parse error: " ++ err return gfenv