diff --git a/src/compiler/GF/Command/Importing.hs b/src/compiler/GF/Command/Importing.hs index e2284aa58..4ef966f77 100644 --- a/src/compiler/GF/Command/Importing.hs +++ b/src/compiler/GF/Command/Importing.hs @@ -10,7 +10,7 @@ import GF.Grammar (SourceGrammar) -- for cc command import GF.Grammar.CFG import GF.Grammar.EBNF import GF.Compile.CFGtoPGF -import GF.Infra.UseIO +import GF.Infra.UseIO(die,tryIOE,useIOE) import GF.Infra.Option import GF.Data.ErrM @@ -29,7 +29,7 @@ importGrammar pgf0 opts files = let cs = concatMap snd ascss importGrammar pgf0 opts cs s | elem s [".gf",".gfo"] -> do - res <- appIOE $ compileToPGF opts files + res <- tryIOE $ compileToPGF opts files case res of Ok pgf2 -> ioUnionPGF pgf0 pgf2 Bad msg -> do putStrLn ('\n':'\n':msg) @@ -46,19 +46,10 @@ ioUnionPGF one two = case msgUnionPGF one two of importSource :: SourceGrammar -> Options -> [FilePath] -> IO SourceGrammar importSource src0 opts files = do - src <- appIOE $ batchCompile opts files - case src of - Ok (_,(_,gr)) -> return gr - Bad msg -> do - putStrLn msg - return src0 + useIOE src0 (fmap (snd.snd) (batchCompile opts files)) -- for different cf formats -importCF opts files get convert = do - res <- appIOE impCF - case res of - Ok pgf -> return pgf - Bad s -> error s +importCF opts files get convert = impCF where impCF = do rules <- fmap (convert . concat) $ mapM (get opts) files @@ -66,6 +57,6 @@ importCF opts files get convert = do (CFRule cat _ _ : _) -> return cat _ -> fail "empty CFG" let pgf = cf2pgf (last files) (uniqueFuns (mkCFG startCat Set.empty rules)) - probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf) + probs <- maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf return $ setProbabilities probs $ if flag optOptimizePGF opts then optimizePGF pgf else pgf diff --git a/src/compiler/GF/CompileInParallel.hs b/src/compiler/GF/CompileInParallel.hs index 22a53a841..48e5821b0 100644 --- a/src/compiler/GF/CompileInParallel.hs +++ b/src/compiler/GF/CompileInParallel.hs @@ -81,11 +81,11 @@ batchCompile1 lib_dir (opts,filepaths) = takeFileName f `elem` prelude_files ppPath ps = "-path="<>intercalate ":" (map rel ps) deps <- newMVar M.empty - toLog <- newLog runIOE + toLog <- newLog id term <- getTermColors let --logStrLn = toLog . ePutStrLn --ok :: CollectOutput IO a -> IO a - ok (CO m) = err bad good =<< appIOE m + ok (CO m) = err bad good =<< tryIOE m where good (o,r) = do toLog o; return r bad e = do toLog (redPutStrLn e); fail "failed" @@ -98,7 +98,7 @@ batchCompile1 lib_dir (opts,filepaths) = -- logStrLn $ "Finished "++show (length (modules gr'))++" modules." return gr' fcache <- liftIO $ newIOCache $ \ _ (imp,Hide (f,ps)) -> - do (file,_,_) <- runIOE $ findFile gfoDir ps imp + do (file,_,_) <- findFile gfoDir ps imp return (file,(f,ps)) let find f ps imp = do (file',(f',ps')) <- liftIO $ readIOCache fcache (imp,Hide (f,ps)) diff --git a/src/compiler/GF/Compiler.hs b/src/compiler/GF/Compiler.hs index d92ed387c..57855b1b9 100644 --- a/src/compiler/GF/Compiler.hs +++ b/src/compiler/GF/Compiler.hs @@ -28,7 +28,7 @@ import Control.Monad(unless,forM_) -- and, depending on the options, a @.pgf@ file. (@gf -batch@, @gf -make@) mainGFC :: Options -> [FilePath] -> IO () mainGFC opts fs = do - r <- appIOE (case () of + r <- tryIOE (case () of _ | null fs -> fail $ "No input files." _ | all (extensionIs ".cf") fs -> compileCFFiles opts fs _ | all (\f -> extensionIs ".gf" f || extensionIs ".gfo" f) fs -> compileSourceFiles opts fs diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs index b5ef38f49..14120d811 100644 --- a/src/compiler/GF/Infra/UseIO.hs +++ b/src/compiler/GF/Infra/UseIO.hs @@ -129,14 +129,16 @@ splitInModuleSearchPath s = case break isPathSep s of -- | Was: @newtype IOE a = IOE { appIOE :: IO (Err a) }@ type IOE a = IO a -ioe :: IO (Err a) -> IOE a -ioe io = err fail return =<< io +--ioe :: IO (Err a) -> IOE a +--ioe io = err fail return =<< io -appIOE :: IOE a -> IO (Err a) -appIOE ioe = handle (fmap Ok ioe) (return . Bad) +-- | Catch exceptions caused by calls to 'raise' or 'fail' in the 'IO' monad. +-- To catch all 'IO' exceptions, use 'try' instead. +tryIOE :: IOE a -> IO (Err a) +tryIOE ioe = handle (fmap Ok ioe) (return . Bad) -runIOE :: IOE a -> IO a -runIOE = id +--runIOE :: IOE a -> IO a +--runIOE = id -- instance MonadIO IOE where liftIO io = ioe (io >>= return . return) @@ -160,6 +162,8 @@ instance Monad IOE where appIOE $ err raise f x -- f :: a -> IOE a fail = raise -} + +-- | Print the error message and return a default value if the IO operation 'fail's useIOE :: a -> IOE a -> IO a useIOE a ioe = handle ioe (\s -> putStrLn s >> return a) diff --git a/src/compiler/GF/Support.hs b/src/compiler/GF/Support.hs index a4baf63c9..dfab662ea 100644 --- a/src/compiler/GF/Support.hs +++ b/src/compiler/GF/Support.hs @@ -4,6 +4,7 @@ module GF.Support( module GF.Infra.Option, module GF.Data.Operations, module GF.Infra.UseIO, + module GF.System.Catch, module GF.System.Console, -- ** Binary serialisation Binary,encode,decode,encodeFile,decodeFile @@ -13,5 +14,6 @@ import GF.Infra.Location import GF.Data.Operations import GF.Infra.Option import GF.Infra.UseIO +import GF.System.Catch import GF.System.Console import Data.Binary diff --git a/src/compiler/GF/System/Catch.hs b/src/compiler/GF/System/Catch.hs index 950774947..f69934af5 100644 --- a/src/compiler/GF/System/Catch.hs +++ b/src/compiler/GF/System/Catch.hs @@ -3,6 +3,7 @@ module GF.System.Catch where import qualified System.IO.Error as S +-- ** Backwards compatible try and catch #if MIN_VERSION_base(4,4,0) catch = S.catchIOError try = S.tryIOError