From 58e5128142540bac4fdcc36a57b7b863c7502e35 Mon Sep 17 00:00:00 2001 From: Kirill Andreev Date: Mon, 13 Jul 2020 15:26:32 +0400 Subject: [PATCH] Fix dying on broken code and handle errors in Main.hs --- src/test/contracts/negative/fail1.ligo | 6 +++ src/test/contracts/negative/fail2.ligo | 4 ++ tools/lsp/squirrel/app/Main.hs | 68 +++++++++++++++----------- tools/lsp/squirrel/src/AST/Parser.hs | 4 +- tools/lsp/squirrel/src/Parser.hs | 12 +++-- 5 files changed, 59 insertions(+), 35 deletions(-) create mode 100644 src/test/contracts/negative/fail1.ligo create mode 100644 src/test/contracts/negative/fail2.ligo diff --git a/src/test/contracts/negative/fail1.ligo b/src/test/contracts/negative/fail1.ligo new file mode 100644 index 000000000..7d1870006 --- /dev/null +++ b/src/test/contracts/negative/fail1.ligo @@ -0,0 +1,6 @@ +function hello (const x : int) : return is + block { + const boom : int = + if boom > x + else x; + } with boom diff --git a/src/test/contracts/negative/fail2.ligo b/src/test/contracts/negative/fail2.ligo new file mode 100644 index 000000000..078baf5b6 --- /dev/null +++ b/src/test/contracts/negative/fail2.ligo @@ -0,0 +1,4 @@ +function hello (const x : int) : return + block { + const boom : int = x + } with boom \ No newline at end of file diff --git a/tools/lsp/squirrel/app/Main.hs b/tools/lsp/squirrel/app/Main.hs index 2e256c2c1..876fb155b 100644 --- a/tools/lsp/squirrel/app/Main.hs +++ b/tools/lsp/squirrel/app/Main.hs @@ -1,15 +1,16 @@ import Control.Concurrent import Control.Concurrent.STM -import Control.Exception as E +import Control.Exception as E import Control.Lens import Control.Monad import Data.Default -- import Data.Foldable import qualified Data.Text as Text -import Data.Text (Text) -import Data.String.Interpolate (i) +import Data.Text (Text) +import Data.String (fromString) +import Data.String.Interpolate (i) import qualified Language.Haskell.LSP.Control as CTRL import qualified Language.Haskell.LSP.Core as Core @@ -27,8 +28,8 @@ import Parser import ParseTree import Range import Product -import AST hiding (def) -import qualified AST.Find as Find +import AST hiding (def) +import qualified AST.Find as Find import Error main :: IO () @@ -157,34 +158,43 @@ eventLoop funs chan = do (Just 0) ReqDefinition req -> do - let uri = req^.J.params.J.textDocument.J.uri - let pos = posToRange $ req^.J.params.J.position - tree <- loadByURI uri - case Find.definitionOf pos tree of - Just defPos -> do - respondWith req RspDefinition $ J.MultiLoc [J.Location uri $ rangeToLoc defPos] - Nothing -> do - respondWith req RspDefinition $ J.MultiLoc [] + stopDyingAlready funs req do + let uri = req^.J.params.J.textDocument.J.uri + let pos = posToRange $ req^.J.params.J.position + tree <- loadByURI uri + case Find.definitionOf pos tree of + Just defPos -> do + respondWith funs req RspDefinition $ J.MultiLoc [J.Location uri $ rangeToLoc defPos] + Nothing -> do + respondWith funs req RspDefinition $ J.MultiLoc [] ReqFindReferences req -> do - let uri = req^.J.params.J.textDocument.J.uri - let pos = posToRange $ req^.J.params.J.position - tree <- loadFromVFS funs uri - case Find.referencesOf pos tree of - Just refs -> do - let locations = J.Location uri . rangeToLoc <$> refs - respondWith req RspFindReferences $ J.List locations - Nothing -> do - respondWith req RspFindReferences $ J.List [] + stopDyingAlready funs req do + let uri = req^.J.params.J.textDocument.J.uri + let pos = posToRange $ req^.J.params.J.position + tree <- loadFromVFS funs uri + case Find.referencesOf pos tree of + Just refs -> do + let locations = J.Location uri . rangeToLoc <$> refs + respondWith funs req RspFindReferences $ J.List locations + Nothing -> do + respondWith funs req RspFindReferences $ J.List [] _ -> U.logs "unknown msg" - where - respondWith - :: J.RequestMessage J.ClientMethod req rsp - -> (J.ResponseMessage rsp -> FromServerMessage) - -> rsp - -> IO () - respondWith req wrap rsp = Core.sendFunc funs $ wrap $ Core.makeResponseMessage req rsp + +respondWith + :: Core.LspFuncs () + -> J.RequestMessage J.ClientMethod req rsp + -> (J.ResponseMessage rsp -> FromServerMessage) + -> rsp + -> IO () +respondWith funs req wrap rsp = Core.sendFunc funs $ wrap $ Core.makeResponseMessage req rsp + +stopDyingAlready :: Core.LspFuncs () -> J.RequestMessage m a b -> IO () -> IO () +stopDyingAlready funs req = flip catch \(e :: SomeException) -> do + Core.sendErrorResponseS (Core.sendFunc funs) (req^.J.id.to J.responseId) J.InternalError + $ fromString + $ "this happened: " ++ show e posToRange :: J.Position -> Range posToRange (J.Position l c) = Range (l + 1, c + 1, 0) (l + 1, c + 1, 0) "" diff --git a/tools/lsp/squirrel/src/AST/Parser.hs b/tools/lsp/squirrel/src/AST/Parser.hs index ce861c16f..69010137b 100644 --- a/tools/lsp/squirrel/src/AST/Parser.hs +++ b/tools/lsp/squirrel/src/AST/Parser.hs @@ -915,12 +915,12 @@ example :: FilePath -- example = "../../../src/test/contracts/bytes_arithmetic.ligo" -- example = "../../../src/test/contracts/bytes_unpack.ligo" -- example = "../../../src/test/contracts/chain_id.ligo" -example = "../../../src/test/contracts/coase.ligo" +-- example = "../../../src/test/contracts/coase.ligo" -- example = "../../../src/test/contracts/failwith.ligo" -- example = "../../../src/test/contracts/loop.ligo" -- example = "../../../src/test/contracts/redeclaration.ligo" -- example = "../../../src/test/contracts/includer.ligo" -- example = "../../../src/test/contracts/namespaces.ligo" -- example = "../../../src/test/contracts/blocks.ligo" --- example = "../../../src/test/contracts/application.ligo" +example = "../../../src/test/contracts/negative/fail1.ligo" -- example = "../../../src/test/contracts/application.ligo" diff --git a/tools/lsp/squirrel/src/Parser.hs b/tools/lsp/squirrel/src/Parser.hs index 60153d410..6b3140a9d 100644 --- a/tools/lsp/squirrel/src/Parser.hs +++ b/tools/lsp/squirrel/src/Parser.hs @@ -94,7 +94,7 @@ import Debug.Trace -- type Parser = WriterT [Error ASTInfo] - (StateT (Product PList) + (StateT (Product PList) IO) type PList = [ParseForest, [Text], FilePath, Set.Set FilePath] @@ -103,7 +103,8 @@ type PList = [ParseForest, [Text], FilePath, Set.Set FilePath] type ASTInfo = Product [Range, [Text]] runParser - :: Parser a + :: Stubbed a ASTInfo + => Parser a -> Source -> IO (a, [Error ASTInfo]) runParser parser fin = do @@ -117,9 +118,12 @@ runParser parser fin = do (Cons dir (Cons Set.empty Nil))) + `catch` \(e :: Error ASTInfo) -> do + return $ (stub e, []) runParser' - :: Parser a + :: Stubbed a ASTInfo + => Parser a -> Source -> IO a runParser' parser fin = fst <$> runParser parser fin @@ -326,7 +330,7 @@ some p = some' -- | Run parser on given file and pretty-print stuff. -- -debugParser :: Show a => Parser a -> Source -> IO () +debugParser :: (Show a, Stubbed a ASTInfo) => Parser a -> Source -> IO () debugParser parser fin = do (res, errs) <- runParser parser fin putStrLn "Result:"