Added LSP tests for JSON encoder and decoder

luc-tielen · Sep 23, 2023 · 21bea4f · 21bea4f
1 parent 0346d54
commit 21bea4f
Show file tree

Hide file tree

Showing 2 changed files with 155 additions and 11 deletions.
diff --git a/cabal.project b/cabal.project
@@ -3,12 +3,12 @@ packages: .
 source-repository-package
     type: git
     location: https://github.com/luc-tielen/llvm-codegen.git
-    tag: 42043c279797a4f57e254fcf5e60f3df56f9bf65
+    tag: c97de620ed147388cb6213864d33c63d199561e1
 
 source-repository-package
     type: git
     location: https://github.com/luc-tielen/souffle-haskell.git
-    tag: 51786c809e6b5db9d0da80b9821ed87654f620c7
+    tag: bcd7e3c058c9036d8495cf114520663917b7ac81
 
 source-repository-package
     type: git

diff --git a/tests/eclair/Test/Eclair/LSP/JSONSpec.hs b/tests/eclair/Test/Eclair/LSP/JSONSpec.hs
@@ -8,6 +8,7 @@ import qualified Data.Hermes as H
 import Eclair.Common.Location
 import Eclair.LSP.Types
 import Eclair.LSP.JSON
+import Eclair.LSP.Handlers
 import Eclair.JSON
 import Eclair.TypeSystem
 import Test.Hspec
@@ -21,15 +22,79 @@ decodesAs decoder txt expected =
 spec :: Spec
 spec = describe "LSP JSON processing" $ parallel $ do
   describe "JSON encoding" $ parallel $ do
-    it "can encode response to JSON" pending
+    it "can encode response to JSON" $ do
+      encodeJSON (responseToJSON (HoverResponse (HoverOk (SourceSpan "/etc/passwd" (SourcePos 11 13) (SourcePos 17 19)) U32)))
+        `shouldBe` [text|
+          {"type":"success","hover":{"location":{"file":"/etc/passwd","start":{"line":11,"column":13},"end":{"line":17,"column":19}},"type":"u32"}}
+        |]
+      encodeJSON (responseToJSON (HoverResponse (HoverError "/etc/passwd" (SourcePos 11 13) "sample hover error message")))
+        `shouldBe` [text|
+          {"type":"error","error":{"file":"/etc/passwd","position":{"line":11,"column":13},"message":"sample hover error message"}}
+        |]
+      encodeJSON (responseToJSON (DocumentHighlightResponse (DocHLOk [SourceSpan "/etc/passwd" (SourcePos 11 13) (SourcePos 17 19)])))
+        `shouldBe` [text|
+          {"type":"success","highlights":[{"file":"/etc/passwd","start":{"line":11,"column":13},"end":{"line":17,"column":19}}]}
+        |]
+      encodeJSON (responseToJSON (DocumentHighlightResponse (DocHLError "/etc/passwd" (SourcePos 11 13) "sample highlight error message")))
+        `shouldBe` [text|
+          {"type":"error","error":{"file":"/etc/passwd","position":{"line":11,"column":13},"message":"sample highlight error message"}}
+        |]
+      encodeJSON (responseToJSON (DiagnosticsResponse (DiagnosticsOk [Diagnostic Parser (SourceSpan "/etc/passwd" (SourcePos 11 13) (SourcePos 17 19)) Error "sample diagnostic message"])))
+        `shouldBe` [text|
+          {"type":"success","diagnostics":[{"location":{"file":"/etc/passwd","start":{"line":11,"column":13},"end":{"line":17,"column":19}},"source":"Parser","severity":"error","message":"sample diagnostic message"}]}
+        |]
+      encodeJSON (responseToJSON (DiagnosticsResponse (DiagnosticsError "/etc/passwd" (Just (SourcePos 11 13)) "sample diagnostic error message")))
+        `shouldBe` [text|
+          {"type":"error","error":{"file":"/etc/passwd","position":{"line":11,"column":13},"message":"sample diagnostic error message"}}
+        |]
+      encodeJSON (responseToJSON (DiagnosticsResponse (DiagnosticsError "/etc/passwd" Nothing "sample diagnostic error message")))
+        `shouldBe` [text|
+          {"type":"error","error":{"file":"/etc/passwd","position":{"line":0,"column":0},"message":"sample diagnostic error message"}}
+        |]
+      encodeJSON (responseToJSON SuccessResponse)
+        `shouldBe` [text|
+          {"success":true}
+        |]
+      encodeJSON (responseToJSON ShuttingDown)
+        `shouldBe` [text|
+          {"shutdown":true}
+        |]
 
-    it "can encode diagnostic to JSON" pending
+    it "can encode diagnostic to JSON" $ do
+      encodeJSON (diagnosticToJSON (Diagnostic Parser (SourceSpan "/etc/passwd" (SourcePos 11 13) (SourcePos 17 19)) Error "sample diagnostic message"))
+        `shouldBe` [text|
+          {"location":{"file":"/etc/passwd","start":{"line":11,"column":13},"end":{"line":17,"column":19}},"source":"Parser","severity":"error","message":"sample diagnostic message"}
+        |]
 
-    it "can encode diagnostic source to JSON" pending
+    it "can encode diagnostic source to JSON" $ do
+      encodeJSON (diagnosticSourceToJSON Parser)
+        `shouldBe` [text|
+          "Parser"
+        |]
+      encodeJSON (diagnosticSourceToJSON Typesystem)
+        `shouldBe` [text|
+          "Typesystem"
+        |]
+      encodeJSON (diagnosticSourceToJSON SemanticAnalysis)
+        `shouldBe` [text|
+          "SemanticAnalysis"
+        |]
+      encodeJSON (diagnosticSourceToJSON Transpiler)
+        `shouldBe` [text|
+          "Transpiler"
+        |]
 
-    it "can encode severity to JSON" pending
+    it "can encode severity to JSON" $ do
+      encodeJSON (severityToJSON Error)
+        `shouldBe` [text|
+          "error"
+        |]
 
-    it "can encode source span to JSON" pending
+    it "can encode source span to JSON" $ do
+      encodeJSON (srcSpanToJSON (SourceSpan "/etc/passwd" (SourcePos 11 13) (SourcePos 17 19)))
+        `shouldBe` [text|
+          {"file":"/etc/passwd","start":{"line":11,"column":13},"end":{"line":17,"column":19}}
+        |]
 
     it "can encode source position to JSON" $ do
       encodeJSON (srcPosToJSON (SourcePos 32 58))
@@ -46,7 +111,60 @@ spec = describe "LSP JSON processing" $ parallel $ do
       |]
 
   describe "JSON decoding" $ parallel $ do
-    it "can decode a command from JSON" pending
+    it "can decode a command from JSON" $ do
+      decodesAs
+        commandDecoder
+        [text|
+          {
+            "type": "hover",
+            "command": {
+              "position": {"line": 100, "column": 22},
+              "file": "/tmp/file.eclair"
+            }
+          }
+        |]
+        (Hover "/tmp/file.eclair" (SourcePos 100 22))
+
+    it "can decode a command from JSON" $ do
+      decodesAs
+        commandDecoder
+        [text|
+          {
+            "type": "document-highlight",
+            "command": {
+              "position": {"line": 100, "column": 22},
+              "file": "/tmp/file.eclair"
+            }
+          }
+        |]
+        (DocumentHighlight "/tmp/file.eclair" (SourcePos 100 22))
+
+    it "can decode a command from JSON" $ do
+      decodesAs
+        commandDecoder
+        [text|
+          {
+            "type": "diagnostics",
+            "command": {
+              "file": "/tmp/file.eclair"
+            }
+          }
+        |]
+        (Diagnostics "/tmp/file.eclair")
+
+    it "can decode a command from JSON" $ do
+      decodesAs
+        commandDecoder
+        [text|
+          {
+            "type": "update-vfs",
+            "command": {
+              "file": "/etc/passwd",
+              "contents": "root:*:0:0:System Administrator:/var/root:/bin/sh"
+            }
+          }
+        |]
+        (UpdateVFS "/etc/passwd" "root:*:0:0:System Administrator:/var/root:/bin/sh")
 
     it "can decode a hover command from JSON" $ do
       decodesAs
@@ -59,11 +177,37 @@ spec = describe "LSP JSON processing" $ parallel $ do
         |]
         (Hover "/tmp/file.eclair" (SourcePos 100 22))
 
-    it "can decode a document highlight command from JSON" pending
+    it "can decode a document highlight command from JSON" $ do
+      decodesAs
+        referencesDecoder
+        [text|
+          {
+            "position": {"line": 100, "column": 22},
+            "file": "/tmp/file.eclair"
+          }
+        |]
+        (DocumentHighlight "/tmp/file.eclair" (SourcePos 100 22))
 
-    it "can decode a diagnostics command from JSON" pending
+    it "can decode a diagnostics command from JSON" $ do
+      decodesAs
+        diagnosticsDecoder
+        [text|
+          {
+            "file": "/etc/passwd"
+          }
+        |]
+        (Diagnostics "/etc/passwd")
 
-    it "can decode a update-vfs command from JSON" pending
+    it "can decode a update-vfs command from JSON" $ do
+      decodesAs
+        updateVfsDecoder
+        [text|
+          {
+            "file": "/etc/passwd",
+            "contents": "root:*:0:0:System Administrator:/var/root:/bin/sh"
+          }
+        |]
+        (UpdateVFS "/etc/passwd" "root:*:0:0:System Administrator:/var/root:/bin/sh")
 
     it "can decode a source position from JSON" $ do
       decodesAs