From 40633d04dcdefe54606ee6de7a13cfa8676c9a26 Mon Sep 17 00:00:00 2001 From: Alberto Valverde Date: Thu, 25 Jul 2024 12:48:58 +0200 Subject: [PATCH] make it build with newer mtl --- inferno-core/src/Inferno/Core.hs | 2 +- inferno-core/src/Inferno/Eval.hs | 2 +- inferno-core/src/Inferno/Infer.hs | 10 ++++++---- inferno-core/src/Inferno/Instances/Arbitrary.hs | 1 + inferno-core/src/Inferno/Utils/QQ/Script.hs | 3 ++- inferno-types/src/Inferno/Types/Value.hs | 15 ++++++++------- 6 files changed, 19 insertions(+), 14 deletions(-) diff --git a/inferno-core/src/Inferno/Core.hs b/inferno-core/src/Inferno/Core.hs index 1281810b..76422193 100644 --- a/inferno-core/src/Inferno/Core.hs +++ b/inferno-core/src/Inferno/Core.hs @@ -6,7 +6,7 @@ module Inferno.Core where import Control.Monad (foldM) import Control.Monad.Catch (MonadCatch, MonadThrow) -import Control.Monad.Except (MonadFix) +import Control.Monad.Fix (MonadFix) import Data.Bifunctor (bimap, first) import Data.List.NonEmpty (NonEmpty) import qualified Data.Map as Map diff --git a/inferno-core/src/Inferno/Eval.hs b/inferno-core/src/Inferno/Eval.hs index 6baafcb4..eaa2f509 100644 --- a/inferno-core/src/Inferno/Eval.hs +++ b/inferno-core/src/Inferno/Eval.hs @@ -3,8 +3,8 @@ module Inferno.Eval where +import Control.Monad (forM) import Control.Monad.Catch (MonadCatch, MonadThrow (throwM), try) -import Control.Monad.Except (forM) import Control.Monad.Reader (ask, local) import Data.Foldable (foldrM) import Data.Functor ((<&>)) diff --git a/inferno-core/src/Inferno/Infer.hs b/inferno-core/src/Inferno/Infer.hs index 017b6b90..8099074b 100644 --- a/inferno-core/src/Inferno/Infer.hs +++ b/inferno-core/src/Inferno/Infer.hs @@ -16,14 +16,16 @@ module Inferno.Infer ) where -import Control.Monad (when) +import Control.Monad + ( foldM, + forM, + forM_, + when + ) import Control.Monad.Except ( Except, ExceptT, MonadError (catchError, throwError), - foldM, - forM, - forM_, runExcept, runExceptT, ) diff --git a/inferno-core/src/Inferno/Instances/Arbitrary.hs b/inferno-core/src/Inferno/Instances/Arbitrary.hs index 23b1ed0b..c361a168 100644 --- a/inferno-core/src/Inferno/Instances/Arbitrary.hs +++ b/inferno-core/src/Inferno/Instances/Arbitrary.hs @@ -6,6 +6,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} diff --git a/inferno-core/src/Inferno/Utils/QQ/Script.hs b/inferno-core/src/Inferno/Utils/QQ/Script.hs index 7f668d99..b132923e 100644 --- a/inferno-core/src/Inferno/Utils/QQ/Script.hs +++ b/inferno-core/src/Inferno/Utils/QQ/Script.hs @@ -8,7 +8,8 @@ module Inferno.Utils.QQ.Script where import Control.Monad.Catch (MonadCatch (..), MonadThrow (..)) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (ReaderT (..)) -import Control.Monad.Writer (WriterT (..), appEndo) +import Control.Monad.Writer (WriterT (..)) +import Data.Monoid (appEndo) import qualified Crypto.Hash as Crypto import Data.ByteArray (convert) import Data.ByteString (ByteString, unpack) diff --git a/inferno-types/src/Inferno/Types/Value.hs b/inferno-types/src/Inferno/Types/Value.hs index 829eaa81..2ee40028 100644 --- a/inferno-types/src/Inferno/Types/Value.hs +++ b/inferno-types/src/Inferno/Types/Value.hs @@ -6,10 +6,11 @@ module Inferno.Types.Value where import Control.DeepSeq (NFData, rnf) import Control.Monad.Catch (MonadCatch (..), MonadThrow (..)) -import Control.Monad.Except (MonadError, lift) +import Control.Monad.Except (MonadError) import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (MonadReader, ReaderT (..)) +import Control.Monad.Trans (lift) import Data.Int (Int64) import qualified Data.Map as Map import Data.Text (Text) @@ -51,7 +52,7 @@ data Value custom m | VTypeRep InfernoType | VCustom custom -instance NFData custom => NFData (Value custom m) where +instance (NFData custom) => NFData (Value custom m) where rnf (VInt x) = x `seq` () rnf (VDouble x) = x `seq` () rnf (VWord16 x) = x `seq` () @@ -69,7 +70,7 @@ instance NFData custom => NFData (Value custom m) where rnf (VTypeRep x) = rnf x rnf (VCustom x) = rnf x -instance Eq c => Eq (Value c m) where +instance (Eq c) => Eq (Value c m) where (VInt i1) == (VInt i2) = i1 == i2 (VDouble v1) == (VDouble v2) = v1 == v2 (VWord16 w1) == (VWord16 w2) = w1 == w2 @@ -88,7 +89,7 @@ instance Eq c => Eq (Value c m) where (VCustom c1) == (VCustom c2) = c1 == c2 _ == _ = False -instance Pretty c => Pretty (Value c m) where +instance (Pretty c) => Pretty (Value c m) where pretty = \case VInt n -> pretty n VDouble n -> pretty n @@ -113,14 +114,14 @@ instance Pretty c => Pretty (Value c m) where newtype ImplEnvM m c a = ImplEnvM {unImplEnvM :: ReaderT (Map.Map ExtIdent (Value c (ImplEnvM m c))) m a} deriving (Applicative, Functor, Monad, MonadReader (Map.Map ExtIdent (Value c (ImplEnvM m c))), MonadError e, MonadFix, MonadIO) -instance MonadThrow m => MonadThrow (ImplEnvM m c) where +instance (MonadThrow m) => MonadThrow (ImplEnvM m c) where throwM = ImplEnvM . lift . throwM -instance MonadCatch m => MonadCatch (ImplEnvM m c) where +instance (MonadCatch m) => MonadCatch (ImplEnvM m c) where catch (ImplEnvM (ReaderT m)) c = ImplEnvM $ ReaderT $ \env -> m env `catch` \e -> runImplEnvM env (c e) -liftImplEnvM :: Monad m => m a -> ImplEnvM m c a +liftImplEnvM :: (Monad m) => m a -> ImplEnvM m c a liftImplEnvM = ImplEnvM . lift runImplEnvM :: Map.Map ExtIdent (Value c (ImplEnvM m c)) -> ImplEnvM m c a -> m a