1
0
forked from GitHub/gf-core

another attempt to get the paths handling right

This commit is contained in:
krasimir
2009-10-05 14:58:13 +00:00
parent 2a2cc38fda
commit d258b72719
7 changed files with 38 additions and 24 deletions

View File

@@ -9,6 +9,7 @@ import GF.Infra.UseIO
import Paths_gf import Paths_gf
import Data.Version import Data.Version
import System.Directory
import System.Environment (getArgs) import System.Environment (getArgs)
import System.Exit import System.Exit
import System.IO import System.IO
@@ -25,7 +26,8 @@ main = do
setConsoleOutputCP codepage setConsoleOutputCP codepage
#endif #endif
args <- getArgs args <- getArgs
case parseOptions args of cdir <- getCurrentDirectory
case parseOptions cdir args of
Ok (opts,files) -> mainOpts opts files Ok (opts,files) -> mainOpts opts files
Bad err -> do hPutStrLn stderr err Bad err -> do hPutStrLn stderr err
hPutStrLn stderr "You may want to try --help." hPutStrLn stderr "You may want to try --help."

View File

@@ -205,7 +205,7 @@ getOptionsFromFile file = do
(\_ -> return (Bad $ "File " ++ file ++ " does not exist")) (\_ -> return (Bad $ "File " ++ file ++ " does not exist"))
let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
ioeErr $ parseModuleOptions fs ioeErr $ parseModuleOptions (dropFileName file) fs
getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) getFilePath :: [FilePath] -> String -> IO (Maybe FilePath)
getFilePath paths file = get paths getFilePath paths file = get paths

View File

@@ -82,7 +82,7 @@ instance Binary ModuleStatus where
instance Binary Options where instance Binary Options where
put = put . optionsGFO put = put . optionsGFO
get = do opts <- get get = do opts <- get
case parseModuleOptions ["--" ++ flag ++ "=" ++ value | (flag,value) <- opts] of case parseModuleOptions "." ["--" ++ flag ++ "=" ++ value | (flag,value) <- opts] of
Ok x -> return x Ok x -> return x
Bad msg -> fail msg Bad msg -> fail msg

View File

@@ -276,7 +276,7 @@ TermDef
FlagDef :: { Options } FlagDef :: { Options }
FlagDef 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 Ok x -> return x
Bad msg -> failLoc $1 msg } Bad msg -> failLoc $1 msg }

View File

@@ -186,18 +186,28 @@ instance Show Options where
-- Option parsing -- Option parsing
parseOptions :: [String] -> Err (Options, [FilePath]) parseOptions :: FilePath -- ^ if there are relative file paths they will be interpreted as relative to this path
parseOptions args -> [String] -- ^ list of string arguments
| not (null errs) = errors errs -> Err (Options, [FilePath])
| otherwise = do opts <- liftM concatOptions $ sequence optss parseOptions root args
return (opts, files) | not (null errs) = errors errs
where (optss, files, errs) = getOpt RequireOrder optDescr args | 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 :: FilePath -- ^ if there are relative file paths they will be interpreted as relative to this path
parseModuleOptions args = do (opts,nonopts) <- parseOptions args -> [String] -- ^ list of string arguments
if null nonopts -> Err Options
then return opts parseModuleOptions root args = do
else errors $ map ("Non-option among module options: " ++) nonopts (opts,nonopts) <- parseOptions root args
if null nonopts
then return opts
else errors $ map ("Non-option among module options: " ++) nonopts
-- Showing options -- Showing options

View File

@@ -65,20 +65,20 @@ getLibraryPath opts =
(getEnv gfLibraryPath) (getEnv gfLibraryPath)
(\ex -> getDataDir >>= \path -> return (path </> "lib")) (\ex -> getDataDir >>= \path -> return (path </> "lib"))
getGrammarPath :: Options -> IO [FilePath] getGrammarPath :: FilePath -> IO [FilePath]
getGrammarPath opts = do getGrammarPath lib_path = do
let ss1 = flag optLibraryPath opts catch (fmap splitSearchPath $ getEnv gfGrammarPathVar) (\_ -> return [lib_path </> "prelude"]) -- e.g. GF_GRAMMAR_PATH
ss2 <- catch (fmap splitSearchPath $ getEnv gfGrammarPathVar) (\_ -> return ["prelude","."]) -- e.g. GF_GRAMMAR_PATH
return (ss1 ++ ss2)
-- | extends the search path with the -- | extends the search path with the
-- 'gfLibraryPath' and 'gfGrammarPathVar' -- 'gfLibraryPath' and 'gfGrammarPathVar'
-- environment variables. Returns only existing paths. -- environment variables. Returns only existing paths.
extendPathEnv :: Options -> FilePath -> IO [FilePath] extendPathEnv :: Options -> FilePath -> IO [FilePath]
extendPathEnv opts fdir = do extendPathEnv opts fdir = do
b <- getLibraryPath opts -- e.g. GF_LIB_PATH opt_paths <- return $ flag optLibraryPath opts -- e.g. paths given as options
ss <- getGrammarPath opts -- e.g. GF_GRAMMAR_PATH lib_path <- getLibraryPath opts -- e.g. GF_LIB_PATH
ps <- liftM (nub . concat) $ mapM allSubdirs $ [fdir </> s | s <- ss] ++ [b </> s | s <- ss] 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 mapM canonicalizePath ps
where where
allSubdirs :: FilePath -> IO [FilePath] allSubdirs :: FilePath -> IO [FilePath]

View File

@@ -34,6 +34,7 @@ import qualified Data.ByteString.Char8 as BS
import qualified Text.ParserCombinators.ReadP as RP import qualified Text.ParserCombinators.ReadP as RP
import System.Cmd import System.Cmd
import System.CPUTime import System.CPUTime
import System.Directory
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
import Data.Version import Data.Version
@@ -129,7 +130,8 @@ loop opts gfenv0 = do
putStrLn "wrote graph in file _gfdepgraph.dot" putStrLn "wrote graph in file _gfdepgraph.dot"
loopNewCPU gfenv loopNewCPU gfenv
"i":args -> do "i":args -> do
gfenv' <- case parseOptions args of cdir <- getCurrentDirectory
gfenv' <- case parseOptions cdir args of
Ok (opts',files) -> Ok (opts',files) ->
importInEnv gfenv (addOptions opts opts') files importInEnv gfenv (addOptions opts opts') files
Bad err -> do Bad err -> do