Fix dying on broken code and handle errors in Main.hs

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

src/test/contracts/negative/fail2.ligo

@@ -0,0 +1,4 @@
+function hello (const x : int) : return
+  block {
+      const boom : int = x
+  } with boom

tools/lsp/squirrel/app/Main.hs

@@ -9,6 +9,7 @@ import           Data.Default
 -- import           Data.Foldable
 import qualified Data.Text                             as Text
 import           Data.Text                                     (Text)
+import           Data.String                                   (fromString)
 import           Data.String.Interpolate                       (i)
 
 import qualified Language.Haskell.LSP.Control          as CTRL
@@ -157,34 +158,43 @@ eventLoop funs chan = do
           (Just 0)
 
       ReqDefinition req -> do
+        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 req RspDefinition $ J.MultiLoc [J.Location uri $ rangeToLoc defPos]
+              respondWith funs req RspDefinition $ J.MultiLoc [J.Location uri $ rangeToLoc defPos]
             Nothing -> do
-            respondWith req RspDefinition $ J.MultiLoc []
+              respondWith funs req RspDefinition $ J.MultiLoc []
 
       ReqFindReferences req -> do
+        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 req RspFindReferences $ J.List locations
+              respondWith funs req RspFindReferences $ J.List locations
             Nothing -> do
-            respondWith req RspFindReferences $ J.List []
+              respondWith funs req RspFindReferences $ J.List []
 
       _ -> U.logs "unknown msg"
-  where
+
 respondWith
-      :: J.RequestMessage J.ClientMethod req rsp
+  :: Core.LspFuncs ()
+  -> 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 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) ""

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"

tools/lsp/squirrel/src/Parser.hs

@@ -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:"