summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Infra/UseIO.hs
diff options
context:
space:
mode:
authormeng wong <mengwong@pobox.com>2017-08-19 14:27:07 +0300
committerMeng Weng Wong <mengwong@pobox.com>2018-07-22 00:04:07 -0700
commit8a14912ee3b692bc578465b6920575f5d7b11b4c (patch)
treee83be5ddaab3f2fed7f96544aa8445f383b4e441 /src/compiler/GF/Infra/UseIO.hs
parentcd1942a8454d569363b201f2345953e648ec9b53 (diff)
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
Diffstat (limited to 'src/compiler/GF/Infra/UseIO.hs')
-rw-r--r--src/compiler/GF/Infra/UseIO.hs37
1 files changed, 23 insertions, 14 deletions
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]