Start adding tests for LSP mode

luc-tielen · Sep 17, 2023 · d8b3f13 · d8b3f13
1 parent a1bd9cb
commit d8b3f13
Show file tree

Hide file tree

Showing 6 changed files with 96 additions and 22 deletions.
diff --git a/eclair-lang.cabal b/eclair-lang.cabal
@@ -250,10 +250,13 @@ executable eclair
 test-suite eclair-test
   type:               exitcode-stdio-1.0
   main-is:            test.hs
+
+  -- cabal-fmt: expand tests/eclair
   other-modules:
     Paths_eclair_lang
     Test.Eclair.ArgParserSpec
     Test.Eclair.LLVM.HashSpec
+    Test.Eclair.LSP.JSONSpec
     Test.Eclair.RA.IndexSelectionSpec
 
   autogen-modules:    Paths_eclair_lang
@@ -302,6 +305,7 @@ test-suite eclair-test
     , hspec                        >=2.6.1 && <3.0.0
     , hspec-hedgehog               <1
     , llvm-codegen
+    , hermes-json                  <1
     , megaparsec                   >=9     && <10
     , mmorph                       >=1     && <2
     , mtl                          >=2     && <3

diff --git a/lib/Eclair/Common/Location.hs b/lib/Eclair/Common/Location.hs
@@ -69,7 +69,7 @@ data SourcePos
   = SourcePos
   { sourcePosLine :: {-# UNPACK #-} !Int
   , sourcePosColumn :: {-# UNPACK #-} !Int
-  } deriving (Eq, Ord)
+  } deriving (Eq, Ord, Show)
 
 data SourceSpan
   = SourceSpan

diff --git a/lib/Eclair/JSON.hs b/lib/Eclair/JSON.hs
@@ -7,7 +7,6 @@ module Eclair.JSON
   , encodeJSON
   ) where
 
-import qualified Data.HashMap.Strict as HM
 import Data.Text.Builder.Linear.Buffer
 import GHC.Prim (Addr#)
 
@@ -16,7 +15,7 @@ data JSON
   | Boolean Bool
   | Number Int
   | String Text
-  | Object (HashMap Text JSON)
+  | Object [(Text, JSON)]
   | Array [JSON]
 
 encodeJSON :: JSON -> Text
@@ -33,13 +32,12 @@ encodeJSON json =
         buf |> show x
       String s ->
         dquotes buf (|> s)
-      Object kvPairs ->
-        let pairs = HM.toList kvPairs
-        in braces buf (\buf' ->
-             sepBy ","# buf' pairs (\buf'' (k, v) ->
-               (dquotes buf'' (|> k) |>. ':') `toJSON'` v
-             )
-           )
+      Object pairs ->
+        braces buf (\buf' ->
+          sepBy ","# buf' pairs (\buf'' (k, v) ->
+            (dquotes buf'' (|> k) |>. ':') `toJSON'` v
+          )
+        )
       Array elems ->
         brackets buf (\buf' -> sepBy ","# buf' elems toJSON')
 

diff --git a/lib/Eclair/LSP/JSON.hs b/lib/Eclair/LSP/JSON.hs
@@ -21,7 +21,6 @@ import Eclair.TypeSystem hiding (typeCheck)
 import Eclair.LSP.Handlers
 import Eclair.LSP.Types
 import Eclair.Common.Location
-import qualified Data.HashMap.Strict as HM
 
 commandDecoder :: H.Decoder Command
 commandDecoder = H.object $ do
@@ -70,40 +69,40 @@ srcPosDecoder = H.object $
 responseToJSON :: Response -> J.JSON
 responseToJSON = \case
   HoverResponse (HoverOk srcSpan ty) ->
-    J.Object $ HM.fromList
+    J.Object
       [ ("location", srcSpanToJSON srcSpan)
       , ("type", typeToJSON ty)
       ]
   HoverResponse (HoverError path pos err) ->
-    J.Object $ HM.fromList
+    J.Object
       [ ("file", J.String $ toText path)
       , ("position", srcPosToJSON pos)
       , ("error", J.String err)
       ]
   DocumentHighlightResponse (DocHLOk refs) ->
     J.Array $ map srcSpanToJSON refs
   DocumentHighlightResponse (DocHLError path pos err) ->
-    J.Object $ HM.fromList
+    J.Object
       [ ("file", J.String $ toText path)
       , ("position", srcPosToJSON pos)
       , ("error", J.String err)
       ]
   DiagnosticsResponse (DiagnosticsOk diagnostics) ->
     J.Array $ map diagnosticToJSON diagnostics
   DiagnosticsResponse (DiagnosticsError path mPos err) ->
-    J.Object $ HM.fromList
+    J.Object
       [ ("file", J.String $ toText path)
       , ("position", srcPosToJSON $ fromMaybe (SourcePos 0 0) mPos)
       , ("error", J.String err)
       ]
   SuccessResponse ->
-    J.Object $ HM.fromList [("success", J.Boolean True)]
+    J.Object [("success", J.Boolean True)]
   ShuttingDown ->
-    J.Object $ HM.fromList [("shutdown", J.Boolean True)]
+    J.Object [("shutdown", J.Boolean True)]
 
 diagnosticToJSON :: Diagnostic -> J.JSON
 diagnosticToJSON (Diagnostic source srcSpan severity msg) =
-  J.Object $ HM.fromList
+  J.Object
     [ ("location", srcSpanToJSON srcSpan)
     , ("source", diagnosticSourceToJSON source)
     , ("severity", severityToJSON severity)
@@ -120,14 +119,14 @@ severityToJSON Error =
 
 srcSpanToJSON :: SourceSpan -> J.JSON
 srcSpanToJSON srcSpan =
-  J.Object $ HM.fromList
+  J.Object
     [ ("file", J.String $ toText path)
-    , ("start", J.Object $ HM.fromList
+    , ("start", J.Object
         [ ("line", J.Number $ sourcePosLine start)
         , ("column", J.Number $ sourcePosColumn start)
         ]
       )
-    , ("end", J.Object $ HM.fromList
+    , ("end", J.Object
         [ ("line", J.Number $ sourcePosLine end)
         , ("column", J.Number $ sourcePosColumn end)
         ]
@@ -140,7 +139,7 @@ srcSpanToJSON srcSpan =
 
 srcPosToJSON :: SourcePos -> J.JSON
 srcPosToJSON pos =
-  J.Object $ HM.fromList
+  J.Object
     [ ("line", J.Number $ sourcePosLine pos)
     , ("column", J.Number $ sourcePosColumn pos)
     ]

diff --git a/lib/Eclair/LSP/Types.hs b/lib/Eclair/LSP/Types.hs
@@ -12,6 +12,7 @@ data Command
   | Diagnostics FilePath
   | UpdateVFS FilePath Text
   | Shutdown
+  deriving (Eq, Show)
 
 data Response
   = HoverResponse HoverResult

diff --git a/tests/eclair/Test/Eclair/LSP/JSONSpec.hs b/tests/eclair/Test/Eclair/LSP/JSONSpec.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Test.Eclair.LSP.JSONSpec
+  ( module Test.Eclair.LSP.JSONSpec
+  ) where
+
+import qualified Data.Hermes as H
+import Eclair.Common.Location
+import Eclair.LSP.Types
+import Eclair.LSP.JSON
+import Eclair.JSON
+import Eclair.TypeSystem
+import Test.Hspec
+import NeatInterpolation
+
+decodesAs :: (Eq a, Show a) => H.Decoder a -> Text -> a -> IO ()
+decodesAs decoder txt expected =
+  H.decodeEither decoder (encodeUtf8 txt)
+    `shouldBe` Right 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 diagnostic to JSON" pending
+
+    it "can encode diagnostic source to JSON" pending
+
+    it "can encode severity to JSON" pending
+
+    it "can encode source span to JSON" pending
+
+    it "can encode source position to JSON" $ do
+      encodeJSON (srcPosToJSON (SourcePos 32 58))
+        `shouldBe` [text|
+          {"line":32,"column":58}
+        |]
+
+    it "can encode type to JSON" $ do
+      encodeJSON (typeToJSON U32) `shouldBe` [text|
+        "u32"
+      |]
+      encodeJSON (typeToJSON Str) `shouldBe` [text|
+        "string"
+      |]
+
+  describe "JSON decoding" $ parallel $ do
+    it "can decode a command from JSON" pending
+
+    it "can decode a hover command from JSON" $ do
+      decodesAs
+        hoverDecoder
+        [text|
+          {
+            "position": {"line": 100, "column": 22},
+            "file": "/tmp/file.eclair"
+          }
+        |]
+        (Hover "/tmp/file.eclair" (SourcePos 100 22))
+
+    it "can decode a document highlight command from JSON" pending
+
+    it "can decode a diagnostics command from JSON" pending
+
+    it "can decode a update-vfs command from JSON" pending
+
+    it "can decode a source position from JSON" $ do
+      decodesAs
+        srcPosDecoder
+        [text|{"line": 42, "column": 10}|]
+        (SourcePos 42 10)