diff --git a/eclair-lang.cabal b/eclair-lang.cabal index 6944caf..a6d7f81 100644 --- 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 index 0c65a21..3333321 100644 --- 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 index 3bdcfce..38d66c9 100644 --- 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 index 5c4468d..28b5a1f 100644 --- 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,12 +69,12 @@ 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) @@ -83,7 +82,7 @@ responseToJSON = \case 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) @@ -91,19 +90,19 @@ responseToJSON = \case 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 index 835ae9b..4bbaa7e 100644 --- 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 new file mode 100644 index 0000000..60eefac --- /dev/null +++ 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)