mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 03:09:33 -06:00
MonadFail: Make backwards-compatible
This commit is contained in:
@@ -13,6 +13,7 @@
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module GF.Data.BacktrackM (
|
||||
-- * the backtracking state monad
|
||||
BacktrackM,
|
||||
@@ -32,6 +33,7 @@ import Data.List
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Monad.State.Class
|
||||
import qualified Control.Monad.Fail as Fail
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- Combining endomorphisms and continuations
|
||||
@@ -70,7 +72,12 @@ instance Monad (BacktrackM s) where
|
||||
BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
|
||||
where unBM (BM m) = m
|
||||
|
||||
instance MonadFail (BacktrackM s) where
|
||||
#if !(MIN_VERSION_base(4,13,0))
|
||||
-- Monad(fail) will be removed in GHC 8.8+
|
||||
fail = Fail.fail
|
||||
#endif
|
||||
|
||||
instance Fail.MonadFail (BacktrackM s) where
|
||||
fail _ = mzero
|
||||
|
||||
instance Functor (BacktrackM s) where
|
||||
|
||||
@@ -12,10 +12,12 @@
|
||||
-- hack for BNFC generated files. AR 21/9/2003
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
module GF.Data.ErrM where
|
||||
|
||||
import Control.Monad (MonadPlus(..),ap)
|
||||
import Control.Applicative
|
||||
import qualified Control.Monad.Fail as Fail
|
||||
|
||||
-- | Like 'Maybe' type with error msgs
|
||||
data Err a = Ok a | Bad String
|
||||
@@ -36,7 +38,12 @@ instance Monad Err where
|
||||
Ok a >>= f = f a
|
||||
Bad s >>= f = Bad s
|
||||
|
||||
instance MonadFail Err where
|
||||
#if !(MIN_VERSION_base(4,13,0))
|
||||
-- Monad(fail) will be removed in GHC 8.8+
|
||||
fail = Fail.fail
|
||||
#endif
|
||||
|
||||
instance Fail.MonadFail Err where
|
||||
fail = Bad
|
||||
|
||||
|
||||
|
||||
@@ -53,6 +53,7 @@ import Control.Monad (liftM,liftM2) --,ap
|
||||
|
||||
import GF.Data.ErrM
|
||||
import GF.Data.Relation
|
||||
import qualified Control.Monad.Fail as Fail
|
||||
|
||||
infixr 5 +++
|
||||
infixr 5 ++-
|
||||
@@ -88,10 +89,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, MonadFail m) => Maybe a -> Maybe a -> m (Maybe a)
|
||||
unifyMaybe :: (Eq a, Fail.MonadFail m) => Maybe a -> Maybe a -> m (Maybe a)
|
||||
unifyMaybe = unifyMaybeBy id
|
||||
|
||||
unifyMaybeBy :: (Eq b, MonadFail m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a)
|
||||
unifyMaybeBy :: (Eq b, Fail.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 ""
|
||||
|
||||
Reference in New Issue
Block a user