kill me

src/Compiler/RlpcError.hs

@@ -24,8 +24,11 @@ import Control.Monad.Errorful
 import Data.Text                (Text)
 import Data.Text                qualified as T
 import GHC.Exts                 (IsString(..))
-import Control.Lens
+import GHC.Generics
+import Control.Lens             hiding ((.=))
 import Compiler.Types
+
+import Data.Aeson
 ----------------------------------------------------------------------------------
 
 data MsgEnvelope e = MsgEnvelope
@@ -35,8 +38,17 @@ data MsgEnvelope e = MsgEnvelope
    }
    deriving (Functor, Show)
 
+instance (ToJSON e) => ToJSON (MsgEnvelope e) where
+    toJSON msg = object
+        [ "span" .= _msgSpan msg
+        , "severity" .= _msgSeverity msg
+        , "diagnostic" .= _msgDiagnostic msg
+        ]
+
 newtype RlpcError = Text [Text]
-               deriving Show
+    deriving (Show, Generic)
+    deriving (ToJSON)
+        via Generically [Text]
 
 instance IsString RlpcError where
     fromString = Text . pure . T.pack
@@ -50,7 +62,9 @@ instance IsRlpcError RlpcError where
 data Severity = SevWarning
               | SevError
               | SevDebug Text -- ^ Tag
-              deriving Show
+              deriving (Show, Generic)
+              deriving (ToJSON)
+                via Generically Severity
 
 makeLenses ''MsgEnvelope
 

src/Compiler/Types.hs

@@ -33,8 +33,10 @@ import Data.Functor.Compose
 import Data.Functor.Foldable
 import Data.Semigroup.Foldable
 import Data.Fix                     hiding (cata, ana)
+
 import Data.Kind
-import Control.Lens                 hiding ((<<~), (:<))
+import Data.Aeson
+import Control.Lens                 hiding ((<<~), (:<), (.=))
 
 import Data.List.NonEmpty           (NonEmpty)
 import Data.Function                (on)
@@ -45,6 +47,13 @@ import Misc.CofreeF
 data Located a = Located SrcSpan a
     deriving (Show, Lift, Functor)
 
+instance ToJSON SrcSpan where
+    toJSON (SrcSpan l c a s) = object
+        [ "line" .= l
+        , "column" .= c
+        , "abs" .= a
+        , "length" .= s]
+
 (<~>) :: a -> b -> SrcSpan
 (<~>) = undefined
 

src/Rlp/AltParse.y

@@ -195,8 +195,9 @@ list0(p) : {- epsilon -}            { [] }
          | list0(p) p             { $1 `snoc` $2 }
 
 -- layout0(p : β) :: [β]
-layout0(p)  : '{' layout_list0(';',p) '}'   { $2 }
-            | VL  layout_list0(VS,p)  VR    { $2 }
+layout0(p)  : '{' '}'                   { [] }
+            | VL  VR                    { [] }
+            | layout1(p)                { $1 }
 
 -- layout_list0(sep : α, p : β) :: [β]
 layout_list0(sep,p) : p                          { [$1] }
@@ -205,6 +206,7 @@ layout_list0(sep,p) : p                          { [$1] }
 
 -- layout1(p : β) :: [β]
 layout1(p)  : '{' layout_list1(';',p) '}'   { $2 }
+            | VL  layout_list1(VS,p) VS VR     { $2 }
             | VL  layout_list1(VS,p) VR     { $2 }
 
 -- layout_list1(sep : α, p : β) :: [β]
@@ -225,7 +227,9 @@ parseRlpExprR s = liftErrorful $ errorful (ma,es)
     where
         (_,es,ma) = runP' parseRlpExpr s
 
-parseError = error "explode"
+parseError :: (Located RlpToken, [String]) -> P a
+parseError (Located ss t,ts) = addFatalHere (ss ^. srcSpanLen) $
+    RlpParErrUnexpectedToken t ts
 
 extractName = view $ to extract . singular _TokenVarName
 

src/Rlp/Lex.x

@@ -330,6 +330,7 @@ insertRBrace    = {- traceM "inserting rbrace" >> -} insertToken TokenRBraceV
 cmpLayout :: P Ordering
 cmpLayout = do
     i <- indentLevel
+    -- traceM $ "i: " <> show i
     ctx <- preuse (psLayoutStack . _head)
     case ctx of
         Just (Implicit n) -> pure (i `compare` n)
@@ -338,8 +339,6 @@ cmpLayout = do
 doBol :: LexerAction (Located RlpToken)
 doBol inp l = do
     off <- cmpLayout
-    i <- indentLevel
-    -- traceM $ "i: " <> show i
     -- important that we pop the lex state lest we find our lexer diverging
     case off of
         -- the line is aligned with the previous. it therefore belongs to the

src/Rlp/Parse/Types.hs

@@ -17,6 +17,7 @@ module Rlp.Parse.Types
     -- * Other parser types
     , RlpToken(..), AlexInput(..), Position(..), spanFromPos, LexerAction
     , Located(..), PsName
+    , srcSpanLen
     -- ** Lenses
     , _TokenLitInt, _TokenVarName, _TokenConName, _TokenVarSym, _TokenConSym
     , aiPrevChar, aiSource, aiBytes, aiPos, posLine, posColumn
@@ -277,7 +278,7 @@ initAlexInput s = AlexInput
     { _aiPrevChar   = '\0'
     , _aiSource     = s
     , _aiBytes      = []
-    , _aiPos        = (1,0,0)
+    , _aiPos        = (1,1,0)
     }
 
 --------------------------------------------------------------------------------