From c146e1c45091d975473d86889759b2a8fe9eace5 Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Mon, 22 Jan 2024 09:59:48 -0700
Subject: [PATCH] errorful parser

small
---
 src/Compiler/RlpcError.hs | 4 ++++
 src/Rlp/Parse.y           | 2 +-
 src/Rlp/Parse/Types.hs    | 9 +++++----
 3 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/src/Compiler/RlpcError.hs b/src/Compiler/RlpcError.hs
index cff9375..168ad17 100644
--- a/src/Compiler/RlpcError.hs
+++ b/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
+
diff --git a/src/Rlp/Parse.y b/src/Rlp/Parse.y
index 3871a4f..e96db59 100644
--- a/src/Rlp/Parse.y
+++ b/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
diff --git a/src/Rlp/Parse/Types.hs b/src/Rlp/Parse/Types.hs
index d0f9be2..498335f 100644
--- a/src/Rlp/Parse/Types.hs
+++ b/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
 
---------------------------------------------------------------------------------
-