GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-15 15:59:32 -06:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #8 from legalese/GF_LIB_PATH

Browse Source 
GF_LIB_PATH can now be path1:path2:path3, not just 1path
This commit is contained in:
John J. Camilleri
2018-07-22 14:48:44 +02:00
committed by GitHub
parent cd1942a845 7f86bee8e7
commit 895b479564
6 changed files with 74 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
doc/gf-reference.t2t
View File

@@ -412,21 +412,33 @@ use on-line ``h -FLAG``.
===File paths===
===File import search paths===
Colon-separated lists of directories searched in the
Colon-separated list of directories searched in the
given order:
```
--# -path=.:../abstract:../common:prelude
```
This can be (in order of growing preference), as
first line in the top file, as flag to ``gf``
This can be (in order of increasing priority), as
first line in the file, as flag to ``gf``
when invoked, or as flag to the ``i`` command.
The prefix ``--#`` is used only in files.
If the environment variabls ``GF_LIB_PATH`` is defined, its
value is automatically prefixed to each directory to
extend the original search path.
GF attempts to satisfy an ``import`` command by searching for the
import filename in the above search paths, initially qualified
relative to the current working directory. If the file is not found in
that initial expansion, the search paths are re-qualified relative to
the directories given in the ``GF_LIB_PATH`` environment variable. If
``GF_LIB_PATH`` is not defined, its default value is
``/usr/local/share/gf-3.9/lib`` (assuming you have GF version 3.9).
If your GF resource grammar libraries are installed somewhere else,
you will want to set ``GF_LIB_PATH`` to point there instead. In a
pinch, you can point to the ``GF/lib/src/`` folder in your clone of
the GF source code repository.
Developers of resource grammars may find it useful to define multiple
directories, colon-separated, in ``GF_LIB_PATH``.
===Alternative grammar formats===

5
doc/gf-refman.html
View File

@@ -3204,7 +3204,10 @@ in the top of <CODE>FILE.gf</CODE> causes the GF compiler, when invoked on <CODE
to search through the current directory (<CODE>.</CODE>) and the directories
<CODE>present</CODE>, <CODE>prelude</CODE>, and <CODE>/home/aarne/GF/tmp</CODE>, in this order.
If a directory <CODE>DIR</CODE> is not found relative to the working directory,
also <CODE>$(GF_LIB_PATH)/DIR</CODE> is searched.
<CODE>$(GF_LIB_PATH)/DIR</CODE> is searched. <CODE>$GF_LIB_PATH</CODE>
can be a colon-separated list of directories, in which case each directory
in the list contributes to the search path expansion.
</P>
<A NAME="toc53"></A>
<H2>Alternative grammar input formats</H2>

28
src/compiler/GF/Compile.hs
View File

@@ -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

7
src/compiler/GF/CompileInParallel.hs
View File

@@ -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"

9
src/compiler/GF/Infra/Option.hs
View File

@@ -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 }

37
src/compiler/GF/Infra/UseIO.hs
View File

@@ -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]