packages feed

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 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         }