summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Data
diff options
context:
space:
mode:
authorJohn J. Camilleri <john@johnjcamilleri.com>2020-09-14 22:42:37 +0200
committerGitHub <noreply@github.com>2020-09-14 22:42:37 +0200
commit6c54e5b63cb563d780843a1970cba0718a5203f8 (patch)
treeed6777f6cb20f9212fa29ce68fac7e22745c707c /src/compiler/GF/Data
parentbca0691cb028fe33ae1b77e71752d4e937490ff1 (diff)
parent8bcdeedba01847325cc89378fed114bc0561bd4d (diff)
Merge pull request #71 from anka-213/fix-newer-cabal
Fix support for newer stackage snapshots
Diffstat (limited to 'src/compiler/GF/Data')
-rw-r--r--src/compiler/GF/Data/BacktrackM.hs8
-rw-r--r--src/compiler/GF/Data/ErrM.hs13
-rw-r--r--src/compiler/GF/Data/Operations.hs5
3 files changed, 23 insertions, 3 deletions
diff --git a/src/compiler/GF/Data/BacktrackM.hs b/src/compiler/GF/Data/BacktrackM.hs
index f5ae63997..14cbf90d2 100644
--- a/src/compiler/GF/Data/BacktrackM.hs
+++ b/src/compiler/GF/Data/BacktrackM.hs
@@ -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
@@ -69,6 +71,12 @@ instance Monad (BacktrackM s) where
return a = BM (\c s b -> c a s b)
BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
where unBM (BM m) = m
+
+#if !(MIN_VERSION_base(4,13,0))
+ fail = Fail.fail
+#endif
+
+instance Fail.MonadFail (BacktrackM s) where
fail _ = mzero
instance Functor (BacktrackM s) where
diff --git a/src/compiler/GF/Data/ErrM.hs b/src/compiler/GF/Data/ErrM.hs
index 033c1efac..288c61919 100644
--- a/src/compiler/GF/Data/ErrM.hs
+++ b/src/compiler/GF/Data/ErrM.hs
@@ -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
@@ -33,10 +35,19 @@ fromErr a = err (const a) id
instance Monad Err where
return = Ok
- fail = Bad
Ok a >>= f = f a
Bad s >>= f = Bad s
+#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
+
+
+
-- | added 2\/10\/2003 by PEB
instance Functor Err where
fmap f (Ok a) = Ok (f a)
diff --git a/src/compiler/GF/Data/Operations.hs b/src/compiler/GF/Data/Operations.hs
index 4daa9c5d8..08fa15c3e 100644
--- a/src/compiler/GF/Data/Operations.hs
+++ b/src/compiler/GF/Data/Operations.hs
@@ -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, Monad 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, Monad 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 ""