mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Fix most build errors
This commit is contained in:
@@ -44,7 +44,7 @@ pgfEnv pgf = Env pgf mos
|
||||
|
||||
class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
|
||||
|
||||
instance (Monad m,HasPGFEnv m) => TypeCheckArg m where
|
||||
instance (Monad m,HasPGFEnv m,MonadFail m) => TypeCheckArg m where
|
||||
typeCheckArg e = (either (fail . render . ppTcError) (return . fst)
|
||||
. flip inferExpr e . pgf) =<< getPGFEnv
|
||||
|
||||
|
||||
@@ -196,6 +196,9 @@ newtype CnvMonad a = CM {unCM :: SourceGrammar
|
||||
-> ([ProtoFCat],[Symbol])
|
||||
-> Branch b}
|
||||
|
||||
instance MonadFail CnvMonad where
|
||||
fail = bug
|
||||
|
||||
instance Applicative CnvMonad where
|
||||
pure = return
|
||||
(<*>) = ap
|
||||
|
||||
@@ -29,7 +29,7 @@ import Control.Monad
|
||||
import GF.Text.Pretty
|
||||
|
||||
-- | combine a list of definitions into a balanced binary search tree
|
||||
buildAnyTree :: Monad m => ModuleName -> [(Ident,Info)] -> m (Map.Map Ident Info)
|
||||
buildAnyTree :: MonadFail m => ModuleName -> [(Ident,Info)] -> m (Map.Map Ident Info)
|
||||
buildAnyTree m = go Map.empty
|
||||
where
|
||||
go map [] = return map
|
||||
|
||||
@@ -256,6 +256,9 @@ instance Output m => Output (CollectOutput m) where
|
||||
putStrLnE s = CO (return (putStrLnE s,()))
|
||||
putStrE s = CO (return (putStrE s,()))
|
||||
|
||||
instance MonadFail m => MonadFail (CollectOutput m) where
|
||||
fail = CO . fail
|
||||
|
||||
instance ErrorMonad m => ErrorMonad (CollectOutput m) where
|
||||
raise e = CO (raise e)
|
||||
handle (CO m) h = CO $ handle m (unCO . h)
|
||||
|
||||
@@ -35,7 +35,7 @@ type OneOutput = (Maybe FullPath,CompiledModule)
|
||||
type CompiledModule = Module
|
||||
|
||||
compileOne, reuseGFO, useTheSource ::
|
||||
(Output m,ErrorMonad m,MonadIO m) =>
|
||||
(Output m,ErrorMonad m,MonadIO m, MonadFail m) =>
|
||||
Options -> Grammar -> FullPath -> m OneOutput
|
||||
|
||||
-- | Compile a given source file (or just load a .gfo file),
|
||||
|
||||
@@ -88,10 +88,10 @@ checkUnique ss = ["overloaded" +++ show s | s <- nub overloads] where
|
||||
overloaded s = length (filter (==s) ss) > 1
|
||||
|
||||
-- | this is what happens when matching two values in the same module
|
||||
unifyMaybe :: (Eq a, Monad m) => Maybe a -> Maybe a -> m (Maybe a)
|
||||
unifyMaybe :: (Eq a, MonadFail m) => Maybe a -> Maybe a -> m (Maybe a)
|
||||
unifyMaybe = unifyMaybeBy id
|
||||
|
||||
unifyMaybeBy :: (Eq b, Monad m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a)
|
||||
unifyMaybeBy :: (Eq b, MonadFail m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a)
|
||||
unifyMaybeBy f (Just p1) (Just p2)
|
||||
| f p1==f p2 = return (Just p1)
|
||||
| otherwise = fail ""
|
||||
|
||||
@@ -237,7 +237,7 @@ isPredefConstant t = case t of
|
||||
Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True
|
||||
_ -> False
|
||||
|
||||
checkPredefError :: Monad m => Term -> m Term
|
||||
checkPredefError :: MonadFail m => Term -> m Term
|
||||
checkPredefError t =
|
||||
case t of
|
||||
Error s -> fail ("Error: "++s)
|
||||
|
||||
@@ -53,6 +53,9 @@ instance Monad Check where
|
||||
(ws,Success x) -> unCheck (g x) {-ctxt-} ws
|
||||
(ws,Fail msg) -> (ws,Fail msg)
|
||||
|
||||
instance MonadFail Check where
|
||||
fail = raise
|
||||
|
||||
instance Applicative Check where
|
||||
pure = return
|
||||
(<*>) = ap
|
||||
|
||||
@@ -547,7 +547,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 :: Monad m => (Bool -> m a) -> Bool -> ArgDescr (m a)
|
||||
onOff :: 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 +555,7 @@ onOff f def = OptArg g "[on,off]"
|
||||
"off" -> return False
|
||||
_ -> fail $ "Expected [on,off], got: " ++ show x
|
||||
|
||||
readOutputFormat :: Monad m => String -> m OutputFormat
|
||||
readOutputFormat :: MonadFail m => String -> m OutputFormat
|
||||
readOutputFormat s =
|
||||
maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats
|
||||
|
||||
|
||||
@@ -58,6 +58,9 @@ 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
|
||||
fail = liftSIO . fail
|
||||
|
||||
instance Output SIO where
|
||||
ePutStr = lift0 . ePutStr
|
||||
ePutStrLn = lift0 . ePutStrLn
|
||||
|
||||
Reference in New Issue
Block a user