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

View File

@@ -205,7 +205,7 @@ getOptionsFromFile file = do
(\_ -> return (Bad $ "File " ++ file ++ " does not exist"))
let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
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 paths file = get paths

View File

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

View File

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

View File

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

View File

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

View File

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