diff --git a/tools/lsp/squirrel/src/AST.hs b/tools/lsp/squirrel/src/AST.hs index fe8a15e9a..aa05217c7 100644 --- a/tools/lsp/squirrel/src/AST.hs +++ b/tools/lsp/squirrel/src/AST.hs @@ -2,4 +2,5 @@ module AST (module M) where import AST.Types as M -import AST.Parser as M \ No newline at end of file +import AST.Parser as M +import AST.Pretty () \ No newline at end of file diff --git a/tools/lsp/squirrel/src/AST/Pretty.hs b/tools/lsp/squirrel/src/AST/Pretty.hs new file mode 100644 index 000000000..ccc3d0245 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/tools/lsp/squirrel/src/AST/Types.hs b/tools/lsp/squirrel/src/AST/Types.hs index 755c2b948..e51c3d323 100644 --- a/tools/lsp/squirrel/src/AST/Types.hs +++ b/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 diff --git a/tools/lsp/squirrel/src/ParseTree.hs b/tools/lsp/squirrel/src/ParseTree.hs index a75fd7ca6..f71acbf71 100644 --- a/tools/lsp/squirrel/src/ParseTree.hs +++ b/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)) - <+> brackets - ( int sr <> ":" <> int sc - <> " - " - <> int fr <> ":" <> int fc - ) - ) + (quotes (text (Text.unpack n)) <+> pp r) 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 } \ No newline at end of file diff --git a/tools/lsp/squirrel/src/Parser.hs b/tools/lsp/squirrel/src/Parser.hs index 2d3150b3e..20d6754c1 100644 --- a/tools/lsp/squirrel/src/Parser.hs +++ b/tools/lsp/squirrel/src/Parser.hs @@ -19,8 +19,11 @@ import Range import Debug.Trace data Error - = Expected Text Range - | Unexpected Range + = Expected + { 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 msg = (stub . Expected msg) <$> getRange - -die :: Text -> Parser a -die msg = throwError . Expected msg =<< getRange +fallback :: Stubbed a => Text -> Parser a +fallback' :: Stubbed a => Text -> Range -> Parser a +die :: Text -> Parser a +die' :: Text -> Range -> Parser a +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 - return (cutOut source tree) + cutOut ptRange else do - throwError $ Expected node ptRange + die' node ptRange anything :: Parser Text anything = do tree <- takeNext "anything" - source <- asks peSource - return (cutOut source tree) + cutOut $ ptRange 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 bs (ParseTree _ _ s f _ _) = - decodeUtf8 $ ByteString.take (f - s) (ByteString.drop s bs) +cutOut :: Range -> Parser Text +cutOut (Range (_, _, s) (_, _, f)) = do + bs <- asks peSource + return $ decodeUtf8 $ ByteString.take (f - s) (ByteString.drop s bs) range :: Parser a -> Parser (a, Range) range parser = diff --git a/tools/lsp/squirrel/src/Range.hs b/tools/lsp/squirrel/src/Range.hs index 6bd940b66..ef89b9906 100644 --- a/tools/lsp/squirrel/src/Range.hs +++ b/tools/lsp/squirrel/src/Range.hs @@ -1,12 +1,18 @@ module Range where +import PrettyPrint + data Range = Range - { rStart :: (Int, Int) - , rFinish :: (Int, Int) + { rStart :: (Int, 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 \ No newline at end of file