Revise LSP hover details to produce new documentation

pact-lsp/Pact/Core/LanguageServer.hs

@@ -52,6 +52,7 @@ import Pact.Core.IR.Term
 import Pact.Core.LanguageServer.Utils
 import Pact.Core.LanguageServer.Renaming
 import Pact.Core.Repl.BuiltinDocs
+import Pact.Core.Repl.BuiltinDocs.Internal
 import Pact.Core.Repl.UserDocs
 import Pact.Core.Names
 import qualified Pact.Core.IR.ModuleHashing as MHash
@@ -304,19 +305,19 @@ documentHoverRequestHandler = requestHandler SMethod_TextDocumentHover $ \req re
     case getMatch pos =<< view (lsTopLevel . at nuri) st of
       Just tlm -> case tlm of
         TermMatch (Builtin builtin i) -> let
-                docs = fromMaybe "No docs available"
+                docs = fromMaybe (MarkdownDoc "*No docs available*")
                   (M.lookup (replCoreBuiltinToUserText builtin) builtinDocs)
 
-                mc = MarkupContent MarkupKind_PlainText docs
+                mc = MarkupContent MarkupKind_Markdown (_markdownDoc docs)
                 range = spanInfoToRange i
                 hover = Hover (InL mc) (Just range)
                 in resp (Right (InL hover))
 
         TermMatch (Var (Name n (NTopLevel mn _)) _) ->
           -- Access user-annotated documentation using the @doc command.
           let qn = QualifiedName n mn
-              toHover d = Hover (InL $ MarkupContent MarkupKind_PlainText d) Nothing
-              doc = preview (lsReplState . at nuri . _Just . replUserDocs . ix qn) st
+              toHover d = Hover (InL $ MarkupContent MarkupKind_Markdown (_markdownDoc d)) Nothing
+              doc = MarkdownDoc <$> preview (lsReplState . at nuri . _Just . replUserDocs . ix qn) st
           in resp (Right (maybeToNull (toHover <$> doc)))
         _ ->  resp (Right (InR Null))
       Nothing -> do

pact-tests/Pact/Core/Test/DocsTests.hs

@@ -0,0 +1,64 @@
+module Pact.Core.Test.DocsTests (tests) where
+
+import Control.Monad
+import qualified Data.Set as S
+import Data.Text (Text)
+import qualified Data.Text as T
+import Pact.Core.Builtin
+import Paths_pact_tng
+import System.Directory
+import System.FilePath
+import Test.Tasty
+import Test.Tasty.HUnit
+
+tests :: IO TestTree
+tests = do
+  let baseDir = "docs/builtins"
+  cats <- listDirectory baseDir
+  builtinWithDocs <- join <$> traverse (\cat -> map (T.pack . takeBaseName) <$> listDirectory (baseDir </> cat)) cats
+  pure $
+    testGroup
+      "Documentation Tests"
+      [ docsExistsTest builtinWithDocs
+      ]
+
+docsExistsTest :: [Text] -> TestTree
+docsExistsTest b = testCase "Builtins should have docs" $ do
+  let normBuiltins = normalizeBuiltinName <$> replCoreBuiltinNames
+  let diff = (S.fromList normBuiltins `S.difference` excluded) `S.difference` S.fromList b
+  assertEqual "Missing builtins should be empty" S.empty diff
+  where
+    excluded = S.fromList
+      ["cond", "env-ask-gasmodel", "env-chain-data", "env-exec-config"
+      ,"env-gaslog", "env-gasmodel-fixed", "env-milligas", "env-module-admin"
+      ,"env-set-milligas", "env-stackframe", "env-verifiers", "negate"
+      ,"pact-state", "print", "reset-pact-state", "rollback-tx", "show"
+      ,"sig-keyset", "test-capability"]
+
+normalizeBuiltinName :: Text -> Text
+normalizeBuiltinName = \case
+  "!=" -> "neq"
+  "&" -> "and"
+  "*" -> "mult"
+  "+" -> "add"
+  "-" -> "sub"
+  "/" -> "div"
+  "<" -> "lt"
+  "<=" -> "leq"
+  "=" -> "eq"
+  ">" -> "gt"
+  ">=" -> "geq"
+  "^" -> "pow"
+  "and?" -> "and-q"
+  "not?" -> "not-q"
+  "or?" -> "or-q"
+  "|" -> "bitwise-or"
+  "~" -> "bitwise-reverse"
+  "begin-named-tx" -> "begin-tx"
+  "continue-pact-rollback-yield" -> "continue-pact"
+  "continue-pact-rollback-yield-object" -> "continue-pact"
+  "continue-pact-with-rollback" -> "continue-pact"
+  "enforce-pact-version-range" -> "enforce-pact-version"
+  "env-set-gas" -> "env-gas"
+  "expect-failure-match" -> "expect-failure"
+  other -> other

pact-tests/Pact/Core/Test/LanguageServer.hs

@@ -26,6 +26,7 @@ import Pact.Core.Builtin
 import Data.Maybe (isJust)
 import qualified Data.Map.Strict as M
 import Pact.Core.Repl.BuiltinDocs
+import Pact.Core.Repl.BuiltinDocs.Internal
 import Data.Either (isLeft)
 import Data.Text.Encoding
 import qualified Data.ByteString.Lazy as LBS
@@ -66,7 +67,7 @@ userDocHoverTests = [hoverTest "defun my-fun" 11 "This is my-fun documentation"]
       liftIO $ do
         assertBool "Return hover information" (isJust h)
         let Just hov' = h
-        assertEqual "Match builtin docs" (view contents hov') (InL $ MarkupContent MarkupKind_PlainText expected)
+        assertEqual "Match builtin docs" (view contents hov') (InL $ MarkupContent MarkupKind_Markdown expected)
 
 
 definitionRequestTests :: [TestTree]
@@ -106,8 +107,8 @@ builtinHoverTests
         assertBool "Return hover information" (isJust h)
         let
           Just hov' = h
-          Just expectedDocs =  M.lookup (replCoreBuiltinToUserText b) builtinDocs
-        assertEqual "Match builtin docs" (view contents hov') (InL $ MarkupContent MarkupKind_PlainText expectedDocs)
+          Just (MarkdownDoc expectedDocs) =  M.lookup (replCoreBuiltinToUserText b) builtinDocs
+        assertEqual "Match builtin docs" (view contents hov') (InL $ MarkupContent MarkupKind_Markdown expectedDocs)
 
 overloadBuiltinHoverTests :: [TestTree]
 overloadBuiltinHoverTests

pact-tests/PactCoreTests.hs

@@ -16,13 +16,15 @@ import qualified Pact.Core.Test.LanguageServer as LanguageServer
 import qualified Pact.Core.Test.GasGolden as GasGolden
 import qualified Pact.Core.Test.SizeOfTests as SizeOfTests
 import qualified Pact.Core.Test.ConTagGolden as ConTagGoldenTests
+import qualified Pact.Core.Test.DocsTests as DocsTests
 
 main :: IO ()
 main = do
   replTests <- ReplTests.tests
   gasGolden <- GasGolden.tests
   legacyTests <- LegacySerialiseTests.tests
   commandTests <- CommandTests.tests
+  docsTests <- DocsTests.tests
   defaultMain $ testGroup "pactTests"
     [ replTests
     , LexerTests.tests
@@ -38,5 +40,6 @@ main = do
     , SizeOfTests.tests
     , commandTests
     , ConTagGoldenTests.tests
+    , docsTests
     ]
 

pact-tng.cabal

@@ -24,6 +24,7 @@ extra-source-files:
     cbits/musl/log_data.h
     cbits/musl/pow_data.h
     cbits/musl/sqrt_data.h
+    docs/builtins/**/*.md
 
 flag with-crypto
   description: Enable crypto primitives
@@ -188,7 +189,9 @@ library
     cbits/musl/sqrt.c
     cbits/musl/sqrt_data.c
 
-  other-modules: PackageInfo_pact_tng
+  other-modules:
+    PackageInfo_pact_tng
+    Paths_pact_tng
 
   exposed-modules:
     Pact.Core.Compile
@@ -268,6 +271,7 @@ library
     Pact.Core.Repl.Runtime.ReplBuiltin
     Pact.Core.Repl.Compile
     Pact.Core.Repl.BuiltinDocs
+    Pact.Core.Repl.BuiltinDocs.Internal
     Pact.Core.Repl.UserDocs
 
     -- Serialization
@@ -355,7 +359,9 @@ executable pact
   default-language:    Haskell2010
 
   -- beware of the autogen modules. Remember to `cabal clean`!
-  other-modules: PackageInfo_pact_tng
+  other-modules:
+    PackageInfo_pact_tng
+    Paths_pact_tng
 
 benchmark bench
   type: exitcode-stdio-1.0
@@ -488,6 +494,7 @@ test-suite core-tests
     , pact-tng:test-utils
     , lsp-test
     , lsp-types
+
   other-modules:
     , Pact.Core.Test.CommandTests
     , Pact.Core.Test.ReplTests
@@ -504,6 +511,8 @@ test-suite core-tests
     , Pact.Core.Test.LanguageServer
     , Pact.Core.Test.GasGolden
     , Pact.Core.Test.ConTagGolden
+    , Pact.Core.Test.DocsTests
+    , Paths_pact_tng
   if (flag(with-crypto))
     build-depends: pact-tng:pact-crypto