diff options
Diffstat (limited to 'src/compiler/GF/Infra')
| -rw-r--r-- | src/compiler/GF/Infra/Option.hs | 18 | ||||
| -rw-r--r-- | src/compiler/GF/Infra/UseIO.hs | 25 |
2 files changed, 22 insertions, 21 deletions
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs index 1236e729c..115665419 100644 --- a/src/compiler/GF/Infra/Option.hs +++ b/src/compiler/GF/Infra/Option.hs @@ -38,7 +38,7 @@ import GF.Grammar.Predef import System.FilePath --import System.IO -import GF.Data.ErrM +import GF.Data.Operations(Err,ErrorMonad(..),liftErr) import Data.Set (Set) import qualified Data.Set as Set @@ -68,8 +68,8 @@ helpMessage = usageInfo usageHeader optDescr -- FIXME: do we really want multi-line errors? -errors :: [String] -> Err a -errors = fail . unlines +errors :: ErrorMonad err => [String] -> err a +errors = raise . unlines -- Types @@ -185,17 +185,19 @@ instance Show Options where -- Option parsing -parseOptions :: [String] -- ^ list of string arguments - -> Err (Options, [FilePath]) +parseOptions :: ErrorMonad err => + [String] -- ^ list of string arguments + -> err (Options, [FilePath]) parseOptions args | not (null errs) = errors errs - | otherwise = do opts <- liftM concatOptions $ sequence optss + | otherwise = do opts <- concatOptions `fmap` liftErr (sequence optss) return (opts, files) where (optss, files, errs) = getOpt RequireOrder optDescr args -parseModuleOptions :: [String] -- ^ list of string arguments - -> Err Options +parseModuleOptions :: ErrorMonad err => + [String] -- ^ list of string arguments + -> err Options parseModuleOptions args = do (opts,nonopts) <- parseOptions args if null nonopts diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs index 85f26eb33..0af26efa7 100644 --- a/src/compiler/GF/Infra/UseIO.hs +++ b/src/compiler/GF/Infra/UseIO.hs @@ -38,21 +38,21 @@ import Control.Exception(evaluate) --putShow' :: Show a => (c -> a) -> c -> IO () --putShow' f = putStrLn . show . length . show . f -putIfVerb :: Options -> String -> IO () +putIfVerb :: MonadIO io => Options -> String -> io () putIfVerb opts msg = - when (verbAtLeast opts Verbose) $ putStrLn msg + when (verbAtLeast opts Verbose) $ liftIO $ putStrLn msg -putIfVerbW :: Options -> String -> IO () +putIfVerbW :: MonadIO io => Options -> String -> io () putIfVerbW opts msg = - when (verbAtLeast opts Verbose) $ putStr (' ' : msg) - + when (verbAtLeast opts Verbose) $ liftIO $ putStr (' ' : msg) +{- errOptIO :: Options -> a -> Err a -> IO a errOptIO os e m = case m of Ok x -> return x Bad k -> do putIfVerb os k return e - +-} type FileName = String type InitPath = String type FullPath = String @@ -60,13 +60,12 @@ type FullPath = String gfLibraryPath = "GF_LIB_PATH" gfGrammarPathVar = "GF_GRAMMAR_PATH" -getLibraryDirectory :: Options -> IO FilePath +getLibraryDirectory :: MonadIO io => Options -> io FilePath getLibraryDirectory opts = case flag optGFLibPath opts of Just path -> return path - Nothing -> catch - (getEnv gfLibraryPath) - (\ex -> getDataDir >>= \path -> return (path </> "lib")) + Nothing -> liftIO $ catch (getEnv gfLibraryPath) + (\ex -> fmap (</> "lib") getDataDir) getGrammarPath :: FilePath -> IO [FilePath] getGrammarPath lib_dir = do @@ -76,9 +75,9 @@ getGrammarPath lib_dir = do -- | extends the search path with the -- 'gfLibraryPath' and 'gfGrammarPathVar' -- environment variables. Returns only existing paths. -extendPathEnv :: Options -> IO [FilePath] -extendPathEnv opts = do - opt_path <- return $ flag optLibraryPath opts -- e.g. paths given as options +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 |