mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-09 19:22:50 -06:00
another attempt to get the paths handling right
This commit is contained in:
@@ -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
|
||||
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 :: [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
|
||||
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
|
||||
|
||||
|
||||
@@ -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]
|
||||
|
||||
Reference in New Issue
Block a user