summaryrefslogtreecommitdiff
path: root/src/compiler/GF
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF')
-rw-r--r--src/compiler/GF/Command/Importing.hs19
-rw-r--r--src/compiler/GF/CompileInParallel.hs6
-rw-r--r--src/compiler/GF/Compiler.hs2
-rw-r--r--src/compiler/GF/Infra/UseIO.hs16
-rw-r--r--src/compiler/GF/Support.hs2
-rw-r--r--src/compiler/GF/System/Catch.hs1
6 files changed, 22 insertions, 24 deletions
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
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 06:26:36 +0000