diff --git a/src/Compiler/RLPC.hs b/src/Compiler/RLPC.hs index 518e9fb..5acedc6 100644 --- a/src/Compiler/RLPC.hs +++ b/src/Compiler/RLPC.hs @@ -16,6 +16,7 @@ module Compiler.RLPC , RLPCT(..) , RLPCIO , RLPCOptions(RLPCOptions) + , IsRlpcError(..) , RlpcError(..) , addFatal , addWound @@ -56,8 +57,7 @@ import Lens.Micro.TH ---------------------------------------------------------------------------------- newtype RLPCT m a = RLPCT { - runRLPCT :: forall e. (RlpcError e) - => ReaderT RLPCOptions (ErrorfulT e m) a + runRLPCT :: ReaderT RLPCOptions (ErrorfulT RlpcError m) a } type RLPC = RLPCT Identity @@ -72,7 +72,7 @@ evalRLPC = undefined evalRLPCT = undefined evalRLPCIO = undefined -liftErrorful :: (RlpcError e) => ErrorfulT e m a -> RLPCT m a +liftErrorful :: ErrorfulT e m a -> RLPCT m a liftErrorful e = undefined data RLPCOptions = RLPCOptions diff --git a/src/Compiler/RlpcError.hs b/src/Compiler/RlpcError.hs index cd53964..755f05d 100644 --- a/src/Compiler/RlpcError.hs +++ b/src/Compiler/RlpcError.hs @@ -1,9 +1,9 @@ {-# LANGUAGE TemplateHaskell #-} module Compiler.RlpcError - ( RlpcError(..) + ( IsRlpcError(..) , MsgEnvelope(..) , Severity - , RlpcErrorDoc(..) + , RlpcError(..) , SrcSpan(..) , msgSpan , msgDiagnostic @@ -15,16 +15,16 @@ import Control.Monad.Errorful import Lens.Micro.TH ---------------------------------------------------------------------------------- -data MsgEnvelope = MsgEnvelope +data MsgEnvelope e = MsgEnvelope { _msgSpan :: SrcSpan - , _msgDiagnostic :: forall e. (RlpcError e) => e + , _msgDiagnostic :: e , _msgSeverity :: Severity } -class RlpcError e where - liftRlpcError :: e -> RlpcErrorDoc +class IsRlpcError e where + liftRlpcError :: e -> RlpcError -data RlpcErrorDoc +data RlpcError data Severity = SevWarning | SevError diff --git a/src/Core/HindleyMilner.hs b/src/Core/HindleyMilner.hs index ed01359..12c7436 100644 --- a/src/Core/HindleyMilner.hs +++ b/src/Core/HindleyMilner.hs @@ -49,7 +49,7 @@ data TypeError deriving (Show, Eq) -- TODO: -instance RlpcError TypeError where +instance IsRlpcError TypeError where -- | Synonym for @Errorful [TypeError]@. This means an @HMError@ action may -- throw any number of fatal or nonfatal errors. Run with @runErrorful@. diff --git a/src/Core/Lex.x b/src/Core/Lex.x index d076206..1136409 100644 --- a/src/Core/Lex.x +++ b/src/Core/Lex.x @@ -199,10 +199,10 @@ data ParseError = ParErrLexical String deriving Show -- TODO: -instance RlpcError SrcError where +instance IsRlpcError SrcError where -- TODO: -instance RlpcError ParseError where +instance IsRlpcError ParseError where alexEOF :: Alex (Located CoreToken) alexEOF = Alex $ \ st@(AlexState { alex_pos = AlexPn _ y x }) ->