GF_LIB_PATH can now be path1:path2:path3, not just path1

Traditionally, GF_LIB_PATH points to something like
`.../share/ghc-8.0.2-x86_64/gf-3.9/lib`

and if you want prelude and alltenses and present, you add a
`--# -path=.:present`
compiler pragma to the top of your .gf file

But if you are developing some kind of application grammar
library or contrib of your own, you might find yourself
repeating your library path at the top of all your .gf files.

After painstakingly maintaining the same library path at the
top of all your .gf files, you might say, let's factor this
out into GF_LIB_PATH.

Then you might then find to your surprise that GF_LIB_PATH
doesn't accept the usual colon:separated:path notation
familiar from, say, unix PATH and MANPATH.

This patch allows you to define
`GF_LIB_PATH=gf-3.9.lib:$HOME/gf-contrib/whatever/lib`
in a more natural way.

If you are an RGL hacker and have your own version of the
RGL tree sitting somewhere, you should be able to have both
paths in the GF_LIB_PATH, for added convenience. This minor
convenience will probably lead to obscure bugs and great
frustration when you find that your changes are mysteriously
not being picked up by GF; so keep this in mind and use it
cautiously.

This caution should probably sit in the documentation
somewhere. A subsequent commit will do that.

If you use zsh, you can do this to quickly build up a big
GF_LIB_PATH:

% gf_lib_path=( $HOME/src/GF/lib/src/{api,abstract,common,english,api/libraryBrowser,prelude,..} )

% typeset -xT GF_LIB_PATH gf_lib_path

4 files changed, 51 insertions, 30 deletions

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]