src/Compiler/RlpcError.hs

@@ -26,6 +26,7 @@ data MsgEnvelope e = MsgEnvelope
    , _msgDiagnostic  :: e
    , _msgSeverity    :: Severity
    }
+   deriving Functor
 
 newtype RlpcError = Text [Text]
     deriving Show
@@ -55,3 +56,6 @@ liftRlpcErrors :: (Functor m, IsRlpcError e)
                -> ErrorfulT RlpcError m a
 liftRlpcErrors = mapErrorful liftRlpcError
 
+instance (IsRlpcError e) => IsRlpcError (MsgEnvelope e) where
+    liftRlpcError msg = msg ^. msgDiagnostic & liftRlpcError
+

src/Rlp/Parse.y

@@ -161,7 +161,7 @@ mkProgram ds = do
     pure $ RlpProgram (associate pt <$> ds)
 
 parseError :: Located RlpToken -> P a
-parseError (Located ((l,c),s) t) = addFatal RlpParErrUnknown
+parseError (Located ((l,c),s) t) = addFatal RlpParErrUnexpectedToken
 
 mkInfixD :: Assoc -> Int -> Name -> P PartialDecl'
 mkInfixD a p n = do

src/Rlp/Parse/Types.hs

@@ -37,6 +37,7 @@ import Core.Syntax                  (Name)
 import Control.Monad
 import Control.Monad.State.Strict
 import Control.Monad.Errorful
+import Compiler.RlpcError
 import Data.Text                    (Text)
 import Data.Maybe
 import Data.Fix
@@ -151,8 +152,10 @@ type OpInfo = (Assoc, Int)
 data RlpParseError = RlpParErrOutOfBoundsPrecedence Int
                    | RlpParErrDuplicateInfixD
                    | RlpParErrLexical
-                   | RlpParErrUnknown
-    deriving (Eq, Ord, Show)
+                   | RlpParErrUnexpectedToken
+                   deriving (Eq, Ord, Show)
+
+instance IsRlpcError RlpParseError where
 
 ----------------------------------------------------------------------------------
 
@@ -201,5 +204,3 @@ type PartialExpr' = Fix Partial
 makeLenses ''AlexInput
 makeLenses ''ParseState
 
---------------------------------------------------------------------------------
-