dhall-lsp-server 1.0.0 → 1.0.1
raw patch · 12 files changed
+600/−168 lines, 12 filesdep +rope-utf16-splaydep −cryptonitedep −dotgendep −sorted-listdep ~aesondep ~containersdep ~data-defaultPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: rope-utf16-splay
Dependencies removed: cryptonite, dotgen, sorted-list, stm, yi-rope
Dependency ranges changed: aeson, containers, data-default, dhall, directory, filepath, haskell-lsp, hslogger, lens, lens-family-core, megaparsec, mtl, optparse-applicative, prettyprinter, text, transformers, unordered-containers
API changes (from Hackage documentation)
+ Dhall.LSP.Backend.Completion: Completion :: Text -> Maybe (Expr Src X) -> Completion
+ Dhall.LSP.Backend.Completion: CompletionContext :: Context (Expr Src X) -> Context (Expr Src X) -> CompletionContext
+ Dhall.LSP.Backend.Completion: [completeText] :: Completion -> Text
+ Dhall.LSP.Backend.Completion: [completeType] :: Completion -> Maybe (Expr Src X)
+ Dhall.LSP.Backend.Completion: [context] :: CompletionContext -> Context (Expr Src X)
+ Dhall.LSP.Backend.Completion: [values] :: CompletionContext -> Context (Expr Src X)
+ Dhall.LSP.Backend.Completion: buildCompletionContext :: Expr Src X -> CompletionContext
+ Dhall.LSP.Backend.Completion: buildCompletionContext' :: Context (Expr Src X) -> Context (Expr Src X) -> Expr Src X -> CompletionContext
+ Dhall.LSP.Backend.Completion: completeEnvironmentImport :: IO [Completion]
+ Dhall.LSP.Backend.Completion: completeFromContext :: CompletionContext -> [Completion]
+ Dhall.LSP.Backend.Completion: completeLocalImport :: FilePath -> FilePath -> IO [Completion]
+ Dhall.LSP.Backend.Completion: completeProjections :: CompletionContext -> Expr Src X -> [Completion]
+ Dhall.LSP.Backend.Completion: completionQueryAt :: Text -> Position -> (Text, Text)
+ Dhall.LSP.Backend.Completion: contextToVariables :: [(Text, Expr Src X)] -> [Var]
+ Dhall.LSP.Backend.Completion: data Completion
+ Dhall.LSP.Backend.Completion: data CompletionContext
+ Dhall.LSP.Backend.Parsing: binderExprFromText :: Text -> Expr Src Import
+ Dhall.LSP.Backend.Parsing: getImportLink :: Src -> Src
+ Dhall.LSP.Backend.Parsing: holeExpr :: Expr s a
+ Dhall.LSP.Handlers: completionHandler :: CompletionRequest -> HandlerM ()
- Dhall.LSP.Backend.Formatting: formatExpr :: Pretty b => Expr a b -> Text
+ Dhall.LSP.Backend.Formatting: formatExpr :: Pretty b => Expr Src b -> Text
- Dhall.LSP.Backend.Formatting: formatExprWithHeader :: Pretty b => Expr a b -> Text -> Text
+ Dhall.LSP.Backend.Formatting: formatExprWithHeader :: Pretty b => Expr Src b -> Text -> Text
- Dhall.LSP.Backend.Parsing: getForallIdentifier :: Src -> Src
+ Dhall.LSP.Backend.Parsing: getForallIdentifier :: Src -> Maybe Src
- Dhall.LSP.Backend.Parsing: getLamIdentifier :: Src -> Src
+ Dhall.LSP.Backend.Parsing: getLamIdentifier :: Src -> Maybe Src
Files
- README.md +84/−4
- app/Main.hs +3/−1
- dhall-lsp-server.cabal +11/−32
- src/Dhall/LSP/Backend/Completion.hs +181/−0
- src/Dhall/LSP/Backend/Dhall.hs +1/−2
- src/Dhall/LSP/Backend/Diagnostics.hs +2/−1
- src/Dhall/LSP/Backend/Formatting.hs +3/−2
- src/Dhall/LSP/Backend/Linting.hs +26/−21
- src/Dhall/LSP/Backend/Parsing.hs +140/−13
- src/Dhall/LSP/Backend/Typing.hs +26/−65
- src/Dhall/LSP/Handlers.hs +98/−9
- src/Dhall/LSP/Server.hs +25/−18
README.md view
@@ -1,9 +1,89 @@-# dhall-lsp-server+# Dhall language support in VSCode/ium -This is a [Language Server Protocol](https://microsoft.github.io/language-server-protocol/) server implementation for the [Dhall](https://dhall-lang.org) programming language.+The Dhall language integration consists of the following parts:+- The VSCode/ium plugin "Dhall Language Support" *([vscode-language-dhall](https://github.com/PanAeon/vscode-language-dhall))* adds syntax highlighting for Dhall files.+- The VSCode/ium plugin "Dhall LSP Server" *([vscode-dhall-lsp-server](https://github.com/PanAeon/vscode-dhall-lsp-server))* implements the LSP client – yes, there is a naming issue here – that communicates with the backend via the [LSP protocol](https://microsoft.github.io/language-server-protocol/specification) to provide advanced language features like error diagnostics or type information, etc.+- [*dhall-lsp-server*](https://github.com/dhall-lang/dhall-haskell/tree/master/dhall-lsp-server), which is part of the [*dhall-haskell*](https://github.com/dhall-lang/dhall-haskell) project, implements the actual LSP server (i.e. the backend) that implements those language features in an editor agnostic way, though at the moment only a VSCode/ium frontend exists. +# Installation -For installation or development instructions, see:+The "official" releases can be installed as follows: -* [`dhall-haskell` - `README`](https://github.com/dhall-lang/dhall-haskell/blob/master/README.md)+- **vscode-language-dhall** should be installed directly from VSCode/ium via the extensions marketplace.+- **vscode-dhall-lsp-server** can also be installed directly from the marketplace.+- **dhall-lsp-server** can be installed from hackage with `cabal install dhall-lsp-server`. See the+[`dhall-haskell` `README`](https://github.com/dhall-lang/dhall-haskell/blob/master/README.md) for pre-built binaries, as well as comprehensive installation and development instructions using *cabal*, *stack* or *nix*. +## Installing the latest development versions++**Note ** The versions of *vscode-dhall-lsp-server* and *dhall-lsp-server* need not necessarily match: an older client version will simply not expose all commands available in the backend, while an older server might not implement all commands exposed in the UI.++**vscode-dhall-lsp-server**+1. You need to have *npm* installed (e.g. using your favourite package manager).+2. Install the *typescript* compiler with `npm install -g typescript`. I recommend running `npm config set prefix '~/.local'` first to have npm install the executable in `~/.local/bin`; this avoids having to use *sudo* and polluting the rest of the system.+2. Check out a copy of the vscode-dhall-lsp-server repository into the VSCode/ium extensions folder+ ```+ git clone git@github.com:PanAeon/vscode-dhall-lsp-server.git ~/.vscode-oss/extensions/vscode-dhall-lsp-server+ ```+ (replace `~/.vscode-oss/` with `~/.vscode/` if you use VSCode instead of VSCodium).+3. Run the remaining commands in the checked-out directory+ ```+ cd ~/.vscode-oss/extensions/vscode-dhall-lsp-server+ ```+4. Run `npm install` to fetch all library dependencies.+5. Run `npm run compile` to compile the typescript code to javascript.+6. Start (restart) VSCode/ium.++**dhall-lsp-server **+For detailed instructions as well as instructions using cabal or nix, see [`dhall-haskell` - `README`](https://github.com/dhall-lang/dhall-haskell/blob/master/README.md). To install dhall-lsp-server using *stack*:+1. Clone `git@github.com:dhall-lang/dhall-haskell.git`.+2. Inside the checked out repository run `stack install dhall-lsp-server`.+++# Usage / Features++- **Diagnostics **+Every time you save a Dhall file it is parsed and typechecked, and any errors are marked. You can hover over the offending code to see the error message; to see a detailed explanation in the case of type errors, click the *Explain* link in the hover box.++- **Clickable imports **+As long as the file parses successfully, all (local file and remote) imports will be underlined and clickable.++- **Type on hover **+You can hover over any part of the code and it will tell you the type of the subexpression at that point – if you highlight an identifier you see its type; if you highlight the `->` in a function you will see the type of the entire function. This feature only works if the code passes the typechecker!++- **Code completion **+As you type you will be offered completions for:+ - environment variables+ - local imports+ - identifiers in scope (as well as built-ins)+ - record projections from 'easy-to-parse' records (of the form `ident1.ident2`[`.ident3...`])+ - union constructors from 'easy-to-parse' unions++ This is the only feature that works even when the file does not parse (or typecheck).++- **Formatting and Linting **+Right click and select "Format Document" to run the file through the Dhall formatter. The command "Lint and Format" can be selected via the *Command Palette* (Ctrl+Shift+P); this will run the linter over the file, removing unused let bindings and formatting the result.++- **Annotate lets **+Right-click the bound identifier in a `let` binding and select "Annotate Let binding with its type" to do exactly that.++- **Freeze imports **+Right-click an import statement and select "Freeze (refreeze) import" to add (or update) a semantic hash annotation to the import. You can also select "Freeze (refreeze) all imports" from the *Command Palette* to freeze all imports at once.++ Note that this feature behaves slightly differently from the `dhall freeze` command in that the hash annotations are inserted without re-formatting the rest of the code!++# Developer notes++**dhall-lsp-server **+See [`dhall-haskell` - `README`](https://github.com/dhall-lang/dhall-haskell/blob/master/README.md) for general development instructions.+- You can also build using `stack build dhall-lsp-server` and point `vscode-dhall-lsp-server.executable` in the VSCode/ium settings to the stack build directory to avoid overriding the already installed version of the LSP server.+- You can use standard `Debug.Trace`/`putStrLn` debugging; the output will show up in the "Output" panel in VSCode/ium.+- To log all LSP communication set `vscode-dhall-lsp-server.trace.server` to `verbose` in VSCode/ium.++**vscode-dhall-lsp-server**+- Instead of working in `~/vscode-oss/extensions/...` directly, you can open a clone of the git repository in VSCode/ium and use the built-in debugging capabilities for extensions: press F5 (or click the green play button in the debugging tab) to launch a new VSCode/ium window with the modified extension (potentially shadowing the installed version).+- To package a release:+ 1. Make sure you have *npm* and *tsc* installed.+ 2. Use `npm install -g vsce` to install the *vsce* executable.+ 3. Run `vsce package` inside the git repo to package the extension, resulting in a file `vscode-dhall-lsp-server-x.x.x.vsix`.+ 4. You can install the packaged extension directly by opening the `.vsix` file from within VSCod/ium.
app/Main.hs view
@@ -12,7 +12,9 @@ import Control.Applicative ((<|>)) import Data.Monoid ((<>)) +import qualified Data.Version import qualified Dhall.LSP.Server+import qualified Paths_dhall_lsp_server -- | Top-level program options data Options = Options {@@ -56,7 +58,7 @@ runCommand :: Options -> IO () runCommand Options {..} = case command of- Version -> putStrLn ("0.0.1.1" :: String)+ Version -> putStrLn (Data.Version.showVersion Paths_dhall_lsp_server.version) LSPServer -> Dhall.LSP.Server.run logFile -- | Entry point for the @dhall-lsp-server@ executable
dhall-lsp-server.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.12 name: dhall-lsp-server-version: 1.0.0-description: Please see the README on GitHub at <https://github.com/githubuser/dhall-lsp-server#readme>+Version: 1.0.1+synopsis: Language Server Protocol (LSP) server for Dhall homepage: https://github.com/dhall-lang/dhall-haskell/dhall-lsp-server#readme bug-reports: https://github.com/dhall-lang/dhall-haskell/issues author: panaeon@@ -20,6 +20,7 @@ library exposed-modules:+ Dhall.LSP.Backend.Completion Dhall.LSP.Backend.Dhall Dhall.LSP.Backend.Diagnostics Dhall.LSP.Backend.Freezing@@ -36,35 +37,31 @@ Dhall.LSP.Util hs-source-dirs: src- default-extensions: LambdaCase OverloadedStrings FlexibleInstances TypeApplications RecordWildCards ScopedTypeVariables+ default-extensions: RecordWildCards OverloadedStrings build-depends: aeson >= 1.3.1.1 && < 1.5 , aeson-pretty >= 0.8.7 && < 0.9 , base >= 4.7 && < 5 , bytestring >= 0.10.8.2 && < 0.11 , containers >= 0.5.11.0 && < 0.7- , cryptonite >= 0.25 && < 0.27 , data-default >= 0.7.1.1 && < 0.8- , dhall >= 1.25.0 && < 1.26+ , directory >= 1.2.2.0 && < 1.4+ , dhall >= 1.26.0 && < 1.27 , dhall-json >= 1.4 && < 1.5- , dotgen >= 0.4.2 && < 0.5 , filepath >= 1.4.2 && < 1.5- , haskell-lsp >= 0.8.1.0 && < 0.9+ , haskell-lsp >= 0.15.0.0 && < 0.16+ , rope-utf16-splay >= 0.3.1.0 && < 0.4 , hslogger >= 1.2.10 && < 1.4- , lens >= 4.16.1 && < 4.18+ , lens >= 4.16.1 && < 4.19 , lens-family-core >= 1.2.3 && < 2.1 , megaparsec >= 7.0.2 && < 7.1 , mtl >= 2.2.2 && < 2.3 , network-uri >= 2.6.1.0 && < 2.7- , optparse-applicative >= 0.14.3.0 && < 0.16 , prettyprinter >= 1.2.1 && < 1.4- , sorted-list >= 0.2.1.0 && < 0.3- , stm >= 2.4.5.0 && < 2.6 , text >= 1.2.3.0 && < 1.3 , transformers >= 0.5.5.0 && < 0.6 , unordered-containers >= 0.2.9.0 && < 0.3 , uri-encode >= 1.5.0.5 && < 1.6- , yi-rope >= 0.11 && < 0.12 default-language: Haskell2010 GHC-Options: -Wall -fwarn-incomplete-uni-patterns if impl(eta)@@ -77,30 +74,12 @@ Paths_dhall_lsp_server hs-source-dirs: app- default-extensions: LambdaCase OverloadedStrings FlexibleInstances TypeApplications RecordWildCards ScopedTypeVariables+ default-extensions: RecordWildCards OverloadedStrings ghc-options: -rtsopts build-depends:- aeson- , base >=4.7 && <5- , containers- , data-default- , dhall+ base >=4.7 && <5 , dhall-lsp-server- , filepath- , haskell-lsp- , hslogger- , lens- , lens-family-core- , megaparsec- , mtl , optparse-applicative- , prettyprinter- , sorted-list- , stm- , text- , transformers- , unordered-containers- , yi-rope default-language: Haskell2010 GHC-Options: -Wall -fwarn-incomplete-uni-patterns if impl(eta)
+ src/Dhall/LSP/Backend/Completion.hs view
@@ -0,0 +1,181 @@+module Dhall.LSP.Backend.Completion where++import Data.Text (Text)+import Data.Void (absurd)+import Dhall.LSP.Backend.Diagnostics (Position, positionToOffset)+import System.Directory (doesDirectoryExist, listDirectory)+import System.FilePath (takeDirectory, (</>))+import System.Environment (getEnvironment)+import System.Timeout (timeout)++import Dhall.Context (empty, toList)+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 (X, typeWithA, typeOf)+import Dhall.Parser (Src, exprFromText)+import qualified Dhall.Map+import qualified Data.HashSet as HashSet++import Dhall.LSP.Backend.Parsing (holeExpr)++-- | 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+-- be completed, as well as the prefix that is to be completed.+completionQueryAt :: Text -> Position -> (Text, Text)+completionQueryAt text pos = (completionLeadup, completionPrefix)+ where+ off = positionToOffset text pos+ text' = Text.take off text+ breakEnd :: (Char -> Bool) -> Text -> (Text, Text)+ breakEnd p =+ (\(l,r) -> (Text.reverse l, Text.reverse r)) . Text.break p . Text.reverse+ (completionPrefix, completionLeadup) =+ breakEnd (`elem` (" \t\n[(,=+*&|}#?>" :: [Char])) text'++-- | A completion result, optionally annotated with type information.+data Completion =+ Completion {+ completeText :: Text,+ completeType :: Maybe (Expr Src X) }++-- | Complete file names.+completeLocalImport :: FilePath -> FilePath -> IO [Completion]+completeLocalImport relativeTo prefix = do+ let dir = takeDirectory relativeTo </> takeDirectory prefix+ exists <- doesDirectoryExist dir+ if not exists+ then return []+ else do+ let second = 10 ^ (6 :: Int)+ mFiles <- timeout second (listDirectory dir) -- 1s timeout+ case mFiles of+ Just files -> return (map (\file -> Completion (Text.pack file) Nothing) files)+ Nothing -> return []++-- | Complete environment variables.+completeEnvironmentImport :: IO [Completion]+completeEnvironmentImport = do+ environment <- getEnvironment+ let environmentImports = map (Text.pack . fst) environment+ return $ map (\env -> Completion env Nothing) environmentImports+++-- | A completion context, consisting of the (approximated) type-checking+-- context. We need to substitute 'dependent lets' later so we keep their values+-- around.+data CompletionContext =+ CompletionContext {+ context :: Context (Expr Src X),+ -- values to be substituted for 'dependent let' behaviour+ values :: Context (Expr Src X) }++-- | Given a 'binders expression' (with arbitrarily many 'holes') construct the+-- corresponding completion context.+buildCompletionContext :: Expr Src X -> CompletionContext+buildCompletionContext = buildCompletionContext' empty empty++buildCompletionContext' :: Context (Expr Src X) -> Context (Expr Src X)+ -> Expr Src X -> CompletionContext+buildCompletionContext' context values (Let (Binding { variable = x, annotation = mA, value = a }) e)+ -- We prefer the actual value over the annotated type in order to get+ -- 'dependent let' behaviour whenever possible.+ | Right _A <- typeWithA absurd context a =+ let _A' = normalize _A++ a' = normalize a+ e' = subst (V x 0) a' e++ context' = fmap (shift 1 (V x 0)) $ insert x _A' context+ values' = fmap (shift 1 (V x 0)) $ insert x a' values++ in buildCompletionContext' context' values' e'++ -- fall back to annotated type if body doesn't type check; bind to `holeExpr`+ | Just (_, _A) <- mA+ , Right _ <- typeWithA absurd context _A =+ let _A' = normalize _A++ context' = fmap (shift 1 (V x 0)) $ insert x _A' context+ values' = fmap (shift 1 (V x 0)) $ insert x holeExpr values++ in buildCompletionContext' context' values' e++ -- if nothing works, only remember the name (but bind to `holeExpr`)+ | otherwise =+ let context' = fmap (shift 1 (V x 0)) $ insert x holeExpr context+ values' = fmap (shift 1 (V x 0)) $ insert x holeExpr values++ in buildCompletionContext' context' values' e++buildCompletionContext' context values (Lam x _A b) =+ let _A' | Right _ <- typeWithA absurd context _A = normalize _A+ | otherwise = holeExpr++ context' = fmap (shift 1 (V x 0)) $ insert x _A' context+ values' = fmap (shift 1 (V x 0)) $ insert x holeExpr values++ in buildCompletionContext' context' values' b++buildCompletionContext' context values (Pi x _A b) =+ let _A' | Right _ <- typeWithA absurd context _A = normalize _A+ | otherwise = holeExpr++ context' = fmap (shift 1 (V x 0)) $ insert x _A' context+ values' = fmap (shift 1 (V x 0)) $ insert x holeExpr values++ in buildCompletionContext' context' values' b++-- catch-all+buildCompletionContext' context values _ = CompletionContext context values++-- Helper. Given `Dhall.Context.toList ctx` construct the corresponding variable+-- names.+contextToVariables :: [(Text, Expr Src X)] -> [Var]+contextToVariables [] = []+contextToVariables ((name, _) : rest) =+ V name 0 : map (inc name) (contextToVariables rest)+ where inc x (V y i) | x == y = V x (i + 1)+ | otherwise = V y i++-- | Complete identifiers from the given completion context.+completeFromContext :: CompletionContext -> [Completion]+completeFromContext (CompletionContext context _) =+ let context' = toList context+ completeReserved keyword+ | Right expr <- exprFromText "" keyword+ , Right typ <- typeOf (do _ <- expr; holeExpr) =+ Completion keyword (Just typ)+ | otherwise = Completion keyword Nothing+ reserved = map completeReserved $ HashSet.toList reservedIdentifiers+ in [ Completion (pretty var) (if typ == holeExpr then Nothing else Just typ)+ | (var, (_, typ)) <- zip (contextToVariables context') context' ]+ ++ reserved++-- | Complete union constructors and record projections.+completeProjections :: CompletionContext -> Expr Src X -> [Completion]+completeProjections (CompletionContext context values) expr =+ -- substitute 'dependent lets', necessary for completion of unions+ let values' = toList values+ subs = filter ((/= holeExpr) . snd) $ zip (contextToVariables values') (map snd values')+ expr' = foldl (\e (x,val) -> subst x val e) expr subs++ in case typeWithA absurd context expr' of+ Left _ -> []+ Right _A ->+ let expr'' = normalize expr'+ in completeUnion expr'' expr'' ++ completeRecord (normalize _A)++ 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))+ 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 _ = []
src/Dhall/LSP/Backend/Dhall.hs view
@@ -22,7 +22,6 @@ import Dhall.TypeCheck (X) import Dhall.Core (Expr) -import qualified Dhall.Binary as Dhall import qualified Dhall.Core as Dhall import qualified Dhall.Import as Dhall import qualified Dhall.Parser as Dhall@@ -166,5 +165,5 @@ -- Dhall's hash annotations (prefixed by "sha256:" and base-64 encoded). hashNormalToCode :: Normal -> Text hashNormalToCode (Normal expr) =- Dhall.hashExpressionToCode Dhall.defaultStandardVersion alphaNormal+ Dhall.hashExpressionToCode alphaNormal where alphaNormal = Dhall.alphaNormalize expr
src/Dhall/LSP/Backend/Diagnostics.hs view
@@ -22,6 +22,7 @@ import Dhall.LSP.Util import Dhall.LSP.Backend.Dhall+import Dhall.LSP.Backend.Parsing (getImportLink) import Control.Lens (toListOf) import Control.Monad.Trans.Writer (Writer, execWriter, tell)@@ -155,7 +156,7 @@ -- with their associated range in the source code. embedsWithRanges :: Expr Src a -> [(Range, a)] embedsWithRanges =- map (\(src, a) -> (rangeFromDhall src, a)) . execWriter . go+ map (\(src, a) -> (rangeFromDhall . getImportLink $ src, a)) . execWriter . go where go :: Expr Src a -> Writer [(Src, a)] () go (Note src (Embed a)) = tell [(src, a)] go expr = mapM_ go (toListOf subExpressions expr)
src/Dhall/LSP/Backend/Formatting.hs view
@@ -2,6 +2,7 @@ import Dhall.Core (Expr) import Dhall.Pretty (CharacterSet(..), layoutOpts, prettyCharacterSet)+import Dhall.Src (Src) import Data.Monoid ((<>)) import Data.Text (Text)@@ -9,12 +10,12 @@ import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty -- | Pretty-print the given Dhall expression.-formatExpr :: Pretty.Pretty b => Expr a b -> Text+formatExpr :: Pretty.Pretty b => Expr Src b -> Text formatExpr expr = formatExprWithHeader expr "" -- | Pretty-print the given Dhall expression, prepending the given a "header" -- (usually consisting of comments and whitespace).-formatExprWithHeader :: Pretty.Pretty b => Expr a b -> Text -> Text+formatExprWithHeader :: Pretty.Pretty b => Expr Src b -> Text -> Text formatExprWithHeader expr header = Pretty.renderStrict (Pretty.layoutSmart layoutOpts doc) where
src/Dhall/LSP/Backend/Linting.hs view
@@ -6,14 +6,16 @@ where import Dhall.Parser (Src)-import Dhall.Core (Expr(..), Binding(..), Var(..), subExpressions, freeIn, Import)+import Dhall.Core ( Expr(..), Binding(..), MultiLet(..), Import+ , subExpressions, multiLet, wrapInLets) import qualified Dhall.Lint as Dhall import Dhall.LSP.Backend.Diagnostics +import qualified Data.List.NonEmpty as NonEmpty+import Data.Maybe (maybeToList) import Data.Monoid ((<>)) import Data.Text (Text)-import Data.List.NonEmpty (NonEmpty(..), tails, toList) import Control.Lens (universeOf) data Suggestion = Suggestion {@@ -21,32 +23,35 @@ suggestion :: Text } --- Diagnose nested let blocks.-diagLetInLet :: Expr Src a -> [Suggestion]-diagLetInLet (Note _ (Let _ (Note src (Let _ _)))) =- [Suggestion (rangeFromDhall src) "Superfluous 'in' before nested let binding"]-diagLetInLet _ = []+-- Diagnose nested let-blocks.+--+-- Pattern matching on a 'Let' wrapped in a 'Note' prevents us from repeating+-- the search beginning at different @let@s in the same let-block – only+-- the outermost 'Let' of a let-block is wrapped in a 'Note'.+diagLetInLet :: Expr Src a -> Maybe Suggestion+diagLetInLet (Note _ (Let b e)) = case multiLet b e of+ MultiLet _ (Note src (Let {})) ->+ Just (Suggestion (rangeFromDhall src) "Superfluous 'in' before nested let binding")+ _ -> Nothing+diagLetInLet _ = Nothing --- Given a (noted) let block compute all unused variables in the block.-unusedBindings :: Eq a => Expr s a -> [Text]-unusedBindings (Note _ (Let bindings d)) = concatMap- (\case- Binding var _ _ : [] | not (V var 0 `freeIn` d) -> [var]- Binding var _ _ : (b : bs) | not (V var 0 `freeIn` Let (b :| bs) d) -> [var]- _ -> [])- (toList $ tails bindings)-unusedBindings _ = []+-- Given a let-block compute all unused variables in the block.+unusedBindings :: Eq a => MultiLet s a -> [Text]+unusedBindings (MultiLet bindings d) =+ let go bs@(Binding { variable = var} : _) | Just _ <- Dhall.removeUnusedBindings (wrapInLets bs d) = [var]+ go _ = []+ in foldMap go (NonEmpty.tails bindings) -- Diagnose unused let bindings.-diagUnusedBinding :: Eq a => Expr Src a -> [Suggestion]-diagUnusedBinding e@(Note src (Let _ _)) = map+diagUnusedBindings :: Eq a => Expr Src a -> [Suggestion]+diagUnusedBindings (Note src (Let b e)) = map (\var -> Suggestion (rangeFromDhall src) ("Unused let binding '" <> var <> "'"))- (unusedBindings e)-diagUnusedBinding _ = []+ (unusedBindings (multiLet b e))+diagUnusedBindings _ = [] -- | Given an dhall expression suggest all the possible improvements that would -- be made by the linter. suggest :: Expr Src Import -> [Suggestion]-suggest expr = concat [ diagLetInLet e ++ diagUnusedBinding e+suggest expr = concat [ maybeToList (diagLetInLet e) ++ diagUnusedBindings e | e <- universeOf subExpressions expr ]
src/Dhall/LSP/Backend/Parsing.hs view
@@ -1,18 +1,26 @@ module Dhall.LSP.Backend.Parsing- ( getImportHash+ ( getImportLink+ , getImportHash , getLetInner , getLetAnnot , getLetIdentifier , getLamIdentifier- , getForallIdentifier)+ , getForallIdentifier+ , binderExprFromText+ , holeExpr+ ) where +import Data.Text (Text)+import Dhall.Core (Binding(..), Expr(..), Import, Var(..)) import Dhall.Src (Src(..)) import Dhall.Parser import Dhall.Parser.Token import Dhall.Parser.Expression+import Text.Megaparsec (try, skipManyTill, lookAhead, anySingle,+ notFollowedBy, eof, takeRest) -import Control.Applicative (optional)+import Control.Applicative (optional, (<|>)) import qualified Text.Megaparsec as Megaparsec import Text.Megaparsec (SourcePos(..)) @@ -72,11 +80,9 @@ return (Src begin end tokens) -- | Cf. `getLetIdentifier`.-getLamIdentifier :: Src -> Src-getLamIdentifier src@(Src left _ text) =- case Megaparsec.parseMaybe (unParser parseLetIdentifier) text of- Just src' -> src'- Nothing -> src+getLamIdentifier :: Src -> Maybe Src+getLamIdentifier (Src left _ text) =+ Megaparsec.parseMaybe (unParser parseLetIdentifier) text where parseLetIdentifier = do setSourcePos left _lambda@@ -88,11 +94,9 @@ return (Src begin end tokens) -- | Cf. `getLetIdentifier`.-getForallIdentifier :: Src -> Src-getForallIdentifier src@(Src left _ text) =- case Megaparsec.parseMaybe (unParser parseLetIdentifier) text of- Just src' -> src'- Nothing -> src+getForallIdentifier :: Src -> Maybe Src+getForallIdentifier (Src left _ text) =+ Megaparsec.parseMaybe (unParser parseLetIdentifier) text where parseLetIdentifier = do setSourcePos left _forall@@ -122,3 +126,126 @@ setSourcePos src = Megaparsec.updateParserState (\(Megaparsec.State s o (Megaparsec.PosState i o' _ t l)) -> Megaparsec.State s o (Megaparsec.PosState i o' src t l))++getImportLink :: Src -> Src+getImportLink src@(Src left _ text) =+ case Megaparsec.parseMaybe (unParser parseImportLink) text of+ Just src' -> src'+ Nothing -> src+ where+ parseImportLink = do+ setSourcePos left+ begin <- getSourcePos+ (tokens, _) <-+ Megaparsec.match $ (localRaw *> return ()) <|> (httpRaw *> return ())+ end <- getSourcePos+ _ <- Megaparsec.takeRest+ return (Src begin end tokens)++-- | An expression that is guaranteed not to typecheck. Can be used a+-- placeholder type to emulate 'lazy' contexts, when typechecking something in a+-- only partly well-typed context.+holeExpr :: Expr s a+-- The illegal variable name ensures that it can't be bound by the user!+holeExpr = Var (V "" 0)++-- | Approximate the type-checking context at the end of the input. Tries to+-- parse as many binders as possible. Very messy!+binderExprFromText :: Text -> Expr Src Import+binderExprFromText txt =+ case Megaparsec.parseMaybe (unParser parseBinderExpr) (txt <> " ") of+ Just e -> e+ Nothing -> holeExpr+ where+ -- marks the beginning of the next binder+ boundary = _let <|> _forall <|> _lambda++ -- A binder that is out of scope at the end of the input. Discarded in the+ -- resulting 'binder expression'.+ closedBinder = closedLet <|> closedLambda <|> closedPi++ closedLet = do+ _let+ _ <- label+ _ <- optional (do+ _colon+ expr)+ _equal+ _ <- expr+ (do+ _in+ _ <- expr+ return ())+ <|> closedLet++ closedLambda = do+ _lambda+ _openParens+ _ <- label+ _colon+ _ <- expr+ _closeParens+ _arrow+ _ <- expr+ return ()++ closedPi = do+ _forall+ _openParens+ _ <- label+ _colon+ _ <- expr+ _closeParens+ _arrow+ _ <- expr+ return ()++ -- Try to parse as many binders as possible. Skip malformed input and+ -- 'closed' binders that are already out of scope at the end of the input.+ parseBinderExpr = do+ try (do+ skipManyTill anySingle (lookAhead boundary)+ try (do+ closedBinder+ notFollowedBy eof+ parseBinderExpr)+ <|> try (letBinder <|> lambdaBinder <|> forallBinder)+ <|> (do+ boundary+ parseBinderExpr))+ <|> (do+ _ <- takeRest+ return holeExpr)++ letBinder = do+ _let+ name <- label+ mType <- optional (do _colon; _type <- expr; return (Nothing, _type))++ -- if the bound value does not parse, skip and replace with 'hole'+ value <- try (do _equal; expr)+ <|> (do skipManyTill anySingle (lookAhead boundary <|> _in); return holeExpr)+ inner <- parseBinderExpr+ return (Let (Binding Nothing name Nothing mType Nothing value) inner)++ forallBinder = do+ _forall+ _openParens+ name <- label+ _colon+ -- if the bound type does not parse, skip and replace with 'hole'+ typ <- try (do e <- expr; _closeParens; _arrow; return e)+ <|> (do skipManyTill anySingle _arrow; return holeExpr)+ inner <- parseBinderExpr+ return (Pi name typ inner)++ lambdaBinder = do+ _lambda+ _openParens+ name <- label+ _colon+ -- if the bound type does not parse, skip and replace with 'hole'+ typ <- try (do e <- expr; _closeParens; _arrow; return e)+ <|> (do skipManyTill anySingle _arrow; return holeExpr)+ inner <- parseBinderExpr+ return (Lam name typ inner)
src/Dhall/LSP/Backend/Typing.hs view
@@ -1,35 +1,28 @@ module Dhall.LSP.Backend.Typing (annotateLet, exprAt, srcAt, typeAt) where import Dhall.Context (Context, insert, empty)-import Dhall.Core (Expr(..), Binding(..), Const(..), subExpressions, normalize, shift, subst, Var(..))-import Dhall.TypeCheck (typeWithA, X(..), TypeError(..))+import Dhall.Core (Binding(..), Expr(..), subExpressions, normalize, shift, subst, Var(..), pretty)+import Dhall.TypeCheck (typeWithA, X, TypeError(..)) import Dhall.Parser (Src(..)) -import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid ((<>)) import Control.Lens (toListOf) import Data.Text (Text) import Control.Applicative ((<|>)) import Data.Bifunctor (first)+import Data.Void (absurd) -import Dhall.LSP.Backend.Parsing (getLetInner, getLetAnnot, getLetIdentifier,+import Dhall.LSP.Backend.Parsing (getLetAnnot, getLetIdentifier, getLamIdentifier, getForallIdentifier) import Dhall.LSP.Backend.Diagnostics (Position, Range(..), rangeFromDhall) import Dhall.LSP.Backend.Dhall (WellTyped, fromWellTyped) -import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty-import Dhall.Pretty (CharacterSet(..), prettyCharacterSet)- -- | Find the type of the subexpression at the given position. Assumes that the -- input expression is well-typed. Also returns the Src descriptor containing -- that subexpression if possible. typeAt :: Position -> WellTyped -> Either String (Maybe Src, Expr Src X) typeAt pos expr = do- expr' <- case splitLets (fromWellTyped expr) of- Just e -> return e- Nothing -> Left "The impossible happened: failed to split let\- \ blocks when preprocessing for typeAt'."+ let expr' = fromWellTyped expr (mSrc, typ) <- first show $ typeAt' pos empty expr' case mSrc of Just src -> return (Just src, normalize typ)@@ -37,30 +30,25 @@ typeAt' :: Position -> Context (Expr Src X) -> Expr Src X -> Either (TypeError Src X) (Maybe Src, Expr Src X) -- the user hovered over the bound name in a let expression-typeAt' pos ctx (Note src (Let (Binding _ _ a :| []) _)) | pos `inside` getLetIdentifier src = do+typeAt' pos ctx (Note src (Let (Binding { value = a }) _)) | pos `inside` getLetIdentifier src = do typ <- typeWithA absurd ctx a return (Just $ getLetIdentifier src, typ) -- "..." in a lambda expression-typeAt' pos _ctx (Note src (Lam _ _A _)) | pos `inside` getLamIdentifier src =- return (Just $ getLamIdentifier src, _A)+typeAt' pos _ctx (Note src (Lam _ _A _)) | Just src' <- getLamIdentifier src+ , pos `inside` src' =+ return (Just src', _A) -- "..." in a forall expression-typeAt' pos _ctx (Note src (Pi _ _A _)) | pos `inside` getForallIdentifier src =- return (Just $ getForallIdentifier src, _A)+typeAt' pos _ctx (Note src (Pi _ _A _)) | Just src' <- getForallIdentifier src+ , pos `inside` src' =+ return (Just src', _A) -- the input only contains singleton lets-typeAt' pos ctx (Let (Binding x _ a :| []) e@(Note src _)) | pos `inside` src = do- _A <- typeWithA absurd ctx a- t <- fmap normalize (typeWithA absurd ctx _A)- case t of- Const Type -> do -- we don't have types depending on values- let ctx' = fmap (shift 1 (V x 0)) (insert x (normalize _A) ctx)- (mSrc, _B) <- typeAt' pos ctx' e- return (mSrc, shift (-1) (V x 0) _B)- _ -> do -- but we do have types depending on types- let a' = shift 1 (V x 0) (normalize a)- typeAt' pos ctx (shift (-1) (V x 0) (subst (V x 0) a' e))+typeAt' pos ctx (Let (Binding { variable = x, value = a }) e@(Note src _)) | pos `inside` src = do+ _ <- typeWithA absurd ctx a+ let a' = shift 1 (V x 0) (normalize a)+ typeAt' pos ctx (shift (-1) (V x 0) (subst (V x 0) a' e)) typeAt' pos ctx (Lam x _A b@(Note src _)) | pos `inside` src = do let _A' = Dhall.Core.normalize _A@@ -86,16 +74,12 @@ -- | Find the smallest Note-wrapped expression at the given position. exprAt :: Position -> Expr Src a -> Maybe (Expr Src a)-exprAt pos e = do e' <- splitLets e- exprAt' pos e'--exprAt' :: Position -> Expr Src a -> Maybe (Expr Src a)-exprAt' pos e@(Note _ expr) = exprAt pos expr <|> Just e-exprAt' pos expr =+exprAt pos e@(Note _ expr) = exprAt pos expr <|> Just e+exprAt pos expr = let subExprs = toListOf subExpressions expr in case [ (src, e) | (Note src e) <- subExprs, pos `inside` src ] of [] -> Nothing- ((src,e) : _) -> exprAt' pos e <|> Just (Note src e)+ ((src,e) : _) -> exprAt pos e <|> Just (Note src e) -- | Find the smallest Src annotation containing the given position.@@ -110,34 +94,24 @@ -- something goes wrong returns a textual error message. annotateLet :: Position -> WellTyped -> Either String (Src, Text) annotateLet pos expr = do- expr' <- case splitLets (fromWellTyped expr) of- Just e -> return e- Nothing -> Left "The impossible happened: failed to split let\- \ blocks when preprocessing for annotateLet'."- annotateLet' pos empty expr'+ annotateLet' pos empty (fromWellTyped expr) annotateLet' :: Position -> Context (Expr Src X) -> Expr Src X -> Either String (Src, Text) -- the input only contains singleton lets-annotateLet' pos ctx (Note src e@(Let (Binding _ _ a :| []) _))+annotateLet' pos ctx (Note src e@(Let (Binding { value = a }) _)) | not $ any (pos `inside`) [ src' | Note src' _ <- toListOf subExpressions e ] = do _A <- first show $ typeWithA absurd ctx a srcAnnot <- case getLetAnnot src of Just x -> return x Nothing -> Left "The impossible happened: failed\ \ to re-parse a Let expression."- return (srcAnnot, ": " <> printExpr (normalize _A) <> " ")+ return (srcAnnot, ": " <> pretty (normalize _A) <> " ") -- binders, see typeAt'-annotateLet' pos ctx (Let (Binding x _ a :| []) e@(Note src _)) | pos `inside` src = do- _A <- first show $ typeWithA absurd ctx a- t <- first show $ fmap normalize (typeWithA absurd ctx _A)- case t of- Const Type -> do -- we don't have types depending on values- let ctx' = fmap (shift 1 (V x 0)) (insert x (normalize _A) ctx)- annotateLet' pos ctx' e- _ -> do -- but we do have types depending on types- let a' = shift 1 (V x 0) (normalize a)- annotateLet' pos ctx (shift (-1) (V x 0) (subst (V x 0) a' e))+annotateLet' pos ctx (Let (Binding { variable = x, value = a }) e@(Note src _)) | pos `inside` src = do+ _ <- first show $ typeWithA absurd ctx a+ let a' = shift 1 (V x 0) (normalize a)+ annotateLet' pos ctx (shift (-1) (V x 0) (subst (V x 0) a' e)) annotateLet' pos ctx (Lam x _A b@(Note src _)) | pos `inside` src = do let _A' = Dhall.Core.normalize _A@@ -159,19 +133,6 @@ case [ Note src e | (Note src e) <- subExprs, pos `inside` src ] of (e:[]) -> annotateLet' pos ctx e _ -> Left "You weren't pointing at a let binder!"---printExpr :: Pretty.Pretty b => Expr a b -> Text-printExpr expr = Pretty.renderStrict $ Pretty.layoutCompact (Pretty.unAnnotate (prettyCharacterSet Unicode expr))----- Split all multilets into single lets in an expression-splitLets :: Expr Src a -> Maybe (Expr Src a)-splitLets (Note src (Let (b :| (b' : bs)) e)) = do- src' <- getLetInner src- splitLets (Note src (Let (b :| []) (Note src' (Let (b' :| bs) e))))-splitLets expr = subExpressions splitLets expr- -- Check if range lies completely inside a given subexpression. -- This version takes trailing whitespace into account
src/Dhall/LSP/Handlers.hs view
@@ -6,13 +6,15 @@ import qualified Language.Haskell.LSP.Types.Lens as J import qualified Language.Haskell.LSP.VFS as LSP import qualified Data.Aeson as J-import qualified Yi.Rope as Rope+import qualified Data.Rope.UTF16 as Rope import Dhall.Core (Expr(Note, Embed), pretty, Import(..), ImportHashed(..), ImportType(..), headers) import Dhall.Import (localToPath) import Dhall.Parser (Src(..)) import Dhall.TypeCheck (X) +import Dhall.LSP.Backend.Completion (Completion(..), completionQueryAt,+ completeEnvironmentImport, completeLocalImport, buildCompletionContext, completeProjections, completeFromContext) import Dhall.LSP.Backend.Dhall (FileIdentifier, parse, load, typecheck, fileIdentifierFromFilePath, fileIdentifierFromURI, invalidate, parseWithHeader) import Dhall.LSP.Backend.Diagnostics (Range(..), Diagnosis(..), explain,@@ -21,6 +23,7 @@ import Dhall.LSP.Backend.Freezing (computeSemanticHash, getImportHashPosition, stripHash, getAllImportsWithHashPositions) import Dhall.LSP.Backend.Linting (Suggestion(..), suggest, lint)+import Dhall.LSP.Backend.Parsing (binderExprFromText) import Dhall.LSP.Backend.Typing (typeAt, annotateLet, exprAt) import Dhall.LSP.State @@ -34,14 +37,13 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.Map.Strict as Map import Data.Maybe (maybeToList)-import Data.Text (Text)+import Data.Text (Text, isPrefixOf) import qualified Data.Text as Text import qualified Network.URI as URI import qualified Network.URI.Encode as URI import Text.Megaparsec (SourcePos(..), unPos) import System.FilePath - -- Workaround to make our single-threaded LSP fit dhall-lsp's API, which -- expects a multi-threaded implementation. Reports errors to the user via the -- LSP `ShowMessage` notification.@@ -97,9 +99,9 @@ readUri :: J.Uri -> HandlerM Text readUri uri = do getVirtualFileFunc <- uses lspFuncs LSP.getVirtualFileFunc- mVirtualFile <- liftIO $ getVirtualFileFunc uri+ 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 X)@@ -150,7 +152,7 @@ encodedDiag = URI.encode (Text.unpack diagnosis) command = "[Explain error](dhall-explain:?" <> Text.pack encodedDiag <> " )"- _contents = J.List [J.PlainString command]+ _contents = J.HoverContents $ J.MarkupContent J.MkMarkdown command in Just J.Hover { .. } hoverFromDiagnosis _ = Nothing @@ -172,7 +174,7 @@ Left err -> throwE (Error, Text.pack err) Right (mSrc, typ) -> let _range = fmap (rangeToJSON . rangeFromDhall) mSrc- _contents = J.List [J.PlainString (pretty typ)]+ _contents = J.HoverContents $ J.MarkupContent J.MkPlainText (pretty typ) hover = J.Hover{..} in lspRespond LSP.RspHover request (Just hover) @@ -338,7 +340,7 @@ executeAnnotateLet :: J.ExecuteCommandRequest -> HandlerM () executeAnnotateLet request = do- args :: J.TextDocumentPositionParams <- getCommandArguments request+ args <- getCommandArguments request :: HandlerM J.TextDocumentPositionParams let uri = args ^. J.textDocument . J.uri line = args ^. J.position . J.line col = args ^. J.position . J.character@@ -394,7 +396,7 @@ executeFreezeImport :: J.ExecuteCommandRequest -> HandlerM () executeFreezeImport request = do- args :: J.TextDocumentPositionParams <- getCommandArguments request+ args <- getCommandArguments request :: HandlerM J.TextDocumentPositionParams let uri = args ^. J.textDocument . J.uri line = args ^. J.position . J.line col = args ^. J.position . J.character@@ -429,6 +431,93 @@ lspRequest LSP.ReqApplyWorkspaceEdit J.WorkspaceApplyEdit (J.ApplyWorkspaceEditParams edit)++completionHandler :: J.CompletionRequest -> HandlerM ()+completionHandler request = do+ let uri = request ^. J.params . J.textDocument . J.uri+ line = request ^. J.params . J.position . J.line+ col = request ^. J.params . J.position . J.character++ txt <- readUri uri+ let (completionLeadup, completionPrefix) = completionQueryAt txt (line, col)++ let computeCompletions+ -- environment variable+ | "env:" `isPrefixOf` completionPrefix =+ liftIO $ completeEnvironmentImport++ -- local import+ | any (`isPrefixOf` completionPrefix) [ "/", "./", "../", "~/" ] = do+ let relativeTo | Just path <- J.uriToFilePath uri = path+ | otherwise = "."+ liftIO $ completeLocalImport relativeTo (Text.unpack completionPrefix)++ -- record projection / union constructor+ | (target, _) <- Text.breakOnEnd "." completionPrefix+ , not (Text.null target) = do+ let bindersExpr = binderExprFromText completionLeadup++ fileIdentifier <- fileIdentifierFromUri uri+ cache <- use importCache+ loadedBinders <- liftIO $ load fileIdentifier bindersExpr cache++ (cache', bindersExpr') <-+ case loadedBinders of+ Right (cache', binders) -> do+ return (cache', binders)+ Left _ -> throwE (Log, "Could not complete projection; failed to load binders expression.")++ let completionContext = buildCompletionContext bindersExpr'++ targetExpr <- case parse (Text.dropEnd 1 target) of+ Right e -> return e+ Left _ -> throwE (Log, "Could not complete projection; prefix did not parse.")++ loaded' <- liftIO $ load fileIdentifier targetExpr cache'+ case loaded' of+ Right (cache'', targetExpr') -> do+ assign importCache cache''+ return (completeProjections completionContext targetExpr')+ Left _ -> return []++ -- complete identifiers in scope+ | otherwise = do+ let bindersExpr = binderExprFromText completionLeadup++ fileIdentifier <- fileIdentifierFromUri uri+ cache <- use importCache -- todo save cache afterwards+ loadedBinders <- liftIO $ load fileIdentifier bindersExpr cache++ bindersExpr' <-+ case loadedBinders of+ Right (cache', binders) -> do+ assign importCache cache'+ return binders+ Left _ -> throwE (Log, "Could not complete projection; failed to load binders expression.")++ let context = buildCompletionContext bindersExpr'+ return (completeFromContext context)++ completions <- computeCompletions++ let item (Completion {..}) = J.CompletionItem {..}+ where+ _label = completeText+ _kind = Nothing+ _detail = fmap pretty completeType+ _documentation = Nothing+ _deprecated = Nothing+ _preselect = Nothing+ _sortText = Nothing+ _filterText = Nothing+ _insertText = Nothing+ _insertTextFormat = Nothing+ _textEdit = Nothing+ _additionalTextEdits = Nothing+ _commitCharacters = Nothing+ _command = Nothing+ _xdata = Nothing+ lspRespond LSP.RspCompletion request $ J.Completions (J.List (map item completions)) -- handler that doesn't do anything. Useful for example to make haskell-lsp shut
src/Dhall/LSP/Server.hs view
@@ -14,32 +14,34 @@ import Dhall.LSP.State import Dhall.LSP.Handlers (nullHandler, wrapHandler, hoverHandler, didOpenTextDocumentNotificationHandler, didSaveTextDocumentNotificationHandler,- executeCommandHandler, documentFormattingHandler, documentLinkHandler)+ executeCommandHandler, documentFormattingHandler, documentLinkHandler,+ completionHandler) -- | The main entry point for the LSP server. run :: Maybe FilePath -> IO () run mlog = do setupLogger mlog state <- newEmptyMVar- _ <- LSP.Control.run (makeConfig, initCallback state) (lspHandlers state)- lspOptions Nothing- return ()- where- -- Callback that is called when the LSP server is started; makes the lsp- -- state (LspFuncs) available to the message handlers through the vlsp MVar.- initCallback- :: MVar ServerState- -> LSP.Core.LspFuncs ()- -> IO (Maybe J.ResponseError)- initCallback state lsp = do- putMVar state (initialState lsp)- return Nothing - -- Interpret DidChangeConfigurationNotification; pointless at the moment- -- since we don't use a configuration.- makeConfig :: J.DidChangeConfigurationNotification -> Either Text ()- makeConfig _ = Right ()+ -- these two are stubs since we do not use a config+ let onInitialConfiguration :: J.InitializeRequest -> Either Text ()+ onInitialConfiguration _ = Right ()+ let onConfigurationChange :: J.DidChangeConfigurationNotification -> Either Text ()+ onConfigurationChange _ = Right () + -- Callback that is called when the LSP server is started; makes the lsp+ -- state (LspFuncs) available to the message handlers through the `state` MVar.+ let onStartup :: LSP.Core.LspFuncs () -> IO (Maybe J.ResponseError)+ onStartup lsp = do+ putMVar state (initialState lsp)+ return Nothing++ _ <- LSP.Control.run (LSP.Core.InitializeCallbacks {..})+ (lspHandlers state)+ lspOptions+ Nothing+ return ()+ -- | sets the output logger. -- | if no filename is provided then logger is disabled, if input is string `[OUTPUT]` then log goes to stderr, -- | which then redirects inside VSCode to the output pane of the plugin.@@ -64,6 +66,10 @@ -- 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@@ -92,4 +98,5 @@ , LSP.Core.executeCommandHandler = Just $ wrapHandler state executeCommandHandler , LSP.Core.documentFormattingHandler = Just $ wrapHandler state documentFormattingHandler , LSP.Core.documentLinkHandler = Just $ wrapHandler state documentLinkHandler+ , LSP.Core.completionHandler = Just $ wrapHandler state completionHandler }