hopefully the last revision of the relative paths handling algorithm

6 files changed, 34 insertions, 34 deletions

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]