another attempt to get the paths handling right

2 files changed, 30 insertions, 20 deletions

diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index fc5ddf87c..8c3d4d267 100644
--- a/src/GF/Infra/Option.hs
+++ b/src/GF/Infra/Option.hs
@@ -186,18 +186,28 @@ instance Show Options where
 
 -- Option parsing
 
-parseOptions :: [String] -> Err (Options, [FilePath])
-parseOptions args 
-    | not (null errs) = errors errs
-    | otherwise = do opts <- liftM concatOptions $ sequence optss
-                     return (opts, files)
-  where (optss, files, errs) = getOpt RequireOrder optDescr args
-
-parseModuleOptions :: [String] -> Err Options
-parseModuleOptions args = do (opts,nonopts) <- parseOptions args
-                             if null nonopts 
-                                then return opts
-                                else errors $ map ("Non-option among module options: " ++) nonopts
+parseOptions :: FilePath                   -- ^ if there are relative file paths they will be interpreted as relative to this path
+             -> [String]                   -- ^ list of string arguments
+             -> Err (Options, [FilePath])
+parseOptions root args 
+  | not (null errs) = errors errs
+  | otherwise       = do opts <- liftM concatOptions $ sequence optss
+                         return (fixRelativeLibPaths 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
+                   -> Err Options
+parseModuleOptions root args = do
+  (opts,nonopts) <- parseOptions root args
+  if null nonopts 
+    then return opts
+    else errors $ map ("Non-option among module options: " ++) nonopts
 
 -- Showing options
 
diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs
index f8389c672..687e5c212 100644
--- a/src/GF/Infra/UseIO.hs
+++ b/src/GF/Infra/UseIO.hs
@@ -65,20 +65,20 @@ getLibraryPath opts =
                    (getEnv gfLibraryPath)
                    (\ex -> getDataDir >>= \path -> return (path </> "lib"))
 
-getGrammarPath :: Options -> IO [FilePath]
-getGrammarPath opts = do
-  let ss1 = flag optLibraryPath opts
-  ss2 <- catch (fmap splitSearchPath $ getEnv gfGrammarPathVar) (\_ -> return ["prelude","."])     -- e.g. GF_GRAMMAR_PATH
-  return (ss1 ++ ss2)
+getGrammarPath :: FilePath -> IO [FilePath]
+getGrammarPath lib_path = do
+  catch (fmap splitSearchPath $ getEnv gfGrammarPathVar) (\_ -> return [lib_path </> "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
-  b <- getLibraryPath opts                                     -- e.g. GF_LIB_PATH
-  ss <- getGrammarPath opts                                    -- e.g. GF_GRAMMAR_PATH
-  ps <- liftM (nub . concat) $ mapM allSubdirs $ [fdir </> s | s <- ss] ++ [b </> s | s <- ss]
+  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
   mapM canonicalizePath ps
   where
     allSubdirs :: FilePath -> IO [FilePath]