diff --git a/dhall-lsp-server.cabal b/dhall-lsp-server.cabal --- a/dhall-lsp-server.cabal +++ b/dhall-lsp-server.cabal @@ -1,5 +1,5 @@ name: dhall-lsp-server -Version: 1.0.3 +Version: 1.0.4 cabal-version: 1.12 synopsis: Language Server Protocol (LSP) server for Dhall homepage: https://github.com/dhall-lang/dhall-haskell/dhall-lsp-server#readme @@ -50,10 +50,10 @@ , containers >= 0.5.11.0 && < 0.7 , data-default >= 0.7.1.1 && < 0.8 , directory >= 1.2.2.0 && < 1.4 - , dhall >= 1.28.0 && < 1.29 + , dhall >= 1.29.0 && < 1.30 , dhall-json >= 1.4 && < 1.7 , filepath >= 1.4.2 && < 1.5 - , haskell-lsp >= 0.15.0.0 && < 0.17 + , haskell-lsp >= 0.19.0.0 && < 0.20 , rope-utf16-splay >= 0.3.1.0 && < 0.4 , hslogger >= 1.2.10 && < 1.4 , lens >= 4.16.1 && < 4.19 @@ -115,8 +115,8 @@ GHC-Options: -Wall Build-Depends: base , - haskell-lsp-types >= 0.15.0 && < 0.16 , - lsp-test >= 0.6 && < 0.7 , + haskell-lsp-types >= 0.19.0 && < 0.20 , + lsp-test >= 0.9 && < 0.11 , tasty >= 0.11.2 && < 1.3 , tasty-hspec >= 1.1 && < 1.2 , text >= 0.11 && < 1.3 diff --git a/src/Dhall/LSP/Backend/Completion.hs b/src/Dhall/LSP/Backend/Completion.hs --- a/src/Dhall/LSP/Backend/Completion.hs +++ b/src/Dhall/LSP/Backend/Completion.hs @@ -3,22 +3,32 @@ import Data.List (foldl') import Data.Text (Text) import Data.Void (Void, absurd) +import Dhall.Context (Context, insert) +import Dhall.Context (empty, toList) import Dhall.LSP.Backend.Diagnostics (Position, positionToOffset) +import Dhall.LSP.Backend.Parsing (holeExpr) +import Dhall.Parser (Src, exprFromText) +import Dhall.TypeCheck (typeWithA, typeOf) import System.Directory (doesDirectoryExist, listDirectory) -import System.FilePath (takeDirectory, ()) import System.Environment (getEnvironment) +import System.FilePath (takeDirectory, ()) import System.Timeout (timeout) -import Dhall.Context (empty, toList) +import Dhall.Core + ( Binding(..) + , Expr(..) + , Var(..) + , normalize + , shift + , subst + , pretty + , reservedIdentifiers + ) + +import qualified Data.HashSet as HashSet import qualified Data.Text as Text -import Dhall.Context (Context, insert) -import Dhall.Core (Binding(..), Expr(..), Var(..), normalize, shift, subst, pretty, reservedIdentifiers) -import Dhall.TypeCheck (typeWithA, typeOf) -import Dhall.Parser (Src, exprFromText) import qualified Dhall.Map -import qualified Data.HashSet as HashSet - -import Dhall.LSP.Backend.Parsing (holeExpr) +import qualified Dhall.Pretty -- | Given the cursor position construct the corresponding 'completion query' -- consisting of the leadup, i.e. text leading up to the word prefix that is to @@ -58,10 +68,14 @@ completeEnvironmentImport :: IO [Completion] completeEnvironmentImport = do environment <- getEnvironment - let environmentImports = map (Text.pack . fst) environment - return $ map (\env -> Completion env Nothing) environmentImports + let toCompletion (variable, _) = Completion escapedVariable Nothing + where + escapedVariable = + Dhall.Pretty.escapeEnvironmentVariable (Text.pack variable) + return (map toCompletion environment) + -- | A completion context, consisting of the (approximated) type-checking -- context. We need to substitute 'dependent lets' later so we keep their values -- around. @@ -170,13 +184,17 @@ where -- complete a union constructor by inspecting the union value completeUnion _A (Union m) = - let constructor (k, Nothing) = Completion k (Just _A) - constructor (k, Just v) = Completion k (Just (Pi k v _A)) + let constructor (k, Nothing) = + Completion (Dhall.Pretty.escapeLabel True k) (Just _A) + constructor (k, Just v) = + Completion (Dhall.Pretty.escapeLabel True k) (Just (Pi k v _A)) in map constructor (Dhall.Map.toList m) completeUnion _ _ = [] -- complete a record projection by inspecting the record type - completeRecord (Record m) = - map (\(name, typ) -> Completion name (Just typ)) (Dhall.Map.toList m) + completeRecord (Record m) = map toCompletion (Dhall.Map.toList m) + where + toCompletion (name, typ) = + Completion (Dhall.Pretty.escapeLabel True name) (Just typ) completeRecord _ = [] diff --git a/src/Dhall/LSP/Backend/Diagnostics.hs b/src/Dhall/LSP/Backend/Diagnostics.hs --- a/src/Dhall/LSP/Backend/Diagnostics.hs +++ b/src/Dhall/LSP/Backend/Diagnostics.hs @@ -17,7 +17,7 @@ where import Dhall.Parser (SourcedException(..), Src(..), unwrap) -import Dhall.TypeCheck (DetailedTypeError(..), TypeError(..)) +import Dhall.TypeCheck (DetailedTypeError(..), ErrorMessages(..), TypeError(..)) import Dhall.Core (Expr(Note, Embed), subExpressions) import Dhall.LSP.Util @@ -28,10 +28,14 @@ import Control.Monad.Trans.Writer (Writer, execWriter, tell) import Data.Monoid ((<>)) import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.List.NonEmpty as NonEmpty -import qualified Text.Megaparsec as Megaparsec +import qualified Data.Text as Text +import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text +import qualified Data.List.NonEmpty as NonEmpty +import qualified Dhall.Pretty +import qualified Dhall.TypeCheck as TypeCheck +import qualified Text.Megaparsec as Megaparsec + -- | A (line, col) pair representing a position in a source file; 0-based. type Position = (Int, Int) -- | A source code range. @@ -61,11 +65,15 @@ range = Just (rangeFromDhall src) diagnosis = tshow e -diagnose (ErrorTypecheck e@(TypeError _ expr _)) = [Diagnosis { .. }] +diagnose (ErrorTypecheck (TypeError _ expr message)) = [Diagnosis { .. }] where doctor = "Dhall.TypeCheck" + range = fmap rangeFromDhall (note expr) - diagnosis = tshow e + + diagnosis = "Error: " <> Pretty.Text.renderStrict (Dhall.Pretty.layout short) + + ErrorMessages{..} = TypeCheck.prettyTypeMessage message diagnose (ErrorParse e) = [ Diagnosis { .. } | (diagnosis, range) <- zip diagnoses (map Just ranges) ] diff --git a/src/Dhall/LSP/Handlers.hs b/src/Dhall/LSP/Handlers.hs --- a/src/Dhall/LSP/Handlers.hs +++ b/src/Dhall/LSP/Handlers.hs @@ -111,7 +111,7 @@ getVirtualFileFunc <- uses lspFuncs LSP.getVirtualFileFunc mVirtualFile <- liftIO $ getVirtualFileFunc (J.toNormalizedUri uri) case mVirtualFile of - Just (LSP.VirtualFile _ rope _) -> return (Rope.toText rope) + Just (LSP.VirtualFile _ _ rope) -> return (Rope.toText rope) Nothing -> fail $ "Could not find " <> show uri <> " in VFS." loadFile :: J.Uri -> HandlerM (Expr Src Void) @@ -467,7 +467,7 @@ let computeCompletions -- environment variable | "env:" `isPrefixOf` completionPrefix = - liftIO $ completeEnvironmentImport + liftIO completeEnvironmentImport -- local import | any (`isPrefixOf` completionPrefix) [ "/", "./", "../", "~/" ] = do diff --git a/src/Dhall/LSP/Server.hs b/src/Dhall/LSP/Server.hs --- a/src/Dhall/LSP/Server.hs +++ b/src/Dhall/LSP/Server.hs @@ -77,23 +77,19 @@ -- Server capabilities. Tells the LSP client that we can execute commands etc. lspOptions :: LSP.Core.Options lspOptions = def { LSP.Core.textDocumentSync = Just syncOptions - , LSP.Core.completionProvider = - Just (J.CompletionOptions { - _resolveProvider = Nothing - , _triggerCharacters = Just [":", ".", "/"] }) - , LSP.Core.executeCommandProvider = - -- Note that this registers the dhall.server.lint command - -- with VSCode, which means that our plugin can't expose a - -- command of the same name. In the case of dhall.lint we - -- name the server-side command dhall.server.lint to work - -- around this peculiarity. - Just (J.ExecuteCommandOptions - (J.List ["dhall.server.lint", - "dhall.server.annotateLet", - "dhall.server.freezeImport", - "dhall.server.freezeAllImports"])) - , LSP.Core.documentLinkProvider = - Just (J.DocumentLinkOptions { _resolveProvider = Just False }) + , LSP.Core.completionTriggerCharacters = Just [':', '.', '/'] + -- Note that this registers the dhall.server.lint command + -- with VSCode, which means that our plugin can't expose a + -- command of the same name. In the case of dhall.lint we + -- name the server-side command dhall.server.lint to work + -- around this peculiarity. + , LSP.Core.executeCommandCommands = + Just + [ "dhall.server.lint", + "dhall.server.annotateLet", + "dhall.server.freezeImport", + "dhall.server.freezeAllImports" + ] } lspHandlers :: MVar ServerState -> LSP.Core.Handlers diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -108,9 +108,22 @@ docId <- openDoc "ImportedFunctions.dhall" "dhall" cs <- getCompletions docId (Position {_line = 0, _character = 33}) liftIO $ do - let firstItem = head cs - _label firstItem `shouldBe` "makeUser" + let [ firstItem, secondItem ] = cs + _label firstItem `shouldBe` "`make user`" + _label secondItem `shouldBe` "makeUser" _detail firstItem `shouldBe` Just "\8704(user : Text) \8594 { home : Text }" + _detail secondItem `shouldBe` Just "\8704(user : Text) \8594 { home : Text }" + it "suggests union alternatives" + $ runSession "dhall-lsp-server" fullCaps fixtureDir + $ do + docId <- openDoc "Union.dhall" "dhall" + cs <- getCompletions docId (Position {_line = 2, _character = 10}) + liftIO $ do + let [ firstItem, secondItem ] = cs + _label firstItem `shouldBe` "A" + _label secondItem `shouldBe` "`B C`" + _detail firstItem `shouldBe` Just "\8704(A : Text) \8594 < A : Text | `B C` >" + _detail secondItem `shouldBe` Just "< A : Text | `B C` >" diagnosticsSpec :: FilePath -> Spec diagnosticsSpec fixtureDir = do diff --git a/tests/fixtures/completion/Library.dhall b/tests/fixtures/completion/Library.dhall --- a/tests/fixtures/completion/Library.dhall +++ b/tests/fixtures/completion/Library.dhall @@ -1,3 +1,3 @@ let makeUser = λ(user : Text) → let home = "/home/${user}" in { home = home } -in { makeUser = makeUser } +in { makeUser = makeUser, `make user` = makeUser } diff --git a/tests/fixtures/completion/Union.dhall b/tests/fixtures/completion/Union.dhall new file mode 100644 --- /dev/null +++ b/tests/fixtures/completion/Union.dhall @@ -0,0 +1,3 @@ +let Union = < A : Text | `B C` > + +in Union.