MonadFail: Make backwards-compatible

This commit is contained in:
Andreas Källberg
2020-09-05 20:23:07 +02:00
parent 1234c715fc
commit 7268253f5a
15 changed files with 49 additions and 16 deletions

View File

@@ -32,6 +32,7 @@ import System.FilePath(makeRelative)
import Control.Parallel.Strategies(parList,rseq,using)
import Control.Monad(liftM,ap)
import Control.Applicative(Applicative(..))
import qualified Control.Monad.Fail as Fail
type Message = Doc
type Error = Message
@@ -53,7 +54,7 @@ instance Monad Check where
(ws,Success x) -> unCheck (g x) {-ctxt-} ws
(ws,Fail msg) -> (ws,Fail msg)
instance MonadFail Check where
instance Fail.MonadFail Check where
fail = raise
instance Applicative Check where

View File

@@ -44,6 +44,7 @@ import Data.Set (Set)
import qualified Data.Set as Set
import PGF.Internal(Literal(..))
import qualified Control.Monad.Fail as Fail
usageHeader :: String
usageHeader = unlines
@@ -547,7 +548,7 @@ lookupShow xs z = fromMaybe "lookupShow" $ lookup z [(y,x) | (x,y) <- xs]
lookupReadsPrec :: [(String,a)] -> Int -> ReadS a
lookupReadsPrec xs _ s = [(z,rest) | (x,rest) <- lex s, (y,z) <- xs, y == x]
onOff :: MonadFail m => (Bool -> m a) -> Bool -> ArgDescr (m a)
onOff :: Fail.MonadFail m => (Bool -> m a) -> Bool -> ArgDescr (m a)
onOff f def = OptArg g "[on,off]"
where g ma = maybe (return def) readOnOff ma >>= f
readOnOff x = case map toLower x of
@@ -555,7 +556,7 @@ onOff f def = OptArg g "[on,off]"
"off" -> return False
_ -> fail $ "Expected [on,off], got: " ++ show x
readOutputFormat :: MonadFail m => String -> m OutputFormat
readOutputFormat :: Fail.MonadFail m => String -> m OutputFormat
readOutputFormat s =
maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats

View File

@@ -42,6 +42,7 @@ import qualified GF.Command.Importing as GF(importGrammar, importSource)
#ifdef C_RUNTIME
import qualified PGF2
#endif
import qualified Control.Monad.Fail as Fail
-- * The SIO monad
@@ -58,7 +59,7 @@ instance Monad SIO where
return x = SIO (const (return x))
SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
instance MonadFail SIO where
instance Fail.MonadFail SIO where
fail = liftSIO . fail
instance Output SIO where