another attempt to get the paths handling right

7 files changed, 39 insertions, 25 deletions

diff --git a/src/GF.hs b/src/GF.hs
index de288df10..451cff9f9 100644
--- a/src/GF.hs
+++ b/src/GF.hs
@@ -9,6 +9,7 @@ import GF.Infra.UseIO
 import Paths_gf
 
 import Data.Version
+import System.Directory
 import System.Environment (getArgs)
 import System.Exit
 import System.IO
@@ -25,7 +26,8 @@ main = do
   setConsoleOutputCP codepage
 #endif
   args <- getArgs
-  case parseOptions args of
+  cdir <- getCurrentDirectory
+  case parseOptions cdir args of
     Ok (opts,files) -> mainOpts opts files
     Bad err         -> do hPutStrLn stderr err
                           hPutStrLn stderr "You may want to try --help."
diff --git a/src/GF/Compile/ReadFiles.hs b/src/GF/Compile/ReadFiles.hs
index b96d3127b..da06f2789 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 fs
+  ioeErr $ parseModuleOptions (dropFileName file) 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 e22e1dc87..142ca4063 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 1c6b51e77..bb30e5075 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 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]
diff --git a/src/GFI.hs b/src/GFI.hs
index 86f9614ed..edf4ada5f 100644
--- a/src/GFI.hs
+++ b/src/GFI.hs
@@ -34,6 +34,7 @@ import qualified Data.ByteString.Char8 as BS
 import qualified Text.ParserCombinators.ReadP as RP
 import System.Cmd
 import System.CPUTime
+import System.Directory
 import Control.Exception
 import Control.Monad
 import Data.Version
@@ -129,7 +130,8 @@ loop opts gfenv0 = do
              putStrLn "wrote graph in file _gfdepgraph.dot"
              loopNewCPU gfenv
           "i":args -> do
-              gfenv' <- case parseOptions args of
+              cdir <- getCurrentDirectory
+              gfenv' <- case parseOptions cdir args of
                           Ok (opts',files) -> 
                             importInEnv gfenv (addOptions opts opts') files
                           Bad err -> do