lsp-types (empty) → 1.0.0.0
raw patch · 53 files changed
+6666/−0 lines, 53 filesdep +aesondep +basedep +binarysetup-changed
Dependencies added: aeson, base, binary, bytestring, containers, data-default, deepseq, dependent-sum-template, directory, filepath, hashable, hslogger, lens, network-uri, rope-utf16-splay, scientific, some, template-haskell, temporary, text, unordered-containers
Files
- ChangeLog.md +277/−0
- LICENSE +20/−0
- README.md +13/−0
- Setup.hs +2/−0
- lsp-types.cabal +96/−0
- src/Data/IxMap.hs +40/−0
- src/Language/LSP/Types.hs +84/−0
- src/Language/LSP/Types/Cancellation.hs +28/−0
- src/Language/LSP/Types/Capabilities.hs +246/−0
- src/Language/LSP/Types/ClientCapabilities.hs +182/−0
- src/Language/LSP/Types/CodeAction.hs +205/−0
- src/Language/LSP/Types/CodeLens.hs +64/−0
- src/Language/LSP/Types/Command.hs +51/−0
- src/Language/LSP/Types/Common.hs +57/−0
- src/Language/LSP/Types/Completion.hs +337/−0
- src/Language/LSP/Types/Configuration.hs +42/−0
- src/Language/LSP/Types/Declaration.hs +39/−0
- src/Language/LSP/Types/Definition.hs +36/−0
- src/Language/LSP/Types/Diagnostic.hs +139/−0
- src/Language/LSP/Types/DocumentColor.hs +91/−0
- src/Language/LSP/Types/DocumentFilter.hs +36/−0
- src/Language/LSP/Types/DocumentHighlight.hs +71/−0
- src/Language/LSP/Types/DocumentLink.hs +70/−0
- src/Language/LSP/Types/DocumentSymbol.hs +211/−0
- src/Language/LSP/Types/FoldingRange.hs +99/−0
- src/Language/LSP/Types/Formatting.hs +113/−0
- src/Language/LSP/Types/Hover.hs +99/−0
- src/Language/LSP/Types/Implementation.hs +42/−0
- src/Language/LSP/Types/Initialize.hs +98/−0
- src/Language/LSP/Types/Lens.hs +301/−0
- src/Language/LSP/Types/Location.hs +76/−0
- src/Language/LSP/Types/LspId.hs +39/−0
- src/Language/LSP/Types/MarkupContent.hs +93/−0
- src/Language/LSP/Types/Message.hs +636/−0
- src/Language/LSP/Types/Method.hs +385/−0
- src/Language/LSP/Types/Progress.hs +230/−0
- src/Language/LSP/Types/References.hs +43/−0
- src/Language/LSP/Types/Registration.hs +175/−0
- src/Language/LSP/Types/Rename.hs +55/−0
- src/Language/LSP/Types/SelectionRange.hs +54/−0
- src/Language/LSP/Types/ServerCapabilities.hs +128/−0
- src/Language/LSP/Types/SignatureHelp.hs +154/−0
- src/Language/LSP/Types/StaticRegistrationOptions.hs +13/−0
- src/Language/LSP/Types/TextDocument.hs +264/−0
- src/Language/LSP/Types/TypeDefinition.hs +42/−0
- src/Language/LSP/Types/Uri.hs +204/−0
- src/Language/LSP/Types/Utils.hs +118/−0
- src/Language/LSP/Types/WatchedFiles.hs +113/−0
- src/Language/LSP/Types/Window.hs +71/−0
- src/Language/LSP/Types/WorkspaceEdit.hs +163/−0
- src/Language/LSP/Types/WorkspaceFolders.hs +37/−0
- src/Language/LSP/Types/WorkspaceSymbol.hs +76/−0
- src/Language/LSP/VFS.hs +308/−0
+ ChangeLog.md view
@@ -0,0 +1,277 @@+# Revision history for haskell-lsp-types++## 1.0.0.0++1.0.0.0 is a major rework with both internal and external facing changes, and+will require manual migration.++* The package has been renamed from `haskell-lsp` to `lsp`, and similarly for `haskell-lsp-types` to `lsp-types`+ * Because of this, all modules are now exported from `Language.LSP.X` rather than `Language.Haskell.X`.+* Both `lsp` and `lsp-types` have been reworked to be much more *type safe*+* The 3.15 specification should be fully supported now. If you find anything in+ the specification that isn't in lsp-types, please let us know+* The Capture module has been removed as it will be reworked later on and moved to lsp-test+* `lsp` can now handle dynamic registration through the `registerCapability` and+ `unregisterCapability` functions++### Type safety+There are three types of concrete messages, `NotificationMessage`,+`RequestMessage` and `ResponseMessage`. They are parameterised by their+`Method`, which determines what type their parameters or response result must be.++```haskell+data RequestMessage (m :: Method f Request) = RequestMessage+ { _jsonrpc :: Text+ , _id :: LspId m+ , _method :: SMethod m+ , _params :: MessageParams m+ }+```++A `Method` in turn is parameterised by whether it originates from the client or+the server, and whether it is used for notifications or requests:++```haskell+TextDocumentFoldingRange :: Method FromClient Request+TextDocumentSelectionRange :: Method FromClient Request+WindowShowMessage :: Method FromServer Notification+WindowShowMessageRequest :: Method FromServer Request+```++Each `Method` also has a singleton counterpart which allows it to be used at the+term level, for example in `RequestMessage._method`:++```haskell+STextDocumentFoldingRange :: SMethod TextDocumentFoldingRange+STextDocumentSelectionRange :: SMethod TextDocumentSelectionRange++SWindowShowMessage :: SMethod WindowShowMessage+SWindowShowMessageRequest :: SMethod WindowShowMessageRequest+```++The type families `MessageParams` and `ResponseResult` map each `Method` to the+appropriate type to be used in a response:++```haskell+ResponseResult TextDocumentRename = WorkspaceEdit+ResponseResult TextDocumentPrepareRename = Range |? RangeWithPlaceholder+```++Also new is the `|?` type which represents [union types in+TypeScript](https://www.typescriptlang.org/docs/handbook/unions-and-intersections.html#union-types),+and is used throughout the specification where a field can accept several+different types.++As an example of this in action, the types of your handlers will now depend on+whether or not they are a request or a notification. They will pass along the+precise type for the parameters the method you are handling, and in the case of+a request handler, will expect that the response you give back is of the correct+type as well.++```haskell+type family Handler (f :: Type -> Type) (m :: Method from t) = (result :: Type) | result -> f t m where+ Handler f (m :: Method _from Request) = RequestMessage m -> (Either ResponseError (ResponseResult m) -> f ()) -> f ()+ Handler f (m :: Method _from Notification) = NotificationMessage m -> f ()+```++### LspT+`LspFuncs` has been removed and instead functionality is exposed through+functions in the `MonadLsp` class.++```haskell+getVirtualFile :: MonadLsp config m => NormalizedUri -> m (Maybe VirtualFile)+sendRequest :: forall (m :: Method FromServer Request) f config. MonadLsp config f+ => SServerMethod m+ -> MessageParams m+ -> (Either ResponseError (ResponseResult m) -> f ())+ -> f (LspId m)+```++It is parameterised over the server's LSP configuration type and the underlying+monad.+We recommend that you build your own monad for your server on top of the `LspT`+transformer, so it will automatically become an instance of `MonadLsp`.++Inside the new `ServerDefinition` data type which gets passed to `runServer`,+you need to specify how to convert from IO to your monad and back in+`interpretHandler` so that `lsp` can execute your monad inside the handlers. You+can use the result returned from `doInitialize` to pass along the+`LanguageContextEnv` needed to run an `LspT`, as well as anything else your+monad needs.+```haskell+type +ServerDefinition { ...+, doInitialize = \env _req -> pure $ Right env+, interpretHandler = \env -> Iso + (runLspT env) -- how to convert from IO ~> m+ liftIO -- how to convert from m ~> IO+}+```++### Steps to migrate++1. In your `.cabal` file change any `haskell-lsp` dependencies to `lsp`+2. Replace your existing imports with `Haskell.LSP.Server`+3. If necessary define your own monad and fill in `interpretHandler`+4. Migrate your handlers to use `notificationHandler` and `requestHandler`,+ passing along the corresponding `SMethod` (See `example/Simple.hs`)+5. Remove any storage/use of `LspFuncs` and instead call the corresponding+ functions directly from your monad instead of `IO`++## 0.23.0.0++* Add runWith for transporots other than stdio (@paulyoung)+* Fix race condition in event captures (@bgamari)+* Tweak the sectionSeparator (@alanz)+* Add hashWithSaltInstances (@ndmitchell)+* Fix CompletionItem.tags not being optional (@bubba)+* Avoid unnecessary normalisation in Binary instance for+ NormalizedFilePath (@cocreature)+* Fix ordering of TH splices (@fendor)++## 0.22.0.0++* ResponseMessage results are now an Either type (@greenhat)+* Support for GHC 8.10.1++## 0.21.0.0++* Stop getCompletionPrefix from crashing if beforePos is empty+* Add DidChangeWatchedFilesRegistrationOptions+* Add NormalizedFilePath from ghcide+* Add diagnostic and completion tags+* Fix language server example+* Correctly fix the problem with '$/' notifications+* Add azure ci++## 0.20.0.0++* Force utf8 encoding when writing vfs temp files+* Don't log errors for '$/' notifications (@jinwoo)+* Force utf8 encoding when writing vfs temp files (@jneira)+* Store a hash in a NormalizedUri (@mpickering)+* Move "Semigroup WorkspaceEdit" instance (@sheaf)+* Fix vfs line endings (@jneira)++## 0.19.0.0 -- 2019-12-14++* Fix vfs line endings (@jneira)+* Fix typo in .cabal (@turion)+* Normalize file paths before converting to Uri's (@jneira)+* Fixes to persistVirtualFile (@mpickering)++## 0.18.0.0 -- 2019-11-17++* Fix response type for CodeLensResolve, add the ContentModified error+ code (@SquidDev)+* Add missing fmClientPrepareRenameRequest to MessageFuncs export (@alanz)+* Rework Core.Options and infer all server capabilities from handlers (@bubba)+* Generate lenses for WorkDoneProgress data types (@alanz)++## 0.17.0.0 -- 2019-10-18++* Update progress reporting to match the LSP 3.15 specification (@cocreature)+* Ensure ResponseMessage has either a result or an error (@cocreature)++## 0.16.0.0 -- 2019-09-07++* Add support for CodeActionOptions (@thomasjm)+* Add support for `textDocument/prepareRename` request (@thomasjm)+* Fix diagnostic code parsing (@thomasjm)+* Fix shutdown response type (@bubba)+* Relax base constraints for GHC 8.8 (@bubba)++## 0.15.0.0 -- 2019-07-01++* Normalize URIs to avoid issues with percent encoding (@cocreature)++## 0.14.0.1 -- 2019-06-13++* Fix Haddock error++## 0.14.0.0 -- 2019-06-13++* Add support for custom request and notification methods+ (@cocreature)++## 0.11.0.0 -- 2019-04-28++* Fix `window/progress/cancel` notification being a from server+ notification when it should be a from client notification+* Fix typo in FoldingRange request name++## 0.10.0.0 -- 2019-04-22++* Add types for `window/progress` notifications.++## 0.8.3.0++* Add `MarkupContent` to `HoverResponse`, and (some) json roundtrip tests.++## 0.8.2.0 -- 2019-04-11++* Add `applyTextEdit` and `editTextEdit` helpers++## 0.8.0.1 -- 2018-10-27++* Support GHC 8.6.1 by loosening constraints. Via @domenkozar++## 0.8.0.0 -- 2018-09-08++* Update Hover to be a nullable according to spec+* Move Lenses into a separate module, `Language.Haskell.LSP.Types.Lens`++## 0.7.0.0 -- 2018-08-14++* Update CompletionItem+ * Add `commitCharacters` field+ * Add `MarkupContent` option for `documentation`+ * Add `preselect` field+* Add CompletionContext+* Add new server capabilities+* Add workspace folder support+* Add document color and color presentation+* Add folding range support+* Add goto type support+* s/TH/Types/g+ * Move all types into haskell-lsp-types+ * Hide Language.Haskell.LSP.TH.DataTypesJSON - Use Language.Haskell.LSP.Types instead+* Add lenses for Language.Haskell.LSP.Types.Capabilities++## 0.6.0.0 -- 2018-08-06++* Add new DocumentSymbol type and hierarchal support+* Rename CommandOrCodeAction to CAResult++## 0.5.0.0 -- 2018-08-03++* Update Command.arguments to match specification+* Update ClientCapabilities to v3.10+* Add MarkupContent+* Add new CompletionKinds+* Add new SymbolKinds+* Add preset version capabilities++## 0.4.0.0 -- 2018-07-10++* CodeAction support as per v3.8 of the specification, by @Bubba+* Update VersionedTextDocumentIdentifier to match specification, by @Bubba.++## 0.3.0.0++* Handle TextDocumentSync fallbacks with new TDS type.++## 0.2.3.0++* GHC 8.4.3 support+* Introduce additional error codes as per the LSP spec. By @Bubba++## 0.2.2.0 -- 2018-05-04++* Make Diagnostic relatedInformation optional, as per the LSP Spec. By @Bubba.++## 0.2.1.0 -- 2018-05-02++* Broken out from the haskell-lsp package, to simplify development+ by not having to run massive TH processes when working on the+ framework.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Alan Zimmerman++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,13 @@+[](https://hackage.haskell.org/package/lsp-types)++# lsp-types+Haskell library for the data types for Microsoft Language Server Protocol++## Useful links++- https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md++## Other resource++See #haskell-ide-engine on IRC freenode+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lsp-types.cabal view
@@ -0,0 +1,96 @@+name: lsp-types+version: 1.0.0.0+synopsis: Haskell library for the Microsoft Language Server Protocol, data types++description: An implementation of the types to allow language implementors to+ support the Language Server Protocol for their specific language.++homepage: https://github.com/alanz/lsp+license: MIT+license-file: LICENSE+author: Alan Zimmerman+maintainer: alan.zimm@gmail.com+copyright: Alan Zimmerman, 2016-2020+category: Development+build-type: Simple+extra-source-files: ChangeLog.md, README.md+cabal-version: >=1.10++library+ exposed-modules: Language.LSP.Types+ , Language.LSP.Types.Capabilities+ , Language.LSP.Types.Lens+ , Language.LSP.VFS+ , Data.IxMap+ other-modules: Language.LSP.Types.Cancellation+ , Language.LSP.Types.ClientCapabilities+ , Language.LSP.Types.CodeAction+ , Language.LSP.Types.CodeLens+ , Language.LSP.Types.Command+ , Language.LSP.Types.Common+ , Language.LSP.Types.Completion+ , Language.LSP.Types.Configuration+ , Language.LSP.Types.Declaration+ , Language.LSP.Types.Definition+ , Language.LSP.Types.Diagnostic+ , Language.LSP.Types.DocumentColor+ , Language.LSP.Types.DocumentFilter+ , Language.LSP.Types.DocumentHighlight+ , Language.LSP.Types.DocumentLink+ , Language.LSP.Types.DocumentSymbol+ , Language.LSP.Types.FoldingRange+ , Language.LSP.Types.Formatting+ , Language.LSP.Types.Hover+ , Language.LSP.Types.Implementation+ , Language.LSP.Types.Initialize+ , Language.LSP.Types.Location+ , Language.LSP.Types.LspId+ , Language.LSP.Types.MarkupContent+ , Language.LSP.Types.Method+ , Language.LSP.Types.Message+ , Language.LSP.Types.Progress+ , Language.LSP.Types.Registration+ , Language.LSP.Types.References+ , Language.LSP.Types.Rename+ , Language.LSP.Types.SelectionRange+ , Language.LSP.Types.ServerCapabilities+ , Language.LSP.Types.SignatureHelp+ , Language.LSP.Types.StaticRegistrationOptions+ , Language.LSP.Types.TextDocument+ , Language.LSP.Types.TypeDefinition+ , Language.LSP.Types.Uri+ , Language.LSP.Types.Utils+ , Language.LSP.Types.Window+ , Language.LSP.Types.WatchedFiles+ , Language.LSP.Types.WorkspaceEdit+ , Language.LSP.Types.WorkspaceFolders+ , Language.LSP.Types.WorkspaceSymbol+ -- other-extensions:+ ghc-options: -Wall+ build-depends: base >= 4.9 && < 4.15+ , aeson >=1.2.2.0+ , binary+ , bytestring+ , containers+ , data-default+ , deepseq+ , directory+ , filepath+ , hashable+ , hslogger+ , lens >= 4.15.2+ , network-uri+ , rope-utf16-splay >= 0.3.1.0+ , scientific+ , some+ , dependent-sum-template+ , text+ , template-haskell+ , temporary+ , unordered-containers+ hs-source-dirs: src+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/alanz/haskell-lsp
+ src/Data/IxMap.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns #-}++module Data.IxMap where++import qualified Data.Map as M+import Data.Some+import Data.Kind+import Unsafe.Coerce++-- a `compare` b <=> toBase a `compare` toBase b+-- toBase (i :: f a) == toBase (j :: f b) <=> a ~ b+class Ord (Base f) => IxOrd f where+ type Base f+ toBase :: forall a. f a -> Base f++newtype IxMap (k :: a -> Type) (f :: a -> Type) = IxMap { getMap :: M.Map (Base k) (Some f) }++emptyIxMap :: IxMap k f+emptyIxMap = IxMap M.empty+ +insertIxMap :: IxOrd k => k m -> f m -> IxMap k f -> Maybe (IxMap k f)+insertIxMap (toBase -> i) x (IxMap m)+ | M.notMember i m = Just $ IxMap $ M.insert i (mkSome x) m+ | otherwise = Nothing++lookupIxMap :: IxOrd k => k m -> IxMap k f -> Maybe (f m)+lookupIxMap i (IxMap m) =+ case M.lookup (toBase i) m of+ Just (Some v) -> Just $ unsafeCoerce v+ Nothing -> Nothing++pickFromIxMap :: IxOrd k => k m -> IxMap k f -> (Maybe (f m), IxMap k f)+pickFromIxMap i (IxMap m) =+ case M.updateLookupWithKey (\_ _ -> Nothing) (toBase i) m of+ (Nothing,m') -> (Nothing,IxMap m')+ (Just (Some k),m') -> (Just (unsafeCoerce k),IxMap m')
+ src/Language/LSP/Types.hs view
@@ -0,0 +1,84 @@+module Language.LSP.Types+ ( module Language.LSP.Types.Cancellation+ , module Language.LSP.Types.CodeAction+ , module Language.LSP.Types.CodeLens+ , module Language.LSP.Types.Command+ , module Language.LSP.Types.Common+ , module Language.LSP.Types.Completion+ , module Language.LSP.Types.Configuration+ , module Language.LSP.Types.Declaration+ , module Language.LSP.Types.Definition+ , module Language.LSP.Types.Diagnostic+ , module Language.LSP.Types.DocumentColor+ , module Language.LSP.Types.DocumentFilter+ , module Language.LSP.Types.DocumentHighlight+ , module Language.LSP.Types.DocumentLink+ , module Language.LSP.Types.DocumentSymbol+ , module Language.LSP.Types.FoldingRange+ , module Language.LSP.Types.Formatting+ , module Language.LSP.Types.Hover+ , module Language.LSP.Types.Implementation+ , module Language.LSP.Types.Initialize+ , module Language.LSP.Types.Location+ , module Language.LSP.Types.LspId+ , module Language.LSP.Types.MarkupContent+ , module Language.LSP.Types.Method+ , module Language.LSP.Types.Message+ , module Language.LSP.Types.Progress+ , module Language.LSP.Types.References+ , module Language.LSP.Types.Registration+ , module Language.LSP.Types.Rename+ , module Language.LSP.Types.SignatureHelp+ , module Language.LSP.Types.StaticRegistrationOptions+ , module Language.LSP.Types.SelectionRange+ , module Language.LSP.Types.TextDocument+ , module Language.LSP.Types.TypeDefinition+ , module Language.LSP.Types.Uri+ , module Language.LSP.Types.WatchedFiles+ , module Language.LSP.Types.Window+ , module Language.LSP.Types.WorkspaceEdit+ , module Language.LSP.Types.WorkspaceFolders+ , module Language.LSP.Types.WorkspaceSymbol+ )+where++import Language.LSP.Types.Cancellation+import Language.LSP.Types.CodeAction+import Language.LSP.Types.CodeLens+import Language.LSP.Types.Command+import Language.LSP.Types.Common+import Language.LSP.Types.Completion+import Language.LSP.Types.Configuration+import Language.LSP.Types.Declaration+import Language.LSP.Types.Definition+import Language.LSP.Types.Diagnostic+import Language.LSP.Types.DocumentColor+import Language.LSP.Types.DocumentFilter+import Language.LSP.Types.DocumentHighlight+import Language.LSP.Types.DocumentLink+import Language.LSP.Types.DocumentSymbol+import Language.LSP.Types.FoldingRange+import Language.LSP.Types.Formatting+import Language.LSP.Types.Hover+import Language.LSP.Types.Implementation+import Language.LSP.Types.Initialize+import Language.LSP.Types.Location+import Language.LSP.Types.LspId+import Language.LSP.Types.MarkupContent+import Language.LSP.Types.Method+import Language.LSP.Types.Message+import Language.LSP.Types.Progress+import Language.LSP.Types.References+import Language.LSP.Types.Registration+import Language.LSP.Types.Rename+import Language.LSP.Types.SelectionRange+import Language.LSP.Types.SignatureHelp+import Language.LSP.Types.StaticRegistrationOptions+import Language.LSP.Types.TextDocument+import Language.LSP.Types.TypeDefinition+import Language.LSP.Types.Uri+import Language.LSP.Types.WatchedFiles+import Language.LSP.Types.Window+import Language.LSP.Types.WorkspaceEdit+import Language.LSP.Types.WorkspaceFolders+import Language.LSP.Types.WorkspaceSymbol
+ src/Language/LSP/Types/Cancellation.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ExistentialQuantification #-}+module Language.LSP.Types.Cancellation where+ +import Data.Aeson.TH+import Language.LSP.Types.LspId+import Language.LSP.Types.Utils++data CancelParams = forall m.+ CancelParams+ { -- | The request id to cancel.+ _id :: LspId m+ }++deriving instance Read CancelParams+deriving instance Show CancelParams+instance Eq CancelParams where+ (CancelParams a) == CancelParams b =+ case (a,b) of+ (IdInt x, IdInt y) -> x == y+ (IdString x, IdString y) -> x == y+ _ -> False++deriveJSON lspOptions ''CancelParams
+ src/Language/LSP/Types/Capabilities.hs view
@@ -0,0 +1,246 @@+module Language.LSP.Types.Capabilities+ (+ module Language.LSP.Types.ClientCapabilities+ , module Language.LSP.Types.ServerCapabilities+ , module Language.LSP.Types.WorkspaceEdit+ , fullCaps+ , LSPVersion(..)+ , capsForVersion+ ) where++import Prelude hiding (min)+import Language.LSP.Types.ClientCapabilities+import Language.LSP.Types.ServerCapabilities+import Language.LSP.Types.WorkspaceEdit+import Language.LSP.Types++-- | Capabilities for full conformance to the current (v3.15) LSP specification.+fullCaps :: ClientCapabilities+fullCaps = capsForVersion (LSPVersion maxBound maxBound)++-- | A specific version of the LSP specification.+data LSPVersion = LSPVersion Int Int -- ^ Construct a major.minor version++-- | Capabilities for full conformance to the LSP specification up until a version.+-- Some important milestones:+--+-- * 3.12 textDocument/prepareRename request+-- * 3.11 CodeActionOptions provided by the server+-- * 3.10 hierarchical document symbols, folding ranges+-- * 3.9 completion item preselect+-- * 3.8 codeAction literals+-- * 3.7 related information in diagnostics+-- * 3.6 workspace folders, colors, goto type/implementation+-- * 3.4 extended completion item and symbol item kinds+-- * 3.0 dynamic registration+capsForVersion :: LSPVersion -> ClientCapabilities+capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Just window) Nothing+ where+ w = WorkspaceClientCapabilities+ (Just True)+ (Just (WorkspaceEditClientCapabilities+ (Just True)+ (since 3 13 resourceOperations)+ Nothing))+ (Just (DidChangeConfigurationClientCapabilities dynamicReg))+ (Just (DidChangeWatchedFilesClientCapabilities dynamicReg))+ (Just symbolCapabilities)+ (Just (ExecuteCommandClientCapabilities dynamicReg))+ (since 3 6 True)+ (since 3 6 True)+ + resourceOperations = List+ [ ResourceOperationCreate+ , ResourceOperationDelete+ , ResourceOperationRename+ ]++ symbolCapabilities = WorkspaceSymbolClientCapabilities+ dynamicReg+ (since 3 4 symbolKindCapabilities)++ symbolKindCapabilities =+ WorkspaceSymbolKindClientCapabilities (Just sKs)++ sKs+ | maj >= 3 && min >= 4 = List (oldSKs ++ newSKs)+ | otherwise = List oldSKs++ oldSKs = [ SkFile+ , SkModule+ , SkNamespace+ , SkPackage+ , SkClass+ , SkMethod+ , SkProperty+ , SkField+ , SkConstructor+ , SkEnum+ , SkInterface+ , SkFunction+ , SkVariable+ , SkConstant+ , SkString+ , SkNumber+ , SkBoolean+ , SkArray+ ]++ newSKs = [ SkObject+ , SkKey+ , SkNull+ , SkEnumMember+ , SkStruct+ , SkEvent+ , SkOperator+ , SkTypeParameter+ ]++ td = TextDocumentClientCapabilities+ (Just sync)+ (Just completionCapability)+ (Just hoverCapability)+ (Just signatureHelpCapability)+ (Just (ReferencesClientCapabilities dynamicReg))+ (Just (DocumentHighlightClientCapabilities dynamicReg))+ (Just documentSymbolCapability)+ (Just (DocumentFormattingClientCapabilities dynamicReg))+ (Just (DocumentRangeFormattingClientCapabilities dynamicReg))+ (Just (DocumentOnTypeFormattingClientCapabilities dynamicReg))+ (since 3 14 (DeclarationClientCapabilities dynamicReg (Just True)))+ (Just (DefinitionClientCapabilities dynamicReg (since 3 14 True)))+ (since 3 6 (TypeDefinitionClientCapabilities dynamicReg (since 3 14 True)))+ (since 3 6 (ImplementationClientCapabilities dynamicReg (since 3 14 True)))+ (Just codeActionCapability)+ (Just (CodeLensClientCapabilities dynamicReg))+ (Just (DocumentLinkClientCapabilities dynamicReg (since 3 15 True)))+ (since 3 6 (DocumentColorClientCapabilities dynamicReg))+ (Just (RenameClientCapabilities dynamicReg (since 3 12 True)))+ (Just publishDiagnosticsCapabilities)+ (since 3 10 foldingRangeCapability)+ (since 3 5 (SelectionRangeClientCapabilities dynamicReg))+ sync =+ TextDocumentSyncClientCapabilities+ dynamicReg+ (Just True)+ (Just True)+ (Just True)++ completionCapability =+ CompletionClientCapabilities+ dynamicReg+ (Just completionItemCapabilities)+ (since 3 4 completionItemKindCapabilities)+ (since 3 3 True)++ completionItemCapabilities = CompletionItemClientCapabilities+ (Just True)+ (Just True)+ (since 3 3 (List [MkPlainText, MkMarkdown]))+ (Just True)+ (since 3 9 True)+ (since 3 15 completionItemTagsCapabilities)++ completionItemKindCapabilities =+ CompletionItemKindClientCapabilities (Just ciKs)++ completionItemTagsCapabilities =+ CompletionItemTagsClientCapabilities (List [ CtDeprecated ])++ ciKs+ | maj >= 3 && min >= 4 = List (oldCiKs ++ newCiKs)+ | otherwise = List oldCiKs++ oldCiKs = [ CiText+ , CiMethod+ , CiFunction+ , CiConstructor+ , CiField+ , CiVariable+ , CiClass+ , CiInterface+ , CiModule+ , CiProperty+ , CiUnit+ , CiValue+ , CiEnum+ , CiKeyword+ , CiSnippet+ , CiColor+ , CiFile+ , CiReference+ ]++ newCiKs = [ CiFolder+ , CiEnumMember+ , CiConstant+ , CiStruct+ , CiEvent+ , CiOperator+ , CiTypeParameter+ ]++ hoverCapability =+ HoverClientCapabilities+ dynamicReg+ (since 3 3 (List [MkPlainText, MkMarkdown]))++ codeActionCapability+ = CodeActionClientCapabilities+ dynamicReg+ (since 3 8 (CodeActionLiteralSupport caKs))+ (since 3 15 True)+ caKs = CodeActionKindClientCapabilities+ (List [ CodeActionQuickFix+ , CodeActionRefactor+ , CodeActionRefactorExtract+ , CodeActionRefactorInline+ , CodeActionRefactorRewrite+ , CodeActionSource+ , CodeActionSourceOrganizeImports+ ])++ signatureHelpCapability =+ SignatureHelpClientCapabilities+ dynamicReg+ (Just signatureInformationCapability)+ Nothing++ signatureInformationCapability =+ SignatureHelpSignatureInformation+ (Just (List [MkPlainText, MkMarkdown])) Nothing++ documentSymbolCapability =+ DocumentSymbolClientCapabilities+ dynamicReg+ (since 3 4 documentSymbolKind)+ (since 3 10 True)++ documentSymbolKind =+ DocumentSymbolKindClientCapabilities+ (Just sKs) -- same as workspace symbol kinds++ foldingRangeCapability =+ FoldingRangeClientCapabilities+ dynamicReg+ Nothing+ (Just False)++ publishDiagnosticsCapabilities =+ PublishDiagnosticsClientCapabilities+ (since 3 7 True)+ (since 3 15 publishDiagnosticsTagsCapabilities)+ (since 3 15 True)++ publishDiagnosticsTagsCapabilities =+ PublishDiagnosticsTagsClientCapabilities+ (List [ DtUnnecessary, DtDeprecated ])++ dynamicReg+ | maj >= 3 = Just True+ | otherwise = Nothing+ since x y a+ | maj >= x && min >= y = Just a+ | otherwise = Nothing+ + window = WindowClientCapabilities (since 3 15 True)
+ src/Language/LSP/Types/ClientCapabilities.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}++module Language.LSP.Types.ClientCapabilities where++import Data.Aeson.TH+import qualified Data.Aeson as A+import Data.Default+import Language.LSP.Types.CodeAction+import Language.LSP.Types.CodeLens+import Language.LSP.Types.Command+import Language.LSP.Types.Completion+import Language.LSP.Types.Configuration+import Language.LSP.Types.Diagnostic+import Language.LSP.Types.Declaration+import Language.LSP.Types.Definition+import Language.LSP.Types.DocumentColor+import Language.LSP.Types.DocumentHighlight+import Language.LSP.Types.DocumentLink+import Language.LSP.Types.DocumentSymbol+import Language.LSP.Types.FoldingRange+import Language.LSP.Types.Formatting+import Language.LSP.Types.Hover+import Language.LSP.Types.Implementation+import Language.LSP.Types.References+import Language.LSP.Types.Rename+import Language.LSP.Types.SelectionRange+import Language.LSP.Types.SignatureHelp+import Language.LSP.Types.TextDocument+import Language.LSP.Types.TypeDefinition+import Language.LSP.Types.Utils+import Language.LSP.Types.WatchedFiles+import Language.LSP.Types.WorkspaceEdit+import Language.LSP.Types.WorkspaceSymbol+++data WorkspaceClientCapabilities =+ WorkspaceClientCapabilities+ { -- | The client supports applying batch edits to the workspace by supporting+ -- the request 'workspace/applyEdit'+ _applyEdit :: Maybe Bool++ -- | Capabilities specific to `WorkspaceEdit`s+ , _workspaceEdit :: Maybe WorkspaceEditClientCapabilities++ -- | Capabilities specific to the `workspace/didChangeConfiguration` notification.+ , _didChangeConfiguration :: Maybe DidChangeConfigurationClientCapabilities++ -- | Capabilities specific to the `workspace/didChangeWatchedFiles` notification.+ , _didChangeWatchedFiles :: Maybe DidChangeWatchedFilesClientCapabilities++ -- | Capabilities specific to the `workspace/symbol` request.+ , _symbol :: Maybe WorkspaceSymbolClientCapabilities++ -- | Capabilities specific to the `workspace/executeCommand` request.+ , _executeCommand :: Maybe ExecuteCommandClientCapabilities++ -- | The client has support for workspace folders.+ , _workspaceFolders :: Maybe Bool++ -- | The client supports `workspace/configuration` requests.+ , _configuration :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''WorkspaceClientCapabilities++instance Default WorkspaceClientCapabilities where+ def = WorkspaceClientCapabilities def def def def def def def def++-- -------------------------------------++data TextDocumentClientCapabilities =+ TextDocumentClientCapabilities+ { _synchronization :: Maybe TextDocumentSyncClientCapabilities++ -- | Capabilities specific to the `textDocument/completion`+ , _completion :: Maybe CompletionClientCapabilities++ -- | Capabilities specific to the `textDocument/hover`+ , _hover :: Maybe HoverClientCapabilities++ -- | Capabilities specific to the `textDocument/signatureHelp`+ , _signatureHelp :: Maybe SignatureHelpClientCapabilities++ -- | Capabilities specific to the `textDocument/references`+ , _references :: Maybe ReferencesClientCapabilities++ -- | Capabilities specific to the `textDocument/documentHighlight`+ , _documentHighlight :: Maybe DocumentHighlightClientCapabilities++ -- | Capabilities specific to the `textDocument/documentSymbol`+ , _documentSymbol :: Maybe DocumentSymbolClientCapabilities++ -- | Capabilities specific to the `textDocument/formatting`+ , _formatting :: Maybe DocumentFormattingClientCapabilities++ -- | Capabilities specific to the `textDocument/rangeFormatting`+ , _rangeFormatting :: Maybe DocumentRangeFormattingClientCapabilities++ -- | Capabilities specific to the `textDocument/onTypeFormatting`+ , _onTypeFormatting :: Maybe DocumentOnTypeFormattingClientCapabilities++ -- | Capabilities specific to the `textDocument/declaration` request.+ -- + -- Since LSP 3.14.0+ , _declaration :: Maybe DeclarationClientCapabilities++ -- | Capabilities specific to the `textDocument/definition`+ , _definition :: Maybe DefinitionClientCapabilities++ -- | Capabilities specific to the `textDocument/typeDefinition`+ , _typeDefinition :: Maybe TypeDefinitionClientCapabilities++ -- | Capabilities specific to the `textDocument/implementation`+ , _implementation :: Maybe ImplementationClientCapabilities++ -- | Capabilities specific to the `textDocument/codeAction`+ , _codeAction :: Maybe CodeActionClientCapabilities++ -- | Capabilities specific to the `textDocument/codeLens`+ , _codeLens :: Maybe CodeLensClientCapabilities++ -- | Capabilities specific to the `textDocument/documentLink`+ , _documentLink :: Maybe DocumentLinkClientCapabilities++ -- | Capabilities specific to the `textDocument/documentColor` and the+ -- `textDocument/colorPresentation` request+ , _colorProvider :: Maybe DocumentColorClientCapabilities++ -- | Capabilities specific to the `textDocument/rename`+ , _rename :: Maybe RenameClientCapabilities++ -- | Capabilities specific to `textDocument/publishDiagnostics`+ , _publishDiagnostics :: Maybe PublishDiagnosticsClientCapabilities++ -- | Capabilities specific to the `textDocument/foldingRange` request.+ -- Since LSP 3.10.+ --+ -- @since 0.7.0.0+ , _foldingRange :: Maybe FoldingRangeClientCapabilities++ -- | Capabilities specific to the `textDocument/selectionRange` request.+ -- Since LSP 3.15.0+ , _selectionRange :: Maybe SelectionRangeClientCapabilities+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''TextDocumentClientCapabilities++instance Default TextDocumentClientCapabilities where+ def = TextDocumentClientCapabilities def def def def def def def def+ def def def def def def def def+ def def def def def def++-- ---------------------------------------------------------------------++-- | Window specific client capabilities.+data WindowClientCapabilities =+ WindowClientCapabilities+ { -- | Whether client supports handling progress notifications.+ _workDoneProgress :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''WindowClientCapabilities++instance Default WindowClientCapabilities where+ def = WindowClientCapabilities def++data ClientCapabilities =+ ClientCapabilities+ { _workspace :: Maybe WorkspaceClientCapabilities+ , _textDocument :: Maybe TextDocumentClientCapabilities+ -- | Capabilities specific to `window/progress` requests. Experimental.+ --+ -- @since 0.10.0.0+ , _window :: Maybe WindowClientCapabilities+ , _experimental :: Maybe A.Object+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ClientCapabilities++instance Default ClientCapabilities where+ def = ClientCapabilities def def def def
+ src/Language/LSP/Types/CodeAction.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Language.LSP.Types.CodeAction where++import Data.Aeson.TH+import Data.Aeson.Types+import Data.Default+import Data.Text ( Text )+import Language.LSP.Types.Command+import Language.LSP.Types.Diagnostic+import Language.LSP.Types.Common+import Language.LSP.Types.Location+import Language.LSP.Types.Progress+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils+import Language.LSP.Types.WorkspaceEdit+++data CodeActionKind+ = -- | Empty kind.+ CodeActionEmpty+ | -- | Base kind for quickfix actions: @quickfix@.+ CodeActionQuickFix+ | -- | Base kind for refactoring actions: @refactor@.+ CodeActionRefactor+ | -- | Base kind for refactoring extraction actions: @refactor.extract@.+ -- Example extract actions:+ --+ -- - Extract method+ -- - Extract function+ -- - Extract variable+ -- - Extract interface from class+ -- - ...+ CodeActionRefactorExtract+ | -- | Base kind for refactoring inline actions: @refactor.inline@.+ --+ -- Example inline actions:+ --+ -- - Inline function+ -- - Inline variable+ -- - Inline constant+ -- - ...+ CodeActionRefactorInline+ | -- | Base kind for refactoring rewrite actions: @refactor.rewrite@.+ --+ -- Example rewrite actions:+ --+ -- - Convert JavaScript function to class+ -- - Add or remove parameter+ -- - Encapsulate field+ -- - Make method static+ -- - Move method to base class+ -- - ...+ CodeActionRefactorRewrite+ | -- | Base kind for source actions: @source@.+ --+ -- Source code actions apply to the entire file.+ CodeActionSource+ | -- | Base kind for an organize imports source action: @source.organizeImports@.+ CodeActionSourceOrganizeImports+ | CodeActionUnknown Text+ deriving (Read, Show, Eq)++instance ToJSON CodeActionKind where+ toJSON CodeActionEmpty = String ""+ toJSON CodeActionQuickFix = String "quickfix"+ toJSON CodeActionRefactor = String "refactor"+ toJSON CodeActionRefactorExtract = String "refactor.extract"+ toJSON CodeActionRefactorInline = String "refactor.inline"+ toJSON CodeActionRefactorRewrite = String "refactor.rewrite"+ toJSON CodeActionSource = String "source"+ toJSON CodeActionSourceOrganizeImports = String "source.organizeImports"+ toJSON (CodeActionUnknown s) = String s++instance FromJSON CodeActionKind where+ parseJSON (String "") = pure CodeActionEmpty+ parseJSON (String "quickfix") = pure CodeActionQuickFix+ parseJSON (String "refactor") = pure CodeActionRefactor+ parseJSON (String "refactor.extract") = pure CodeActionRefactorExtract+ parseJSON (String "refactor.inline") = pure CodeActionRefactorInline+ parseJSON (String "refactor.rewrite") = pure CodeActionRefactorRewrite+ parseJSON (String "source") = pure CodeActionSource+ parseJSON (String "source.organizeImports") = pure CodeActionSourceOrganizeImports+ parseJSON (String s) = pure (CodeActionUnknown s)+ parseJSON _ = mempty+ +-- -------------------------------------++data CodeActionKindClientCapabilities =+ CodeActionKindClientCapabilities+ { -- | The code action kind values the client supports. When this+ -- property exists the client also guarantees that it will+ -- handle values outside its set gracefully and falls back+ -- to a default value when unknown.+ _valueSet :: List CodeActionKind+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''CodeActionKindClientCapabilities++instance Default CodeActionKindClientCapabilities where+ def = CodeActionKindClientCapabilities (List allKinds)+ where allKinds = [ CodeActionQuickFix+ , CodeActionRefactor+ , CodeActionRefactorExtract+ , CodeActionRefactorInline+ , CodeActionRefactorRewrite+ , CodeActionSource+ , CodeActionSourceOrganizeImports+ ]++data CodeActionLiteralSupport =+ CodeActionLiteralSupport+ { _codeActionKind :: CodeActionKindClientCapabilities -- ^ The code action kind is support with the following value set.+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''CodeActionLiteralSupport++data CodeActionClientCapabilities = CodeActionClientCapabilities+ { -- | Whether code action supports dynamic registration.+ _dynamicRegistration :: Maybe Bool,+ -- | The client support code action literals as a valid response+ -- of the `textDocument/codeAction` request.+ -- Since 3.8.0+ _codeActionLiteralSupport :: Maybe CodeActionLiteralSupport,+ -- | Whether code action supports the `isPreferred` property. Since LSP 3.15.0+ _isPreferredSupport :: Maybe Bool+ }+ deriving (Show, Read, Eq)++deriveJSON lspOptions ''CodeActionClientCapabilities++-- -------------------------------------++makeExtendingDatatype "CodeActionOptions" [''WorkDoneProgressOptions]+ [("_codeActionKinds", [t| Maybe (List CodeActionKind) |])]+deriveJSON lspOptions ''CodeActionOptions++makeExtendingDatatype "CodeActionRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''CodeActionOptions+ ] []+deriveJSON lspOptions ''CodeActionRegistrationOptions++-- -------------------------------------++-- | Contains additional diagnostic information about the context in which a+-- code action is run.+data CodeActionContext = CodeActionContext+ { -- | An array of diagnostics known on the client side overlapping the range provided to the+ -- @textDocument/codeAction@ request. They are provided so that the server knows which+ -- errors are currently presented to the user for the given range. There is no guarantee+ -- that these accurately reflect the error state of the resource. The primary parameter+ -- to compute code actions is the provided range.+ _diagnostics :: List Diagnostic+ -- | Requested kind of actions to return.+ --+ -- Actions not of this kind are filtered out by the client before being shown. So servers+ -- can omit computing them.+ , _only :: Maybe (List CodeActionKind)+ }+ deriving (Read, Show, Eq)++deriveJSON lspOptions ''CodeActionContext++makeExtendingDatatype "CodeActionParams"+ [ ''WorkDoneProgressParams+ , ''PartialResultParams+ ]+ [ ("_textDocument", [t|TextDocumentIdentifier|]),+ ("_range", [t|Range|]),+ ("_context", [t|CodeActionContext|])+ ]+deriveJSON lspOptions ''CodeActionParams++-- | A code action represents a change that can be performed in code, e.g. to fix a problem or+-- to refactor code.+--+-- A CodeAction must set either '_edit' and/or a '_command'. If both are supplied,+-- the '_edit' is applied first, then the '_command' is executed.+data CodeAction =+ CodeAction+ { -- | A short, human-readable, title for this code action.+ _title :: Text,+ -- | The kind of the code action. Used to filter code actions.+ _kind :: Maybe CodeActionKind,+ -- | The diagnostics that this code action resolves.+ _diagnostics :: Maybe (List Diagnostic),+ -- | Marks this as a preferred action. Preferred actions are used by the `auto fix` command and can be targeted+ -- by keybindings.+ --+ -- A quick fix should be marked preferred if it properly addresses the underlying error.+ -- A refactoring should be marked preferred if it is the most reasonable choice of actions to take.+ --+ -- Since LSP 3.15.0+ _isPreferred :: Maybe Bool,+ -- | The workspace edit this code action performs.+ _edit :: Maybe WorkspaceEdit,+ -- | A command this code action executes. If a code action+ -- provides an edit and a command, first the edit is+ -- executed and then the command.+ _command :: Maybe Command+ }+ deriving (Read, Show, Eq)+deriveJSON lspOptions ''CodeAction
+ src/Language/LSP/Types/CodeLens.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Language.LSP.Types.CodeLens where++import Data.Aeson+import Data.Aeson.TH+import Language.LSP.Types.Command+import Language.LSP.Types.Location+import Language.LSP.Types.Progress+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils++-- -------------------------------------++data CodeLensClientCapabilities =+ CodeLensClientCapabilities+ { -- | Whether code lens supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''CodeLensClientCapabilities++-- -------------------------------------++makeExtendingDatatype "CodeLensOptions" [''WorkDoneProgressOptions]+ [ ("_resolveProvider", [t| Maybe Bool |] )]+deriveJSON lspOptions ''CodeLensOptions++makeExtendingDatatype "CodeLensRegistrationOptions" + [ ''TextDocumentRegistrationOptions+ , ''CodeLensOptions+ ] []+deriveJSON lspOptions ''CodeLensRegistrationOptions++-- -------------------------------------++makeExtendingDatatype "CodeLensParams"+ [ ''WorkDoneProgressParams,+ ''PartialResultParams+ ]+ [("_textDocument", [t|TextDocumentIdentifier|])]+deriveJSON lspOptions ''CodeLensParams++-- -------------------------------------++-- | A code lens represents a command that should be shown along with source+-- text, like the number of references, a way to run tests, etc.+-- +-- A code lens is _unresolved_ when no command is associated to it. For+-- performance reasons the creation of a code lens and resolving should be done+-- in two stages.+data CodeLens =+ CodeLens+ { -- | The range in which this code lens is valid. Should only span a single line.+ _range :: Range+ , -- | The command this code lens represents.+ _command :: Maybe Command+ , -- | A data entry field that is preserved on a code lens item between+ -- a code lens and a code lens resolve request.+ _xdata :: Maybe Value+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''CodeLens
+ src/Language/LSP/Types/Command.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Language.LSP.Types.Command where++import Data.Aeson+import Data.Aeson.TH+import Data.Text+import Language.LSP.Types.Common+import Language.LSP.Types.Progress+import Language.LSP.Types.Utils++-- -------------------------------------++data ExecuteCommandClientCapabilities =+ ExecuteCommandClientCapabilities+ { _dynamicRegistration :: Maybe Bool -- ^Execute command supports dynamic+ -- registration.+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ExecuteCommandClientCapabilities++-- -------------------------------------++makeExtendingDatatype "ExecuteCommandOptions" [''WorkDoneProgressOptions]+ [("_commands", [t| List Text |])]+deriveJSON lspOptions ''ExecuteCommandOptions++makeExtendingDatatype "ExecuteCommandRegistrationOptions" [''ExecuteCommandOptions] []+deriveJSON lspOptions ''ExecuteCommandRegistrationOptions++-- -------------------------------------++makeExtendingDatatype "ExecuteCommandParams" [''WorkDoneProgressParams]+ [ ("_command", [t| Text |])+ , ("_arguments", [t| Maybe (List Value) |])+ ]+deriveJSON lspOptions ''ExecuteCommandParams++data Command =+ Command+ { -- | Title of the command, like @save@.+ _title :: Text+ , -- | The identifier of the actual command handler.+ _command :: Text+ , -- | Arguments that the command handler should be invoked with.+ _arguments :: Maybe (List Value)+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''Command+
+ src/Language/LSP/Types/Common.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}++-- | Common types that aren't in the specification+module Language.LSP.Types.Common where++import Control.Applicative+import Control.DeepSeq+import Data.Aeson+import GHC.Generics++-- | A terser, isomorphic data type for 'Either', that does not get tagged when+-- converting to and from JSON.+data a |? b = InL a+ | InR b+ deriving (Read,Show,Eq,Ord,Generic)+infixr |?++toEither :: a |? b -> Either a b+toEither (InL a) = Left a+toEither (InR b) = Right b++instance (ToJSON a, ToJSON b) => ToJSON (a |? b) where+ toJSON (InL x) = toJSON x+ toJSON (InR x) = toJSON x++instance (FromJSON a, FromJSON b) => FromJSON (a |? b) where+ -- Important: Try to parse the **rightmost** type first, as in the specification+ -- the more complex types tend to appear on the right of the |, i.e.+ -- @colorProvider?: boolean | DocumentColorOptions | DocumentColorRegistrationOptions;@+ parseJSON v = InR <$> parseJSON v <|> InL <$> parseJSON v++instance (NFData a, NFData b) => NFData (a |? b)++-- | All LSP types representing a list **must** use this type rather than '[]'.+-- In particular this is necessary to change the 'FromJSON' instance to be compatible+-- with Elisp (where empty lists show up as 'null')+newtype List a = List [a]+ deriving (Show,Read,Eq,Ord,Semigroup,Monoid,Functor,Foldable,Traversable,Generic)++instance NFData a => NFData (List a)++instance (ToJSON a) => ToJSON (List a) where+ toJSON (List ls) = toJSON ls++instance (FromJSON a) => FromJSON (List a) where+ parseJSON Null = return (List [])+ parseJSON v = List <$> parseJSON v++data Empty = Empty deriving (Eq,Ord,Show)+instance ToJSON Empty where+ toJSON Empty = Null+instance FromJSON Empty where+ parseJSON Null = pure Empty+ parseJSON _ = mempty
+ src/Language/LSP/Types/Completion.hs view
@@ -0,0 +1,337 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Language.LSP.Types.Completion where++import Control.Applicative+import qualified Data.Aeson as A+import Data.Aeson.TH+import Data.Scientific ( Scientific )+import Data.Text ( Text )+import Language.LSP.Types.Command+import Language.LSP.Types.Common+import Language.LSP.Types.MarkupContent+import Language.LSP.Types.Progress+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils+import Language.LSP.Types.WorkspaceEdit++data CompletionItemKind = CiText+ | CiMethod+ | CiFunction+ | CiConstructor+ | CiField+ | CiVariable+ | CiClass+ | CiInterface+ | CiModule+ | CiProperty+ | CiUnit+ | CiValue+ | CiEnum+ | CiKeyword+ | CiSnippet+ | CiColor+ | CiFile+ | CiReference+ | CiFolder+ | CiEnumMember+ | CiConstant+ | CiStruct+ | CiEvent+ | CiOperator+ | CiTypeParameter+ deriving (Read,Show,Eq,Ord)++instance A.ToJSON CompletionItemKind where+ toJSON CiText = A.Number 1+ toJSON CiMethod = A.Number 2+ toJSON CiFunction = A.Number 3+ toJSON CiConstructor = A.Number 4+ toJSON CiField = A.Number 5+ toJSON CiVariable = A.Number 6+ toJSON CiClass = A.Number 7+ toJSON CiInterface = A.Number 8+ toJSON CiModule = A.Number 9+ toJSON CiProperty = A.Number 10+ toJSON CiUnit = A.Number 11+ toJSON CiValue = A.Number 12+ toJSON CiEnum = A.Number 13+ toJSON CiKeyword = A.Number 14+ toJSON CiSnippet = A.Number 15+ toJSON CiColor = A.Number 16+ toJSON CiFile = A.Number 17+ toJSON CiReference = A.Number 18+ toJSON CiFolder = A.Number 19+ toJSON CiEnumMember = A.Number 20+ toJSON CiConstant = A.Number 21+ toJSON CiStruct = A.Number 22+ toJSON CiEvent = A.Number 23+ toJSON CiOperator = A.Number 24+ toJSON CiTypeParameter = A.Number 25++instance A.FromJSON CompletionItemKind where+ parseJSON (A.Number 1) = pure CiText+ parseJSON (A.Number 2) = pure CiMethod+ parseJSON (A.Number 3) = pure CiFunction+ parseJSON (A.Number 4) = pure CiConstructor+ parseJSON (A.Number 5) = pure CiField+ parseJSON (A.Number 6) = pure CiVariable+ parseJSON (A.Number 7) = pure CiClass+ parseJSON (A.Number 8) = pure CiInterface+ parseJSON (A.Number 9) = pure CiModule+ parseJSON (A.Number 10) = pure CiProperty+ parseJSON (A.Number 11) = pure CiUnit+ parseJSON (A.Number 12) = pure CiValue+ parseJSON (A.Number 13) = pure CiEnum+ parseJSON (A.Number 14) = pure CiKeyword+ parseJSON (A.Number 15) = pure CiSnippet+ parseJSON (A.Number 16) = pure CiColor+ parseJSON (A.Number 17) = pure CiFile+ parseJSON (A.Number 18) = pure CiReference+ parseJSON (A.Number 19) = pure CiFolder+ parseJSON (A.Number 20) = pure CiEnumMember+ parseJSON (A.Number 21) = pure CiConstant+ parseJSON (A.Number 22) = pure CiStruct+ parseJSON (A.Number 23) = pure CiEvent+ parseJSON (A.Number 24) = pure CiOperator+ parseJSON (A.Number 25) = pure CiTypeParameter+ parseJSON _ = mempty++data CompletionItemTag+ -- | Render a completion as obsolete, usually using a strike-out.+ = CtDeprecated+ deriving (Eq, Ord, Show, Read)++instance A.ToJSON CompletionItemTag where+ toJSON CtDeprecated = A.Number 1++instance A.FromJSON CompletionItemTag where+ parseJSON (A.Number 1) = pure CtDeprecated+ parseJSON _ = mempty++data CompletionItemTagsClientCapabilities =+ CompletionItemTagsClientCapabilities+ { -- | The tag supported by the client.+ _valueSet :: List CompletionItemTag+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''CompletionItemTagsClientCapabilities++data CompletionItemClientCapabilities =+ CompletionItemClientCapabilities+ { -- | Client supports snippets as insert text.+ --+ -- A snippet can define tab stops and placeholders with `$1`, `$2` and+ -- `${3:foo}`. `$0` defines the final tab stop, it defaults to the end of+ -- the snippet. Placeholders with equal identifiers are linked, that is+ -- typing in one will update others too.+ _snippetSupport :: Maybe Bool++ -- | Client supports commit characters on a completion item.+ , _commitCharactersSupport :: Maybe Bool++ -- | Client supports the follow content formats for the documentation+ -- property. The order describes the preferred format of the client.+ , _documentationFormat :: Maybe (List MarkupKind)++ -- | Client supports the deprecated property on a completion item.+ , _deprecatedSupport :: Maybe Bool++ -- | Client supports the preselect property on a completion item.+ , _preselectSupport :: Maybe Bool++ -- | Client supports the tag property on a completion item. Clients+ -- supporting tags have to handle unknown tags gracefully. Clients+ -- especially need to preserve unknown tags when sending a+ -- completion item back to the server in a resolve call.+ , _tagSupport :: Maybe CompletionItemTagsClientCapabilities+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''CompletionItemClientCapabilities++data CompletionItemKindClientCapabilities =+ CompletionItemKindClientCapabilities+ { -- | The completion item kind values the client supports. When this+ -- property exists the client also guarantees that it will+ -- handle values outside its set gracefully and falls back+ -- to a default value when unknown.+ _valueSet :: Maybe (List CompletionItemKind)+ }+ deriving (Show, Read, Eq)++deriveJSON lspOptions ''CompletionItemKindClientCapabilities++data CompletionClientCapabilities =+ CompletionClientCapabilities+ { _dynamicRegistration :: Maybe Bool -- ^ Whether completion supports dynamic+ -- registration.+ , _completionItem :: Maybe CompletionItemClientCapabilities+ , _completionItemKind :: Maybe CompletionItemKindClientCapabilities+ , _contextSupport :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''CompletionClientCapabilities++-- -------------------------------------++data InsertTextFormat+ = PlainText -- ^The primary text to be inserted is treated as a plain string.+ | Snippet+ -- ^ The primary text to be inserted is treated as a snippet.+ --+ -- A snippet can define tab stops and placeholders with `$1`, `$2`+ -- and `${3:foo}`. `$0` defines the final tab stop, it defaults to+ -- the end of the snippet. Placeholders with equal identifiers are linked,+ -- that is typing in one will update others too.+ --+ -- See also: https://github.com/Microsoft/vscode/blob/master/src/vs/editor/contrib/snippet/common/snippet.md+ deriving (Show, Read, Eq)++instance A.ToJSON InsertTextFormat where+ toJSON PlainText = A.Number 1+ toJSON Snippet = A.Number 2++instance A.FromJSON InsertTextFormat where+ parseJSON (A.Number 1) = pure PlainText+ parseJSON (A.Number 2) = pure Snippet+ parseJSON _ = mempty++data CompletionDoc = CompletionDocString Text+ | CompletionDocMarkup MarkupContent+ deriving (Show, Read, Eq)++instance A.ToJSON CompletionDoc where+ toJSON (CompletionDocString x) = A.toJSON x+ toJSON (CompletionDocMarkup x) = A.toJSON x++instance A.FromJSON CompletionDoc where+ parseJSON x = CompletionDocString <$> A.parseJSON x <|> CompletionDocMarkup <$> A.parseJSON x++data CompletionItem =+ CompletionItem+ { _label :: Text -- ^ The label of this completion item. By default also+ -- the text that is inserted when selecting this+ -- completion.+ , _kind :: Maybe CompletionItemKind+ , _tags :: Maybe (List CompletionItemTag) -- ^ Tags for this completion item.+ , _detail :: Maybe Text -- ^ A human-readable string with additional+ -- information about this item, like type or+ -- symbol information.+ , _documentation :: Maybe CompletionDoc -- ^ A human-readable string that represents+ -- a doc-comment.+ , _deprecated :: Maybe Bool -- ^ Indicates if this item is deprecated.+ , _preselect :: Maybe Bool+ -- ^ Select this item when showing.+ -- *Note* that only one completion item can be selected and that the+ -- tool / client decides which item that is. The rule is that the *first*+ -- item of those that match best is selected.+ , _sortText :: Maybe Text -- ^ A string that should be used when filtering+ -- a set of completion items. When `falsy` the+ -- label is used.+ , _filterText :: Maybe Text -- ^ A string that should be used when+ -- filtering a set of completion items. When+ -- `falsy` the label is used.+ , _insertText :: Maybe Text -- ^ A string that should be inserted a+ -- document when selecting this completion.+ -- When `falsy` the label is used.+ , _insertTextFormat :: Maybe InsertTextFormat+ -- ^ The format of the insert text. The format applies to both the+ -- `insertText` property and the `newText` property of a provided+ -- `textEdit`.+ , _textEdit :: Maybe TextEdit+ -- ^ An edit which is applied to a document when selecting this+ -- completion. When an edit is provided the value of `insertText` is+ -- ignored.+ --+ -- *Note:* The range of the edit must be a single line range and it+ -- must contain the position at which completion has been requested.+ , _additionalTextEdits :: Maybe (List TextEdit)+ -- ^ An optional array of additional text edits that are applied when+ -- selecting this completion. Edits must not overlap with the main edit+ -- nor with themselves.+ , _commitCharacters :: Maybe (List Text)+ -- ^ An optional set of characters that when pressed while this completion+ -- is active will accept it first and then type that character. *Note*+ -- that all commit characters should have `length=1` and that superfluous+ -- characters will be ignored.+ , _command :: Maybe Command+ -- ^ An optional command that is executed *after* inserting this+ -- completion. *Note* that additional modifications to the current+ -- document should be described with the additionalTextEdits-property.+ , _xdata :: Maybe A.Value -- ^ An data entry field that is preserved on a+ -- completion item between a completion and a+ -- completion resolve request.+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''CompletionItem++-- | Represents a collection of 'CompletionItem's to be presented in the editor.+data CompletionList =+ CompletionList+ { _isIncomplete :: Bool -- ^ This list it not complete. Further typing+ -- should result in recomputing this list.+ , _items :: List CompletionItem -- ^ The completion items.+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''CompletionList++-- | How a completion was triggered+data CompletionTriggerKind = -- | Completion was triggered by typing an identifier (24x7 code+ -- complete), manual invocation (e.g Ctrl+Space) or via API.+ CtInvoked+ -- | Completion was triggered by a trigger character specified by+ -- the `triggerCharacters` properties of the `CompletionRegistrationOptions`.+ | CtTriggerCharacter+ -- | Completion was re-triggered as the current completion list is incomplete.+ | CtTriggerForIncompleteCompletions+ -- | An unknown 'CompletionTriggerKind' not yet supported in haskell-lsp.+ | CtUnknown Scientific+ deriving (Read, Show, Eq)++instance A.ToJSON CompletionTriggerKind where+ toJSON CtInvoked = A.Number 1+ toJSON CtTriggerCharacter = A.Number 2+ toJSON CtTriggerForIncompleteCompletions = A.Number 3+ toJSON (CtUnknown x) = A.Number x++instance A.FromJSON CompletionTriggerKind where+ parseJSON (A.Number 1) = pure CtInvoked+ parseJSON (A.Number 2) = pure CtTriggerCharacter+ parseJSON (A.Number 3) = pure CtTriggerForIncompleteCompletions+ parseJSON (A.Number x) = pure (CtUnknown x)+ parseJSON _ = mempty++makeExtendingDatatype "CompletionOptions" [''WorkDoneProgressOptions]+ [ ("_triggerCharacters", [t| Maybe [String] |])+ , ("_allCommitCharacters", [t| Maybe [String] |])+ , ("_resolveProvider", [t| Maybe Bool|])+ ]+deriveJSON lspOptions ''CompletionOptions++makeExtendingDatatype "CompletionRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''CompletionOptions+ ]+ []+deriveJSON lspOptions ''CompletionRegistrationOptions++data CompletionContext =+ CompletionContext+ { _triggerKind :: CompletionTriggerKind -- ^ How the completion was triggered.+ , _triggerCharacter :: Maybe Text+ -- ^ The trigger character (a single character) that has trigger code complete.+ -- Is undefined if `triggerKind !== CompletionTriggerKind.TriggerCharacter`+ }+ deriving (Read, Show, Eq)++deriveJSON lspOptions ''CompletionContext++makeExtendingDatatype "CompletionParams"+ [ ''TextDocumentPositionParams+ , ''WorkDoneProgressParams+ , ''PartialResultParams+ ]+ [ ("_context", [t| Maybe CompletionContext |]) ]+deriveJSON lspOptions ''CompletionParams+
+ src/Language/LSP/Types/Configuration.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell #-}+module Language.LSP.Types.Configuration where++import Data.Aeson+import Data.Aeson.TH+import Data.Text (Text)+import Language.LSP.Types.Common+import Language.LSP.Types.Utils++-- -------------------------------------++data DidChangeConfigurationClientCapabilities =+ DidChangeConfigurationClientCapabilities+ { _dynamicRegistration :: Maybe Bool -- ^Did change configuration+ -- notification supports dynamic+ -- registration.+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''DidChangeConfigurationClientCapabilities++data DidChangeConfigurationParams =+ DidChangeConfigurationParams+ { _settings :: Value -- ^ The actual changed settings+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''DidChangeConfigurationParams++-- ---------------------------------------------------------------------++data ConfigurationItem =+ ConfigurationItem+ { _scopeUri :: Maybe Text -- ^ The scope to get the configuration section for.+ , _section :: Maybe Text -- ^ The configuration section asked for.+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ConfigurationItem++data ConfigurationParams =+ ConfigurationParams+ { _items :: List ConfigurationItem+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''ConfigurationParams
+ src/Language/LSP/Types/Declaration.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}++module Language.LSP.Types.Declaration where++import Data.Aeson.TH+import Language.LSP.Types.Progress+import Language.LSP.Types.StaticRegistrationOptions+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils++data DeclarationClientCapabilities =+ DeclarationClientCapabilities+ { -- | Whether declaration supports dynamic registration. If this is set to 'true'+ -- the client supports the new 'DeclarationRegistrationOptions' return value+ -- for the corresponding server capability as well.+ _dynamicRegistration :: Maybe Bool+ -- | The client supports additional metadata in the form of declaration links.+ , _linkSupport :: Maybe Bool+ }+ deriving (Read, Show, Eq)+deriveJSON lspOptions ''DeclarationClientCapabilities++makeExtendingDatatype "DeclarationOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''DeclarationOptions++makeExtendingDatatype "DeclarationRegistrationOptions"+ [ ''DeclarationOptions+ , ''TextDocumentRegistrationOptions+ , ''StaticRegistrationOptions+ ] []+deriveJSON lspOptions ''DeclarationRegistrationOptions++makeExtendingDatatype "DeclarationParams"+ [ ''TextDocumentPositionParams+ , ''WorkDoneProgressParams+ , ''PartialResultParams+ ] []+deriveJSON lspOptions ''DeclarationParams
+ src/Language/LSP/Types/Definition.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}++module Language.LSP.Types.Definition where+ +import Data.Aeson.TH+import Language.LSP.Types.Progress+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils++data DefinitionClientCapabilities =+ DefinitionClientCapabilities+ { -- | Whether definition supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ -- | The client supports additional metadata in the form of definition+ -- links.+ -- Since LSP 3.14.0+ , _linkSupport :: Maybe Bool+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''DefinitionClientCapabilities++makeExtendingDatatype "DefinitionOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''DefinitionOptions++makeExtendingDatatype "DefinitionRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''DefinitionOptions+ ] []+deriveJSON lspOptions ''DefinitionRegistrationOptions++makeExtendingDatatype "DefinitionParams"+ [ ''TextDocumentPositionParams+ , ''WorkDoneProgressParams+ , ''PartialResultParams+ ] []+deriveJSON lspOptions ''DefinitionParams
+ src/Language/LSP/Types/Diagnostic.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}++module Language.LSP.Types.Diagnostic where++import Control.DeepSeq+import qualified Data.Aeson as A+import Data.Aeson.TH+import Data.Text+import GHC.Generics+import Language.LSP.Types.Common+import Language.LSP.Types.Location+import Language.LSP.Types.Uri+import Language.LSP.Types.Utils++-- ---------------------------------------------------------------------++data DiagnosticSeverity+ = DsError -- ^ Error = 1,+ | DsWarning -- ^ Warning = 2,+ | DsInfo -- ^ Info = 3,+ | DsHint -- ^ Hint = 4+ deriving (Eq,Ord,Show,Read, Generic)++instance NFData DiagnosticSeverity++instance A.ToJSON DiagnosticSeverity where+ toJSON DsError = A.Number 1+ toJSON DsWarning = A.Number 2+ toJSON DsInfo = A.Number 3+ toJSON DsHint = A.Number 4++instance A.FromJSON DiagnosticSeverity where+ parseJSON (A.Number 1) = pure DsError+ parseJSON (A.Number 2) = pure DsWarning+ parseJSON (A.Number 3) = pure DsInfo+ parseJSON (A.Number 4) = pure DsHint+ parseJSON _ = mempty++data DiagnosticTag+ -- | Unused or unnecessary code.+ --+ -- Clients are allowed to render diagnostics with this tag faded out+ -- instead of having an error squiggle.+ = DtUnnecessary+ -- | Deprecated or obsolete code.+ --+ -- Clients are allowed to rendered diagnostics with this tag strike+ -- through.+ | DtDeprecated+ deriving (Eq, Ord, Show, Read, Generic)++instance NFData DiagnosticTag++instance A.ToJSON DiagnosticTag where+ toJSON DtUnnecessary = A.Number 1+ toJSON DtDeprecated = A.Number 2++instance A.FromJSON DiagnosticTag where+ parseJSON (A.Number 1) = pure DtUnnecessary+ parseJSON (A.Number 2) = pure DtDeprecated+ parseJSON _ = mempty++-- ---------------------------------------------------------------------++data DiagnosticRelatedInformation =+ DiagnosticRelatedInformation+ { _location :: Location+ , _message :: Text+ } deriving (Show, Read, Eq, Ord, Generic)++instance NFData DiagnosticRelatedInformation++deriveJSON lspOptions ''DiagnosticRelatedInformation++-- ---------------------------------------------------------------------++type DiagnosticSource = Text+data Diagnostic =+ Diagnostic+ { _range :: Range+ , _severity :: Maybe DiagnosticSeverity+ , _code :: Maybe (Int |? String)+ , _source :: Maybe DiagnosticSource+ , _message :: Text+ , _tags :: Maybe (List DiagnosticTag)+ , _relatedInformation :: Maybe (List DiagnosticRelatedInformation)+ } deriving (Show, Read, Eq, Ord, Generic)++instance NFData Diagnostic++deriveJSON lspOptions ''Diagnostic++-- -------------------------------------++data PublishDiagnosticsTagsClientCapabilities =+ PublishDiagnosticsTagsClientCapabilities+ { -- | The tags supported by the client.+ _valueSet :: List DiagnosticTag+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''PublishDiagnosticsTagsClientCapabilities++data PublishDiagnosticsClientCapabilities =+ PublishDiagnosticsClientCapabilities+ { -- | Whether the clients accepts diagnostics with related information.+ _relatedInformation :: Maybe Bool+ -- | Client supports the tag property to provide metadata about a+ -- diagnostic.+ --+ -- Clients supporting tags have to handle unknown tags gracefully.+ -- + -- Since LSP 3.15.0+ , _tagSupport :: Maybe PublishDiagnosticsTagsClientCapabilities+ -- | Whether the client interprets the version property of the+ -- @textDocument/publishDiagnostics@ notification's parameter.+ -- + -- Since LSP 3.15.0+ , _versionSupport :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''PublishDiagnosticsClientCapabilities++data PublishDiagnosticsParams =+ PublishDiagnosticsParams+ { -- | The URI for which diagnostic information is reported.+ _uri :: Uri+ -- | Optional the version number of the document the diagnostics are+ -- published for.+ -- + -- Since LSP 3.15.0+ , _version :: Maybe Int+ -- | An array of diagnostic information items.+ , _diagnostics :: List Diagnostic+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''PublishDiagnosticsParams
+ src/Language/LSP/Types/DocumentColor.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}+module Language.LSP.Types.DocumentColor where++import Data.Aeson.TH+import Data.Text (Text)+import Language.LSP.Types.Common+import Language.LSP.Types.Location+import Language.LSP.Types.Progress+import Language.LSP.Types.StaticRegistrationOptions+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils+import Language.LSP.Types.WorkspaceEdit++data DocumentColorClientCapabilities =+ DocumentColorClientCapabilities+ { -- | Whether document color supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ } deriving (Read, Show, Eq)+deriveJSON lspOptions ''DocumentColorClientCapabilities++-- -------------------------------------++makeExtendingDatatype "DocumentColorOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''DocumentColorOptions++makeExtendingDatatype "DocumentColorRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''StaticRegistrationOptions+ , ''DocumentColorOptions+ ] []+deriveJSON lspOptions ''DocumentColorRegistrationOptions++-- -------------------------------------++makeExtendingDatatype "DocumentColorParams"+ [ ''WorkDoneProgressParams+ , ''PartialResultParams+ ]+ [("_textDocument", [t| TextDocumentIdentifier |])]+deriveJSON lspOptions ''DocumentColorParams++-- -------------------------------------++-- | Represents a color in RGBA space.+data Color =+ Color+ { _red :: Int -- ^ The red component of this color in the range [0-1].+ , _green :: Int -- ^ The green component of this color in the range [0-1].+ , _blue :: Int -- ^ The blue component of this color in the range [0-1].+ , _alpha :: Int -- ^ The alpha component of this color in the range [0-1].+ } deriving (Read, Show, Eq)+deriveJSON lspOptions ''Color++data ColorInformation =+ ColorInformation+ { _range :: Range -- ^ The range in the document where this color appears.+ , _color :: Color -- ^ The actual color value for this color range.+ } deriving (Read, Show, Eq)+deriveJSON lspOptions ''ColorInformation++-- -------------------------------------++makeExtendingDatatype "ColorPresentationParams"+ [ ''WorkDoneProgressParams+ , ''PartialResultParams+ ]+ [ ("_textDocument", [t| TextDocumentIdentifier |])+ , ("_color", [t| Color |])+ , ("_range", [t| Range |])+ ]+deriveJSON lspOptions ''ColorPresentationParams++-- -------------------------------------++data ColorPresentation =+ ColorPresentation+ { -- | The label of this color presentation. It will be shown on the color+ -- picker header. By default this is also the text that is inserted when selecting+ -- this color presentation.+ _label :: Text+ -- | A 'TextEdit' which is applied to a document when selecting+ -- this presentation for the color. When `falsy` the '_label'+ -- is used.+ , _textEdit :: Maybe TextEdit+ -- | An optional array of additional 'TextEdit's that are applied when+ -- selecting this color presentation. Edits must not overlap with the main+ -- '_textEdit' nor with themselves.+ , _additionalTextEdits :: Maybe (List TextEdit)+ } deriving (Read, Show, Eq)+deriveJSON lspOptions ''ColorPresentation
+ src/Language/LSP/Types/DocumentFilter.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE TemplateHaskell #-}+module Language.LSP.Types.DocumentFilter where++import Data.Aeson.TH+import Data.Text ( Text )+import Language.LSP.Types.Common+import Language.LSP.Types.Utils++-- ---------------------------------------------------------------------++data DocumentFilter =+ DocumentFilter+ { -- | A language id, like `typescript`.+ _language :: Maybe Text+ -- | A Uri scheme, like @file@ or @untitled@.+ , _scheme :: Maybe Text+ , -- | A glob pattern, like `*.{ts,js}`.+ --+ -- Glob patterns can have the following syntax:+ -- - @*@ to match one or more characters in a path segment+ -- - @?@ to match on one character in a path segment+ -- - @**@ to match any number of path segments, including none+ -- - @{}@ to group conditions (e.g. @**/*.{ts,js}@ matches all TypeScript and JavaScript files)+ -- - @[]@ to declare a range of characters to match in a path segment (e.g., @example.[0-9]@ to match on @example.0@, @example.1@, …)+ -- - @[!...]@ to negate a range of characters to match in a path segment (e.g., @example.[!0-9]@ to match on @example.a@, @example.b@, but not @example.0@)+ _pattern :: Maybe Text+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''DocumentFilter++{-+A document selector is the combination of one or many document filters.++export type DocumentSelector = DocumentFilter[];+-}+type DocumentSelector = List DocumentFilter
+ src/Language/LSP/Types/DocumentHighlight.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}+module Language.LSP.Types.DocumentHighlight where++import Data.Aeson+import Data.Aeson.TH+import Language.LSP.Types.Location+import Language.LSP.Types.Progress+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils++-- -------------------------------------++data DocumentHighlightClientCapabilities =+ DocumentHighlightClientCapabilities+ { -- | Whether document highlight supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''DocumentHighlightClientCapabilities++makeExtendingDatatype "DocumentHighlightOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''DocumentHighlightOptions++makeExtendingDatatype "DocumentHighlightRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''DocumentHighlightOptions+ ] []+deriveJSON lspOptions ''DocumentHighlightRegistrationOptions++makeExtendingDatatype "DocumentHighlightParams"+ [ ''TextDocumentPositionParams+ , ''WorkDoneProgressParams+ , ''PartialResultParams+ ] []+deriveJSON lspOptions ''DocumentHighlightParams++data DocumentHighlightKind+ = -- | A textual occurrence.+ HkText+ | -- | Read-access of a symbol, like reading a variable.+ HkRead+ | -- | Write-access of a symbol, like writing to a variable.+ HkWrite+ deriving (Read, Show, Eq)++instance ToJSON DocumentHighlightKind where+ toJSON HkText = Number 1+ toJSON HkRead = Number 2+ toJSON HkWrite = Number 3++instance FromJSON DocumentHighlightKind where+ parseJSON (Number 1) = pure HkText+ parseJSON (Number 2) = pure HkRead+ parseJSON (Number 3) = pure HkWrite+ parseJSON _ = mempty++-- -------------------------------------++-- | A document highlight is a range inside a text document which deserves+-- special attention. Usually a document highlight is visualized by changing the+-- background color of its range.+data DocumentHighlight =+ DocumentHighlight+ { -- | The range this highlight applies to.+ _range :: Range+ -- | The highlight kind, default is 'HkText'.+ , _kind :: Maybe DocumentHighlightKind+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''DocumentHighlight
+ src/Language/LSP/Types/DocumentLink.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Language.LSP.Types.DocumentLink where++import Data.Aeson+import Data.Aeson.TH+import Language.LSP.Types.Location+import Language.LSP.Types.Progress+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Uri+import Language.LSP.Types.Utils++data DocumentLinkClientCapabilities =+ DocumentLinkClientCapabilities+ { -- | Whether document link supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ -- | Whether the client supports the `tooltip` property on `DocumentLink`.+ --+ -- Since LSP 3.15.0+ , _tooltipSupport :: Maybe Bool+ } deriving (Read, Show, Eq)+deriveJSON lspOptions ''DocumentLinkClientCapabilities++-- -------------------------------------++makeExtendingDatatype "DocumentLinkOptions" [''WorkDoneProgressOptions]+ [("_resolveProvider", [t| Maybe Bool |])]+deriveJSON lspOptions ''DocumentLinkOptions++makeExtendingDatatype "DocumentLinkRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''DocumentLinkOptions+ ] []+deriveJSON lspOptions ''DocumentLinkRegistrationOptions++-- -------------------------------------++makeExtendingDatatype "DocumentLinkParams"+ [ ''WorkDoneProgressParams+ , ''PartialResultParams+ ]+ [("_textDocument", [t| TextDocumentIdentifier |])]+deriveJSON lspOptions ''DocumentLinkParams++-- -------------------------------------++-- | A document link is a range in a text document that links to an internal or+-- external resource, like another text document or a web site.+data DocumentLink =+ DocumentLink+ { -- | The range this link applies to.+ _range :: Range+ -- | The uri this link points to. If missing a resolve request is sent+ -- later.+ , _target :: Maybe Uri+ -- | The tooltip text when you hover over this link.+ --+ -- If a tooltip is provided, is will be displayed in a string that includes+ -- instructions on how to trigger the link, such as @{0} (ctrl + click)@.+ -- The specific instructions vary depending on OS, user settings, and+ -- localization.+ --+ -- Since LSP 3.15.0+ , _tooltip :: Maybe String+ -- | A data entry field that is preserved on a document link between a+ -- DocumentLinkRequest and a DocumentLinkResolveRequest.+ , _xdata :: Maybe Value+ } deriving (Read, Show, Eq)+deriveJSON lspOptions ''DocumentLink
+ src/Language/LSP/Types/DocumentSymbol.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}+module Language.LSP.Types.DocumentSymbol where++import Data.Aeson+import Data.Aeson.TH+import Data.Scientific+import Data.Text (Text)++import Language.LSP.Types.TextDocument+import Language.LSP.Types.Common+import Language.LSP.Types.Location+import Language.LSP.Types.Progress+import Language.LSP.Types.Utils++-- ---------------------------------------------------------------------++makeExtendingDatatype "DocumentSymbolOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''DocumentSymbolOptions++makeExtendingDatatype "DocumentSymbolRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''DocumentSymbolOptions+ ] []+deriveJSON lspOptions ''DocumentSymbolRegistrationOptions++-- ---------------------------------------------------------------------++makeExtendingDatatype "DocumentSymbolParams"+ [ ''WorkDoneProgressParams+ , ''PartialResultParams+ ]+ [ ("_textDocument", [t| TextDocumentIdentifier |])]+deriveJSON lspOptions ''DocumentSymbolParams++-- -------------------------------------++data SymbolKind+ = SkFile+ | SkModule+ | SkNamespace+ | SkPackage+ | SkClass+ | SkMethod+ | SkProperty+ | SkField+ | SkConstructor+ | SkEnum+ | SkInterface+ | SkFunction+ | SkVariable+ | SkConstant+ | SkString+ | SkNumber+ | SkBoolean+ | SkArray+ | SkObject+ | SkKey+ | SkNull+ | SkEnumMember+ | SkStruct+ | SkEvent+ | SkOperator+ | SkTypeParameter+ | SkUnknown Scientific+ deriving (Read,Show,Eq)++instance ToJSON SymbolKind where+ toJSON SkFile = Number 1+ toJSON SkModule = Number 2+ toJSON SkNamespace = Number 3+ toJSON SkPackage = Number 4+ toJSON SkClass = Number 5+ toJSON SkMethod = Number 6+ toJSON SkProperty = Number 7+ toJSON SkField = Number 8+ toJSON SkConstructor = Number 9+ toJSON SkEnum = Number 10+ toJSON SkInterface = Number 11+ toJSON SkFunction = Number 12+ toJSON SkVariable = Number 13+ toJSON SkConstant = Number 14+ toJSON SkString = Number 15+ toJSON SkNumber = Number 16+ toJSON SkBoolean = Number 17+ toJSON SkArray = Number 18+ toJSON SkObject = Number 19+ toJSON SkKey = Number 20+ toJSON SkNull = Number 21+ toJSON SkEnumMember = Number 22+ toJSON SkStruct = Number 23+ toJSON SkEvent = Number 24+ toJSON SkOperator = Number 25+ toJSON SkTypeParameter = Number 26+ toJSON (SkUnknown x) = Number x++instance FromJSON SymbolKind where+ parseJSON (Number 1) = pure SkFile+ parseJSON (Number 2) = pure SkModule+ parseJSON (Number 3) = pure SkNamespace+ parseJSON (Number 4) = pure SkPackage+ parseJSON (Number 5) = pure SkClass+ parseJSON (Number 6) = pure SkMethod+ parseJSON (Number 7) = pure SkProperty+ parseJSON (Number 8) = pure SkField+ parseJSON (Number 9) = pure SkConstructor+ parseJSON (Number 10) = pure SkEnum+ parseJSON (Number 11) = pure SkInterface+ parseJSON (Number 12) = pure SkFunction+ parseJSON (Number 13) = pure SkVariable+ parseJSON (Number 14) = pure SkConstant+ parseJSON (Number 15) = pure SkString+ parseJSON (Number 16) = pure SkNumber+ parseJSON (Number 17) = pure SkBoolean+ parseJSON (Number 18) = pure SkArray+ parseJSON (Number 19) = pure SkObject+ parseJSON (Number 20) = pure SkKey+ parseJSON (Number 21) = pure SkNull+ parseJSON (Number 22) = pure SkEnumMember+ parseJSON (Number 23) = pure SkStruct+ parseJSON (Number 24) = pure SkEvent+ parseJSON (Number 25) = pure SkOperator+ parseJSON (Number 26) = pure SkTypeParameter+ parseJSON (Number x) = pure (SkUnknown x)+ parseJSON _ = mempty+ +-- -------------------------------------++data DocumentSymbolKindClientCapabilities =+ DocumentSymbolKindClientCapabilities+ { -- | The symbol kind values the client supports. When this+ -- property exists the client also guarantees that it will+ -- handle values outside its set gracefully and falls back+ -- to a default value when unknown.+ --+ -- If this property is not present the client only supports+ -- the symbol kinds from `File` to `Array` as defined in+ -- the initial version of the protocol.+ _valueSet :: Maybe (List SymbolKind)+ }+ deriving (Show, Read, Eq)++deriveJSON lspOptions ''DocumentSymbolKindClientCapabilities++data DocumentSymbolClientCapabilities =+ DocumentSymbolClientCapabilities+ { -- | Whether document symbol supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ -- | Specific capabilities for the `SymbolKind`.+ , _symbolKind :: Maybe DocumentSymbolKindClientCapabilities+ , _hierarchicalDocumentSymbolSupport :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''DocumentSymbolClientCapabilities+++-- ---------------------------------------------------------------------++-- | Represents programming constructs like variables, classes, interfaces etc.+-- that appear in a document. Document symbols can be hierarchical and they+-- have two ranges: one that encloses its definition and one that points to its+-- most interesting range, e.g. the range of an identifier.+data DocumentSymbol =+ DocumentSymbol+ { _name :: Text -- ^ The name of this symbol.+ -- | More detail for this symbol, e.g the signature of a function. If not+ -- provided the name is used.+ , _detail :: Maybe Text+ , _kind :: SymbolKind -- ^ The kind of this symbol.+ , _deprecated :: Maybe Bool -- ^ Indicates if this symbol is deprecated.+ -- | The range enclosing this symbol not including leading/trailing+ -- whitespace but everything else like comments. This information is+ -- typically used to determine if the the clients cursor is inside the symbol+ -- to reveal in the symbol in the UI.+ , _range :: Range+ -- | The range that should be selected and revealed when this symbol is being+ -- picked, e.g the name of a function. Must be contained by the the '_range'.+ , _selectionRange :: Range+ -- | Children of this symbol, e.g. properties of a class.+ , _children :: Maybe (List DocumentSymbol)+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''DocumentSymbol++-- ---------------------------------------------------------------------++-- | Represents information about programming constructs like variables, classes,+-- interfaces etc.+data SymbolInformation =+ SymbolInformation+ { _name :: Text -- ^ The name of this symbol.+ , _kind :: SymbolKind -- ^ The kind of this symbol.+ , _deprecated :: Maybe Bool -- ^ Indicates if this symbol is deprecated.+ -- | The location of this symbol. The location's range is used by a tool+ -- to reveal the location in the editor. If the symbol is selected in the+ -- tool the range's start information is used to position the cursor. So+ -- the range usually spans more then the actual symbol's name and does+ -- normally include things like visibility modifiers.+ --+ -- The range doesn't have to denote a node range in the sense of a abstract+ -- syntax tree. It can therefore not be used to re-construct a hierarchy of+ -- the symbols.+ , _location :: Location+ -- | The name of the symbol containing this symbol. This information is for+ -- user interface purposes (e.g. to render a qualifier in the user interface+ -- if necessary). It can't be used to re-infer a hierarchy for the document+ -- symbols.+ , _containerName :: Maybe Text+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''SymbolInformation
+ src/Language/LSP/Types/FoldingRange.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}+module Language.LSP.Types.FoldingRange where++import qualified Data.Aeson as A+import Data.Aeson.TH+import Data.Text (Text)+import Language.LSP.Types.Progress+import Language.LSP.Types.StaticRegistrationOptions+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils+++-- -------------------------------------++data FoldingRangeClientCapabilities =+ FoldingRangeClientCapabilities+ { -- | Whether implementation supports dynamic registration for folding range+ -- providers. If this is set to `true` the client supports the new+ -- `(FoldingRangeProviderOptions & TextDocumentRegistrationOptions & StaticRegistrationOptions)`+ -- return value for the corresponding server capability as well.+ _dynamicRegistration :: Maybe Bool+ -- | The maximum number of folding ranges that the client prefers to receive+ -- per document. The value serves as a hint, servers are free to follow the limit.+ , _rangeLimit :: Maybe Int+ -- | If set, the client signals that it only supports folding complete lines. If set,+ -- client will ignore specified `startCharacter` and `endCharacter` properties in a+ -- FoldingRange.+ , _lineFoldingOnly :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''FoldingRangeClientCapabilities++makeExtendingDatatype "FoldingRangeOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''FoldingRangeOptions++makeExtendingDatatype "FoldingRangeRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''FoldingRangeOptions+ , ''StaticRegistrationOptions+ ] []+deriveJSON lspOptions ''FoldingRangeRegistrationOptions+++makeExtendingDatatype "FoldingRangeParams"+ [ ''WorkDoneProgressParams+ , ''PartialResultParams+ ]+ [("_textDocument", [t| TextDocumentIdentifier |])]+deriveJSON lspOptions ''FoldingRangeParams++-- | Enum of known range kinds+data FoldingRangeKind = FoldingRangeComment+ -- ^ Folding range for a comment+ | FoldingRangeImports+ -- ^ Folding range for a imports or includes+ | FoldingRangeRegion+ -- ^ Folding range for a region (e.g. #region)+ | FoldingRangeUnknown Text+ -- ^ Folding range that haskell-lsp-types does+ -- not yet support+ deriving (Read, Show, Eq)++instance A.ToJSON FoldingRangeKind where+ toJSON FoldingRangeComment = A.String "comment"+ toJSON FoldingRangeImports = A.String "imports"+ toJSON FoldingRangeRegion = A.String "region"+ toJSON (FoldingRangeUnknown x) = A.String x++instance A.FromJSON FoldingRangeKind where+ parseJSON (A.String "comment") = pure FoldingRangeComment+ parseJSON (A.String "imports") = pure FoldingRangeImports+ parseJSON (A.String "region") = pure FoldingRangeRegion+ parseJSON (A.String x) = pure (FoldingRangeUnknown x)+ parseJSON _ = mempty++-- | Represents a folding range.+data FoldingRange =+ FoldingRange+ { -- | The zero-based line number from where the folded range starts.+ _startLine :: Int+ -- | The zero-based character offset from where the folded range+ -- starts. If not defined, defaults to the length of the start line.+ , _startCharacter :: Maybe Int+ -- | The zero-based line number where the folded range ends.+ , _endLine :: Int+ -- | The zero-based character offset before the folded range ends.+ -- If not defined, defaults to the length of the end line.+ , _endCharacter :: Maybe Int+ -- | Describes the kind of the folding range such as 'comment' or+ -- 'region'. The kind is used to categorize folding ranges and used+ -- by commands like 'Fold all comments'. See 'FoldingRangeKind' for+ -- an enumeration of standardized kinds.+ , _kind :: Maybe FoldingRangeKind+ }+ deriving (Read, Show, Eq)++deriveJSON lspOptions ''FoldingRange
+ src/Language/LSP/Types/Formatting.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}+module Language.LSP.Types.Formatting where++import Data.Aeson.TH+import Data.Text (Text)+import Language.LSP.Types.Location+import Language.LSP.Types.Progress+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils++data DocumentFormattingClientCapabilities =+ DocumentFormattingClientCapabilities+ { -- | Whether formatting supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''DocumentFormattingClientCapabilities++makeExtendingDatatype "DocumentFormattingOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''DocumentFormattingOptions++makeExtendingDatatype "DocumentFormattingRegistrationOptions"+ [ ''TextDocumentRegistrationOptions,+ ''DocumentFormattingOptions+ ]+ []+deriveJSON lspOptions ''DocumentFormattingRegistrationOptions++-- | Value-object describing what options formatting should use.+data FormattingOptions = FormattingOptions+ { -- | Size of a tab in spaces.+ _tabSize :: Int,+ -- | Prefer spaces over tabs+ _insertSpaces :: Bool,+ -- | Trim trailing whitespace on a line.+ --+ -- Since LSP 3.15.0+ _trimTrailingWhitespace :: Maybe Bool,+ -- | Insert a newline character at the end of the file if one does not exist.+ --+ -- Since LSP 3.15.0+ _insertFinalNewline :: Maybe Bool,+ -- | Trim all newlines after the final newline at the end of the file.+ -- + -- Since LSP 3.15.0+ _trimFinalNewlines :: Maybe Bool+ -- Note: May be more properties+ }+ deriving (Read, Show, Eq)++deriveJSON lspOptions ''FormattingOptions+makeExtendingDatatype "DocumentFormattingParams" [''WorkDoneProgressParams]+ [ ("_textDocument", [t| TextDocumentIdentifier |])+ , ("_options", [t| FormattingOptions |])+ ]+deriveJSON lspOptions ''DocumentFormattingParams++-- -------------------------------------++data DocumentRangeFormattingClientCapabilities =+ DocumentRangeFormattingClientCapabilities+ { -- | Whether formatting supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''DocumentRangeFormattingClientCapabilities++makeExtendingDatatype "DocumentRangeFormattingOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''DocumentRangeFormattingOptions++makeExtendingDatatype "DocumentRangeFormattingRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''DocumentRangeFormattingOptions+ ]+ []+deriveJSON lspOptions ''DocumentRangeFormattingRegistrationOptions++makeExtendingDatatype "DocumentRangeFormattingParams" [''WorkDoneProgressParams]+ [ ("_textDocument", [t| TextDocumentIdentifier |])+ , ("_range", [t| Range |])+ , ("_options", [t| FormattingOptions |])+ ]+deriveJSON lspOptions ''DocumentRangeFormattingParams++-- -------------------------------------++data DocumentOnTypeFormattingClientCapabilities =+ DocumentOnTypeFormattingClientCapabilities+ { -- | Whether formatting supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''DocumentOnTypeFormattingClientCapabilities++data DocumentOnTypeFormattingOptions =+ DocumentOnTypeFormattingOptions+ { -- | A character on which formatting should be triggered, like @}@.+ _firstTriggerCharacter :: Text+ , -- | More trigger characters.+ _moreTriggerCharacter :: Maybe [Text]+ } deriving (Read,Show,Eq)+deriveJSON lspOptions ''DocumentOnTypeFormattingOptions++makeExtendingDatatype "DocumentOnTypeFormattingRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''DocumentOnTypeFormattingOptions+ ]+ []+deriveJSON lspOptions ''DocumentOnTypeFormattingRegistrationOptions++makeExtendingDatatype "DocumentOnTypeFormattingParams" [''TextDocumentPositionParams]+ [ ("_ch", [t| String |])+ , ("_options", [t| FormattingOptions |])+ ]+deriveJSON lspOptions ''DocumentOnTypeFormattingParams
+ src/Language/LSP/Types/Hover.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}+module Language.LSP.Types.Hover where++import Control.Applicative+import Data.Aeson+import Data.Aeson.TH+import Data.Text ( Text )++import Language.LSP.Types.Common+import Language.LSP.Types.Location+import Language.LSP.Types.MarkupContent+import Language.LSP.Types.Progress+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils+++-- -------------------------------------++data HoverClientCapabilities =+ HoverClientCapabilities+ { _dynamicRegistration :: Maybe Bool+ , _contentFormat :: Maybe (List MarkupKind)+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''HoverClientCapabilities++makeExtendingDatatype "HoverOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''HoverOptions++makeExtendingDatatype "HoverRegistrationOptions" [''TextDocumentRegistrationOptions, ''HoverOptions] []+deriveJSON lspOptions ''HoverRegistrationOptions++makeExtendingDatatype "HoverParams" [''TextDocumentPositionParams, ''WorkDoneProgressParams] []+deriveJSON lspOptions ''HoverParams++-- -------------------------------------++data LanguageString =+ LanguageString+ { _language :: Text+ , _value :: Text+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''LanguageString++{-# DEPRECATED MarkedString, PlainString, CodeString "Use MarkupContent instead, since 3.3.0 (11/24/2017)" #-}+data MarkedString =+ PlainString Text+ | CodeString LanguageString+ deriving (Eq,Read,Show)++instance ToJSON MarkedString where+ toJSON (PlainString x) = toJSON x+ toJSON (CodeString x) = toJSON x+instance FromJSON MarkedString where+ parseJSON (String t) = pure $ PlainString t+ parseJSON o = CodeString <$> parseJSON o++-- -------------------------------------++data HoverContents =+ HoverContentsMS (List MarkedString)+ | HoverContents MarkupContent+ deriving (Read,Show,Eq)++instance ToJSON HoverContents where+ toJSON (HoverContentsMS x) = toJSON x+ toJSON (HoverContents x) = toJSON x+instance FromJSON HoverContents where+ parseJSON v@(String _) = HoverContentsMS <$> parseJSON v+ parseJSON v@(Array _) = HoverContentsMS <$> parseJSON v+ parseJSON v@(Object _) = HoverContents <$> parseJSON v+ <|> HoverContentsMS <$> parseJSON v+ parseJSON _ = mempty++-- -------------------------------------++instance Semigroup HoverContents where+ HoverContents h1 <> HoverContents h2 = HoverContents (h1 `mappend` h2)+ HoverContents h1 <> HoverContentsMS (List h2s) = HoverContents (mconcat (h1: (map toMarkupContent h2s)))+ HoverContentsMS (List h1s) <> HoverContents h2 = HoverContents (mconcat ((map toMarkupContent h1s) ++ [h2]))+ HoverContentsMS (List h1s) <> HoverContentsMS (List h2s) = HoverContentsMS (List (h1s `mappend` h2s))++instance Monoid HoverContents where+ mempty = HoverContentsMS (List [])++toMarkupContent :: MarkedString -> MarkupContent+toMarkupContent (PlainString s) = unmarkedUpContent s+toMarkupContent (CodeString (LanguageString lang s)) = markedUpContent lang s++-- -------------------------------------++data Hover =+ Hover+ { _contents :: HoverContents+ , _range :: Maybe Range+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''Hover
+ src/Language/LSP/Types/Implementation.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}++module Language.LSP.Types.Implementation where++import Data.Aeson.TH+import Language.LSP.Types.Progress+import Language.LSP.Types.StaticRegistrationOptions+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils++data ImplementationClientCapabilities = ImplementationClientCapabilities+ { -- | Whether implementation supports dynamic registration. If this is set+ -- to 'True'+ -- the client supports the new 'ImplementationRegistrationOptions' return+ -- value for the corresponding server capability as well.+ _dynamicRegistration :: Maybe Bool,+ -- | The client supports additional metadata in the form of definition links.+ --+ -- Since LSP 3.14.0+ _linkSupport :: Maybe Bool+ }+ deriving (Read, Show, Eq)++deriveJSON lspOptions ''ImplementationClientCapabilities++makeExtendingDatatype "ImplementationOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''ImplementationOptions++makeExtendingDatatype "ImplementationRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''ImplementationOptions+ , ''StaticRegistrationOptions+ ] []+deriveJSON lspOptions ''ImplementationRegistrationOptions++makeExtendingDatatype "ImplementationParams"+ [ ''TextDocumentPositionParams+ , ''WorkDoneProgressParams+ , ''PartialResultParams+ ] []+deriveJSON lspOptions ''ImplementationParams
+ src/Language/LSP/Types/Initialize.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Language.LSP.Types.Initialize where++import Data.Aeson+import Data.Aeson.TH+import Data.Text (Text)+import qualified Data.Text as T+import Language.LSP.Types.ClientCapabilities+import Language.LSP.Types.Common+import Language.LSP.Types.Progress+import Language.LSP.Types.ServerCapabilities+import Language.LSP.Types.Uri+import Language.LSP.Types.Utils+import Language.LSP.Types.WorkspaceFolders++data Trace = TraceOff | TraceMessages | TraceVerbose+ deriving (Show, Read, Eq)++instance ToJSON Trace where+ toJSON TraceOff = String (T.pack "off")+ toJSON TraceMessages = String (T.pack "messages")+ toJSON TraceVerbose = String (T.pack "verbose")++instance FromJSON Trace where+ parseJSON (String s) = case T.unpack s of+ "off" -> return TraceOff+ "messages" -> return TraceMessages+ "verbose" -> return TraceVerbose+ _ -> mempty+ parseJSON _ = mempty++data ClientInfo =+ ClientInfo+ { -- | The name of the client as defined by the client.+ _name :: Text+ -- | The client's version as defined by the client.+ , _version :: Maybe Text+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''ClientInfo++makeExtendingDatatype "InitializeParams" [''WorkDoneProgressParams]+ [ ("_processId", [t| Maybe Int|])+ , ("_clientInfo", [t| Maybe ClientInfo |])+ , ("_rootPath", [t| Maybe Text |])+ , ("_rootUri", [t| Maybe Uri |])+ , ("_initializationOptions", [t| Maybe Value |])+ , ("_capabilities", [t| ClientCapabilities |])+ , ("_trace", [t| Maybe Trace |])+ , ("_workspaceFolders", [t| Maybe (List WorkspaceFolder) |])+ ]++{-# DEPRECATED _rootPath "Use _rootUri" #-}++deriveJSON lspOptions ''InitializeParams++data InitializeError =+ InitializeError+ { _retry :: Bool+ } deriving (Read, Show, Eq)++deriveJSON lspOptions ''InitializeError++data ServerInfo =+ ServerInfo+ { -- | The name of the server as defined by the server.+ _name :: Text+ -- | The server's version as defined by the server.+ , _version :: Maybe Text+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''ServerInfo++data InitializeResult =+ InitializeResult+ { -- | The capabilities the language server provides.+ _capabilities :: ServerCapabilities+ -- | Information about the server.+ -- Since LSP 3.15.0+ , _serverInfo :: Maybe ServerInfo+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''InitializeResult++-- ---------------------------------------------------------------------++data InitializedParams =+ InitializedParams+ {+ } deriving (Show, Read, Eq)++instance FromJSON InitializedParams where+ parseJSON (Object _) = pure InitializedParams+ parseJSON _ = mempty++instance ToJSON InitializedParams where+ toJSON InitializedParams = Object mempty+
+ src/Language/LSP/Types/Lens.hs view
@@ -0,0 +1,301 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}++module Language.LSP.Types.Lens where++import Language.LSP.Types.Cancellation+import Language.LSP.Types.ClientCapabilities+import Language.LSP.Types.CodeAction+import Language.LSP.Types.CodeLens+import Language.LSP.Types.DocumentColor+import Language.LSP.Types.Command+import Language.LSP.Types.Completion+import Language.LSP.Types.Configuration+import Language.LSP.Types.Declaration+import Language.LSP.Types.Definition+import Language.LSP.Types.Diagnostic+import Language.LSP.Types.DocumentFilter+import Language.LSP.Types.DocumentHighlight+import Language.LSP.Types.DocumentLink+import Language.LSP.Types.FoldingRange+import Language.LSP.Types.Formatting+import Language.LSP.Types.Hover+import Language.LSP.Types.Implementation+import Language.LSP.Types.Initialize+import Language.LSP.Types.Location+import Language.LSP.Types.Progress+import Language.LSP.Types.Registration+import Language.LSP.Types.References+import Language.LSP.Types.Rename+import Language.LSP.Types.SignatureHelp+import Language.LSP.Types.SelectionRange+import Language.LSP.Types.ServerCapabilities+import Language.LSP.Types.DocumentSymbol+import Language.LSP.Types.TextDocument+import Language.LSP.Types.TypeDefinition+import Language.LSP.Types.Window+import Language.LSP.Types.WatchedFiles+import Language.LSP.Types.WorkspaceEdit+import Language.LSP.Types.WorkspaceFolders+import Language.LSP.Types.WorkspaceSymbol+import Language.LSP.Types.Message+import Control.Lens.TH++-- TODO: This is out of date and very unmantainable, use TH to call all these!!++-- client capabilities+makeFieldsNoPrefix ''WorkspaceEditClientCapabilities+makeFieldsNoPrefix ''DidChangeConfigurationClientCapabilities+makeFieldsNoPrefix ''ExecuteCommandClientCapabilities+makeFieldsNoPrefix ''WorkspaceClientCapabilities+makeFieldsNoPrefix ''TextDocumentSyncClientCapabilities+makeFieldsNoPrefix ''CompletionItemTagsClientCapabilities+makeFieldsNoPrefix ''CompletionItemClientCapabilities+makeFieldsNoPrefix ''CompletionItemKindClientCapabilities+makeFieldsNoPrefix ''CompletionClientCapabilities+makeFieldsNoPrefix ''HoverClientCapabilities+makeFieldsNoPrefix ''SignatureHelpSignatureInformation+makeFieldsNoPrefix ''SignatureHelpParameterInformation+makeFieldsNoPrefix ''SignatureHelpClientCapabilities+makeFieldsNoPrefix ''ReferencesClientCapabilities+makeFieldsNoPrefix ''DefinitionClientCapabilities+makeFieldsNoPrefix ''TypeDefinitionClientCapabilities+makeFieldsNoPrefix ''ImplementationClientCapabilities+makeFieldsNoPrefix ''PublishDiagnosticsClientCapabilities+makeFieldsNoPrefix ''PublishDiagnosticsTagsClientCapabilities+makeFieldsNoPrefix ''TextDocumentClientCapabilities+makeFieldsNoPrefix ''ClientCapabilities++-- ---------------------------------------------------------------------++makeFieldsNoPrefix ''CompletionOptions+makeFieldsNoPrefix ''SignatureHelpOptions+makeFieldsNoPrefix ''ExecuteCommandOptions+makeFieldsNoPrefix ''SaveOptions+makeFieldsNoPrefix ''TextDocumentSyncOptions+makeFieldsNoPrefix ''WorkspaceServerCapabilities+makeFieldsNoPrefix ''WorkspaceFoldersServerCapabilities+makeFieldsNoPrefix ''ServerCapabilities+makeFieldsNoPrefix ''Registration+makeFieldsNoPrefix ''RegistrationParams+makeFieldsNoPrefix ''TextDocumentRegistrationOptions+makeFieldsNoPrefix ''Unregistration+makeFieldsNoPrefix ''UnregistrationParams+makeFieldsNoPrefix ''DidChangeConfigurationParams+makeFieldsNoPrefix ''ConfigurationItem+makeFieldsNoPrefix ''ConfigurationParams+makeFieldsNoPrefix ''DidOpenTextDocumentParams+makeFieldsNoPrefix ''TextDocumentContentChangeEvent+makeFieldsNoPrefix ''DidChangeTextDocumentParams+makeFieldsNoPrefix ''TextDocumentChangeRegistrationOptions+makeFieldsNoPrefix ''WillSaveTextDocumentParams+makeFieldsNoPrefix ''DidSaveTextDocumentParams+makeFieldsNoPrefix ''TextDocumentSaveRegistrationOptions+makeFieldsNoPrefix ''DidCloseTextDocumentParams+makeFieldsNoPrefix ''PublishDiagnosticsParams+makeFieldsNoPrefix ''LanguageString+makeFieldsNoPrefix ''ParameterInformation+makeFieldsNoPrefix ''SignatureInformation+makeFieldsNoPrefix ''SignatureHelp+makeFieldsNoPrefix ''SignatureHelpRegistrationOptions+makeFieldsNoPrefix ''ReferenceContext+makeFieldsNoPrefix ''ReferenceParams+makeFieldsNoPrefix ''ExecuteCommandParams+makeFieldsNoPrefix ''ExecuteCommandRegistrationOptions+makeFieldsNoPrefix ''ApplyWorkspaceEditParams+makeFieldsNoPrefix ''ApplyWorkspaceEditResponseBody++-- ---------------------------------------------------------------------++-- Initialize+makeFieldsNoPrefix ''InitializeParams+makeFieldsNoPrefix ''InitializeError+makeFieldsNoPrefix ''InitializeResult+makeFieldsNoPrefix ''ClientInfo+makeFieldsNoPrefix ''ServerInfo+makeFieldsNoPrefix ''InitializedParams++-- Watched files+makeFieldsNoPrefix ''DidChangeWatchedFilesClientCapabilities+makeFieldsNoPrefix ''DidChangeWatchedFilesRegistrationOptions+makeFieldsNoPrefix ''FileSystemWatcher+makeFieldsNoPrefix ''WatchKind+makeFieldsNoPrefix ''FileEvent+makeFieldsNoPrefix ''DidChangeWatchedFilesParams++-- Workspace symbols+makeFieldsNoPrefix ''WorkspaceSymbolKindClientCapabilities+makeFieldsNoPrefix ''WorkspaceSymbolClientCapabilities+makeFieldsNoPrefix ''WorkspaceSymbolOptions+makeFieldsNoPrefix ''WorkspaceSymbolRegistrationOptions+makeFieldsNoPrefix ''WorkspaceSymbolParams++-- Location+makeFieldsNoPrefix ''Position+makeFieldsNoPrefix ''Range+makeFieldsNoPrefix ''Location++-- Completion+makeFieldsNoPrefix ''CompletionItem+makeFieldsNoPrefix ''CompletionContext+makeFieldsNoPrefix ''CompletionList+makeFieldsNoPrefix ''CompletionParams+makeFieldsNoPrefix ''CompletionRegistrationOptions++-- Declaration+makeFieldsNoPrefix ''DeclarationClientCapabilities+makeFieldsNoPrefix ''DeclarationOptions+makeFieldsNoPrefix ''DeclarationRegistrationOptions+makeFieldsNoPrefix ''DeclarationParams++-- CodeActions+makeFieldsNoPrefix ''CodeActionKindClientCapabilities+makeFieldsNoPrefix ''CodeActionLiteralSupport+makeFieldsNoPrefix ''CodeActionClientCapabilities+makeFieldsNoPrefix ''CodeActionOptions+makeFieldsNoPrefix ''CodeActionRegistrationOptions+makeFieldsNoPrefix ''CodeActionContext+makeFieldsNoPrefix ''CodeActionParams+makeFieldsNoPrefix ''CodeAction++-- CodeLens+makeFieldsNoPrefix ''CodeLensClientCapabilities+makeFieldsNoPrefix ''CodeLensOptions+makeFieldsNoPrefix ''CodeLensRegistrationOptions+makeFieldsNoPrefix ''CodeLensParams+makeFieldsNoPrefix ''CodeLens++-- DocumentLink+makeFieldsNoPrefix ''DocumentLinkClientCapabilities+makeFieldsNoPrefix ''DocumentLinkOptions+makeFieldsNoPrefix ''DocumentLinkRegistrationOptions+makeFieldsNoPrefix ''DocumentLinkParams+makeFieldsNoPrefix ''DocumentLink++-- DocumentColor+makeFieldsNoPrefix ''DocumentColorClientCapabilities+makeFieldsNoPrefix ''DocumentColorOptions+makeFieldsNoPrefix ''DocumentColorRegistrationOptions+makeFieldsNoPrefix ''DocumentColorParams+makeFieldsNoPrefix ''Color+makeFieldsNoPrefix ''ColorInformation++-- ColorPresentation+makeFieldsNoPrefix ''ColorPresentationParams+makeFieldsNoPrefix ''ColorPresentation++-- Formatting+makeFieldsNoPrefix ''DocumentFormattingClientCapabilities+makeFieldsNoPrefix ''DocumentFormattingOptions+makeFieldsNoPrefix ''DocumentFormattingRegistrationOptions+makeFieldsNoPrefix ''FormattingOptions+makeFieldsNoPrefix ''DocumentFormattingParams++-- RangeFormatting+makeFieldsNoPrefix ''DocumentRangeFormattingClientCapabilities+makeFieldsNoPrefix ''DocumentRangeFormattingOptions+makeFieldsNoPrefix ''DocumentRangeFormattingRegistrationOptions+makeFieldsNoPrefix ''DocumentRangeFormattingParams++-- OnTypeFormatting+makeFieldsNoPrefix ''DocumentOnTypeFormattingClientCapabilities+makeFieldsNoPrefix ''DocumentOnTypeFormattingOptions+makeFieldsNoPrefix ''DocumentOnTypeFormattingRegistrationOptions+makeFieldsNoPrefix ''DocumentOnTypeFormattingParams++-- Rename+makeFieldsNoPrefix ''RenameClientCapabilities+makeFieldsNoPrefix ''RenameOptions+makeFieldsNoPrefix ''RenameRegistrationOptions+makeFieldsNoPrefix ''RenameParams++-- PrepareRename+makeFieldsNoPrefix ''PrepareRenameParams+makeFieldsNoPrefix ''RangeWithPlaceholder++-- FoldingRange+makeFieldsNoPrefix ''FoldingRangeClientCapabilities+makeFieldsNoPrefix ''FoldingRangeOptions+makeFieldsNoPrefix ''FoldingRangeRegistrationOptions+makeFieldsNoPrefix ''FoldingRangeParams+makeFieldsNoPrefix ''FoldingRange++-- SelectionRange+makeFieldsNoPrefix ''SelectionRangeClientCapabilities+makeFieldsNoPrefix ''SelectionRangeOptions+makeFieldsNoPrefix ''SelectionRangeRegistrationOptions+makeFieldsNoPrefix ''SelectionRangeParams+makeFieldsNoPrefix ''SelectionRange++-- DocumentHighlight+makeFieldsNoPrefix ''DocumentHighlightClientCapabilities+makeFieldsNoPrefix ''DocumentHighlightOptions+makeFieldsNoPrefix ''DocumentHighlightRegistrationOptions+makeFieldsNoPrefix ''DocumentHighlightParams+makeFieldsNoPrefix ''DocumentHighlight++-- DocumentSymbol+makeFieldsNoPrefix ''DocumentSymbolKindClientCapabilities+makeFieldsNoPrefix ''DocumentSymbolClientCapabilities+makeFieldsNoPrefix ''DocumentSymbolOptions+makeFieldsNoPrefix ''DocumentSymbolRegistrationOptions+makeFieldsNoPrefix ''DocumentSymbolParams+makeFieldsNoPrefix ''DocumentSymbol+makeFieldsNoPrefix ''SymbolInformation++-- DocumentFilter+makeFieldsNoPrefix ''DocumentFilter++-- WorkspaceEdit+makeFieldsNoPrefix ''TextEdit+makeFieldsNoPrefix ''VersionedTextDocumentIdentifier+makeFieldsNoPrefix ''TextDocumentEdit+makeFieldsNoPrefix ''WorkspaceEdit++-- Workspace Folders+makeFieldsNoPrefix ''WorkspaceFolder+makeFieldsNoPrefix ''WorkspaceFoldersChangeEvent+makeFieldsNoPrefix ''DidChangeWorkspaceFoldersParams++-- Message+makeFieldsNoPrefix ''RequestMessage+makeFieldsNoPrefix ''ResponseError+makeFieldsNoPrefix ''ResponseMessage+makeFieldsNoPrefix ''NotificationMessage+makeFieldsNoPrefix ''CancelParams++-- TextDocument+makeFieldsNoPrefix ''TextDocumentItem+makeFieldsNoPrefix ''TextDocumentIdentifier+makeFieldsNoPrefix ''TextDocumentPositionParams++-- Command+makeFieldsNoPrefix ''Command++-- Diagnostic+makeFieldsNoPrefix ''Diagnostic+makeFieldsNoPrefix ''DiagnosticRelatedInformation++-- Hover+makeFieldsNoPrefix ''Hover+makeFieldsNoPrefix ''HoverRegistrationOptions+++-- Window+makeFieldsNoPrefix ''ShowMessageParams+makeFieldsNoPrefix ''MessageActionItem+makeFieldsNoPrefix ''ShowMessageRequestParams+makeFieldsNoPrefix ''LogMessageParams+makeFieldsNoPrefix ''ProgressParams+makeFieldsNoPrefix ''WorkDoneProgressBeginParams+makeFieldsNoPrefix ''WorkDoneProgressReportParams+makeFieldsNoPrefix ''WorkDoneProgressEndParams+makeFieldsNoPrefix ''WorkDoneProgressCancelParams+makeFieldsNoPrefix ''WorkDoneProgressCreateParams
+ src/Language/LSP/Types/Location.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}+module Language.LSP.Types.Location where++import Control.DeepSeq+import Data.Aeson.TH+import GHC.Generics+import Language.LSP.Types.Uri+import Language.LSP.Types.Utils++-- ---------------------------------------------------------------------++data Position =+ Position+ { -- | Line position in a document (zero-based).+ _line :: Int+ -- | Character offset on a line in a document (zero-based). Assuming that+ -- the line is represented as a string, the @character@ value represents the+ -- gap between the @character@ and @character + 1@.+ , _character :: Int+ } deriving (Show, Read, Eq, Ord, Generic)++instance NFData Position+deriveJSON lspOptions ''Position++-- ---------------------------------------------------------------------++data Range =+ Range+ { _start :: Position -- ^ The range's start position.+ , _end :: Position -- ^ The range's end position.+ } deriving (Show, Read, Eq, Ord, Generic)++instance NFData Range+deriveJSON lspOptions ''Range++-- ---------------------------------------------------------------------++data Location =+ Location+ { _uri :: Uri+ , _range :: Range+ } deriving (Show, Read, Eq, Ord, Generic)++instance NFData Location+deriveJSON lspOptions ''Location++-- ---------------------------------------------------------------------++-- | Represents a link between a source and a target location.+data LocationLink =+ LocationLink+ { -- | Span of the origin of this link.+ -- Used as the underlined span for mouse interaction. Defaults to the word+ -- range at the mouse position.+ _originSelectionRange :: Maybe Range+ -- | The target resource identifier of this link.+ , _targetUri :: Uri+ -- | The full target range of this link. If the target for example is a+ -- symbol then target range is the range enclosing this symbol not including+ -- leading/trailing whitespace but everything else like comments. This+ -- information is typically used to highlight the range in the editor.+ , _targetRange :: Range+ -- | The range that should be selected and revealed when this link is being+ -- followed, e.g the name of a function. Must be contained by the the+ -- 'targetRange'. See also @DocumentSymbol._range@+ , _targetSelectionRange :: Range+ } deriving (Read, Show, Eq)+deriveJSON lspOptions ''LocationLink++-- ---------------------------------------------------------------------++-- | A helper function for creating ranges.+-- prop> mkRange l c l' c' = Range (Position l c) (Position l' c')+mkRange :: Int -> Int -> Int -> Int -> Range+mkRange l c l' c' = Range (Position l c) (Position l' c')
+ src/Language/LSP/Types/LspId.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}+module Language.LSP.Types.LspId where++import qualified Data.Aeson as A+import Data.Text (Text)+import Data.IxMap+import Language.LSP.Types.Method++-- | Id used for a request, Can be either a String or an Int+data LspId (m :: Method f Request) = IdInt Int | IdString Text+ deriving (Show,Read,Eq,Ord)++instance A.ToJSON (LspId m) where+ toJSON (IdInt i) = A.toJSON i+ toJSON (IdString s) = A.toJSON s++instance A.FromJSON (LspId m) where+ parseJSON v@(A.Number _) = IdInt <$> A.parseJSON v+ parseJSON (A.String s) = return (IdString s)+ parseJSON _ = mempty++instance IxOrd LspId where+ type Base LspId = Either Int Text+ toBase (IdInt i) = Left i+ toBase (IdString s) = Right s++data SomeLspId where+ SomeLspId :: LspId m -> SomeLspId++deriving instance Show SomeLspId+instance Eq SomeLspId where+ SomeLspId a == SomeLspId b = toBase a == toBase b+instance Ord SomeLspId where+ SomeLspId a `compare` SomeLspId b = toBase a `compare` toBase b
+ src/Language/LSP/Types/MarkupContent.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++-- | A MarkupContent literal represents a string value which content can+-- be represented in different formats.+-- Currently plaintext and markdown are supported formats.+-- A MarkupContent is usually used in documentation properties of result+-- literals like CompletionItem or SignatureInformation.+module Language.LSP.Types.MarkupContent where++import Data.Aeson+import Data.Aeson.TH+import Data.Text (Text)+import Language.LSP.Types.Utils++-- | Describes the content type that a client supports in various+-- result literals like `Hover`, `ParameterInfo` or `CompletionItem`.+data MarkupKind = MkPlainText -- ^ Plain text is supported as a content format+ | MkMarkdown -- ^ Markdown is supported as a content format+ deriving (Read, Show, Eq)++instance ToJSON MarkupKind where+ toJSON MkPlainText = String "plaintext"+ toJSON MkMarkdown = String "markdown"++instance FromJSON MarkupKind where+ parseJSON (String "plaintext") = pure MkPlainText+ parseJSON (String "markdown") = pure MkMarkdown+ parseJSON _ = mempty++-- | A `MarkupContent` literal represents a string value which content is interpreted base on its+-- | kind flag. Currently the protocol supports `plaintext` and `markdown` as markup kinds.+-- |+-- | If the kind is `markdown` then the value can contain fenced code blocks like in GitHub issues.+-- | See https://help.github.com/articles/creating-and-highlighting-code-blocks/#syntax-highlighting+-- |+-- | Here is an example how such a string can be constructed using JavaScript / TypeScript:+-- | ```ts+-- | let markdown: MarkdownContent = {+-- | kind: MarkupKind.Markdown,+-- | value: [+-- | '# Header',+-- | 'Some text',+-- | '```typescript',+-- | 'someCode();',+-- | '```'+-- | ].join('\n')+-- | };+-- | ```+-- |+-- | *Please Note* that clients might sanitize the return markdown. A client could decide to+-- | remove HTML from the markdown to avoid script execution.+data MarkupContent =+ MarkupContent+ { _kind :: MarkupKind -- ^ The type of the Markup+ , _value :: Text -- ^ The content itself+ }+ deriving (Read, Show, Eq)++deriveJSON lspOptions ''MarkupContent++-- ---------------------------------------------------------------------++-- | Create a 'MarkupContent' containing a quoted language string only.+markedUpContent :: Text -> Text -> MarkupContent+markedUpContent lang quote+ = MarkupContent MkMarkdown ("\n```" <> lang <> "\n" <> quote <> "\n```\n")++-- ---------------------------------------------------------------------++-- | Create a 'MarkupContent' containing unquoted text+unmarkedUpContent :: Text -> MarkupContent+unmarkedUpContent str = MarkupContent MkPlainText str++-- ---------------------------------------------------------------------++-- | Markdown for a section separator in Markdown, being a horizontal line+sectionSeparator :: Text+sectionSeparator = "* * *\n"++-- ---------------------------------------------------------------------++instance Semigroup MarkupContent where+ MarkupContent MkPlainText s1 <> MarkupContent MkPlainText s2 = MarkupContent MkPlainText (s1 `mappend` s2)+ MarkupContent MkMarkdown s1 <> MarkupContent _ s2 = MarkupContent MkMarkdown (s1 `mappend` s2)+ MarkupContent _ s1 <> MarkupContent MkMarkdown s2 = MarkupContent MkMarkdown (s1 `mappend` s2)++instance Monoid MarkupContent where+ mempty = MarkupContent MkPlainText ""++-- ---------------------------------------------------------------------+
+ src/Language/LSP/Types/Message.hs view
@@ -0,0 +1,636 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}++module Language.LSP.Types.Message where++import Language.LSP.Types.Cancellation+import Language.LSP.Types.CodeAction+import Language.LSP.Types.CodeLens+import Language.LSP.Types.Command+import Language.LSP.Types.Common+import Language.LSP.Types.Configuration+import Language.LSP.Types.Completion+import Language.LSP.Types.Declaration+import Language.LSP.Types.Definition+import Language.LSP.Types.Diagnostic+import Language.LSP.Types.DocumentColor+import Language.LSP.Types.DocumentHighlight+import Language.LSP.Types.DocumentLink+import Language.LSP.Types.DocumentSymbol+import Language.LSP.Types.FoldingRange+import Language.LSP.Types.Formatting+import Language.LSP.Types.Hover+import Language.LSP.Types.Implementation+import Language.LSP.Types.Initialize+import Language.LSP.Types.Location+import Language.LSP.Types.LspId+import Language.LSP.Types.Method+import Language.LSP.Types.Progress+import Language.LSP.Types.Registration+import Language.LSP.Types.Rename+import Language.LSP.Types.References+import Language.LSP.Types.SelectionRange+import Language.LSP.Types.SignatureHelp+import Language.LSP.Types.TextDocument+import Language.LSP.Types.TypeDefinition+import Language.LSP.Types.Utils+import Language.LSP.Types.Window+import Language.LSP.Types.WatchedFiles+import Language.LSP.Types.WorkspaceEdit+import Language.LSP.Types.WorkspaceFolders+import Language.LSP.Types.WorkspaceSymbol+import qualified Data.HashMap.Strict as HM++import Data.Kind+import Data.Aeson+import Data.Aeson.Types+import Data.Aeson.TH+import Data.GADT.Compare+import Data.Text (Text)+import Data.Type.Equality+import Data.Function (on)+import GHC.Generics++-- ---------------------------------------------------------------------+-- PARAMS definition+-- Map Methods to params/responses+-- ---------------------------------------------------------------------++-- | Map a method to the message payload type+type family MessageParams (m :: Method f t) :: Type where+-- Client+ -- General+ MessageParams Initialize = InitializeParams+ MessageParams Initialized = Maybe InitializedParams+ MessageParams Shutdown = Empty+ MessageParams Exit = Empty+ -- Workspace+ MessageParams WorkspaceDidChangeWorkspaceFolders = DidChangeWorkspaceFoldersParams+ MessageParams WorkspaceDidChangeConfiguration = DidChangeConfigurationParams+ MessageParams WorkspaceDidChangeWatchedFiles = DidChangeWatchedFilesParams+ MessageParams WorkspaceSymbol = WorkspaceSymbolParams+ MessageParams WorkspaceExecuteCommand = ExecuteCommandParams+ -- Sync/Document state+ MessageParams TextDocumentDidOpen = DidOpenTextDocumentParams+ MessageParams TextDocumentDidChange = DidChangeTextDocumentParams+ MessageParams TextDocumentWillSave = WillSaveTextDocumentParams+ MessageParams TextDocumentWillSaveWaitUntil = WillSaveTextDocumentParams+ MessageParams TextDocumentDidSave = DidSaveTextDocumentParams+ MessageParams TextDocumentDidClose = DidCloseTextDocumentParams+ -- Completion+ MessageParams TextDocumentCompletion = CompletionParams+ MessageParams CompletionItemResolve = CompletionItem+ -- Language Queries+ MessageParams TextDocumentHover = HoverParams+ MessageParams TextDocumentSignatureHelp = SignatureHelpParams+ MessageParams TextDocumentDeclaration = DeclarationParams+ MessageParams TextDocumentDefinition = DefinitionParams+ MessageParams TextDocumentTypeDefinition = TypeDefinitionParams+ MessageParams TextDocumentImplementation = ImplementationParams+ MessageParams TextDocumentReferences = ReferenceParams+ MessageParams TextDocumentDocumentHighlight = DocumentHighlightParams+ MessageParams TextDocumentDocumentSymbol = DocumentSymbolParams+ -- Code Action/Lens/Link+ MessageParams TextDocumentCodeAction = CodeActionParams+ MessageParams TextDocumentCodeLens = CodeLensParams+ MessageParams CodeLensResolve = CodeLens+ MessageParams TextDocumentDocumentLink = DocumentLinkParams+ MessageParams DocumentLinkResolve = DocumentLink+ -- Syntax highlighting/coloring+ MessageParams TextDocumentDocumentColor = DocumentColorParams+ MessageParams TextDocumentColorPresentation = ColorPresentationParams+ -- Formatting+ MessageParams TextDocumentFormatting = DocumentFormattingParams+ MessageParams TextDocumentRangeFormatting = DocumentRangeFormattingParams+ MessageParams TextDocumentOnTypeFormatting = DocumentOnTypeFormattingParams+ -- Rename+ MessageParams TextDocumentRename = RenameParams+ MessageParams TextDocumentPrepareRename = PrepareRenameParams+ -- Folding Range+ MessageParams TextDocumentFoldingRange = FoldingRangeParams+ -- Selection Range+ MessageParams TextDocumentSelectionRange = SelectionRangeParams+-- Server+ -- Window+ MessageParams WindowShowMessage = ShowMessageParams+ MessageParams WindowShowMessageRequest = ShowMessageRequestParams+ MessageParams WindowLogMessage = LogMessageParams+ -- Progress+ MessageParams WindowWorkDoneProgressCreate = WorkDoneProgressCreateParams+ MessageParams WindowWorkDoneProgressCancel = WorkDoneProgressCancelParams+ MessageParams Progress = ProgressParams SomeProgressParams+ -- Telemetry+ MessageParams TelemetryEvent = Value+ -- Client+ MessageParams ClientRegisterCapability = RegistrationParams+ MessageParams ClientUnregisterCapability = UnregistrationParams+ -- Workspace+ MessageParams WorkspaceWorkspaceFolders = Empty+ MessageParams WorkspaceConfiguration = ConfigurationParams+ MessageParams WorkspaceApplyEdit = ApplyWorkspaceEditParams+ -- Document/Diagnostic+ MessageParams TextDocumentPublishDiagnostics = PublishDiagnosticsParams+ -- Cancel+ MessageParams CancelRequest = CancelParams+ -- Custom+ MessageParams CustomMethod = Value++-- | Map a request method to the response payload type+type family ResponseResult (m :: Method f Request) :: Type where+-- Even though the specification mentions that the result types are+-- @x | y | ... | null@, they don't actually need to be wrapped in a Maybe since+-- (we think) this is just to account for how the response field is always+-- nullable. I.e. if it is null, then the error field is set++-- Client+ -- General+ ResponseResult Initialize = InitializeResult+ ResponseResult Shutdown = Empty+ -- Workspace+ ResponseResult WorkspaceSymbol = List SymbolInformation+ ResponseResult WorkspaceExecuteCommand = Value+ -- Sync/Document state+ ResponseResult TextDocumentWillSaveWaitUntil = List TextEdit+ -- Completion+ ResponseResult TextDocumentCompletion = List CompletionItem |? CompletionList+ ResponseResult CompletionItemResolve = CompletionItem+ -- Language Queries+ ResponseResult TextDocumentHover = Maybe Hover+ ResponseResult TextDocumentSignatureHelp = SignatureHelp+ ResponseResult TextDocumentDeclaration = Location |? List Location |? List LocationLink+ ResponseResult TextDocumentDefinition = Location |? List Location |? List LocationLink+ ResponseResult TextDocumentTypeDefinition = Location |? List Location |? List LocationLink+ ResponseResult TextDocumentImplementation = Location |? List Location |? List LocationLink+ ResponseResult TextDocumentReferences = List Location+ ResponseResult TextDocumentDocumentHighlight = List DocumentHighlight+ ResponseResult TextDocumentDocumentSymbol = List DocumentSymbol |? List SymbolInformation+ -- Code Action/Lens/Link+ ResponseResult TextDocumentCodeAction = List (Command |? CodeAction)+ ResponseResult TextDocumentCodeLens = List CodeLens+ ResponseResult CodeLensResolve = CodeLens+ ResponseResult TextDocumentDocumentLink = List DocumentLink+ ResponseResult DocumentLinkResolve = DocumentLink+ -- Syntax highlighting/coloring+ ResponseResult TextDocumentDocumentColor = List ColorInformation+ ResponseResult TextDocumentColorPresentation = List ColorPresentation+ -- Formatting+ ResponseResult TextDocumentFormatting = List TextEdit+ ResponseResult TextDocumentRangeFormatting = List TextEdit+ ResponseResult TextDocumentOnTypeFormatting = List TextEdit+ -- Rename+ ResponseResult TextDocumentRename = WorkspaceEdit+ ResponseResult TextDocumentPrepareRename = Range |? RangeWithPlaceholder+ -- FoldingRange+ ResponseResult TextDocumentFoldingRange = List FoldingRange+ ResponseResult TextDocumentSelectionRange = List SelectionRange+ -- Custom can be either a notification or a message+-- Server+ -- Window+ ResponseResult WindowShowMessageRequest = Maybe MessageActionItem+ ResponseResult WindowWorkDoneProgressCreate = ()+ -- Capability+ ResponseResult ClientRegisterCapability = Empty+ ResponseResult ClientUnregisterCapability = Empty+ -- Workspace+ ResponseResult WorkspaceWorkspaceFolders = Maybe (List WorkspaceFolder)+ ResponseResult WorkspaceConfiguration = List Value+ ResponseResult WorkspaceApplyEdit = ApplyWorkspaceEditResponseBody+-- Custom+ ResponseResult CustomMethod = Value+++-- ---------------------------------------------------------------------+{-+$ Notifications and Requests++Notification and requests ids starting with '$/' are messages which are protocol+implementation dependent and might not be implementable in all clients or+servers. For example if the server implementation uses a single threaded+synchronous programming language then there is little a server can do to react+to a '$/cancelRequest'. If a server or client receives notifications or requests+starting with '$/' it is free to ignore them if they are unknown.++-}++data NotificationMessage (m :: Method f Notification) =+ NotificationMessage+ { _jsonrpc :: Text+ , _method :: SMethod m+ , _params :: MessageParams m+ } deriving Generic++deriving instance Eq (MessageParams m) => Eq (NotificationMessage m)+deriving instance Show (MessageParams m) => Show (NotificationMessage m)++instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (NotificationMessage m) where+ parseJSON = genericParseJSON lspOptions+instance (ToJSON (MessageParams m)) => ToJSON (NotificationMessage m) where+ toJSON = genericToJSON lspOptions+ toEncoding = genericToEncoding lspOptions++data RequestMessage (m :: Method f Request) = RequestMessage+ { _jsonrpc :: Text+ , _id :: LspId m+ , _method :: SMethod m+ , _params :: MessageParams m+ } deriving Generic++deriving instance Eq (MessageParams m) => Eq (RequestMessage m)+deriving instance (Read (SMethod m), Read (MessageParams m)) => Read (RequestMessage m)+deriving instance Show (MessageParams m) => Show (RequestMessage m)++instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (RequestMessage m) where+ parseJSON = genericParseJSON lspOptions+instance (ToJSON (MessageParams m), FromJSON (SMethod m)) => ToJSON (RequestMessage m) where+ toJSON = genericToJSON lspOptions+ toEncoding = genericToEncoding lspOptions++-- | A custom message data type is needed to distinguish between+-- notifications and requests, since a CustomMethod can be both!+data CustomMessage f t where+ ReqMess :: RequestMessage (CustomMethod :: Method f Request) -> CustomMessage f Request+ NotMess :: NotificationMessage (CustomMethod :: Method f Notification) -> CustomMessage f Notification++deriving instance Show (CustomMessage p t)++instance ToJSON (CustomMessage p t) where+ toJSON (ReqMess a) = toJSON a+ toJSON (NotMess a) = toJSON a++instance FromJSON (CustomMessage p Request) where+ parseJSON v = ReqMess <$> parseJSON v+instance FromJSON (CustomMessage p Notification) where+ parseJSON v = NotMess <$> parseJSON v++-- ---------------------------------------------------------------------+-- Response Message+-- ---------------------------------------------------------------------++data ErrorCode = ParseError+ | InvalidRequest+ | MethodNotFound+ | InvalidParams+ | InternalError+ | ServerErrorStart+ | ServerErrorEnd+ | ServerNotInitialized+ | UnknownErrorCode+ | RequestCancelled+ | ContentModified+ -- ^ Note: server error codes are reserved from -32099 to -32000+ deriving (Read,Show,Eq)++instance ToJSON ErrorCode where+ toJSON ParseError = Number (-32700)+ toJSON InvalidRequest = Number (-32600)+ toJSON MethodNotFound = Number (-32601)+ toJSON InvalidParams = Number (-32602)+ toJSON InternalError = Number (-32603)+ toJSON ServerErrorStart = Number (-32099)+ toJSON ServerErrorEnd = Number (-32000)+ toJSON ServerNotInitialized = Number (-32002)+ toJSON UnknownErrorCode = Number (-32001)+ toJSON RequestCancelled = Number (-32800)+ toJSON ContentModified = Number (-32801)++instance FromJSON ErrorCode where+ parseJSON (Number (-32700)) = pure ParseError+ parseJSON (Number (-32600)) = pure InvalidRequest+ parseJSON (Number (-32601)) = pure MethodNotFound+ parseJSON (Number (-32602)) = pure InvalidParams+ parseJSON (Number (-32603)) = pure InternalError+ parseJSON (Number (-32099)) = pure ServerErrorStart+ parseJSON (Number (-32000)) = pure ServerErrorEnd+ parseJSON (Number (-32002)) = pure ServerNotInitialized+ parseJSON (Number (-32001)) = pure UnknownErrorCode+ parseJSON (Number (-32800)) = pure RequestCancelled+ parseJSON (Number (-32801)) = pure ContentModified+ parseJSON _ = mempty++-- -------------------------------------++data ResponseError =+ ResponseError+ { _code :: ErrorCode+ , _message :: Text+ , _xdata :: Maybe Value+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''ResponseError++-- | Either result or error must be Just.+data ResponseMessage (m :: Method f Request) =+ ResponseMessage+ { _jsonrpc :: Text+ , _id :: Maybe (LspId m)+ , _result :: Either ResponseError (ResponseResult m)+ } deriving Generic++deriving instance Eq (ResponseResult m) => Eq (ResponseMessage m)+deriving instance Read (ResponseResult m) => Read (ResponseMessage m)+deriving instance Show (ResponseResult m) => Show (ResponseMessage m)++instance (ToJSON (ResponseResult m)) => ToJSON (ResponseMessage m) where+ toJSON (ResponseMessage { _jsonrpc = jsonrpc, _id = lspid, _result = result })+ = object+ [ "jsonrpc" .= jsonrpc+ , "id" .= lspid+ , case result of+ Left err -> "error" .= err+ Right a -> "result" .= a+ ]++instance FromJSON (ResponseResult a) => FromJSON (ResponseMessage a) where+ parseJSON = withObject "Response" $ \o -> do+ _jsonrpc <- o .: "jsonrpc"+ _id <- o .: "id"+ -- It is important to use .:! so that "result = null" (without error) gets decoded as Just Null+ _result <- o .:! "result"+ _error <- o .:? "error"+ result <- case (_error, _result) of+ ((Just err), Nothing ) -> pure $ Left err+ (Nothing , (Just res)) -> pure $ Right res+ ((Just _err), (Just _res)) -> fail $ "both error and result cannot be present: " ++ show o+ (Nothing, Nothing) -> fail "both error and result cannot be Nothing"+ return $ ResponseMessage _jsonrpc _id $ result++-- ---------------------------------------------------------------------+-- Helper Type Families+-- ---------------------------------------------------------------------++-- | Map a method to the Request/Notification type with the correct+-- payload+type family Message (m :: Method f t) :: Type where+ Message (CustomMethod :: Method f t) = CustomMessage f t+ Message (m :: Method f Request) = RequestMessage m+ Message (m :: Method f Notification) = NotificationMessage m++-- Some helpful type synonyms+type ClientMessage (m :: Method FromClient t) = Message m+type ServerMessage (m :: Method FromServer t) = Message m++-- ---------------------------------------------------------------------+-- Working with arbritary messages+-- ---------------------------------------------------------------------++data FromServerMessage' a where+ FromServerMess :: forall t (m :: Method FromServer t) a. SMethod m -> Message m -> FromServerMessage' a+ FromServerRsp :: forall (m :: Method FromClient Request) a. a m -> ResponseMessage m -> FromServerMessage' a++type FromServerMessage = FromServerMessage' SMethod++instance Eq FromServerMessage where+ (==) = (==) `on` toJSON+instance Show FromServerMessage where+ show = show . toJSON++instance ToJSON FromServerMessage where+ toJSON (FromServerMess m p) = serverMethodJSON m (toJSON p)+ toJSON (FromServerRsp m p) = clientResponseJSON m (toJSON p)++fromServerNot :: forall (m :: Method FromServer Notification).+ Message m ~ NotificationMessage m => NotificationMessage m -> FromServerMessage+fromServerNot m@NotificationMessage{_method=meth} = FromServerMess meth m++fromServerReq :: forall (m :: Method FromServer Request).+ Message m ~ RequestMessage m => RequestMessage m -> FromServerMessage+fromServerReq m@RequestMessage{_method=meth} = FromServerMess meth m++data FromClientMessage' a where+ FromClientMess :: forall t (m :: Method FromClient t) a. SMethod m -> Message m -> FromClientMessage' a+ FromClientRsp :: forall (m :: Method FromServer Request) a. a m -> ResponseMessage m -> FromClientMessage' a++type FromClientMessage = FromClientMessage' SMethod++instance ToJSON FromClientMessage where+ toJSON (FromClientMess m p) = clientMethodJSON m (toJSON p)+ toJSON (FromClientRsp m p) = serverResponseJSON m (toJSON p)++fromClientNot :: forall (m :: Method FromClient Notification).+ Message m ~ NotificationMessage m => NotificationMessage m -> FromClientMessage+fromClientNot m@NotificationMessage{_method=meth} = FromClientMess meth m++fromClientReq :: forall (m :: Method FromClient Request).+ Message m ~ RequestMessage m => RequestMessage m -> FromClientMessage+fromClientReq m@RequestMessage{_method=meth} = FromClientMess meth m++type LookupFunc f a = forall (m :: Method f Request). LspId m -> Maybe (SMethod m, a m)++{-+Message Types we must handle are the following+ +Request | jsonrpc | id | method | params?+Response | jsonrpc | id | | | response? | error?+Notification | jsonrpc | | method | params?+-}++parseServerMessage :: LookupFunc FromClient a -> Value -> Parser (FromServerMessage' a)+parseServerMessage lookupId v@(Object o) = do+ case HM.lookup "method" o of+ Just cmd -> do+ -- Request or Notification+ SomeServerMethod m <- parseJSON cmd+ case splitServerMethod m of+ IsServerNot -> FromServerMess m <$> parseJSON v+ IsServerReq -> FromServerMess m <$> parseJSON v+ IsServerEither+ | HM.member "id" o -- Request+ , SCustomMethod cm <- m ->+ let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromServer Request))+ in FromServerMess m' <$> parseJSON v+ | SCustomMethod cm <- m ->+ let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromServer Notification))+ in FromServerMess m' <$> parseJSON v+ Nothing -> do+ case HM.lookup "id" o of+ Just i' -> do+ i <- parseJSON i'+ case lookupId i of+ Just (m,res) -> clientResponseJSON m $ FromServerRsp res <$> parseJSON v+ Nothing -> fail $ unwords ["Failed in looking up response type of", show v]+ Nothing -> fail $ unwords ["Got unexpected message without method or id"]+parseServerMessage _ v = fail $ unwords ["parseServerMessage expected object, got:",show v]++parseClientMessage :: LookupFunc FromServer a -> Value -> Parser (FromClientMessage' a)+parseClientMessage lookupId v@(Object o) = do+ case HM.lookup "method" o of+ Just cmd -> do+ -- Request or Notification+ SomeClientMethod m <- parseJSON cmd+ case splitClientMethod m of+ IsClientNot -> FromClientMess m <$> parseJSON v+ IsClientReq -> FromClientMess m <$> parseJSON v+ IsClientEither+ | HM.member "id" o -- Request+ , SCustomMethod cm <- m ->+ let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromClient Request))+ in FromClientMess m' <$> parseJSON v+ | SCustomMethod cm <- m ->+ let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromClient Notification))+ in FromClientMess m' <$> parseJSON v+ Nothing -> do+ case HM.lookup "id" o of+ Just i' -> do+ i <- parseJSON i'+ case lookupId i of+ Just (m,res) -> serverResponseJSON m $ FromClientRsp res <$> parseJSON v+ Nothing -> fail $ unwords ["Failed in looking up response type of", show v]+ Nothing -> fail $ unwords ["Got unexpected message without method or id"]+parseClientMessage _ v = fail $ unwords ["parseClientMessage expected object, got:",show v]++-- ---------------------------------------------------------------------+-- Helper Utilities+-- ---------------------------------------------------------------------++clientResponseJSON :: SClientMethod m -> (HasJSON (ResponseMessage m) => x) -> x+clientResponseJSON m x = case splitClientMethod m of+ IsClientReq -> x+ IsClientEither -> x++serverResponseJSON :: SServerMethod m -> (HasJSON (ResponseMessage m) => x) -> x+serverResponseJSON m x = case splitServerMethod m of+ IsServerReq -> x+ IsServerEither -> x++clientMethodJSON :: SClientMethod m -> (ToJSON (ClientMessage m) => x) -> x+clientMethodJSON m x =+ case splitClientMethod m of+ IsClientNot -> x+ IsClientReq -> x+ IsClientEither -> x++serverMethodJSON :: SServerMethod m -> (ToJSON (ServerMessage m) => x) -> x+serverMethodJSON m x =+ case splitServerMethod m of+ IsServerNot -> x+ IsServerReq -> x+ IsServerEither -> x++type HasJSON a = (ToJSON a,FromJSON a,Eq a)++-- Reify universal properties about Client/Server Messages++data ClientNotOrReq (m :: Method FromClient t) where+ IsClientNot+ :: ( HasJSON (ClientMessage m)+ , Message m ~ NotificationMessage m)+ => ClientNotOrReq (m :: Method FromClient Notification)+ IsClientReq+ :: forall (m :: Method FromClient Request).+ ( HasJSON (ClientMessage m)+ , HasJSON (ResponseMessage m)+ , Message m ~ RequestMessage m)+ => ClientNotOrReq m+ IsClientEither+ :: ClientNotOrReq CustomMethod++data ServerNotOrReq (m :: Method FromServer t) where+ IsServerNot+ :: ( HasJSON (ServerMessage m)+ , Message m ~ NotificationMessage m)+ => ServerNotOrReq (m :: Method FromServer Notification)+ IsServerReq+ :: forall (m :: Method FromServer Request).+ ( HasJSON (ServerMessage m)+ , HasJSON (ResponseMessage m)+ , Message m ~ RequestMessage m)+ => ServerNotOrReq m+ IsServerEither+ :: ServerNotOrReq CustomMethod++splitClientMethod :: SClientMethod m -> ClientNotOrReq m+splitClientMethod SInitialize = IsClientReq+splitClientMethod SInitialized = IsClientNot+splitClientMethod SShutdown = IsClientReq+splitClientMethod SExit = IsClientNot+splitClientMethod SWorkspaceDidChangeWorkspaceFolders = IsClientNot+splitClientMethod SWorkspaceDidChangeConfiguration = IsClientNot+splitClientMethod SWorkspaceDidChangeWatchedFiles = IsClientNot+splitClientMethod SWorkspaceSymbol = IsClientReq+splitClientMethod SWorkspaceExecuteCommand = IsClientReq+splitClientMethod SWindowWorkDoneProgressCancel = IsClientNot+splitClientMethod STextDocumentDidOpen = IsClientNot+splitClientMethod STextDocumentDidChange = IsClientNot+splitClientMethod STextDocumentWillSave = IsClientNot+splitClientMethod STextDocumentWillSaveWaitUntil = IsClientReq+splitClientMethod STextDocumentDidSave = IsClientNot+splitClientMethod STextDocumentDidClose = IsClientNot+splitClientMethod STextDocumentCompletion = IsClientReq+splitClientMethod SCompletionItemResolve = IsClientReq+splitClientMethod STextDocumentHover = IsClientReq+splitClientMethod STextDocumentSignatureHelp = IsClientReq+splitClientMethod STextDocumentDeclaration = IsClientReq+splitClientMethod STextDocumentDefinition = IsClientReq+splitClientMethod STextDocumentTypeDefinition = IsClientReq+splitClientMethod STextDocumentImplementation = IsClientReq+splitClientMethod STextDocumentReferences = IsClientReq+splitClientMethod STextDocumentDocumentHighlight = IsClientReq+splitClientMethod STextDocumentDocumentSymbol = IsClientReq+splitClientMethod STextDocumentCodeAction = IsClientReq+splitClientMethod STextDocumentCodeLens = IsClientReq+splitClientMethod SCodeLensResolve = IsClientReq+splitClientMethod STextDocumentDocumentLink = IsClientReq+splitClientMethod SDocumentLinkResolve = IsClientReq+splitClientMethod STextDocumentDocumentColor = IsClientReq+splitClientMethod STextDocumentColorPresentation = IsClientReq+splitClientMethod STextDocumentFormatting = IsClientReq+splitClientMethod STextDocumentRangeFormatting = IsClientReq+splitClientMethod STextDocumentOnTypeFormatting = IsClientReq+splitClientMethod STextDocumentRename = IsClientReq+splitClientMethod STextDocumentPrepareRename = IsClientReq+splitClientMethod STextDocumentFoldingRange = IsClientReq+splitClientMethod STextDocumentSelectionRange = IsClientReq+splitClientMethod SCancelRequest = IsClientNot+splitClientMethod SCustomMethod{} = IsClientEither++splitServerMethod :: SServerMethod m -> ServerNotOrReq m+splitServerMethod SWindowShowMessage = IsServerNot+splitServerMethod SWindowShowMessageRequest = IsServerReq+splitServerMethod SWindowLogMessage = IsServerNot+splitServerMethod SWindowWorkDoneProgressCreate = IsServerReq+splitServerMethod SProgress = IsServerNot+splitServerMethod STelemetryEvent = IsServerNot+splitServerMethod SClientRegisterCapability = IsServerReq+splitServerMethod SClientUnregisterCapability = IsServerReq+splitServerMethod SWorkspaceWorkspaceFolders = IsServerReq+splitServerMethod SWorkspaceConfiguration = IsServerReq+splitServerMethod SWorkspaceApplyEdit = IsServerReq+splitServerMethod STextDocumentPublishDiagnostics = IsServerNot+splitServerMethod SCancelRequest = IsServerNot+splitServerMethod SCustomMethod{} = IsServerEither++-- | Heterogeneous equality on singleton server methods+mEqServer :: SServerMethod m1 -> SServerMethod m2 -> Maybe (m1 :~~: m2)+mEqServer m1 m2 = case (splitServerMethod m1, splitServerMethod m2) of+ (IsServerNot, IsServerNot) -> do+ Refl <- geq m1 m2+ pure HRefl+ (IsServerReq, IsServerReq) -> do+ Refl <- geq m1 m2+ pure HRefl+ _ -> Nothing++-- | Heterogeneous equality on singlton client methods+mEqClient :: SClientMethod m1 -> SClientMethod m2 -> Maybe (m1 :~~: m2)+mEqClient m1 m2 = case (splitClientMethod m1, splitClientMethod m2) of+ (IsClientNot, IsClientNot) -> do+ Refl <- geq m1 m2+ pure HRefl+ (IsClientReq, IsClientReq) -> do+ Refl <- geq m1 m2+ pure HRefl+ _ -> Nothing
+ src/Language/LSP/Types/Method.hs view
@@ -0,0 +1,385 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}+module Language.LSP.Types.Method where++import qualified Data.Aeson as A+import Data.Aeson.Types+import Data.Text (Text)+import Language.LSP.Types.Utils+import Data.Function (on)+import Control.Applicative+import Data.GADT.Compare.TH++-- ---------------------------------------------------------------------++data From = FromServer | FromClient+data MethodType = Notification | Request++data Method (f :: From) (t :: MethodType) where+-- Client Methods+ -- General+ Initialize :: Method FromClient Request+ Initialized :: Method FromClient Notification+ Shutdown :: Method FromClient Request+ Exit :: Method FromClient Notification+ -- Workspace+ WorkspaceDidChangeWorkspaceFolders :: Method FromClient Notification+ WorkspaceDidChangeConfiguration :: Method FromClient Notification+ WorkspaceDidChangeWatchedFiles :: Method FromClient Notification+ WorkspaceSymbol :: Method FromClient Request+ WorkspaceExecuteCommand :: Method FromClient Request+ -- Document+ TextDocumentDidOpen :: Method FromClient Notification+ TextDocumentDidChange :: Method FromClient Notification+ TextDocumentWillSave :: Method FromClient Notification+ TextDocumentWillSaveWaitUntil :: Method FromClient Request+ TextDocumentDidSave :: Method FromClient Notification+ TextDocumentDidClose :: Method FromClient Notification+ -- Completion+ TextDocumentCompletion :: Method FromClient Request+ CompletionItemResolve :: Method FromClient Request+ -- LanguageQueries+ TextDocumentHover :: Method FromClient Request+ TextDocumentSignatureHelp :: Method FromClient Request+ TextDocumentDeclaration :: Method FromClient Request+ TextDocumentDefinition :: Method FromClient Request+ TextDocumentTypeDefinition :: Method FromClient Request+ TextDocumentImplementation :: Method FromClient Request+ TextDocumentReferences :: Method FromClient Request+ TextDocumentDocumentHighlight :: Method FromClient Request+ TextDocumentDocumentSymbol :: Method FromClient Request+ -- Code Action/Lens/Link+ TextDocumentCodeAction :: Method FromClient Request+ TextDocumentCodeLens :: Method FromClient Request+ CodeLensResolve :: Method FromClient Request+ TextDocumentDocumentLink :: Method FromClient Request+ DocumentLinkResolve :: Method FromClient Request+ -- Syntax highlighting/Coloring+ TextDocumentDocumentColor :: Method FromClient Request+ TextDocumentColorPresentation :: Method FromClient Request+ -- Formatting+ TextDocumentFormatting :: Method FromClient Request+ TextDocumentRangeFormatting :: Method FromClient Request+ TextDocumentOnTypeFormatting :: Method FromClient Request+ -- Rename+ TextDocumentRename :: Method FromClient Request+ TextDocumentPrepareRename :: Method FromClient Request+ -- FoldingRange+ TextDocumentFoldingRange :: Method FromClient Request+ TextDocumentSelectionRange :: Method FromClient Request++-- ServerMethods+ -- Window+ WindowShowMessage :: Method FromServer Notification+ WindowShowMessageRequest :: Method FromServer Request+ WindowLogMessage :: Method FromServer Notification+ WindowWorkDoneProgressCancel :: Method FromClient Notification+ WindowWorkDoneProgressCreate :: Method FromServer Request+ -- Progress+ Progress :: Method FromServer Notification+ -- Telemetry+ TelemetryEvent :: Method FromServer Notification+ -- Client+ ClientRegisterCapability :: Method FromServer Request+ ClientUnregisterCapability :: Method FromServer Request+ -- Workspace+ WorkspaceWorkspaceFolders :: Method FromServer Request+ WorkspaceConfiguration :: Method FromServer Request+ WorkspaceApplyEdit :: Method FromServer Request+ -- Document+ TextDocumentPublishDiagnostics :: Method FromServer Notification++-- Cancelling+ CancelRequest :: Method f Notification++-- Custom+ -- A custom message type. It is not enforced that this starts with $/.+ CustomMethod :: Method f t++data SMethod (m :: Method f t) where+ SInitialize :: SMethod Initialize+ SInitialized :: SMethod Initialized+ SShutdown :: SMethod Shutdown+ SExit :: SMethod Exit+ SWorkspaceDidChangeWorkspaceFolders :: SMethod WorkspaceDidChangeWorkspaceFolders+ SWorkspaceDidChangeConfiguration :: SMethod WorkspaceDidChangeConfiguration+ SWorkspaceDidChangeWatchedFiles :: SMethod WorkspaceDidChangeWatchedFiles+ SWorkspaceSymbol :: SMethod WorkspaceSymbol+ SWorkspaceExecuteCommand :: SMethod WorkspaceExecuteCommand+ STextDocumentDidOpen :: SMethod TextDocumentDidOpen+ STextDocumentDidChange :: SMethod TextDocumentDidChange+ STextDocumentWillSave :: SMethod TextDocumentWillSave+ STextDocumentWillSaveWaitUntil :: SMethod TextDocumentWillSaveWaitUntil+ STextDocumentDidSave :: SMethod TextDocumentDidSave+ STextDocumentDidClose :: SMethod TextDocumentDidClose+ STextDocumentCompletion :: SMethod TextDocumentCompletion+ SCompletionItemResolve :: SMethod CompletionItemResolve+ STextDocumentHover :: SMethod TextDocumentHover+ STextDocumentSignatureHelp :: SMethod TextDocumentSignatureHelp+ STextDocumentDeclaration :: SMethod TextDocumentDeclaration+ STextDocumentDefinition :: SMethod TextDocumentDefinition+ STextDocumentTypeDefinition :: SMethod TextDocumentTypeDefinition+ STextDocumentImplementation :: SMethod TextDocumentImplementation+ STextDocumentReferences :: SMethod TextDocumentReferences+ STextDocumentDocumentHighlight :: SMethod TextDocumentDocumentHighlight+ STextDocumentDocumentSymbol :: SMethod TextDocumentDocumentSymbol+ STextDocumentCodeAction :: SMethod TextDocumentCodeAction+ STextDocumentCodeLens :: SMethod TextDocumentCodeLens+ SCodeLensResolve :: SMethod CodeLensResolve+ STextDocumentDocumentLink :: SMethod TextDocumentDocumentLink+ SDocumentLinkResolve :: SMethod DocumentLinkResolve+ STextDocumentDocumentColor :: SMethod TextDocumentDocumentColor+ STextDocumentColorPresentation :: SMethod TextDocumentColorPresentation+ STextDocumentFormatting :: SMethod TextDocumentFormatting+ STextDocumentRangeFormatting :: SMethod TextDocumentRangeFormatting+ STextDocumentOnTypeFormatting :: SMethod TextDocumentOnTypeFormatting+ STextDocumentRename :: SMethod TextDocumentRename+ STextDocumentPrepareRename :: SMethod TextDocumentPrepareRename+ STextDocumentFoldingRange :: SMethod TextDocumentFoldingRange+ STextDocumentSelectionRange :: SMethod TextDocumentSelectionRange++ SWindowShowMessage :: SMethod WindowShowMessage+ SWindowShowMessageRequest :: SMethod WindowShowMessageRequest+ SWindowLogMessage :: SMethod WindowLogMessage+ SWindowWorkDoneProgressCreate :: SMethod WindowWorkDoneProgressCreate+ SWindowWorkDoneProgressCancel :: SMethod WindowWorkDoneProgressCancel+ SProgress :: SMethod Progress+ STelemetryEvent :: SMethod TelemetryEvent+ SClientRegisterCapability :: SMethod ClientRegisterCapability+ SClientUnregisterCapability :: SMethod ClientUnregisterCapability+ SWorkspaceWorkspaceFolders :: SMethod WorkspaceWorkspaceFolders+ SWorkspaceConfiguration :: SMethod WorkspaceConfiguration+ SWorkspaceApplyEdit :: SMethod WorkspaceApplyEdit+ STextDocumentPublishDiagnostics :: SMethod TextDocumentPublishDiagnostics++ SCancelRequest :: SMethod CancelRequest+ SCustomMethod :: Text -> SMethod CustomMethod++deriveGEq ''SMethod+deriveGCompare ''SMethod++deriving instance Eq (SMethod m)+deriving instance Ord (SMethod m)+deriving instance Show (SMethod m)++-- Some useful type synonyms+type SClientMethod (m :: Method FromClient t) = SMethod m+type SServerMethod (m :: Method FromServer t) = SMethod m++data SomeClientMethod = forall t (m :: Method FromClient t). SomeClientMethod (SMethod m)+data SomeServerMethod = forall t (m :: Method FromServer t). SomeServerMethod (SMethod m)++data SomeMethod where+ SomeMethod :: forall m. SMethod m -> SomeMethod++deriving instance Show SomeMethod+instance Eq SomeMethod where+ (==) = (==) `on` toJSON+instance Ord SomeMethod where+ compare = compare `on` (getString . toJSON)+ where+ getString (A.String t) = t+ getString _ = error "ToJSON instance for some method isn't string"+deriving instance Show SomeClientMethod+instance Eq SomeClientMethod where+ (==) = (==) `on` toJSON+instance Ord SomeClientMethod where+ compare = compare `on` (getString . toJSON)+ where+ getString (A.String t) = t+ getString _ = error "ToJSON instance for some method isn't string"+deriving instance Show SomeServerMethod+instance Eq SomeServerMethod where+ (==) = (==) `on` toJSON+instance Ord SomeServerMethod where+ compare = compare `on` (getString . toJSON)+ where+ getString (A.String t) = t+ getString _ = error "ToJSON instance for some method isn't string"++-- ---------------------------------------------------------------------+-- From JSON+-- ---------------------------------------------------------------------++instance FromJSON SomeMethod where+ parseJSON v = client <|> server+ where+ client = do+ c <- parseJSON v+ case c of+ -- Don't parse the client custom method so that we can still+ -- parse the server methods+ SomeClientMethod (SCustomMethod _) -> mempty+ SomeClientMethod m -> pure $ SomeMethod m+ server = do+ c <- parseJSON v+ case c of+ SomeServerMethod m -> pure $ SomeMethod m++instance FromJSON SomeClientMethod where+ -- General+ parseJSON (A.String "initialize") = pure $ SomeClientMethod SInitialize+ parseJSON (A.String "initialized") = pure $ SomeClientMethod SInitialized+ parseJSON (A.String "shutdown") = pure $ SomeClientMethod SShutdown+ parseJSON (A.String "exit") = pure $ SomeClientMethod SExit+ -- Workspace+ parseJSON (A.String "workspace/didChangeWorkspaceFolders") = pure $ SomeClientMethod SWorkspaceDidChangeWorkspaceFolders+ parseJSON (A.String "workspace/didChangeConfiguration") = pure $ SomeClientMethod SWorkspaceDidChangeConfiguration+ parseJSON (A.String "workspace/didChangeWatchedFiles") = pure $ SomeClientMethod SWorkspaceDidChangeWatchedFiles+ parseJSON (A.String "workspace/symbol") = pure $ SomeClientMethod SWorkspaceSymbol+ parseJSON (A.String "workspace/executeCommand") = pure $ SomeClientMethod SWorkspaceExecuteCommand+ -- Document+ parseJSON (A.String "textDocument/didOpen") = pure $ SomeClientMethod STextDocumentDidOpen+ parseJSON (A.String "textDocument/didChange") = pure $ SomeClientMethod STextDocumentDidChange+ parseJSON (A.String "textDocument/willSave") = pure $ SomeClientMethod STextDocumentWillSave+ parseJSON (A.String "textDocument/willSaveWaitUntil") = pure $ SomeClientMethod STextDocumentWillSaveWaitUntil+ parseJSON (A.String "textDocument/didSave") = pure $ SomeClientMethod STextDocumentDidSave+ parseJSON (A.String "textDocument/didClose") = pure $ SomeClientMethod STextDocumentDidClose+ parseJSON (A.String "textDocument/completion") = pure $ SomeClientMethod STextDocumentCompletion+ parseJSON (A.String "completionItem/resolve") = pure $ SomeClientMethod SCompletionItemResolve+ parseJSON (A.String "textDocument/hover") = pure $ SomeClientMethod STextDocumentHover+ parseJSON (A.String "textDocument/signatureHelp") = pure $ SomeClientMethod STextDocumentSignatureHelp+ parseJSON (A.String "textDocument/declaration") = pure $ SomeClientMethod STextDocumentDeclaration+ parseJSON (A.String "textDocument/definition") = pure $ SomeClientMethod STextDocumentDefinition+ parseJSON (A.String "textDocument/typeDefinition") = pure $ SomeClientMethod STextDocumentTypeDefinition+ parseJSON (A.String "textDocument/implementation") = pure $ SomeClientMethod STextDocumentImplementation+ parseJSON (A.String "textDocument/references") = pure $ SomeClientMethod STextDocumentReferences+ parseJSON (A.String "textDocument/documentHighlight") = pure $ SomeClientMethod STextDocumentDocumentHighlight+ parseJSON (A.String "textDocument/documentSymbol") = pure $ SomeClientMethod STextDocumentDocumentSymbol+ parseJSON (A.String "textDocument/codeAction") = pure $ SomeClientMethod STextDocumentCodeAction+ parseJSON (A.String "textDocument/codeLens") = pure $ SomeClientMethod STextDocumentCodeLens+ parseJSON (A.String "codeLens/resolve") = pure $ SomeClientMethod SCodeLensResolve+ parseJSON (A.String "textDocument/documentLink") = pure $ SomeClientMethod STextDocumentDocumentLink+ parseJSON (A.String "documentLink/resolve") = pure $ SomeClientMethod SDocumentLinkResolve+ parseJSON (A.String "textDocument/documentColor") = pure $ SomeClientMethod STextDocumentDocumentColor+ parseJSON (A.String "textDocument/colorPresentation") = pure $ SomeClientMethod STextDocumentColorPresentation+ parseJSON (A.String "textDocument/formatting") = pure $ SomeClientMethod STextDocumentFormatting+ parseJSON (A.String "textDocument/rangeFormatting") = pure $ SomeClientMethod STextDocumentRangeFormatting+ parseJSON (A.String "textDocument/onTypeFormatting") = pure $ SomeClientMethod STextDocumentOnTypeFormatting+ parseJSON (A.String "textDocument/rename") = pure $ SomeClientMethod STextDocumentRename+ parseJSON (A.String "textDocument/prepareRename") = pure $ SomeClientMethod STextDocumentPrepareRename+ parseJSON (A.String "textDocument/foldingRange") = pure $ SomeClientMethod STextDocumentFoldingRange+ parseJSON (A.String "textDocument/selectionRange") = pure $ SomeClientMethod STextDocumentFoldingRange+ parseJSON (A.String "window/workDoneProgress/cancel") = pure $ SomeClientMethod SWindowWorkDoneProgressCancel+-- Cancelling+ parseJSON (A.String "$/cancelRequest") = pure $ SomeClientMethod SCancelRequest+-- Custom+ parseJSON (A.String m) = pure $ SomeClientMethod (SCustomMethod m)+ parseJSON _ = mempty++instance A.FromJSON SomeServerMethod where+-- Server+ -- Window+ parseJSON (A.String "window/showMessage") = pure $ SomeServerMethod SWindowShowMessage+ parseJSON (A.String "window/showMessageRequest") = pure $ SomeServerMethod SWindowShowMessageRequest+ parseJSON (A.String "window/logMessage") = pure $ SomeServerMethod SWindowLogMessage+ parseJSON (A.String "window/workDoneProgress/create") = pure $ SomeServerMethod SWindowWorkDoneProgressCreate+ parseJSON (A.String "$/progress") = pure $ SomeServerMethod SProgress+ parseJSON (A.String "telemetry/event") = pure $ SomeServerMethod STelemetryEvent+ -- Client+ parseJSON (A.String "client/registerCapability") = pure $ SomeServerMethod SClientRegisterCapability+ parseJSON (A.String "client/unregisterCapability") = pure $ SomeServerMethod SClientUnregisterCapability+ -- Workspace+ parseJSON (A.String "workspace/workspaceFolders") = pure $ SomeServerMethod SWorkspaceWorkspaceFolders+ parseJSON (A.String "workspace/configuration") = pure $ SomeServerMethod SWorkspaceConfiguration+ parseJSON (A.String "workspace/applyEdit") = pure $ SomeServerMethod SWorkspaceApplyEdit+ -- Document+ parseJSON (A.String "textDocument/publishDiagnostics") = pure $ SomeServerMethod STextDocumentPublishDiagnostics++-- Cancelling+ parseJSON (A.String "$/cancelRequest") = pure $ SomeServerMethod SCancelRequest++-- Custom+ parseJSON (A.String m) = pure $ SomeServerMethod (SCustomMethod m)+ parseJSON _ = mempty++-- instance FromJSON (SMethod m)+makeSingletonFromJSON 'SomeMethod ''SMethod++-- ---------------------------------------------------------------------+-- TO JSON+-- ---------------------------------------------------------------------++instance ToJSON SomeMethod where+ toJSON (SomeMethod m) = toJSON m++instance ToJSON SomeClientMethod where+ toJSON (SomeClientMethod m) = toJSON m+instance ToJSON SomeServerMethod where+ toJSON (SomeServerMethod m) = toJSON m++instance A.ToJSON (SMethod m) where+-- Client+ -- General+ toJSON SInitialize = A.String "initialize"+ toJSON SInitialized = A.String "initialized"+ toJSON SShutdown = A.String "shutdown"+ toJSON SExit = A.String "exit"+ -- Workspace+ toJSON SWorkspaceDidChangeWorkspaceFolders = A.String "workspace/didChangeWorkspaceFolders"+ toJSON SWorkspaceDidChangeConfiguration = A.String "workspace/didChangeConfiguration"+ toJSON SWorkspaceDidChangeWatchedFiles = A.String "workspace/didChangeWatchedFiles"+ toJSON SWorkspaceSymbol = A.String "workspace/symbol"+ toJSON SWorkspaceExecuteCommand = A.String "workspace/executeCommand"+ -- Document+ toJSON STextDocumentDidOpen = A.String "textDocument/didOpen"+ toJSON STextDocumentDidChange = A.String "textDocument/didChange"+ toJSON STextDocumentWillSave = A.String "textDocument/willSave"+ toJSON STextDocumentWillSaveWaitUntil = A.String "textDocument/willSaveWaitUntil"+ toJSON STextDocumentDidSave = A.String "textDocument/didSave"+ toJSON STextDocumentDidClose = A.String "textDocument/didClose"+ toJSON STextDocumentCompletion = A.String "textDocument/completion"+ toJSON SCompletionItemResolve = A.String "completionItem/resolve"+ toJSON STextDocumentHover = A.String "textDocument/hover"+ toJSON STextDocumentSignatureHelp = A.String "textDocument/signatureHelp"+ toJSON STextDocumentReferences = A.String "textDocument/references"+ toJSON STextDocumentDocumentHighlight = A.String "textDocument/documentHighlight"+ toJSON STextDocumentDocumentSymbol = A.String "textDocument/documentSymbol"+ toJSON STextDocumentDeclaration = A.String "textDocument/declaration"+ toJSON STextDocumentDefinition = A.String "textDocument/definition"+ toJSON STextDocumentTypeDefinition = A.String "textDocument/typeDefinition"+ toJSON STextDocumentImplementation = A.String "textDocument/implementation"+ toJSON STextDocumentCodeAction = A.String "textDocument/codeAction"+ toJSON STextDocumentCodeLens = A.String "textDocument/codeLens"+ toJSON SCodeLensResolve = A.String "codeLens/resolve"+ toJSON STextDocumentDocumentColor = A.String "textDocument/documentColor"+ toJSON STextDocumentColorPresentation = A.String "textDocument/colorPresentation"+ toJSON STextDocumentFormatting = A.String "textDocument/formatting"+ toJSON STextDocumentRangeFormatting = A.String "textDocument/rangeFormatting"+ toJSON STextDocumentOnTypeFormatting = A.String "textDocument/onTypeFormatting"+ toJSON STextDocumentRename = A.String "textDocument/rename"+ toJSON STextDocumentPrepareRename = A.String "textDocument/prepareRename"+ toJSON STextDocumentFoldingRange = A.String "textDocument/foldingRange"+ toJSON STextDocumentSelectionRange = A.String "textDocument/selectionRange"+ toJSON STextDocumentDocumentLink = A.String "textDocument/documentLink"+ toJSON SDocumentLinkResolve = A.String "documentLink/resolve"+ toJSON SWindowWorkDoneProgressCancel = A.String "window/workDoneProgress/cancel"+-- Server+ -- Window+ toJSON SWindowShowMessage = A.String "window/showMessage"+ toJSON SWindowShowMessageRequest = A.String "window/showMessageRequest"+ toJSON SWindowLogMessage = A.String "window/logMessage"+ toJSON SWindowWorkDoneProgressCreate = A.String "window/workDoneProgress/create"+ toJSON SProgress = A.String "$/progress"+ toJSON STelemetryEvent = A.String "telemetry/event"+ -- Client+ toJSON SClientRegisterCapability = A.String "client/registerCapability"+ toJSON SClientUnregisterCapability = A.String "client/unregisterCapability"+ -- Workspace+ toJSON SWorkspaceWorkspaceFolders = A.String "workspace/workspaceFolders"+ toJSON SWorkspaceConfiguration = A.String "workspace/configuration"+ toJSON SWorkspaceApplyEdit = A.String "workspace/applyEdit"+ -- Document+ toJSON STextDocumentPublishDiagnostics = A.String "textDocument/publishDiagnostics"+ -- Cancelling+ toJSON SCancelRequest = A.String "$/cancelRequest"+-- Custom+ toJSON (SCustomMethod m) = A.String m
+ src/Language/LSP/Types/Progress.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}++module Language.LSP.Types.Progress where++import Control.Applicative+import Control.Monad (unless)+import qualified Data.Aeson as A+import Data.Aeson.TH+import Data.Maybe (catMaybes)+import Data.Text (Text)+import Language.LSP.Types.Utils++-- | A token used to report progress back or return partial results for a+-- specific request.+-- @since 0.17.0.0+data ProgressToken+ = ProgressNumericToken Int+ | ProgressTextToken Text+ deriving (Show, Read, Eq, Ord)++instance A.ToJSON ProgressToken where+ toJSON (ProgressNumericToken i) = A.toJSON i+ toJSON (ProgressTextToken t) = A.toJSON t++instance A.FromJSON ProgressToken where+ parseJSON (A.String t) = pure $ ProgressTextToken t+ parseJSON (A.Number i) = ProgressNumericToken <$> A.parseJSON (A.Number i)+ parseJSON v = fail $ "Invalid progress token: " ++ show v++-- | Parameters for a $/progress notification.+data ProgressParams t =+ ProgressParams {+ _token :: ProgressToken+ , _value :: t+ } deriving (Show, Read, Eq, Functor)++deriveJSON lspOptions ''ProgressParams++data SomeProgressParams+ = Begin WorkDoneProgressBeginParams+ | Report WorkDoneProgressReportParams+ | End WorkDoneProgressEndParams+ deriving Eq++instance A.FromJSON SomeProgressParams where+ parseJSON x =+ (Begin <$> A.parseJSON x)+ <|> (Report <$> A.parseJSON x)+ <|> (End <$> A.parseJSON x)++instance A.ToJSON SomeProgressParams where+ toJSON (Begin x) = A.toJSON x+ toJSON (Report x) = A.toJSON x+ toJSON (End x) = A.toJSON x++-- | Parameters for 'WorkDoneProgressBeginNotification'.+--+-- @since 0.10.0.0+data WorkDoneProgressBeginParams =+ WorkDoneProgressBeginParams {+ -- | Mandatory title of the progress operation.+ -- Used to briefly inform about the kind of operation being+ -- performed. Examples: "Indexing" or "Linking dependencies".+ _title :: Text+ -- | Controls if a cancel button should show to allow the user to cancel the+ -- long running operation. Clients that don't support cancellation are allowed+ -- to ignore the setting.+ , _cancellable :: Maybe Bool+ -- | Optional, more detailed associated progress+ -- message. Contains complementary information to the+ -- '_title'. Examples: "3/25 files",+ -- "project/src/module2", "node_modules/some_dep". If+ -- unset, the previous progress message (if any) is+ -- still valid.+ , _message :: Maybe Text+ -- | Optional progress percentage to display (value 100 is considered 100%).+ -- If not provided infinite progress is assumed and clients are allowed+ -- to ignore the '_percentage' value in subsequent in report notifications.+ --+ -- The value should be steadily rising. Clients are free to ignore values+ -- that are not following this rule.+ , _percentage :: Maybe Double+ } deriving (Show, Read, Eq)++instance A.ToJSON WorkDoneProgressBeginParams where+ toJSON WorkDoneProgressBeginParams{..} =+ A.object $ catMaybes+ [ Just $ "kind" A..= ("begin" :: Text)+ , Just $ "title" A..= _title+ , ("cancellable" A..=) <$> _cancellable+ , ("message" A..=) <$> _message+ , ("percentage" A..=) <$> _percentage+ ]++instance A.FromJSON WorkDoneProgressBeginParams where+ parseJSON = A.withObject "WorkDoneProgressBegin" $ \o -> do+ kind <- o A..: "kind"+ unless (kind == ("begin" :: Text)) $ fail $ "Expected kind \"begin\" but got " ++ show kind+ _title <- o A..: "title"+ _cancellable <- o A..:? "cancellable"+ _message <- o A..:? "message"+ _percentage <- o A..:? "percentage"+ pure WorkDoneProgressBeginParams{..}++-- The $/progress begin notification is sent from the server to the+-- client to ask the client to start progress.+--+-- @since 0.10.0.0++-- | Parameters for 'WorkDoneProgressReportNotification'+--+-- @since 0.10.0.0+data WorkDoneProgressReportParams =+ WorkDoneProgressReportParams {+ _cancellable :: Maybe Bool+ -- | Optional, more detailed associated progress+ -- message. Contains complementary information to the+ -- '_title'. Examples: "3/25 files",+ -- "project/src/module2", "node_modules/some_dep". If+ -- unset, the previous progress message (if any) is+ -- still valid.+ , _message :: Maybe Text+ -- | Optional progress percentage to display (value 100 is considered 100%).+ -- If infinite progress was indicated in the start notification client+ -- are allowed to ignore the value. In addition the value should be steadily+ -- rising. Clients are free to ignore values that are not following this rule.+ , _percentage :: Maybe Double+ } deriving (Show, Read, Eq)++instance A.ToJSON WorkDoneProgressReportParams where+ toJSON WorkDoneProgressReportParams{..} =+ A.object $ catMaybes+ [ Just $ "kind" A..= ("report" :: Text)+ , ("cancellable" A..=) <$> _cancellable+ , ("message" A..=) <$> _message+ , ("percentage" A..=) <$> _percentage+ ]++instance A.FromJSON WorkDoneProgressReportParams where+ parseJSON = A.withObject "WorkDoneProgressReport" $ \o -> do+ kind <- o A..: "kind"+ unless (kind == ("report" :: Text)) $ fail $ "Expected kind \"report\" but got " ++ show kind+ _cancellable <- o A..:? "cancellable"+ _message <- o A..:? "message"+ _percentage <- o A..:? "percentage"+ pure WorkDoneProgressReportParams{..}++-- The workdone $/progress report notification is sent from the server to the+-- client to report progress for a previously started progress.+--+-- @since 0.10.0.0++-- | Parameters for 'WorkDoneProgressEndNotification'.+--+-- @since 0.10.0.0+data WorkDoneProgressEndParams =+ WorkDoneProgressEndParams {+ _message :: Maybe Text+ } deriving (Show, Read, Eq)++instance A.ToJSON WorkDoneProgressEndParams where+ toJSON WorkDoneProgressEndParams{..} =+ A.object $ catMaybes+ [ Just $ "kind" A..= ("end" :: Text)+ , ("message" A..=) <$> _message+ ]++instance A.FromJSON WorkDoneProgressEndParams where+ parseJSON = A.withObject "WorkDoneProgressEnd" $ \o -> do+ kind <- o A..: "kind"+ unless (kind == ("end" :: Text)) $ fail $ "Expected kind \"end\" but got " ++ show kind+ _message <- o A..:? "message"+ pure WorkDoneProgressEndParams{..}++-- The $/progress end notification is sent from the server to the+-- client to stop a previously started progress.+--+-- @since 0.10.0.0++-- | Parameters for 'WorkDoneProgressCancelNotification'.+--+-- @since 0.10.0.0+data WorkDoneProgressCancelParams =+ WorkDoneProgressCancelParams {+ -- | A unique identifier to associate multiple progress+ -- notifications with the same progress.+ _token :: ProgressToken+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''WorkDoneProgressCancelParams++-- The window/workDoneProgress/cancel notification is sent from the client to the server+-- to inform the server that the user has pressed the cancel button on the progress UX.+-- A server receiving a cancel request must still close a progress using the done notification.+--+-- @since 0.10.0.0++data WorkDoneProgressCreateParams =+ WorkDoneProgressCreateParams {+ _token :: ProgressToken+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''WorkDoneProgressCreateParams++data WorkDoneProgressOptions =+ WorkDoneProgressOptions+ { _workDoneProgress :: Maybe Bool+ }+ deriving (Read, Show, Eq)++deriveJSON lspOptions ''WorkDoneProgressOptions++data WorkDoneProgressParams =+ WorkDoneProgressParams+ { -- | An optional token that a server can use to report work done progress+ _workDoneToken :: Maybe ProgressToken+ } deriving (Read,Show,Eq)+deriveJSON lspOptions ''WorkDoneProgressParams++data PartialResultParams =+ PartialResultParams+ { -- | An optional token that a server can use to report partial results+ -- (e.g. streaming) to the client.+ _partialResultToken :: Maybe ProgressToken+ } deriving (Read,Show,Eq)+deriveJSON lspOptions ''PartialResultParams
+ src/Language/LSP/Types/References.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}+-- | Find References Request+-- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#textDocument_references+module Language.LSP.Types.References where++import Data.Aeson.TH++import Language.LSP.Types.TextDocument+import Language.LSP.Types.Progress+import Language.LSP.Types.Utils++data ReferencesClientCapabilities =+ ReferencesClientCapabilities+ { -- | Whether references supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''ReferencesClientCapabilities++makeExtendingDatatype "ReferenceOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''ReferenceOptions++makeExtendingDatatype "ReferenceRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''ReferenceOptions+ ]+ []+deriveJSON lspOptions ''ReferenceRegistrationOptions++data ReferenceContext =+ ReferenceContext+ { -- | Include the declaration of the current symbol.+ _includeDeclaration :: Bool+ } deriving (Read,Show,Eq)+deriveJSON lspOptions ''ReferenceContext++makeExtendingDatatype "ReferenceParams"+ [ ''TextDocumentPositionParams+ , ''WorkDoneProgressParams+ , ''PartialResultParams+ ]+ [("_context", [t| ReferenceContext |])]+deriveJSON lspOptions ''ReferenceParams
+ src/Language/LSP/Types/Registration.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}++{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}+{-# OPTIONS_GHC -Werror=incomplete-patterns #-}++module Language.LSP.Types.Registration where++import Data.Aeson+import Data.Aeson.TH+import Data.Text (Text)+import Data.Function (on)+import Data.Kind+import Data.Void (Void)+import GHC.Generics+import Language.LSP.Types.CodeAction+import Language.LSP.Types.CodeLens+import Language.LSP.Types.Command+import Language.LSP.Types.Common+import Language.LSP.Types.Completion+import Language.LSP.Types.Declaration+import Language.LSP.Types.Definition+import Language.LSP.Types.DocumentColor+import Language.LSP.Types.DocumentHighlight+import Language.LSP.Types.DocumentLink+import Language.LSP.Types.DocumentSymbol+import Language.LSP.Types.FoldingRange+import Language.LSP.Types.Formatting+import Language.LSP.Types.Hover+import Language.LSP.Types.Implementation+import Language.LSP.Types.Method+import Language.LSP.Types.References+import Language.LSP.Types.Rename+import Language.LSP.Types.SignatureHelp+import Language.LSP.Types.SelectionRange+import Language.LSP.Types.TextDocument+import Language.LSP.Types.TypeDefinition+import Language.LSP.Types.Utils+import Language.LSP.Types.WatchedFiles+import Language.LSP.Types.WorkspaceSymbol+++-- ---------------------------------------------------------------------++-- | Matches up the registration options for a specific method+type family RegistrationOptions (m :: Method FromClient t) :: Type where+ -- Workspace+ RegistrationOptions WorkspaceDidChangeWorkspaceFolders = Empty+ RegistrationOptions WorkspaceDidChangeConfiguration = Empty+ RegistrationOptions WorkspaceDidChangeWatchedFiles = DidChangeWatchedFilesRegistrationOptions+ RegistrationOptions WorkspaceSymbol = WorkspaceSymbolRegistrationOptions+ RegistrationOptions WorkspaceExecuteCommand = ExecuteCommandRegistrationOptions++ -- Text synchronisation+ RegistrationOptions TextDocumentDidOpen = TextDocumentRegistrationOptions+ RegistrationOptions TextDocumentDidChange = TextDocumentChangeRegistrationOptions+ RegistrationOptions TextDocumentWillSave = TextDocumentRegistrationOptions+ RegistrationOptions TextDocumentWillSaveWaitUntil = TextDocumentRegistrationOptions+ RegistrationOptions TextDocumentDidSave = TextDocumentSaveRegistrationOptions+ RegistrationOptions TextDocumentDidClose = TextDocumentRegistrationOptions++ -- Language features+ RegistrationOptions TextDocumentCompletion = CompletionRegistrationOptions+ RegistrationOptions TextDocumentHover = HoverRegistrationOptions+ RegistrationOptions TextDocumentSignatureHelp = SignatureHelpRegistrationOptions+ RegistrationOptions TextDocumentDeclaration = DeclarationRegistrationOptions+ RegistrationOptions TextDocumentDefinition = DefinitionRegistrationOptions+ RegistrationOptions TextDocumentTypeDefinition = TypeDefinitionRegistrationOptions+ RegistrationOptions TextDocumentImplementation = ImplementationRegistrationOptions+ RegistrationOptions TextDocumentReferences = ReferenceRegistrationOptions+ RegistrationOptions TextDocumentDocumentHighlight = DocumentHighlightRegistrationOptions+ RegistrationOptions TextDocumentDocumentSymbol = DocumentSymbolRegistrationOptions+ RegistrationOptions TextDocumentCodeAction = CodeActionRegistrationOptions+ RegistrationOptions TextDocumentCodeLens = CodeLensRegistrationOptions+ RegistrationOptions TextDocumentDocumentLink = DocumentLinkRegistrationOptions+ RegistrationOptions TextDocumentDocumentColor = DocumentColorRegistrationOptions+ RegistrationOptions TextDocumentFormatting = DocumentFormattingRegistrationOptions+ RegistrationOptions TextDocumentRangeFormatting = DocumentRangeFormattingRegistrationOptions+ RegistrationOptions TextDocumentOnTypeFormatting = DocumentOnTypeFormattingRegistrationOptions+ RegistrationOptions TextDocumentRename = RenameRegistrationOptions+ RegistrationOptions TextDocumentFoldingRange = FoldingRangeRegistrationOptions+ RegistrationOptions TextDocumentSelectionRange = SelectionRangeRegistrationOptions+ RegistrationOptions m = Void++data Registration (m :: Method FromClient t) =+ Registration+ { -- | The id used to register the request. The id can be used to deregister+ -- the request again.+ _id :: Text+ -- | The method / capability to register for.+ , _method :: SClientMethod m+ -- | Options necessary for the registration.+ -- Make this strict to aid the pattern matching exhaustiveness checker+ , _registerOptions :: !(RegistrationOptions m)+ }+ deriving Generic++deriving instance Eq (RegistrationOptions m) => Eq (Registration m)+deriving instance Show (RegistrationOptions m) => Show (Registration m)++-- This generates the function+-- regHelper :: SMethod m+-- -> (( Show (RegistrationOptions m)+-- , ToJSON (RegistrationOptions m)+-- , FromJSON ($regOptTcon m)+-- => x)+-- -> x+makeRegHelper ''RegistrationOptions++instance ToJSON (Registration m) where+ toJSON x@(Registration _ m _) = regHelper m (genericToJSON lspOptions x)++data SomeRegistration = forall t (m :: Method FromClient t). SomeRegistration (Registration m)++instance ToJSON SomeRegistration where+ toJSON (SomeRegistration r) = toJSON r++instance FromJSON SomeRegistration where+ parseJSON = withObject "Registration" $ \o -> do+ SomeClientMethod m <- o .: "method"+ r <- Registration <$> o .: "id" <*> pure m <*> regHelper m (o .: "registerOptions")+ pure (SomeRegistration r)++instance Eq SomeRegistration where+ (==) = (==) `on` toJSON++instance Show SomeRegistration where+ show (SomeRegistration r@(Registration _ m _)) = regHelper m (show r)++data RegistrationParams =+ RegistrationParams { _registrations :: List SomeRegistration }+ deriving (Show, Eq)++deriveJSON lspOptions ''RegistrationParams+++-- ---------------------------------------------------------------------++-- | General parameters to unregister a capability.+data Unregistration =+ Unregistration+ { -- | The id used to unregister the request or notification. Usually an id+ -- provided during the register request.+ _id :: Text+ -- | The method / capability to unregister for.+ , _method :: SomeClientMethod+ } deriving (Show, Eq)++deriveJSON lspOptions ''Unregistration++data UnregistrationParams =+ UnregistrationParams+ { -- | This should correctly be named @unregistrations@. However changing this+ -- is a breaking change and needs to wait until we deliver a 4.x version+ -- of the specification.+ _unregisterations :: List Unregistration+ } deriving (Show, Eq)++deriveJSON lspOptions ''UnregistrationParams
+ src/Language/LSP/Types/Rename.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Language.LSP.Types.Rename where++import Data.Aeson.TH+import Data.Text (Text)++import Language.LSP.Types.Location+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Progress+import Language.LSP.Types.Utils++data RenameClientCapabilities =+ RenameClientCapabilities+ { -- | Whether rename supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ -- | Client supports testing for validity of rename operations+ -- before execution.+ --+ -- Since LSP 3.12.0+ , _prepareSupport :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''RenameClientCapabilities++makeExtendingDatatype "RenameOptions" [''WorkDoneProgressOptions]+ [("_prepareProvider", [t| Maybe Bool |])]+deriveJSON lspOptions ''RenameOptions++makeExtendingDatatype "RenameRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''RenameOptions+ ] []+deriveJSON lspOptions ''RenameRegistrationOptions++makeExtendingDatatype "RenameParams"+ [ ''TextDocumentPositionParams+ , ''WorkDoneProgressParams+ ]+ [("_newName", [t| Text |])]+deriveJSON lspOptions ''RenameParams++-- -----------------------------------------++makeExtendingDatatype "PrepareRenameParams" [''TextDocumentPositionParams] []+deriveJSON lspOptions ''PrepareRenameParams++data RangeWithPlaceholder =+ RangeWithPlaceholder+ {+ _range :: Range+ , _placeholder :: Text+ } deriving Eq+deriveJSON lspOptions ''RangeWithPlaceholder
+ src/Language/LSP/Types/SelectionRange.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}++module Language.LSP.Types.SelectionRange where++import Data.Aeson.TH+import Language.LSP.Types.Common+import Language.LSP.Types.Location+import Language.LSP.Types.Progress+import Language.LSP.Types.StaticRegistrationOptions+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils++data SelectionRangeClientCapabilities = SelectionRangeClientCapabilities+ { -- | Whether implementation supports dynamic registration for selection range providers. If this is set to 'True'+ -- the client supports the new 'SelectionRangeRegistrationOptions' return value for the corresponding server+ -- capability as well.+ _dynamicRegistration :: Maybe Bool+ }+ deriving (Read, Show, Eq)++deriveJSON lspOptions ''SelectionRangeClientCapabilities++makeExtendingDatatype "SelectionRangeOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''SelectionRangeOptions++makeExtendingDatatype+ "SelectionRangeRegistrationOptions"+ [ ''SelectionRangeOptions,+ ''TextDocumentRegistrationOptions,+ ''StaticRegistrationOptions+ ]+ []+deriveJSON lspOptions ''SelectionRangeRegistrationOptions++makeExtendingDatatype+ "SelectionRangeParams"+ [ ''WorkDoneProgressParams,+ ''PartialResultParams+ ]+ [ ("_textDocument", [t|TextDocumentIdentifier|]),+ ("_positions", [t|List Position|])+ ]+deriveJSON lspOptions ''SelectionRangeParams++data SelectionRange = SelectionRange+ { -- | The 'range' of this selection range.+ _range :: Range,+ -- | The parent selection range containing this range. Therefore @parent.range@ must contain @this.range@.+ _parent :: Maybe SelectionRange+ }+ deriving (Read, Show, Eq)++deriveJSON lspOptions ''SelectionRange
+ src/Language/LSP/Types/ServerCapabilities.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Language.LSP.Types.ServerCapabilities where++import Data.Aeson+import Data.Aeson.TH+import Data.Text (Text)+import Language.LSP.Types.CodeAction+import Language.LSP.Types.CodeLens+import Language.LSP.Types.Command+import Language.LSP.Types.Common+import Language.LSP.Types.Completion+import Language.LSP.Types.Declaration+import Language.LSP.Types.Definition+import Language.LSP.Types.DocumentColor+import Language.LSP.Types.DocumentHighlight+import Language.LSP.Types.DocumentLink+import Language.LSP.Types.DocumentSymbol+import Language.LSP.Types.FoldingRange+import Language.LSP.Types.Formatting+import Language.LSP.Types.Hover+import Language.LSP.Types.Implementation+import Language.LSP.Types.References+import Language.LSP.Types.Rename+import Language.LSP.Types.SelectionRange+import Language.LSP.Types.SignatureHelp+import Language.LSP.Types.TextDocument+import Language.LSP.Types.TypeDefinition+import Language.LSP.Types.Utils++-- ---------------------------------------------------------------------++data WorkspaceFoldersServerCapabilities =+ WorkspaceFoldersServerCapabilities+ { -- | The server has support for workspace folders+ _supported :: Maybe Bool+ -- | Whether the server wants to receive workspace folder+ -- change notifications.+ -- If a strings is provided the string is treated as a ID+ -- under which the notification is registered on the client+ -- side. The ID can be used to unregister for these events+ -- using the `client/unregisterCapability` request.+ , _changeNotifications :: Maybe (Text |? Bool)+ }+ deriving (Show, Read, Eq)++deriveJSON lspOptions ''WorkspaceFoldersServerCapabilities++data WorkspaceServerCapabilities =+ WorkspaceServerCapabilities+ { -- | The server supports workspace folder. Since LSP 3.6+ --+ -- @since 0.7.0.0+ _workspaceFolders :: Maybe WorkspaceFoldersServerCapabilities+ }+ deriving (Show, Read, Eq)+deriveJSON lspOptions ''WorkspaceServerCapabilities++data ServerCapabilities =+ ServerCapabilities+ { -- | Defines how text documents are synced. Is either a detailed structure+ -- defining each notification or for backwards compatibility the+ -- 'TextDocumentSyncKind' number.+ -- If omitted it defaults to 'TdSyncNone'.+ _textDocumentSync :: Maybe (TextDocumentSyncOptions |? TextDocumentSyncKind)+ -- | The server provides hover support.+ , _hoverProvider :: Maybe (Bool |? HoverOptions)+ -- | The server provides completion support.+ , _completionProvider :: Maybe CompletionOptions+ -- | The server provides signature help support.+ , _signatureHelpProvider :: Maybe SignatureHelpOptions+ -- | The server provides go to declaration support.+ -- + -- Since LSP 3.14.0+ , _declarationProvider :: Maybe (Bool |? DeclarationOptions |? DeclarationRegistrationOptions)+ -- | The server provides goto definition support.+ , _definitionProvider :: Maybe (Bool |? DefinitionOptions)+ -- | The server provides Goto Type Definition support. Since LSP 3.6+ --+ -- @since 0.7.0.0+ , _typeDefinitionProvider :: Maybe (Bool |? TypeDefinitionOptions |? TypeDefinitionRegistrationOptions)+ -- | The server provides Goto Implementation support. Since LSP 3.6+ --+ -- @since 0.7.0.0+ , _implementationProvider :: Maybe (Bool |? ImplementationOptions |? ImplementationRegistrationOptions)+ -- | The server provides find references support.+ , _referencesProvider :: Maybe (Bool |? ReferenceOptions)+ -- | The server provides document highlight support.+ , _documentHighlightProvider :: Maybe (Bool |? DocumentHighlightOptions)+ -- | The server provides document symbol support.+ , _documentSymbolProvider :: Maybe (Bool |? DocumentSymbolOptions)+ -- | The server provides code actions.+ , _codeActionProvider :: Maybe (Bool |? CodeActionOptions)+ -- | The server provides code lens.+ , _codeLensProvider :: Maybe CodeLensOptions+ -- | The server provides document link support.+ , _documentLinkProvider :: Maybe DocumentLinkOptions+ -- | The server provides color provider support. Since LSP 3.6+ --+ -- @since 0.7.0.0+ , _colorProvider :: Maybe (Bool |? DocumentColorOptions |? DocumentColorRegistrationOptions)+ -- | The server provides document formatting.+ , _documentFormattingProvider :: Maybe (Bool |? DocumentFormattingOptions)+ -- | The server provides document range formatting.+ , _documentRangeFormattingProvider :: Maybe (Bool |? DocumentRangeFormattingOptions)+ -- | The server provides document formatting on typing.+ , _documentOnTypeFormattingProvider :: Maybe DocumentOnTypeFormattingOptions+ -- | The server provides rename support.+ , _renameProvider :: Maybe (Bool |? RenameOptions)+ -- | The server provides folding provider support. Since LSP 3.10+ --+ -- @since 0.7.0.0+ , _foldingRangeProvider :: Maybe (Bool |? FoldingRangeOptions |? FoldingRangeRegistrationOptions)+ -- | The server provides execute command support.+ , _executeCommandProvider :: Maybe ExecuteCommandOptions+ -- | The server provides selection range support. Since LSP 3.15+ , _selectionRangeProvider :: Maybe (Bool |? SelectionRangeOptions |? SelectionRangeRegistrationOptions)+ -- | The server provides workspace symbol support.+ , _workspaceSymbolProvider :: Maybe Bool+ -- | Workspace specific server capabilities+ , _workspace :: Maybe WorkspaceServerCapabilities+ -- | Experimental server capabilities.+ , _experimental :: Maybe Value+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ServerCapabilities
+ src/Language/LSP/Types/SignatureHelp.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}+-- | Signature Help Request+-- https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#signature-help-request+module Language.LSP.Types.SignatureHelp where+ +import Data.Aeson+import Data.Aeson.TH+import Data.Text (Text)+import Language.LSP.Types.Common+import Language.LSP.Types.MarkupContent+import Language.LSP.Types.Progress+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils++-- -------------------------------------++data SignatureHelpParameterInformation =+ SignatureHelpParameterInformation+ { -- | The client supports processing label offsets instead of a simple+ -- label string.+ --+ -- @since 3.14.0+ _labelOffsetSupport :: Maybe Bool+ }+ deriving (Read, Show, Eq)+deriveJSON lspOptions ''SignatureHelpParameterInformation++data SignatureHelpSignatureInformation =+ SignatureHelpSignatureInformation+ { -- | Client supports the follow content formats for the documentation+ -- property. The order describes the preferred format of the client.+ _documentationFormat :: Maybe (List MarkupKind)+ -- | Client capabilities specific to parameter information.+ , _parameterInformation :: Maybe SignatureHelpParameterInformation+ }+ deriving (Show, Read, Eq)++deriveJSON lspOptions ''SignatureHelpSignatureInformation++data SignatureHelpClientCapabilities =+ SignatureHelpClientCapabilities+ { -- | Whether signature help supports dynamic registration.+ _dynamicRegistration :: Maybe Bool+ -- | The client supports the following 'SignatureInformation'+ -- specific properties.+ , _signatureInformation :: Maybe SignatureHelpSignatureInformation+ -- | The client supports to send additional context information for a+ -- @textDocument/signatureHelp@ request. A client that opts into+ -- contextSupport will also support the '_retriggerCharacters' on+ -- 'SignatureHelpOptions'.+ --+ -- @since 3.15.0+ , _contextSupport :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''SignatureHelpClientCapabilities++-- -------------------------------------++makeExtendingDatatype "SignatureHelpOptions" [''WorkDoneProgressOptions]+ [ ("_triggerCharacters", [t| Maybe (List String) |])+ , ("_retriggerCharacters", [t| Maybe (List String) |])+ ]+deriveJSON lspOptions ''SignatureHelpOptions++makeExtendingDatatype "SignatureHelpRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''SignatureHelpOptions+ ] []+deriveJSON lspOptions ''SignatureHelpRegistrationOptions++-- -------------------------------------++data ParameterInformation =+ ParameterInformation+ { _label :: Text+ , _documentation :: Maybe Text+ } deriving (Read,Show,Eq)+deriveJSON lspOptions ''ParameterInformation++-- -------------------------------------++data SignatureInformation =+ SignatureInformation+ { _label :: Text+ , _documentation :: Maybe Text+ , _parameters :: Maybe (List ParameterInformation)+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''SignatureInformation++data SignatureHelp =+ SignatureHelp+ { _signatures :: List SignatureInformation+ , _activeSignature :: Maybe Int -- ^ The active signature+ , _activeParameter :: Maybe Int -- ^ The active parameter of the active signature+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''SignatureHelp++-- -------------------------------------++data SignatureHelpTriggerKind = SHTKInvoked+ | SHTKTriggerCharacter+ | SHTKContentChange+ deriving (Read,Show,Eq)++instance ToJSON SignatureHelpTriggerKind where+ toJSON SHTKInvoked = Number 1+ toJSON SHTKTriggerCharacter = Number 2+ toJSON SHTKContentChange = Number 3++instance FromJSON SignatureHelpTriggerKind where+ parseJSON (Number 1) = pure SHTKInvoked+ parseJSON (Number 2) = pure SHTKTriggerCharacter+ parseJSON (Number 3) = pure SHTKContentChange+ parseJSON _ = mempty++-- | Additional information about the context in which a signature help request+-- was triggered.+data SignatureHelpContext = + SignatureHelpContext+ { -- | Action that caused signature help to be triggered.+ _triggerKind :: SignatureHelpTriggerKind+ -- | Character that caused signature help to be triggered. This is+ -- undefined when @triggerKind !==+ -- SignatureHelpTriggerKind.TriggerCharacter@+ , _triggerCharacter :: Maybe String+ -- | 'True' if signature help was already showing when it was triggered.+ -- + -- Retriggers occur when the signature help is already active and can be+ -- caused by actions such as typing a trigger character, a cursor move, or+ -- document content changes.+ , _isRetrigger :: Bool+ -- | The currently active 'SignatureHelp'.+ -- + -- The '_activeSignatureHelp' has its @SignatureHelp.activeSignature@+ -- field updated based on the user navigating through available+ -- signatures.+ , _activeSignatureHelp :: Maybe SignatureHelp+ }+ deriving (Read,Show,Eq)+deriveJSON lspOptions ''SignatureHelpContext++makeExtendingDatatype "SignatureHelpParams"+ [ ''TextDocumentPositionParams+ , ''WorkDoneProgressParams+ ]+ [ ("_context", [t| Maybe SignatureHelpContext |])+ ]+deriveJSON lspOptions ''SignatureHelpParams++
+ src/Language/LSP/Types/StaticRegistrationOptions.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TemplateHaskell #-}+-- Cyclic dependencies mean we have to put poor StaticRegistrationOptions on its own+module Language.LSP.Types.StaticRegistrationOptions where++import Data.Aeson.TH+import Data.Text (Text)+import Language.LSP.Types.Utils++data StaticRegistrationOptions =+ StaticRegistrationOptions+ { _id :: Maybe Text+ } deriving (Read,Show,Eq)+deriveJSON lspOptions ''StaticRegistrationOptions
+ src/Language/LSP/Types/TextDocument.hs view
@@ -0,0 +1,264 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+module Language.LSP.Types.TextDocument where++import Data.Aeson+import Data.Aeson.TH+import Data.Default+import Data.Text ( Text )++import Language.LSP.Types.Common+import Language.LSP.Types.DocumentFilter+import Language.LSP.Types.Location+import Language.LSP.Types.Uri+import Language.LSP.Types.Utils++-- ---------------------------------------------------------------------++data TextDocumentIdentifier =+ TextDocumentIdentifier+ { _uri :: Uri+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''TextDocumentIdentifier++type TextDocumentVersion = Maybe Int++makeExtendingDatatype "VersionedTextDocumentIdentifier" [''TextDocumentIdentifier]+ [ ("_version", [t| TextDocumentVersion |])]+deriveJSON lspOptions ''VersionedTextDocumentIdentifier++data TextDocumentItem =+ TextDocumentItem {+ _uri :: Uri+ , _languageId :: Text+ , _version :: Int+ , _text :: Text+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''TextDocumentItem++-- ---------------------------------------------------------------------++data TextDocumentPositionParams =+ TextDocumentPositionParams+ { -- | The text document.+ _textDocument :: TextDocumentIdentifier+ , -- | The position inside the text document.+ _position :: Position+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''TextDocumentPositionParams++-- -------------------------------------++-- Text document synchronisation+++data TextDocumentSyncClientCapabilities =+ TextDocumentSyncClientCapabilities+ { -- | Whether text document synchronization supports dynamic registration.+ _dynamicRegistration :: Maybe Bool++ -- | The client supports sending will save notifications.+ , _willSave :: Maybe Bool++ -- | The client supports sending a will save request and waits for a+ -- response providing text edits which will be applied to the document+ -- before it is saved.+ , _willSaveWaitUntil :: Maybe Bool++ -- | The client supports did save notifications.+ , _didSave :: Maybe Bool+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''TextDocumentSyncClientCapabilities++instance Default TextDocumentSyncClientCapabilities where+ def = TextDocumentSyncClientCapabilities def def def def++-- -------------------------------------++data SaveOptions =+ SaveOptions+ { -- | The client is supposed to include the content on save.+ _includeText :: Maybe Bool+ } deriving (Show, Read, Eq)++-- -------------------------------------++-- | Defines how the host (editor) should sync document changes to the language server.+data TextDocumentSyncKind+ = -- | Documents should not be synced at all.+ TdSyncNone+ | -- | Documents are synced by always sending the full content of the document.+ TdSyncFull+ | -- | Documents are synced by sending the full content on open. After that only incremental updates to the document are send.+ TdSyncIncremental+ deriving (Read, Eq, Show)++instance ToJSON TextDocumentSyncKind where+ toJSON TdSyncNone = Number 0+ toJSON TdSyncFull = Number 1+ toJSON TdSyncIncremental = Number 2++instance FromJSON TextDocumentSyncKind where+ parseJSON (Number 0) = pure TdSyncNone+ parseJSON (Number 1) = pure TdSyncFull+ parseJSON (Number 2) = pure TdSyncIncremental+ parseJSON _ = mempty+ +data TextDocumentSyncOptions =+ TextDocumentSyncOptions+ { -- | Open and close notifications are sent to the server. If omitted open+ -- close notification should not be sent.+ _openClose :: Maybe Bool+ , -- | Change notifications are sent to the server. See+ -- TextDocumentSyncKind.None, TextDocumentSyncKind.Full+ -- and TextDocumentSyncKind.Incremental. If omitted it defaults to+ -- TextDocumentSyncKind.None.+ _change :: Maybe TextDocumentSyncKind+ -- | If present will save notifications are sent to the server. If omitted the notification should not be+ -- sent.+ , _willSave :: Maybe Bool+ -- | If present will save wait until requests are sent to the server. If omitted the request should not be+ -- sent.+ , _willSaveWaitUntil :: Maybe Bool+ -- | If present save notifications are sent to the server. If omitted the+ -- notification should not be sent.+ , _save :: Maybe (Bool |? SaveOptions)+ } deriving (Show, Read, Eq)+deriveJSON lspOptions ''TextDocumentSyncOptions++-- -------------------------------------++{-+Since most of the registration options require to specify a document selector+there is a base interface that can be used.+-}++data TextDocumentRegistrationOptions =+ TextDocumentRegistrationOptions+ { _documentSelector :: Maybe DocumentSelector+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''TextDocumentRegistrationOptions++-- -------------------------------------++data DidOpenTextDocumentParams =+ DidOpenTextDocumentParams+ { -- | The document that was opened.+ _textDocument :: TextDocumentItem+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''DidOpenTextDocumentParams++-- -------------------------------------++makeExtendingDatatype "TextDocumentChangeRegistrationOptions"+ [''TextDocumentRegistrationOptions]+ [("_syncKind", [t| TextDocumentSyncKind |])]++deriveJSON lspOptions ''TextDocumentChangeRegistrationOptions++{-# DEPRECATED _rangeLength "Use _range instead" #-}+data TextDocumentContentChangeEvent =+ TextDocumentContentChangeEvent+ { -- | The range of the document that changed.+ _range :: Maybe Range+ -- | The optional length of the range that got replaced.+ , _rangeLength :: Maybe Int+ -- | The new text for the provided range, if provided.+ -- Otherwise the new text of the whole document.+ , _text :: Text+ }+ deriving (Read,Show,Eq)++deriveJSON lspOptions ''TextDocumentContentChangeEvent++-- -------------------------------------++data DidChangeTextDocumentParams =+ DidChangeTextDocumentParams+ { -- | The document that did change. The version number points+ -- to the version after all provided content changes have+ -- been applied.+ _textDocument :: VersionedTextDocumentIdentifier+ -- | The actual content changes. The content changes describe single state changes+ -- to the document. So if there are two content changes c1 (at array index 0) and+ -- c2 (at array index 1) for a document in state S then c1 moves the document from+ -- S to S' and c2 from S' to S''. So c1 is computed on the state S and c2 is computed+ -- on the state S'.+ --+ -- To mirror the content of a document using change events use the following approach:+ -- - start with the same initial content+ -- - apply the 'textDocument/didChange' notifications in the order you recevie them.+ -- - apply the `TextDocumentContentChangeEvent`s in a single notification in the order+ -- you receive them.+ , _contentChanges :: List TextDocumentContentChangeEvent+ } deriving (Show,Read,Eq)++deriveJSON lspOptions ''DidChangeTextDocumentParams++-- -------------------------------------++data TextDocumentSaveReason+ = SaveManual+ -- ^ Manually triggered, e.g. by the user pressing save, by starting+ -- debugging, or by an API call.+ | SaveAfterDelay -- ^ Automatic after a delay+ | SaveFocusOut -- ^ When the editor lost focus+ deriving (Show, Read, Eq)++instance ToJSON TextDocumentSaveReason where+ toJSON SaveManual = Number 1+ toJSON SaveAfterDelay = Number 2+ toJSON SaveFocusOut = Number 3++instance FromJSON TextDocumentSaveReason where+ parseJSON (Number 1) = pure SaveManual+ parseJSON (Number 2) = pure SaveAfterDelay+ parseJSON (Number 3) = pure SaveFocusOut+ parseJSON _ = mempty++data WillSaveTextDocumentParams =+ WillSaveTextDocumentParams+ { -- | The document that will be saved.+ _textDocument :: TextDocumentIdentifier+ -- | The 'TextDocumentSaveReason'.+ , _reason :: TextDocumentSaveReason+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''WillSaveTextDocumentParams++-- -------------------------------------++deriveJSON lspOptions ''SaveOptions++makeExtendingDatatype "TextDocumentSaveRegistrationOptions"+ [''TextDocumentRegistrationOptions]+ [("_includeText", [t| Maybe Bool |])]++deriveJSON lspOptions ''TextDocumentSaveRegistrationOptions++data DidSaveTextDocumentParams =+ DidSaveTextDocumentParams+ { -- | The document that was saved.+ _textDocument :: TextDocumentIdentifier+ -- | Optional the content when saved. Depends on the includeText value+ -- when the save notification was requested.+ , _text :: Maybe Text+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''DidSaveTextDocumentParams++-- -------------------------------------++data DidCloseTextDocumentParams =+ DidCloseTextDocumentParams+ { -- | The document that was closed.+ _textDocument :: TextDocumentIdentifier+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''DidCloseTextDocumentParams
+ src/Language/LSP/Types/TypeDefinition.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}++module Language.LSP.Types.TypeDefinition where++import Data.Aeson.TH+import Language.LSP.Types.Progress+import Language.LSP.Types.StaticRegistrationOptions+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Utils++data TypeDefinitionClientCapabilities = TypeDefinitionClientCapabilities+ { -- | Whether implementation supports dynamic registration. If this is set+ -- to 'True'+ -- the client supports the new 'TypeDefinitionRegistrationOptions' return+ -- value for the corresponding server capability as well.+ _dynamicRegistration :: Maybe Bool,+ -- | The client supports additional metadata in the form of definition links.+ --+ -- Since LSP 3.14.0+ _linkSupport :: Maybe Bool+ }+ deriving (Read, Show, Eq)++deriveJSON lspOptions ''TypeDefinitionClientCapabilities++makeExtendingDatatype "TypeDefinitionOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''TypeDefinitionOptions++makeExtendingDatatype "TypeDefinitionRegistrationOptions"+ [ ''TextDocumentRegistrationOptions+ , ''TypeDefinitionOptions+ , ''StaticRegistrationOptions+ ] []+deriveJSON lspOptions ''TypeDefinitionRegistrationOptions++makeExtendingDatatype "TypeDefinitionParams"+ [ ''TextDocumentPositionParams+ , ''WorkDoneProgressParams+ , ''PartialResultParams+ ] []+deriveJSON lspOptions ''TypeDefinitionParams
+ src/Language/LSP/Types/Uri.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+module Language.LSP.Types.Uri+ ( Uri(..)+ , uriToFilePath+ , filePathToUri+ , NormalizedUri(..)+ , toNormalizedUri+ , fromNormalizedUri+ , NormalizedFilePath(..)+ , toNormalizedFilePath+ , fromNormalizedFilePath+ , normalizedFilePathToUri+ , uriToNormalizedFilePath+ -- Private functions+ , platformAwareUriToFilePath+ , platformAwareFilePathToUri+ )+ where++import Control.DeepSeq+import qualified Data.Aeson as A+import Data.Binary (Binary, Get, put, get)+import Data.Hashable+import Data.List (stripPrefix)+import Data.String (IsString, fromString)+import Data.Text (Text)+import qualified Data.Text as T+import GHC.Generics+import Network.URI hiding (authority)+import qualified System.FilePath as FP+import qualified System.FilePath.Posix as FPP+import qualified System.FilePath.Windows as FPW+import qualified System.Info++newtype Uri = Uri { getUri :: Text }+ deriving (Eq,Ord,Read,Show,Generic,A.FromJSON,A.ToJSON,Hashable,A.ToJSONKey,A.FromJSONKey)++instance NFData Uri++-- If you care about performance then you should use a hash map. The keys+-- are cached in order to make hashing very fast.+data NormalizedUri = NormalizedUri !Int !Text+ deriving (Read,Show,Generic, Eq)++-- Slow but compares paths alphabetically as you would expect.+instance Ord NormalizedUri where+ compare (NormalizedUri _ u1) (NormalizedUri _ u2) = compare u1 u2++instance Hashable NormalizedUri where+ hash (NormalizedUri h _) = h+ hashWithSalt salt (NormalizedUri h _) = hashWithSalt salt h++instance NFData NormalizedUri++isUnescapedInUriPath :: SystemOS -> Char -> Bool+isUnescapedInUriPath systemOS c+ | systemOS == windowsOS = isUnreserved c || c `elem` [':', '\\', '/']+ | otherwise = isUnreserved c || c == '/'++-- | When URIs are supposed to be used as keys, it is important to normalize+-- the percent encoding in the URI since URIs that only differ+-- when it comes to the percent-encoding should be treated as equivalent.+normalizeUriEscaping :: String -> String+normalizeUriEscaping uri =+ case stripPrefix (fileScheme ++ "//") uri of+ Just p -> fileScheme ++ "//" ++ (escapeURIPath $ unEscapeString p)+ Nothing -> escapeURIString isUnescapedInURI $ unEscapeString uri+ where escapeURIPath = escapeURIString (isUnescapedInUriPath System.Info.os)++toNormalizedUri :: Uri -> NormalizedUri+toNormalizedUri uri = NormalizedUri (hash norm) norm+ where (Uri t) = maybe uri filePathToUri (uriToFilePath uri)+ -- To ensure all `Uri`s have the file path normalized+ norm = T.pack (normalizeUriEscaping (T.unpack t))++fromNormalizedUri :: NormalizedUri -> Uri+fromNormalizedUri (NormalizedUri _ t) = Uri t++fileScheme :: String+fileScheme = "file:"++windowsOS :: String+windowsOS = "mingw32"++type SystemOS = String++uriToFilePath :: Uri -> Maybe FilePath+uriToFilePath = platformAwareUriToFilePath System.Info.os++{-# WARNING platformAwareUriToFilePath "This function is considered private. Use normalizedFilePathToUri instead." #-}+platformAwareUriToFilePath :: String -> Uri -> Maybe FilePath+platformAwareUriToFilePath systemOS (Uri uri) = do+ URI{..} <- parseURI $ T.unpack uri+ if uriScheme == fileScheme+ then return $+ platformAdjustFromUriPath systemOS (uriRegName <$> uriAuthority) $ unEscapeString uriPath+ else Nothing++-- | We pull in the authority because in relative file paths the Uri likes to put everything before the slash+-- into the authority field+platformAdjustFromUriPath :: SystemOS+ -> Maybe String -- ^ authority+ -> String -- ^ path+ -> FilePath+platformAdjustFromUriPath systemOS authority srcPath =+ (maybe id (++) authority) $+ if systemOS /= windowsOS || null srcPath then srcPath+ else let+ firstSegment:rest = (FPP.splitDirectories . tail) srcPath -- Drop leading '/' for absolute Windows paths+ drive = if FPW.isDrive firstSegment+ then FPW.addTrailingPathSeparator firstSegment+ else firstSegment+ in FPW.joinDrive drive $ FPW.joinPath rest++filePathToUri :: FilePath -> Uri+filePathToUri = (platformAwareFilePathToUri System.Info.os) . FP.normalise++{-# WARNING platformAwareFilePathToUri "This function is considered private. Use normalizedUriToFilePath instead." #-}+platformAwareFilePathToUri :: SystemOS -> FilePath -> Uri+platformAwareFilePathToUri systemOS fp = Uri . T.pack . show $ URI+ { uriScheme = fileScheme+ , uriAuthority = Just $ URIAuth "" "" ""+ , uriPath = platformAdjustToUriPath systemOS fp+ , uriQuery = ""+ , uriFragment = ""+ }++platformAdjustToUriPath :: SystemOS -> FilePath -> String+platformAdjustToUriPath systemOS srcPath+ | systemOS == windowsOS = '/' : escapedPath+ | otherwise = escapedPath+ where+ (splitDirectories, splitDrive)+ | systemOS == windowsOS =+ (FPW.splitDirectories, FPW.splitDrive)+ | otherwise =+ (FPP.splitDirectories, FPP.splitDrive)+ escapedPath =+ case splitDrive srcPath of+ (drv, rest) ->+ convertDrive drv `FPP.joinDrive`+ FPP.joinPath (map (escapeURIString (isUnescapedInUriPath systemOS)) $ splitDirectories rest)+ -- splitDirectories does not remove the path separator after the drive so+ -- we do a final replacement of \ to /+ convertDrive drv+ | systemOS == windowsOS && FPW.hasTrailingPathSeparator drv =+ FPP.addTrailingPathSeparator (init drv)+ | otherwise = drv++-- | Newtype wrapper around FilePath that always has normalized slashes.+-- The NormalizedUri and hash of the FilePath are cached to avoided+-- repeated normalisation when we need to compute them (which is a lot).+--+-- This is one of the most performance critical parts of ghcide, do not+-- modify it without profiling.+data NormalizedFilePath = NormalizedFilePath NormalizedUri !FilePath+ deriving (Generic, Eq, Ord)++instance NFData NormalizedFilePath++instance Binary NormalizedFilePath where+ put (NormalizedFilePath _ fp) = put fp+ get = do+ v <- Data.Binary.get :: Get FilePath+ let nuri = internalNormalizedFilePathToUri v+ return (NormalizedFilePath nuri v)++-- | Internal helper that takes a file path that is assumed to+-- already be normalized to a URI. It is up to the caller+-- to ensure normalization.+internalNormalizedFilePathToUri :: FilePath -> NormalizedUri+internalNormalizedFilePathToUri fp = nuri+ where+ uriPath = platformAdjustToUriPath System.Info.os fp+ nuriStr = T.pack $ fileScheme <> "//" <> uriPath+ nuri = NormalizedUri (hash nuriStr) nuriStr++instance Show NormalizedFilePath where+ show (NormalizedFilePath _ fp) = "NormalizedFilePath " ++ show fp++instance Hashable NormalizedFilePath where+ hash (NormalizedFilePath uri _) = hash uri+ hashWithSalt salt (NormalizedFilePath uri _) = hashWithSalt salt uri++instance IsString NormalizedFilePath where+ fromString = toNormalizedFilePath++toNormalizedFilePath :: FilePath -> NormalizedFilePath+toNormalizedFilePath fp = NormalizedFilePath nuri nfp+ where+ nfp = FP.normalise fp+ nuri = internalNormalizedFilePathToUri nfp++fromNormalizedFilePath :: NormalizedFilePath -> FilePath+fromNormalizedFilePath (NormalizedFilePath _ fp) = fp++normalizedFilePathToUri :: NormalizedFilePath -> NormalizedUri+normalizedFilePathToUri (NormalizedFilePath uri _) = uri++uriToNormalizedFilePath :: NormalizedUri -> Maybe NormalizedFilePath+uriToNormalizedFilePath nuri = fmap (NormalizedFilePath nuri) mbFilePath+ where mbFilePath = platformAwareUriToFilePath System.Info.os (fromNormalizedUri nuri)
+ src/Language/LSP/Types/Utils.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE LambdaCase #-}+-- | Internal helpers for generating definitions+module Language.LSP.Types.Utils+ ( rdrop+ , makeSingletonFromJSON+ , makeRegHelper+ , makeExtendingDatatype+ , lspOptions+ ) where++import Control.Monad+import Data.Aeson+import Data.List+import Language.Haskell.TH++-- ---------------------------------------------------------------------++rdrop :: Int -> [a] -> [a]+rdrop cnt = reverse . drop cnt . reverse++-- | Given a wrapper and a singleton GADT, construct FromJSON+-- instances for each constructor return type by invoking the+-- FromJSON instance for the wrapper and unwrapping+makeSingletonFromJSON :: Name -> Name -> Q [Dec]+makeSingletonFromJSON wrap gadt = do+ TyConI (DataD _ _ _ _ cons _) <- reify gadt+ concat <$> mapM (makeInst wrap) cons++{-+instance FromJSON (SMethod $method) where+ parseJSON = parseJSON >=> \case+ SomeMethod $singleton-method -> pure $singleton-method+ _ -> mempty+-}+makeInst :: Name -> Con -> Q [Dec]+makeInst wrap (GadtC [sConstructor] args t) = do+ ns <- replicateM (length args) (newName "x")+ let wrappedPat = pure $ ConP wrap [ConP sConstructor (map VarP ns)]+ unwrappedE = pure $ foldl' AppE (ConE sConstructor) (map VarE ns)+ [d| instance FromJSON $(pure t) where+ parseJSON = parseJSON >=> \case+ $wrappedPat -> pure $unwrappedE+ _ -> mempty+ |]+makeInst wrap (ForallC _ _ con) = makeInst wrap con -- Cancel and Custom requests+makeInst _ _ = fail "makeInst only defined for GADT constructors"++makeRegHelper :: Name -> DecsQ+makeRegHelper regOptTypeName = do+ Just sMethodTypeName <- lookupTypeName "SMethod"+ Just fromClientName <- lookupValueName "FromClient"+ TyConI (DataD _ _ _ _ allCons _) <- reify sMethodTypeName++ let isConsFromClient (GadtC _ _ (AppT _ method)) = isMethodFromClient method+ isConsFromClient _ = return False+ isMethodFromClient :: Type -> Q Bool+ isMethodFromClient (PromotedT method) = do+ DataConI _ typ _ <- reify method+ case typ of+ AppT (AppT _ (PromotedT n)) _ -> return $ n == fromClientName+ _ -> return False+ isMethodFromClient _ = fail "Didn't expect this type of Method!"++ cons <- filterM isConsFromClient allCons++ let conNames = map (\(GadtC [name] _ _) -> name) cons+ helperName = mkName "regHelper"+ mkClause name = do+ x <- newName "x"+ clause [ conP name [], varP x ]+ (normalB (varE x))+ []+ regOptTcon = conT regOptTypeName+ fun <- funD helperName (map mkClause conNames)++ typSig <- sigD helperName $+ [t| forall m x. $(conT sMethodTypeName) m+ -> (Show ($regOptTcon m) => ToJSON ($regOptTcon m) => FromJSON ($regOptTcon m) => x)+ -> x |]+ return [typSig, fun]++-- | @makeExtendingDatatype name extends fields@ generates a record datatype+-- that contains all the fields of @extends@, plus the additional fields in+-- @fields@.+-- e.g.+-- data Foo = { a :: Int }+-- makeExtendingDatatype "bar" [''Foo] [("b", [t| String |])]+-- Will generate+-- data Bar = { a :: Int, b :: String }+makeExtendingDatatype :: String -> [Name] -> [(String, TypeQ)] -> DecsQ+makeExtendingDatatype datatypeNameStr extends fields = do+ extendFields <- fmap concat $ forM extends $ \e -> do+ TyConI (DataD _ _ _ _ [RecC _ eFields] _) <- reify e+ return eFields+ let datatypeName = mkName datatypeNameStr+ insts = [[t| Read |], [t| Show |], [t| Eq |]]+ constructor = recC datatypeName combinedFields+ userFields = flip map fields $ \(s, typ) -> do+ varBangType (mkName s) (bangType (bang noSourceUnpackedness noSourceStrictness) typ)+ combinedFields = (map pure extendFields) <> userFields+ derivs = [derivClause Nothing insts]+ (\a -> [a]) <$> dataD (cxt []) datatypeName [] Nothing [constructor] derivs++-- | Standard options for use when generating JSON instances+-- NOTE: This needs to be in a separate file because of the TH stage restriction+lspOptions :: Options+lspOptions = defaultOptions { omitNothingFields = True, fieldLabelModifier = modifier }+ where+ modifier :: String -> String+ -- For fields called data and type in the spec, we call them xdata and xtype+ -- in haskell-lsp-types to avoid it clashing with the Haskell keywords. This+ -- fixes up the json derivation+ modifier "_xdata" = "data"+ modifier "_xtype" = "type"+ modifier xs = drop 1 xs+
+ src/Language/LSP/Types/WatchedFiles.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Language.LSP.Types.WatchedFiles where+ +import Data.Aeson+import Data.Aeson.TH+import Data.Bits+import Data.Scientific+import Language.LSP.Types.Common+import Language.LSP.Types.Uri+import Language.LSP.Types.Utils++-- -------------------------------------++data DidChangeWatchedFilesClientCapabilities = DidChangeWatchedFilesClientCapabilities+ { -- | Did change watched files notification supports dynamic+ -- registration.+ _dynamicRegistration :: Maybe Bool+ }+ deriving (Show, Read, Eq)+deriveJSON lspOptions ''DidChangeWatchedFilesClientCapabilities++-- | Describe options to be used when registering for file system change events.+data DidChangeWatchedFilesRegistrationOptions =+ DidChangeWatchedFilesRegistrationOptions+ { -- | The watchers to register.+ _watchers :: List FileSystemWatcher+ } deriving (Show, Read, Eq)++data FileSystemWatcher =+ FileSystemWatcher+ { -- | The glob pattern to watch.+ -- Glob patterns can have the following syntax:+ -- - @*@ to match one or more characters in a path segment+ -- - @?@ to match on one character in a path segment+ -- - @**@ to match any number of path segments, including none+ -- - @{}@ to group conditions (e.g. @**/*.{ts,js}@ matches all TypeScript and JavaScript files)+ -- - @[]@ to declare a range of characters to match in a path segment (e.g., @example.[0-9]@ to match on @example.0@, @example.1@, …)+ -- - @[!...]@ to negate a range of characters to match in a path segment (e.g., @example.[!0-9]@ to match on @example.a@, @example.b@, but not @example.0@)+ _globPattern :: String,+ -- | The kind of events of interest. If omitted it defaults+ -- to WatchKind.Create | WatchKind.Change | WatchKind.Delete+ -- which is 7.+ _kind :: Maybe WatchKind+ } deriving (Show, Read, Eq)++data WatchKind =+ WatchKind {+ -- | Watch for create events+ _watchCreate :: Bool,+ -- | Watch for change events+ _watchChange :: Bool,+ -- | Watch for delete events+ _watchDelete :: Bool+ } deriving (Show, Read, Eq)++instance ToJSON WatchKind where+ toJSON wk = Number (createNum + changeNum + deleteNum)+ where+ createNum = if _watchCreate wk then 0x1 else 0x0+ changeNum = if _watchChange wk then 0x2 else 0x0+ deleteNum = if _watchDelete wk then 0x4 else 0x0++instance FromJSON WatchKind where+ parseJSON (Number n)+ | Right i <- floatingOrInteger n :: Either Double Int+ , 0 <= i && i <= 7 =+ pure $ WatchKind (testBit i 0x0) (testBit i 0x1) (testBit i 0x2)+ | otherwise = mempty+ parseJSON _ = mempty++deriveJSON lspOptions ''DidChangeWatchedFilesRegistrationOptions+deriveJSON lspOptions ''FileSystemWatcher++-- | The file event type.+data FileChangeType = FcCreated -- ^ The file got created.+ | FcChanged -- ^ The file got changed.+ | FcDeleted -- ^ The file got deleted.+ deriving (Read,Show,Eq)++instance ToJSON FileChangeType where+ toJSON FcCreated = Number 1+ toJSON FcChanged = Number 2+ toJSON FcDeleted = Number 3++instance FromJSON FileChangeType where+ parseJSON (Number 1) = pure FcCreated+ parseJSON (Number 2) = pure FcChanged+ parseJSON (Number 3) = pure FcDeleted+ parseJSON _ = mempty+++-- -------------------------------------++-- | An event describing a file change.+data FileEvent =+ FileEvent+ { -- | The file's URI.+ _uri :: Uri+ -- | The change type.+ , _xtype :: FileChangeType+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''FileEvent++data DidChangeWatchedFilesParams =+ DidChangeWatchedFilesParams+ { -- | The actual file events.+ _changes :: List FileEvent+ } deriving (Read,Show,Eq)++deriveJSON lspOptions ''DidChangeWatchedFilesParams
+ src/Language/LSP/Types/Window.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+module Language.LSP.Types.Window where++import qualified Data.Aeson as A+import Data.Aeson.TH+import Data.Text (Text)+import Language.LSP.Types.Utils++-- ---------------------------------------------------------------------++data MessageType = MtError -- ^ Error = 1,+ | MtWarning -- ^ Warning = 2,+ | MtInfo -- ^ Info = 3,+ | MtLog -- ^ Log = 4+ deriving (Eq,Ord,Show,Read,Enum)++instance A.ToJSON MessageType where+ toJSON MtError = A.Number 1+ toJSON MtWarning = A.Number 2+ toJSON MtInfo = A.Number 3+ toJSON MtLog = A.Number 4++instance A.FromJSON MessageType where+ parseJSON (A.Number 1) = pure MtError+ parseJSON (A.Number 2) = pure MtWarning+ parseJSON (A.Number 3) = pure MtInfo+ parseJSON (A.Number 4) = pure MtLog+ parseJSON _ = mempty++-- ---------------------------------------+++data ShowMessageParams =+ ShowMessageParams {+ _xtype :: MessageType+ , _message :: Text+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ShowMessageParams++-- ---------------------------------------------------------------------++data MessageActionItem =+ MessageActionItem+ { _title :: Text+ } deriving (Show,Read,Eq)++deriveJSON lspOptions ''MessageActionItem+++data ShowMessageRequestParams =+ ShowMessageRequestParams+ { _xtype :: MessageType+ , _message :: Text+ , _actions :: Maybe [MessageActionItem]+ } deriving (Show,Read,Eq)++deriveJSON lspOptions ''ShowMessageRequestParams++-- ---------------------------------------------------------------------++data LogMessageParams =+ LogMessageParams {+ _xtype :: MessageType+ , _message :: Text+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''LogMessageParams
+ src/Language/LSP/Types/WorkspaceEdit.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Language.LSP.Types.WorkspaceEdit where++import Data.Aeson+import Data.Aeson.TH+import qualified Data.HashMap.Strict as H+import Data.Text (Text)+import qualified Data.Text as T++import Language.LSP.Types.Common+import Language.LSP.Types.Location+import Language.LSP.Types.TextDocument+import Language.LSP.Types.Uri+import Language.LSP.Types.Utils++-- ---------------------------------------------------------------------++data TextEdit =+ TextEdit+ { _range :: Range+ , _newText :: Text+ } deriving (Show,Read,Eq)++deriveJSON lspOptions ''TextEdit+++-- ---------------------------------------------------------------------++data TextDocumentEdit =+ TextDocumentEdit+ { _textDocument :: VersionedTextDocumentIdentifier+ , _edits :: List TextEdit+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''TextDocumentEdit++-- ---------------------------------------------------------------------++type WorkspaceEditMap = H.HashMap Uri (List TextEdit)++data WorkspaceEdit =+ WorkspaceEdit+ { _changes :: Maybe WorkspaceEditMap+ , _documentChanges :: Maybe (List TextDocumentEdit)+ } deriving (Show, Read, Eq)++instance Semigroup WorkspaceEdit where+ (WorkspaceEdit a b) <> (WorkspaceEdit c d) = WorkspaceEdit (a <> c) (b <> d)+instance Monoid WorkspaceEdit where+ mempty = WorkspaceEdit Nothing Nothing++deriveJSON lspOptions ''WorkspaceEdit++-- -------------------------------------++data ResourceOperationKind+ = ResourceOperationCreate -- ^ Supports creating new files and folders.+ | ResourceOperationRename -- ^ Supports renaming existing files and folders.+ | ResourceOperationDelete -- ^ Supports deleting existing files and folders.+ deriving (Read, Show, Eq)+ +instance ToJSON ResourceOperationKind where+ toJSON ResourceOperationCreate = String "create"+ toJSON ResourceOperationRename = String "rename"+ toJSON ResourceOperationDelete = String "delete"++instance FromJSON ResourceOperationKind where+ parseJSON (String "create") = pure ResourceOperationCreate+ parseJSON (String "rename") = pure ResourceOperationRename+ parseJSON (String "delete") = pure ResourceOperationDelete+ parseJSON _ = mempty++data FailureHandlingKind+ = FailureHandlingAbort -- ^ Applying the workspace change is simply aborted if one of the changes provided fails. All operations executed before the failing operation stay executed.+ | FailureHandlingTransactional -- ^ All operations are executed transactional. That means they either all succeed or no changes at all are applied to the workspace.+ | FailureHandlingTextOnlyTransactional -- ^ If the workspace edit contains only textual file changes they are executed transactional. If resource changes (create, rename or delete file) are part of the change the failure handling strategy is abort.+ | FailureHandlingUndo -- ^ The client tries to undo the operations already executed. But there is no guarantee that this is succeeding.+ deriving (Read, Show, Eq)+ +instance ToJSON FailureHandlingKind where+ toJSON FailureHandlingAbort = String "abort"+ toJSON FailureHandlingTransactional = String "transactional"+ toJSON FailureHandlingTextOnlyTransactional = String "textOnlyTransactional"+ toJSON FailureHandlingUndo = String "undo"++instance FromJSON FailureHandlingKind where+ parseJSON (String "abort") = pure FailureHandlingAbort+ parseJSON (String "transactional") = pure FailureHandlingTransactional+ parseJSON (String "textOnlyTransactional") = pure FailureHandlingTextOnlyTransactional+ parseJSON (String "undo") = pure FailureHandlingUndo+ parseJSON _ = mempty++data WorkspaceEditClientCapabilities =+ WorkspaceEditClientCapabilities+ { _documentChanges :: Maybe Bool -- ^The client supports versioned document+ -- changes in 'WorkspaceEdit's+ -- | The resource operations the client supports. Clients should at least+ -- support @create@, @rename@ and @delete@ files and folders.+ , _resourceOperations :: Maybe (List ResourceOperationKind)+ -- | The failure handling strategy of a client if applying the workspace edit+ -- fails.+ , _failureHandling :: Maybe FailureHandlingKind+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''WorkspaceEditClientCapabilities++-- ---------------------------------------------------------------------++data ApplyWorkspaceEditParams =+ ApplyWorkspaceEditParams+ { -- | An optional label of the workspace edit. This label is+ -- presented in the user interface for example on an undo+ -- stack to undo the workspace edit.+ _label :: Maybe Text+ -- | The edits to apply+ , _edit :: WorkspaceEdit+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ApplyWorkspaceEditParams++data ApplyWorkspaceEditResponseBody =+ ApplyWorkspaceEditResponseBody+ { -- | Indicates whether the edit was applied or not.+ _applied :: Bool+ -- | An optional textual description for why the edit was not applied.+ -- This may be used may be used by the server for diagnostic+ -- logging or to provide a suitable error for a request that+ -- triggered the edit.+ , _failureReason :: Maybe Text+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''ApplyWorkspaceEditResponseBody++-- ---------------------------------------------------------------------++-- | Applies a 'TextEdit' to some 'Text'.+-- >>> applyTextEdit (TextEdit (Range (Position 0 1) (Position 0 2)) "i") "foo"+-- "fio"+applyTextEdit :: TextEdit -> Text -> Text+applyTextEdit (TextEdit (Range sp ep) newText) oldText =+ let (_, afterEnd) = splitAtPos ep oldText+ (beforeStart, _) = splitAtPos sp oldText+ in mconcat [beforeStart, newText, afterEnd]+ where+ splitAtPos :: Position -> Text -> (Text, Text)+ splitAtPos (Position sl sc) t =+ let index = sc + startLineIndex sl t+ in T.splitAt index t++ -- The index of the first character of line 'line'+ startLineIndex 0 _ = 0+ startLineIndex line t' =+ case T.findIndex (== '\n') t' of+ Just i -> i + 1 + startLineIndex (line - 1) (T.drop (i + 1) t')+ Nothing -> 0++-- | 'editTextEdit' @outer@ @inner@ applies @inner@ to the text inside @outer@.+editTextEdit :: TextEdit -> TextEdit -> TextEdit+editTextEdit (TextEdit origRange origText) innerEdit =+ let newText = applyTextEdit innerEdit origText+ in TextEdit origRange newText
+ src/Language/LSP/Types/WorkspaceFolders.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell #-}+module Language.LSP.Types.WorkspaceFolders where++import Data.Aeson.TH+import Data.Text ( Text )++import Language.LSP.Types.Common+import Language.LSP.Types.Utils++data WorkspaceFolder =+ WorkspaceFolder+ { -- | The name of the workspace folder. Defaults to the uri's basename.+ _uri :: Text+ -- | The name of the workspace folder. Defaults to the uri's basename.+ , _name :: Text+ } deriving (Read, Show, Eq)++deriveJSON lspOptions ''WorkspaceFolder++-- | The workspace folder change event.+data WorkspaceFoldersChangeEvent =+ WorkspaceFoldersChangeEvent+ { _added :: List WorkspaceFolder -- ^ The array of added workspace folders+ , _removed :: List WorkspaceFolder -- ^ The array of the removed workspace folders+ } deriving (Read, Show, Eq)++deriveJSON lspOptions ''WorkspaceFoldersChangeEvent++data DidChangeWorkspaceFoldersParams = + DidChangeWorkspaceFoldersParams+ { _event :: WorkspaceFoldersChangeEvent+ -- ^ The actual workspace folder change event.+ } deriving (Read, Show, Eq)++deriveJSON lspOptions ''DidChangeWorkspaceFoldersParams+
+ src/Language/LSP/Types/WorkspaceSymbol.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Language.LSP.Types.WorkspaceSymbol where++import Data.Aeson.TH+import Data.Default+import Language.LSP.Types.Common+import Language.LSP.Types.DocumentSymbol+import Language.LSP.Types.Progress+import Language.LSP.Types.Utils++data WorkspaceSymbolKindClientCapabilities =+ WorkspaceSymbolKindClientCapabilities+ { -- | The symbol kind values the client supports. When this+ -- property exists the client also guarantees that it will+ -- handle values outside its set gracefully and falls back+ -- to a default value when unknown.+ --+ -- If this property is not present the client only supports+ -- the symbol kinds from `File` to `Array` as defined in+ -- the initial version of the protocol.+ _valueSet :: Maybe (List SymbolKind)+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''WorkspaceSymbolKindClientCapabilities++instance Default WorkspaceSymbolKindClientCapabilities where+ def = WorkspaceSymbolKindClientCapabilities (Just $ List allKinds)+ where allKinds = [ SkFile+ , SkModule+ , SkNamespace+ , SkPackage+ , SkClass+ , SkMethod+ , SkProperty+ , SkField+ , SkConstructor+ , SkEnum+ , SkInterface+ , SkFunction+ , SkVariable+ , SkConstant+ , SkString+ , SkNumber+ , SkBoolean+ , SkArray+ ]++data WorkspaceSymbolClientCapabilities =+ WorkspaceSymbolClientCapabilities+ { _dynamicRegistration :: Maybe Bool -- ^Symbol request supports dynamic+ -- registration.+ , _symbolKind :: Maybe WorkspaceSymbolKindClientCapabilities -- ^ Specific capabilities for the `SymbolKind`.+ } deriving (Show, Read, Eq)++deriveJSON lspOptions ''WorkspaceSymbolClientCapabilities++-- -------------------------------------++makeExtendingDatatype "WorkspaceSymbolOptions" [''WorkDoneProgressOptions] []+deriveJSON lspOptions ''WorkspaceSymbolOptions++makeExtendingDatatype "WorkspaceSymbolRegistrationOptions"+ [''WorkspaceSymbolOptions] []+deriveJSON lspOptions ''WorkspaceSymbolRegistrationOptions++-- -------------------------------------++makeExtendingDatatype "WorkspaceSymbolParams"+ [ ''WorkDoneProgressParams+ , ''PartialResultParams+ ]+ [("_query", [t| String |])]++deriveJSON lspOptions ''WorkspaceSymbolParams
+ src/Language/LSP/VFS.hs view
@@ -0,0 +1,308 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE DataKinds #-}++{-|+Handles the "Language.LSP.Types.TextDocumentDidChange" \/+"Language.LSP.Types.TextDocumentDidOpen" \/+"Language.LSP.Types.TextDocumentDidClose" messages to keep an in-memory+`filesystem` of the current client workspace. The server can access and edit+files in the client workspace by operating on the "VFS" in "LspFuncs".+-}+module Language.LSP.VFS+ (+ VFS(..)+ , VirtualFile(..)+ , virtualFileText+ , virtualFileVersion+ -- * Managing the VFS+ , initVFS+ , openVFS+ , changeFromClientVFS+ , changeFromServerVFS+ , persistFileVFS+ , closeVFS+ , updateVFS++ -- * manipulating the file contents+ , rangeLinesFromVfs+ , PosPrefixInfo(..)+ , getCompletionPrefix++ -- * for tests+ , applyChanges+ , applyChange+ , changeChars+ ) where++import Control.Lens hiding ( parts )+import Control.Monad+import Data.Char (isUpper, isAlphaNum)+import Data.Text ( Text )+import qualified Data.Text as T+import Data.List+import Data.Ord+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Map as Map+import Data.Maybe+import Data.Rope.UTF16 ( Rope )+import qualified Data.Rope.UTF16 as Rope+import qualified Language.LSP.Types as J+import qualified Language.LSP.Types.Lens as J+import System.FilePath+import Data.Hashable+import System.Directory+import System.IO +import System.IO.Temp+import System.Log.Logger++-- ---------------------------------------------------------------------+{-# ANN module ("hlint: ignore Eta reduce" :: String) #-}+{-# ANN module ("hlint: ignore Redundant do" :: String) #-}+-- ---------------------------------------------------------------------++data VirtualFile =+ VirtualFile {+ _lsp_version :: !Int -- ^ The LSP version of the document+ , _file_version :: !Int -- ^ This number is only incremented whilst the file+ -- remains in the map.+ , _text :: Rope -- ^ The full contents of the document+ } deriving (Show)+++type VFSMap = Map.Map J.NormalizedUri VirtualFile++data VFS = VFS { vfsMap :: Map.Map J.NormalizedUri VirtualFile+ , vfsTempDir :: FilePath -- ^ This is where all the temporary files will be written to+ } deriving Show++---++virtualFileText :: VirtualFile -> Text+virtualFileText vf = Rope.toText (_text vf)++virtualFileVersion :: VirtualFile -> Int+virtualFileVersion vf = _lsp_version vf++---++initVFS :: (VFS -> IO r) -> IO r+initVFS k = withSystemTempDirectory "haskell-lsp" $ \temp_dir -> k (VFS mempty temp_dir)++-- ---------------------------------------------------------------------++-- | Applies the changes from a 'J.DidOpenTextDocument' to the 'VFS'+openVFS :: VFS -> J.Message 'J.TextDocumentDidOpen -> (VFS, [String])+openVFS vfs (J.NotificationMessage _ _ params) =+ let J.DidOpenTextDocumentParams+ (J.TextDocumentItem uri _ version text) = params+ in (updateVFS (Map.insert (J.toNormalizedUri uri) (VirtualFile version 0 (Rope.fromText text))) vfs+ , [])+++-- ---------------------------------------------------------------------++-- ^ Applies a 'DidChangeTextDocumentNotification' to the 'VFS'+changeFromClientVFS :: VFS -> J.Message 'J.TextDocumentDidChange -> (VFS,[String])+changeFromClientVFS vfs (J.NotificationMessage _ _ params) =+ let+ J.DidChangeTextDocumentParams vid (J.List changes) = params+ J.VersionedTextDocumentIdentifier (J.toNormalizedUri -> uri) version = vid+ in+ case Map.lookup uri (vfsMap vfs) of+ Just (VirtualFile _ file_ver str) ->+ let str' = applyChanges str changes+ -- the client shouldn't be sending over a null version, only the server.+ in (updateVFS (Map.insert uri (VirtualFile (fromMaybe 0 version) (file_ver + 1) str')) vfs, [])+ Nothing ->+ -- logs $ "haskell-lsp:changeVfs:can't find uri:" ++ show uri+ -- return vfs+ (vfs, ["haskell-lsp:changeVfs:can't find uri:" ++ show uri])++updateVFS :: (VFSMap -> VFSMap) -> VFS -> VFS+updateVFS f vfs@VFS{vfsMap} = vfs { vfsMap = f vfsMap }++-- ---------------------------------------------------------------------++-- ^ Applies the changes from a 'ApplyWorkspaceEditRequest' to the 'VFS'+changeFromServerVFS :: VFS -> J.Message 'J.WorkspaceApplyEdit -> IO VFS+changeFromServerVFS initVfs (J.RequestMessage _ _ _ params) = do+ let J.ApplyWorkspaceEditParams _label edit = params+ J.WorkspaceEdit mChanges mDocChanges = edit+ case mDocChanges of+ Just (J.List textDocEdits) -> applyEdits textDocEdits+ Nothing -> case mChanges of+ Just cs -> applyEdits $ HashMap.foldlWithKey' changeToTextDocumentEdit [] cs+ Nothing -> do+ debugM "haskell-lsp.changeVfs" "No changes"+ return initVfs++ where++ changeToTextDocumentEdit acc uri edits =+ acc ++ [J.TextDocumentEdit (J.VersionedTextDocumentIdentifier uri (Just 0)) edits]++ -- applyEdits :: [J.TextDocumentEdit] -> VFS+ applyEdits :: [J.TextDocumentEdit] -> IO VFS+ applyEdits = foldM f initVfs . sortOn (^. J.textDocument . J.version)++ f :: VFS -> J.TextDocumentEdit -> IO VFS+ f vfs (J.TextDocumentEdit vid (J.List edits)) = do+ -- all edits are supposed to be applied at once+ -- so apply from bottom up so they don't affect others+ let sortedEdits = sortOn (Down . (^. J.range)) edits+ changeEvents = map editToChangeEvent sortedEdits+ ps = J.DidChangeTextDocumentParams vid (J.List changeEvents)+ notif = J.NotificationMessage "" J.STextDocumentDidChange ps+ let (vfs',ls) = changeFromClientVFS vfs notif+ mapM_ (debugM "haskell-lsp.changeFromServerVFS") ls+ return vfs'++ editToChangeEvent (J.TextEdit range text) = J.TextDocumentContentChangeEvent (Just range) Nothing text++-- ---------------------------------------------------------------------+virtualFileName :: FilePath -> J.NormalizedUri -> VirtualFile -> FilePath+virtualFileName prefix uri (VirtualFile _ file_ver _) =+ let uri_raw = J.fromNormalizedUri uri+ basename = maybe "" takeFileName (J.uriToFilePath uri_raw)+ -- Given a length and a version number, pad the version number to+ -- the given n. Does nothing if the version number string is longer+ -- than the given length.+ padLeft :: Int -> Int -> String+ padLeft n num =+ let numString = show num+ in replicate (n - length numString) '0' ++ numString+ in prefix </> basename ++ "-" ++ padLeft 5 file_ver ++ "-" ++ show (hash uri_raw) ++ ".hs"++-- | Write a virtual file to a temporary file if it exists in the VFS.+persistFileVFS :: VFS -> J.NormalizedUri -> Maybe (FilePath, IO ())+persistFileVFS vfs uri =+ case Map.lookup uri (vfsMap vfs) of+ Nothing -> Nothing+ Just vf ->+ let tfn = virtualFileName (vfsTempDir vfs) uri vf+ action = do+ exists <- doesFileExist tfn+ unless exists $ do+ let contents = Rope.toString (_text vf)+ writeRaw h = do+ -- We honour original file line endings+ hSetNewlineMode h noNewlineTranslation+ hSetEncoding h utf8+ hPutStr h contents+ debugM "haskell-lsp.persistFileVFS" $ "Writing virtual file: " + ++ "uri = " ++ show uri ++ ", virtual file = " ++ show tfn+ withFile tfn WriteMode writeRaw+ in Just (tfn, action)++-- ---------------------------------------------------------------------++closeVFS :: VFS -> J.Message 'J.TextDocumentDidClose -> (VFS, [String])+closeVFS vfs (J.NotificationMessage _ _ params) =+ let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier uri) = params+ in (updateVFS (Map.delete (J.toNormalizedUri uri)) vfs,["Closed: " ++ show uri])++-- ---------------------------------------------------------------------+{-++data TextDocumentContentChangeEvent =+ TextDocumentContentChangeEvent+ { _range :: Maybe Range+ , _rangeLength :: Maybe Int+ , _text :: String+ } deriving (Read,Show,Eq)+-}++-- | Apply the list of changes.+-- Changes should be applied in the order that they are+-- received from the client.+applyChanges :: Rope -> [J.TextDocumentContentChangeEvent] -> Rope+applyChanges = foldl' applyChange++-- ---------------------------------------------------------------------++applyChange :: Rope -> J.TextDocumentContentChangeEvent -> Rope+applyChange _ (J.TextDocumentContentChangeEvent Nothing Nothing str)+ = Rope.fromText str+applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position sl sc) _to)) (Just len) txt)+ = changeChars str start len txt+ where+ start = Rope.rowColumnCodeUnits (Rope.RowColumn sl sc) str+applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position sl sc) (J.Position el ec))) Nothing txt)+ = changeChars str start len txt+ where+ start = Rope.rowColumnCodeUnits (Rope.RowColumn sl sc) str+ end = Rope.rowColumnCodeUnits (Rope.RowColumn el ec) str+ len = end - start+applyChange str (J.TextDocumentContentChangeEvent Nothing (Just _) _txt)+ = str++-- ---------------------------------------------------------------------++changeChars :: Rope -> Int -> Int -> Text -> Rope+changeChars str start len new = mconcat [before, Rope.fromText new, after']+ where+ (before, after) = Rope.splitAt start str+ after' = Rope.drop len after++-- ---------------------------------------------------------------------++-- TODO:AZ:move this to somewhere sane+-- | Describes the line at the current cursor position+data PosPrefixInfo = PosPrefixInfo+ { fullLine :: T.Text+ -- ^ The full contents of the line the cursor is at++ , prefixModule :: T.Text+ -- ^ If any, the module name that was typed right before the cursor position.+ -- For example, if the user has typed "Data.Maybe.from", then this property+ -- will be "Data.Maybe"++ , prefixText :: T.Text+ -- ^ The word right before the cursor position, after removing the module part.+ -- For example if the user has typed "Data.Maybe.from",+ -- then this property will be "from"+ , cursorPos :: J.Position+ -- ^ The cursor position+ } deriving (Show,Eq)++getCompletionPrefix :: (Monad m) => J.Position -> VirtualFile -> m (Maybe PosPrefixInfo)+getCompletionPrefix pos@(J.Position l c) (VirtualFile _ _ ropetext) =+ return $ Just $ fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad+ let headMaybe [] = Nothing+ headMaybe (x:_) = Just x+ lastMaybe [] = Nothing+ lastMaybe xs = Just $ last xs++ curLine <- headMaybe $ T.lines $ Rope.toText+ $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine l ropetext+ let beforePos = T.take c curLine+ curWord <-+ if | T.null beforePos -> Just ""+ | T.last beforePos == ' ' -> Just "" -- don't count abc as the curword in 'abc '+ | otherwise -> lastMaybe (T.words beforePos)++ let parts = T.split (=='.')+ $ T.takeWhileEnd (\x -> isAlphaNum x || x `elem` ("._'"::String)) curWord+ case reverse parts of+ [] -> Nothing+ (x:xs) -> do+ let modParts = dropWhile (not . isUpper . T.head)+ $ reverse $ filter (not .T.null) xs+ modName = T.intercalate "." modParts+ return $ PosPrefixInfo curLine modName x pos++-- ---------------------------------------------------------------------++rangeLinesFromVfs :: VirtualFile -> J.Range -> T.Text+rangeLinesFromVfs (VirtualFile _ _ ropetext) (J.Range (J.Position lf _cf) (J.Position lt _ct)) = r+ where+ (_ ,s1) = Rope.splitAtLine lf ropetext+ (s2, _) = Rope.splitAtLine (lt - lf) s1+ r = Rope.toText s2+-- ---------------------------------------------------------------------