From 251845f83ea52965b5205fd231ffa2c87bb34de6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Wed, 5 Aug 2020 16:20:35 +0200 Subject: [PATCH] First attempt at fixing incompabilities with newer cabal --- Setup.hs | 1 - .../GF/Compile/TypeCheck/ConcreteNew.hs | 15 +++++++++++++++ src/compiler/GF/Data/ErrM.hs | 19 ++++++++++++++++++- src/compiler/GF/Grammar/Lexer.x | 13 +++++++++++++ src/compiler/GF/Infra/UseIO.hs | 11 +++++++++++ src/runtime/haskell/Data/Binary/Get.hs | 9 +++++++++ src/tools/c/GFCC/ErrM.hs | 13 ++++++++++++- 7 files changed, 78 insertions(+), 3 deletions(-) diff --git a/Setup.hs b/Setup.hs index 27524dbe5..1ee9cec92 100644 --- a/Setup.hs +++ b/Setup.hs @@ -19,7 +19,6 @@ main = defaultMainWithHooks simpleUserHooks , preInst = gfPreInst , postInst = gfPostInst , postCopy = gfPostCopy - , sDistHook = gfSDist } where gfPreBuild args = gfPre args . buildDistPref diff --git a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs index 8fd6023b3..fab3173dc 100644 --- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs +++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs @@ -19,6 +19,10 @@ import GF.Text.Pretty import Data.List (nub, (\\), tails) import qualified Data.IntMap as IntMap import Data.Maybe(fromMaybe,isNothing) +#if !MIN_VERSION_base(4,11,0) +-- Control.Monad.Fail import is redundant since GHC 8.8.1 +import qualified Control.Monad.Fail as Fail +#endif checkLType :: GlobalEnv -> Term -> Type -> Check (Term, Type) checkLType ge t ty = runTcM $ do @@ -646,7 +650,18 @@ instance Monad TcM where f >>= g = TcM (\ms msgs -> case unTcM f ms msgs of TcOk x ms msgs -> unTcM (g x) ms msgs TcFail msgs -> TcFail msgs) + +#if !(MIN_VERSION_base(4,13,0)) fail = tcError . pp +#endif + +instance Fail.MonadFail TcM where + fail = tcError . pp + + +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail + instance Applicative TcM where pure = return diff --git a/src/compiler/GF/Data/ErrM.hs b/src/compiler/GF/Data/ErrM.hs index 033c1efac..0cef54816 100644 --- a/src/compiler/GF/Data/ErrM.hs +++ b/src/compiler/GF/Data/ErrM.hs @@ -16,6 +16,10 @@ module GF.Data.ErrM where import Control.Monad (MonadPlus(..),ap) import Control.Applicative +#if !MIN_VERSION_base(4,11,0) +-- Control.Monad.Fail import is redundant since GHC 8.8.1 +import qualified Control.Monad.Fail as Fail +#endif -- | Like 'Maybe' type with error msgs data Err a = Ok a | Bad String @@ -33,10 +37,23 @@ 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,11,0)) + fail = Bad +#endif + +instance Fail.MonadFail Err where + fail = Bad + +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail + + + + + -- | added 2\/10\/2003 by PEB instance Functor Err where fmap f (Ok a) = Ok (f a) diff --git a/src/compiler/GF/Grammar/Lexer.x b/src/compiler/GF/Grammar/Lexer.x index d1550dd09..c19a32e3b 100644 --- a/src/compiler/GF/Grammar/Lexer.x +++ b/src/compiler/GF/Grammar/Lexer.x @@ -1,5 +1,6 @@ -- -*- haskell -*- { +{-# LANGUAGE CPP #-} module GF.Grammar.Lexer ( Token(..), Posn(..) , P, runP, runPartial, token, lexer, getPosn, failLoc @@ -18,6 +19,9 @@ import qualified Data.Map as Map import Data.Word(Word8) import Data.Char(readLitChar) --import Debug.Trace(trace) + +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail } @@ -282,7 +286,16 @@ instance Monad P where (P m) >>= k = P $ \ s -> case m s of POk s a -> unP (k a) s PFailed posn err -> PFailed posn err + +#if !(MIN_VERSION_base(4,13,0)) fail msg = P $ \(_,AI posn _ _) -> PFailed posn msg +#endif + +instance Fail.MonadFail P where + fail msg = P $ \(_,AI posn _ _) -> PFailed posn msg + + + runP :: P a -> BS.ByteString -> Either (Posn,String) a runP p bs = snd <$> runP' p (Pn 1 0,bs) diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs index e27b6e075..4c5a26d32 100644 --- a/src/compiler/GF/Infra/UseIO.hs +++ b/src/compiler/GF/Infra/UseIO.hs @@ -159,6 +159,9 @@ instance ErrorMonad IO where then h (ioeGetErrorString e) else ioError e {- +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail + instance Functor IOE where fmap = liftM instance Applicative IOE where @@ -170,7 +173,15 @@ instance Monad IOE where IOE c >>= f = IOE $ do x <- c -- Err a appIOE $ err raise f x -- f :: a -> IOE a + + #if !(MIN_VERSION_base(4,13,0)) fail = raise + #endif + +instance Fail.MonadFail IOE where + fail = raise + + -} -- | Print the error message and return a default value if the IO operation 'fail's diff --git a/src/runtime/haskell/Data/Binary/Get.hs b/src/runtime/haskell/Data/Binary/Get.hs index 6e98434f5..01561d7d9 100644 --- a/src/runtime/haskell/Data/Binary/Get.hs +++ b/src/runtime/haskell/Data/Binary/Get.hs @@ -101,6 +101,10 @@ import GHC.Word --import GHC.Int #endif +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail + + -- | The parse state data S = S {-# UNPACK #-} !B.ByteString -- current chunk L.ByteString -- the rest of the input @@ -126,6 +130,11 @@ instance Monad Get where (a, s') -> unGet (k a) s') {-# INLINE (>>=) #-} +#if !(MIN_VERSION_base(4,13,0)) + fail = failDesc +#endif + +instance Fail.MonadFail Get where fail = failDesc instance MonadFix Get where diff --git a/src/tools/c/GFCC/ErrM.hs b/src/tools/c/GFCC/ErrM.hs index 820473ccd..78295d30e 100644 --- a/src/tools/c/GFCC/ErrM.hs +++ b/src/tools/c/GFCC/ErrM.hs @@ -4,6 +4,10 @@ -- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE. module GFCC.ErrM where +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail + + -- the Error monad: like Maybe type with error msgs data Err a = Ok a | Bad String @@ -11,6 +15,13 @@ data Err a = Ok a | Bad String 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)) + fail = Bad +#endif + +instance Fail.MonadFail Err where + fail = Bad +