RlpcError -> IsRlpcError

This commit is contained in:
crumbtoo
2024-01-21 11:53:41 -07:00
parent f47f325e34
commit 257d02da87
4 changed files with 13 additions and 13 deletions

View File

@@ -16,6 +16,7 @@ module Compiler.RLPC
, RLPCT(..) , RLPCT(..)
, RLPCIO , RLPCIO
, RLPCOptions(RLPCOptions) , RLPCOptions(RLPCOptions)
, IsRlpcError(..)
, RlpcError(..) , RlpcError(..)
, addFatal , addFatal
, addWound , addWound
@@ -56,8 +57,7 @@ import Lens.Micro.TH
---------------------------------------------------------------------------------- ----------------------------------------------------------------------------------
newtype RLPCT m a = RLPCT { newtype RLPCT m a = RLPCT {
runRLPCT :: forall e. (RlpcError e) runRLPCT :: ReaderT RLPCOptions (ErrorfulT RlpcError m) a
=> ReaderT RLPCOptions (ErrorfulT e m) a
} }
type RLPC = RLPCT Identity type RLPC = RLPCT Identity
@@ -72,7 +72,7 @@ evalRLPC = undefined
evalRLPCT = undefined evalRLPCT = undefined
evalRLPCIO = undefined evalRLPCIO = undefined
liftErrorful :: (RlpcError e) => ErrorfulT e m a -> RLPCT m a liftErrorful :: ErrorfulT e m a -> RLPCT m a
liftErrorful e = undefined liftErrorful e = undefined
data RLPCOptions = RLPCOptions data RLPCOptions = RLPCOptions

View File

@@ -1,9 +1,9 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Compiler.RlpcError module Compiler.RlpcError
( RlpcError(..) ( IsRlpcError(..)
, MsgEnvelope(..) , MsgEnvelope(..)
, Severity , Severity
, RlpcErrorDoc(..) , RlpcError(..)
, SrcSpan(..) , SrcSpan(..)
, msgSpan , msgSpan
, msgDiagnostic , msgDiagnostic
@@ -15,16 +15,16 @@ import Control.Monad.Errorful
import Lens.Micro.TH import Lens.Micro.TH
---------------------------------------------------------------------------------- ----------------------------------------------------------------------------------
data MsgEnvelope = MsgEnvelope data MsgEnvelope e = MsgEnvelope
{ _msgSpan :: SrcSpan { _msgSpan :: SrcSpan
, _msgDiagnostic :: forall e. (RlpcError e) => e , _msgDiagnostic :: e
, _msgSeverity :: Severity , _msgSeverity :: Severity
} }
class RlpcError e where class IsRlpcError e where
liftRlpcError :: e -> RlpcErrorDoc liftRlpcError :: e -> RlpcError
data RlpcErrorDoc data RlpcError
data Severity = SevWarning data Severity = SevWarning
| SevError | SevError

View File

@@ -49,7 +49,7 @@ data TypeError
deriving (Show, Eq) deriving (Show, Eq)
-- TODO: -- TODO:
instance RlpcError TypeError where instance IsRlpcError TypeError where
-- | Synonym for @Errorful [TypeError]@. This means an @HMError@ action may -- | Synonym for @Errorful [TypeError]@. This means an @HMError@ action may
-- throw any number of fatal or nonfatal errors. Run with @runErrorful@. -- throw any number of fatal or nonfatal errors. Run with @runErrorful@.

View File

@@ -199,10 +199,10 @@ data ParseError = ParErrLexical String
deriving Show deriving Show
-- TODO: -- TODO:
instance RlpcError SrcError where instance IsRlpcError SrcError where
-- TODO: -- TODO:
instance RlpcError ParseError where instance IsRlpcError ParseError where
alexEOF :: Alex (Located CoreToken) alexEOF :: Alex (Located CoreToken)
alexEOF = Alex $ \ st@(AlexState { alex_pos = AlexPn _ y x }) -> alexEOF = Alex $ \ st@(AlexState { alex_pos = AlexPn _ y x }) ->