summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2014-11-10 16:20:01 +0000
committerhallgren <hallgren@chalmers.se>2014-11-10 16:20:01 +0000
commitc707575bd7751ac3b03371edba478e37d3488448 (patch)
tree4d16d9dabed27b5d977d3d4d84a4bb317dff4a4a
parent33571ba44f2a42502722a3b025b448efe1f0ab88 (diff)
Documentation improvements and cleanup relating to the IOE monad
Renamed appIOE to tryIOE (it is analogous to 'try' in the standard libraries). Removed unused IOE operations & documented the remaining ones. Removed/simplified superfluous uses of IOE operations.
-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