forked from GitHub/gf-core
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.
This commit is contained in:
@@ -10,7 +10,7 @@ import GF.Grammar (SourceGrammar) -- for cc command
|
|||||||
import GF.Grammar.CFG
|
import GF.Grammar.CFG
|
||||||
import GF.Grammar.EBNF
|
import GF.Grammar.EBNF
|
||||||
import GF.Compile.CFGtoPGF
|
import GF.Compile.CFGtoPGF
|
||||||
import GF.Infra.UseIO
|
import GF.Infra.UseIO(die,tryIOE,useIOE)
|
||||||
import GF.Infra.Option
|
import GF.Infra.Option
|
||||||
import GF.Data.ErrM
|
import GF.Data.ErrM
|
||||||
|
|
||||||
@@ -29,7 +29,7 @@ importGrammar pgf0 opts files =
|
|||||||
let cs = concatMap snd ascss
|
let cs = concatMap snd ascss
|
||||||
importGrammar pgf0 opts cs
|
importGrammar pgf0 opts cs
|
||||||
s | elem s [".gf",".gfo"] -> do
|
s | elem s [".gf",".gfo"] -> do
|
||||||
res <- appIOE $ compileToPGF opts files
|
res <- tryIOE $ compileToPGF opts files
|
||||||
case res of
|
case res of
|
||||||
Ok pgf2 -> ioUnionPGF pgf0 pgf2
|
Ok pgf2 -> ioUnionPGF pgf0 pgf2
|
||||||
Bad msg -> do putStrLn ('\n':'\n':msg)
|
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 :: SourceGrammar -> Options -> [FilePath] -> IO SourceGrammar
|
||||||
importSource src0 opts files = do
|
importSource src0 opts files = do
|
||||||
src <- appIOE $ batchCompile opts files
|
useIOE src0 (fmap (snd.snd) (batchCompile opts files))
|
||||||
case src of
|
|
||||||
Ok (_,(_,gr)) -> return gr
|
|
||||||
Bad msg -> do
|
|
||||||
putStrLn msg
|
|
||||||
return src0
|
|
||||||
|
|
||||||
-- for different cf formats
|
-- for different cf formats
|
||||||
importCF opts files get convert = do
|
importCF opts files get convert = impCF
|
||||||
res <- appIOE impCF
|
|
||||||
case res of
|
|
||||||
Ok pgf -> return pgf
|
|
||||||
Bad s -> error s
|
|
||||||
where
|
where
|
||||||
impCF = do
|
impCF = do
|
||||||
rules <- fmap (convert . concat) $ mapM (get opts) files
|
rules <- fmap (convert . concat) $ mapM (get opts) files
|
||||||
@@ -66,6 +57,6 @@ importCF opts files get convert = do
|
|||||||
(CFRule cat _ _ : _) -> return cat
|
(CFRule cat _ _ : _) -> return cat
|
||||||
_ -> fail "empty CFG"
|
_ -> fail "empty CFG"
|
||||||
let pgf = cf2pgf (last files) (uniqueFuns (mkCFG startCat Set.empty rules))
|
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
|
return $ setProbabilities probs
|
||||||
$ if flag optOptimizePGF opts then optimizePGF pgf else pgf
|
$ if flag optOptimizePGF opts then optimizePGF pgf else pgf
|
||||||
|
|||||||
@@ -81,11 +81,11 @@ batchCompile1 lib_dir (opts,filepaths) =
|
|||||||
takeFileName f `elem` prelude_files
|
takeFileName f `elem` prelude_files
|
||||||
ppPath ps = "-path="<>intercalate ":" (map rel ps)
|
ppPath ps = "-path="<>intercalate ":" (map rel ps)
|
||||||
deps <- newMVar M.empty
|
deps <- newMVar M.empty
|
||||||
toLog <- newLog runIOE
|
toLog <- newLog id
|
||||||
term <- getTermColors
|
term <- getTermColors
|
||||||
let --logStrLn = toLog . ePutStrLn
|
let --logStrLn = toLog . ePutStrLn
|
||||||
--ok :: CollectOutput IO a -> IO a
|
--ok :: CollectOutput IO a -> IO a
|
||||||
ok (CO m) = err bad good =<< appIOE m
|
ok (CO m) = err bad good =<< tryIOE m
|
||||||
where
|
where
|
||||||
good (o,r) = do toLog o; return r
|
good (o,r) = do toLog o; return r
|
||||||
bad e = do toLog (redPutStrLn e); fail "failed"
|
bad e = do toLog (redPutStrLn e); fail "failed"
|
||||||
@@ -98,7 +98,7 @@ batchCompile1 lib_dir (opts,filepaths) =
|
|||||||
-- logStrLn $ "Finished "++show (length (modules gr'))++" modules."
|
-- logStrLn $ "Finished "++show (length (modules gr'))++" modules."
|
||||||
return gr'
|
return gr'
|
||||||
fcache <- liftIO $ newIOCache $ \ _ (imp,Hide (f,ps)) ->
|
fcache <- liftIO $ newIOCache $ \ _ (imp,Hide (f,ps)) ->
|
||||||
do (file,_,_) <- runIOE $ findFile gfoDir ps imp
|
do (file,_,_) <- findFile gfoDir ps imp
|
||||||
return (file,(f,ps))
|
return (file,(f,ps))
|
||||||
let find f ps imp =
|
let find f ps imp =
|
||||||
do (file',(f',ps')) <- liftIO $ readIOCache fcache (imp,Hide (f,ps))
|
do (file',(f',ps')) <- liftIO $ readIOCache fcache (imp,Hide (f,ps))
|
||||||
|
|||||||
@@ -28,7 +28,7 @@ import Control.Monad(unless,forM_)
|
|||||||
-- and, depending on the options, a @.pgf@ file. (@gf -batch@, @gf -make@)
|
-- and, depending on the options, a @.pgf@ file. (@gf -batch@, @gf -make@)
|
||||||
mainGFC :: Options -> [FilePath] -> IO ()
|
mainGFC :: Options -> [FilePath] -> IO ()
|
||||||
mainGFC opts fs = do
|
mainGFC opts fs = do
|
||||||
r <- appIOE (case () of
|
r <- tryIOE (case () of
|
||||||
_ | null fs -> fail $ "No input files."
|
_ | null fs -> fail $ "No input files."
|
||||||
_ | all (extensionIs ".cf") fs -> compileCFFiles opts fs
|
_ | all (extensionIs ".cf") fs -> compileCFFiles opts fs
|
||||||
_ | all (\f -> extensionIs ".gf" f || extensionIs ".gfo" f) fs -> compileSourceFiles opts fs
|
_ | all (\f -> extensionIs ".gf" f || extensionIs ".gfo" f) fs -> compileSourceFiles opts fs
|
||||||
|
|||||||
@@ -129,14 +129,16 @@ splitInModuleSearchPath s = case break isPathSep s of
|
|||||||
-- | Was: @newtype IOE a = IOE { appIOE :: IO (Err a) }@
|
-- | Was: @newtype IOE a = IOE { appIOE :: IO (Err a) }@
|
||||||
type IOE a = IO a
|
type IOE a = IO a
|
||||||
|
|
||||||
ioe :: IO (Err a) -> IOE a
|
--ioe :: IO (Err a) -> IOE a
|
||||||
ioe io = err fail return =<< io
|
--ioe io = err fail return =<< io
|
||||||
|
|
||||||
appIOE :: IOE a -> IO (Err a)
|
-- | Catch exceptions caused by calls to 'raise' or 'fail' in the 'IO' monad.
|
||||||
appIOE ioe = handle (fmap Ok ioe) (return . Bad)
|
-- 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 :: IOE a -> IO a
|
||||||
runIOE = id
|
--runIOE = id
|
||||||
|
|
||||||
-- instance MonadIO IOE where liftIO io = ioe (io >>= return . return)
|
-- 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
|
appIOE $ err raise f x -- f :: a -> IOE a
|
||||||
fail = raise
|
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 a -> IO a
|
||||||
useIOE a ioe = handle ioe (\s -> putStrLn s >> return a)
|
useIOE a ioe = handle ioe (\s -> putStrLn s >> return a)
|
||||||
|
|
||||||
|
|||||||
@@ -4,6 +4,7 @@ module GF.Support(
|
|||||||
module GF.Infra.Option,
|
module GF.Infra.Option,
|
||||||
module GF.Data.Operations,
|
module GF.Data.Operations,
|
||||||
module GF.Infra.UseIO,
|
module GF.Infra.UseIO,
|
||||||
|
module GF.System.Catch,
|
||||||
module GF.System.Console,
|
module GF.System.Console,
|
||||||
-- ** Binary serialisation
|
-- ** Binary serialisation
|
||||||
Binary,encode,decode,encodeFile,decodeFile
|
Binary,encode,decode,encodeFile,decodeFile
|
||||||
@@ -13,5 +14,6 @@ import GF.Infra.Location
|
|||||||
import GF.Data.Operations
|
import GF.Data.Operations
|
||||||
import GF.Infra.Option
|
import GF.Infra.Option
|
||||||
import GF.Infra.UseIO
|
import GF.Infra.UseIO
|
||||||
|
import GF.System.Catch
|
||||||
import GF.System.Console
|
import GF.System.Console
|
||||||
import Data.Binary
|
import Data.Binary
|
||||||
|
|||||||
@@ -3,6 +3,7 @@
|
|||||||
module GF.System.Catch where
|
module GF.System.Catch where
|
||||||
import qualified System.IO.Error as S
|
import qualified System.IO.Error as S
|
||||||
|
|
||||||
|
-- ** Backwards compatible try and catch
|
||||||
#if MIN_VERSION_base(4,4,0)
|
#if MIN_VERSION_base(4,4,0)
|
||||||
catch = S.catchIOError
|
catch = S.catchIOError
|
||||||
try = S.tryIOError
|
try = S.tryIOError
|
||||||
|
|||||||
Reference in New Issue
Block a user