Add byte offsets to Range

tools/lsp/squirrel/src/AST.hs

@@ -3,3 +3,4 @@ module AST (module M) where
 
 import AST.Types as M
 import AST.Parser as M
+import AST.Pretty ()

tools/lsp/squirrel/src/AST/Pretty.hs

@@ -0,0 +1,22 @@
+
+module AST.Pretty () where
+
+import AST.Types
+import PrettyPrint
+import Parser
+
+-- instance Pretty (Contract i) where
+--   pp (Contract _ decls) =
+--     hang "(* contract *)" 2 do
+--       vcat $ map (($$ empty) . pp) decls
+
+--   pp (WrongContract err) =
+--     pp err
+
+-- instance Pretty Error where
+--   pp
+
+-- instance Pretty (Declaration i) where
+--   pp (
+
+-- wrap [l, r] a = hang (hang l 2 r) 0 r

tools/lsp/squirrel/src/AST/Types.hs

@@ -1,5 +1,5 @@
 
-{- annotate tree with ranges, add offsets to ranges, store verbatim in Wrong* -}
+{- TODO(kirill.andreev): add offsets to ranges, store verbatim in Wrong* -}
 
 module AST.Types where
 

tools/lsp/squirrel/src/ParseTree.hs

@@ -42,8 +42,6 @@ getNodeTypesPath = getDataFileName "../pascaligo/src/node-types.json"
 data ParseTree = ParseTree
   { ptID       :: Int
   , ptName     :: Text.Text
-  , ptStart    :: Int
-  , ptFinish   :: Int
   , ptRange    :: Range
   , ptChildren :: ParseForest
   }
@@ -61,16 +59,10 @@ instance Show ParseForest where
   show = show . pp
 
 instance Pretty ParseTree where
-  pp (ParseTree _ n _ _ (Range (sr, sc) (fr, fc)) forest) =
+  pp (ParseTree _ n r forest) =
     parens
       ( hang
-        (   quotes (text (Text.unpack n))
+        (quotes (text (Text.unpack n)) <+> pp r)
-        <+> brackets
-          ( int sr <> ":" <> int sc
-          <> " - "
-          <> int fr <> ":" <> int fc
-          )
-        )
         2
         (pp forest)
       )
@@ -123,8 +115,6 @@ toParseTree fin = do
 
           ty <- peekCString $ nodeType node
 
-          TSNode start _ _ _ _ <- peek tsNodePtr
-
           let
             start2D  = nodeStartPoint node
             finish2D = nodeEndPoint   node
@@ -138,19 +128,19 @@ toParseTree fin = do
               { rStart  =
                   ( i $ pointRow    start2D + 1
                   , i $ pointColumn start2D + 1
+                  , i $ nodeStartByte node
                   )
 
               , rFinish =
                   ( i $ pointRow    finish2D + 1
                   , i $ pointColumn finish2D + 1
+                  , i $ nodeEndByte node
                   )
               }
 
           return $ ParseTree
             { ptID       = treeID
             , ptName     = Text.pack ty
-            , ptStart    = fromIntegral start
-            , ptFinish   = fromIntegral $ nodeEndByte node
             , ptRange    = range
             , ptChildren = Forest fID trees range
             }

tools/lsp/squirrel/src/Parser.hs

@@ -19,8 +19,11 @@ import Range
 import Debug.Trace
 
 data Error
-  = Expected Text Range
+  = Expected
-  | Unexpected Range
+    { eMsg   :: Text
+    , eWhole :: Text
+    , eRange :: Range
+    }
   deriving stock (Show)
 
 newtype Parser a = Parser
@@ -42,6 +45,21 @@ newtype Parser a = Parser
     , MonadError   Error
     )
 
+makeError :: Text -> Parser Error
+makeError msg = do
+  rng <- getRange
+  makeError' msg rng
+
+makeError' :: Text -> Range -> Parser Error
+makeError' msg rng = do
+  rng <- getRange
+  src <- cutOut rng
+  return Expected
+    { eMsg   = msg
+    , eWhole = src
+    , eRange = rng
+    }
+
 takeNext :: Text -> Parser ParseTree
 takeNext msg = do
   st@Forest {pfGrove, pfRange} <- get
@@ -82,11 +100,16 @@ field name parser = do
         , pfRange = if firstOne then diffRange rng ptRange else rng
         }
 
-fallback :: Stubbed a => Text -> Parser a
+fallback  :: Stubbed a => Text          -> Parser a
-fallback msg = (stub . Expected msg) <$> getRange
+fallback' :: Stubbed a => Text -> Range -> Parser a
-
+die       ::              Text          -> Parser a
-die :: Text -> Parser a
+die'      ::              Text -> Range -> Parser a
-die msg = throwError . Expected msg =<< getRange
+complain  ::              Text -> Range -> Parser ()
+fallback  msg     = pure . stub =<< makeError  msg
+fallback' msg rng = pure . stub =<< makeError' msg rng
+die       msg     = throwError  =<< makeError  msg
+die'      msg rng = throwError  =<< makeError' msg rng
+complain  msg rng = tell . pure =<< makeError' msg rng
 
 stubbed :: Stubbed a => Text -> Parser a -> Parser a
 stubbed msg parser = do
@@ -174,33 +197,32 @@ token node = do
   tree@ParseTree {ptName, ptRange} <- takeNext node
   if ptName == node
   then do
-    source <- asks peSource
+    cutOut ptRange
-    return (cutOut source tree)
 
   else do
-    throwError $ Expected node ptRange
+    die' node ptRange
 
 anything :: Parser Text
 anything = do
   tree <- takeNext "anything"
-  source <- asks peSource
+  cutOut $ ptRange tree
-  return (cutOut source tree)
 
 consume :: Text -> Parser ()
 consume node = do
   ParseTree {ptName, ptRange} <- takeNext node
   when (ptName /= node) do
-    tell [Expected node ptRange]
+    complain node ptRange
 
 consumeOrDie :: Text -> Parser ()
 consumeOrDie node = do
   ParseTree {ptName, ptRange} <- takeNext node
   when (ptName /= node) do
-    throwError $ Expected node ptRange
+    die' node ptRange
 
-cutOut :: ByteString -> ParseTree -> Text
+cutOut :: Range -> Parser Text
-cutOut bs (ParseTree _ _ s f _ _) =
+cutOut (Range (_, _, s) (_, _, f)) = do
-  decodeUtf8 $ ByteString.take (f - s) (ByteString.drop s bs)
+  bs <- asks peSource
+  return $ decodeUtf8 $ ByteString.take (f - s) (ByteString.drop s bs)
 
 range :: Parser a -> Parser (a, Range)
 range parser =

tools/lsp/squirrel/src/Range.hs

@@ -1,12 +1,18 @@
 
 module Range where
 
+import PrettyPrint
+
 data Range = Range
-  { rStart  :: (Int, Int)
+  { rStart  :: (Int, Int, Int)
-  , rFinish :: (Int, Int)
+  , rFinish :: (Int, Int, Int)
   }
   deriving stock (Show)
 
 diffRange :: Range -> Range -> Range
 diffRange (Range ws wf) (Range ps _) = Range (max ws ps) wf
 
+instance Pretty Range where
+  pp (Range (ll, lc, _) (rl, rc, _)) =
+    brackets do
+      int ll <> ":" <> int lc <> "-" <> int rl <> ":" <> int rc