hls-plugin-api 0.5.0.1 → 0.6.0.0
raw patch · 9 files changed
+955/−1504 lines, 9 filesdep +Win32dep +unixdep −ghcdep −ghc-boot-thdep −ghcidedep ~haskell-lspPVP ok
version bump matches the API change (PVP)
Dependencies added: Win32, unix
Dependencies removed: ghc, ghc-boot-th, ghcide
Dependency ranges changed: haskell-lsp
API changes (from Hackage documentation)
- Ide.Logger: hlsLogger :: Logger
- Ide.Plugin: allLspCmdIds :: Text -> [(PluginId, [PluginCommand])] -> [Text]
- Ide.Plugin: allLspCmdIds' :: Text -> IdePlugins -> [Text]
- Ide.Plugin: asGhcIdePlugin :: IdePlugins -> Plugin Config
- Ide.Plugin: getClientConfig :: LspFuncs Config -> IO Config
- Ide.Plugin: getClientConfigAction :: Action Config
- Ide.Plugin: getPid :: IO Text
- Ide.Plugin: instance Data.Aeson.Types.FromJSON.FromJSON Ide.Plugin.FallbackCodeActionParams
- Ide.Plugin: instance Data.Aeson.Types.ToJSON.ToJSON Ide.Plugin.FallbackCodeActionParams
- Ide.Plugin: instance GHC.Generics.Generic Ide.Plugin.FallbackCodeActionParams
- Ide.Plugin: mkLspCmdId :: Text -> PluginId -> CommandId -> Text
- Ide.Plugin: mkLspCommand :: PluginId -> CommandId -> Text -> Maybe [Value] -> IO Command
- Ide.Plugin: pluginDescToIdePlugins :: [PluginDescriptor] -> IdePlugins
- Ide.Plugin: responseError :: Text -> ResponseError
- Ide.Plugin.Formatter: extractRange :: Range -> Text -> Text
- Ide.Plugin.Formatter: formatting :: Map PluginId (FormattingProvider IO) -> LspFuncs Config -> IdeState -> DocumentFormattingParams -> IO (Either ResponseError (List TextEdit))
- Ide.Plugin.Formatter: fullRange :: Text -> Range
- Ide.Plugin.Formatter: noneProvider :: FormattingProvider IO
- Ide.Plugin.Formatter: rangeFormatting :: Map PluginId (FormattingProvider IO) -> LspFuncs Config -> IdeState -> DocumentRangeFormattingParams -> IO (Either ResponseError (List TextEdit))
- Ide.Plugin.Formatter: responseError :: Text -> ResponseError
- Ide.Plugin.GhcIde: descriptor :: PluginId -> PluginDescriptor
- Ide.PluginUtils: clientSupportsDocumentChanges :: ClientCapabilities -> Bool
- Ide.PluginUtils: diffTextEdit :: Text -> Text -> WithDeletions -> List TextEdit
+ Ide.Plugin.Config: AlwaysCheck :: CheckParents
+ Ide.Plugin.Config: CheckOnClose :: CheckParents
+ Ide.Plugin.Config: CheckOnSaveAndClose :: CheckParents
+ Ide.Plugin.Config: NeverCheck :: CheckParents
+ Ide.Plugin.Config: PluginConfig :: !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Object -> PluginConfig
+ Ide.Plugin.Config: [checkParents] :: Config -> CheckParents
+ Ide.Plugin.Config: [checkProject] :: Config -> !Bool
+ Ide.Plugin.Config: [plcCodeActionsOn] :: PluginConfig -> !Bool
+ Ide.Plugin.Config: [plcCodeLensOn] :: PluginConfig -> !Bool
+ Ide.Plugin.Config: [plcCompletionOn] :: PluginConfig -> !Bool
+ Ide.Plugin.Config: [plcConfig] :: PluginConfig -> !Object
+ Ide.Plugin.Config: [plcDiagnosticsOn] :: PluginConfig -> !Bool
+ Ide.Plugin.Config: [plcGlobalOn] :: PluginConfig -> !Bool
+ Ide.Plugin.Config: [plcHoverOn] :: PluginConfig -> !Bool
+ Ide.Plugin.Config: [plcRenameOn] :: PluginConfig -> !Bool
+ Ide.Plugin.Config: [plcSymbolsOn] :: PluginConfig -> !Bool
+ Ide.Plugin.Config: [plugins] :: Config -> !Map Text PluginConfig
+ Ide.Plugin.Config: data CheckParents
+ Ide.Plugin.Config: data PluginConfig
+ Ide.Plugin.Config: instance Data.Aeson.Types.FromJSON.FromJSON Ide.Plugin.Config.CheckParents
+ Ide.Plugin.Config: instance Data.Aeson.Types.FromJSON.FromJSON Ide.Plugin.Config.PluginConfig
+ Ide.Plugin.Config: instance Data.Aeson.Types.ToJSON.ToJSON Ide.Plugin.Config.CheckParents
+ Ide.Plugin.Config: instance Data.Aeson.Types.ToJSON.ToJSON Ide.Plugin.Config.PluginConfig
+ Ide.Plugin.Config: instance Data.Default.Class.Default Ide.Plugin.Config.PluginConfig
+ Ide.Plugin.Config: instance GHC.Classes.Eq Ide.Plugin.Config.CheckParents
+ Ide.Plugin.Config: instance GHC.Classes.Eq Ide.Plugin.Config.PluginConfig
+ Ide.Plugin.Config: instance GHC.Classes.Ord Ide.Plugin.Config.CheckParents
+ Ide.Plugin.Config: instance GHC.Generics.Generic Ide.Plugin.Config.CheckParents
+ Ide.Plugin.Config: instance GHC.Show.Show Ide.Plugin.Config.CheckParents
+ Ide.Plugin.Config: instance GHC.Show.Show Ide.Plugin.Config.PluginConfig
+ Ide.PluginUtils: allLspCmdIds :: Text -> [(PluginId, [PluginCommand ideState])] -> [Text]
+ Ide.PluginUtils: allLspCmdIds' :: Text -> IdePlugins ideState -> [Text]
+ Ide.PluginUtils: configForPlugin :: Config -> PluginId -> PluginConfig
+ Ide.PluginUtils: extractRange :: Range -> Text -> Text
+ Ide.PluginUtils: fullRange :: Text -> Range
+ Ide.PluginUtils: getClientConfig :: LspFuncs Config -> IO Config
+ Ide.PluginUtils: getPluginConfig :: LspFuncs Config -> PluginId -> IO PluginConfig
+ Ide.PluginUtils: getProcessID :: IO Int
+ Ide.PluginUtils: installSigUsr1Handler :: IO () -> IO ()
+ Ide.PluginUtils: mkLspCmdId :: Text -> PluginId -> CommandId -> Text
+ Ide.PluginUtils: mkLspCommand :: PluginId -> CommandId -> Text -> Maybe [Value] -> IO Command
+ Ide.PluginUtils: pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
+ Ide.PluginUtils: pluginEnabled :: PluginConfig -> (PluginConfig -> Bool) -> Bool
+ Ide.PluginUtils: responseError :: Text -> ResponseError
+ Ide.Types: noneProvider :: FormattingProvider ideState IO
- Ide.Plugin.Config: Config :: Bool -> Bool -> Int -> Int -> Bool -> Bool -> Bool -> Text -> Config
+ Ide.Plugin.Config: Config :: CheckParents -> !Bool -> !Bool -> !Bool -> !Int -> !Int -> !Bool -> !Bool -> !Bool -> !Text -> !Map Text PluginConfig -> Config
- Ide.Plugin.Config: [completionSnippetsOn] :: Config -> Bool
+ Ide.Plugin.Config: [completionSnippetsOn] :: Config -> !Bool
- Ide.Plugin.Config: [diagnosticsDebounceDuration] :: Config -> Int
+ Ide.Plugin.Config: [diagnosticsDebounceDuration] :: Config -> !Int
- Ide.Plugin.Config: [diagnosticsOnChange] :: Config -> Bool
+ Ide.Plugin.Config: [diagnosticsOnChange] :: Config -> !Bool
- Ide.Plugin.Config: [formatOnImportOn] :: Config -> Bool
+ Ide.Plugin.Config: [formatOnImportOn] :: Config -> !Bool
- Ide.Plugin.Config: [formattingProvider] :: Config -> Text
+ Ide.Plugin.Config: [formattingProvider] :: Config -> !Text
- Ide.Plugin.Config: [hlintOn] :: Config -> Bool
+ Ide.Plugin.Config: [hlintOn] :: Config -> !Bool
- Ide.Plugin.Config: [liquidOn] :: Config -> Bool
+ Ide.Plugin.Config: [liquidOn] :: Config -> !Bool
- Ide.Plugin.Config: [maxNumberOfProblems] :: Config -> Int
+ Ide.Plugin.Config: [maxNumberOfProblems] :: Config -> !Int
- Ide.Types: IdePlugins :: Map PluginId PluginDescriptor -> IdePlugins
+ Ide.Types: IdePlugins :: Map PluginId (PluginDescriptor ideState) -> IdePlugins ideState
- Ide.Types: PluginCommand :: CommandId -> Text -> CommandFunction a -> PluginCommand
+ Ide.Types: PluginCommand :: CommandId -> Text -> CommandFunction ideState a -> PluginCommand ideState
- Ide.Types: PluginDescriptor :: !PluginId -> !Rules () -> ![PluginCommand] -> !Maybe CodeActionProvider -> !Maybe CodeLensProvider -> !Maybe DiagnosticProvider -> !Maybe HoverProvider -> !Maybe SymbolsProvider -> !Maybe (FormattingProvider IO) -> !Maybe CompletionProvider -> !Maybe RenameProvider -> PluginDescriptor
+ Ide.Types: PluginDescriptor :: !PluginId -> !Rules () -> ![PluginCommand ideState] -> !Maybe (CodeActionProvider ideState) -> !Maybe (CodeLensProvider ideState) -> !Maybe DiagnosticProvider -> !Maybe (HoverProvider ideState) -> !Maybe (SymbolsProvider ideState) -> !Maybe (FormattingProvider ideState IO) -> !Maybe (CompletionProvider ideState) -> !Maybe (RenameProvider ideState) -> PluginDescriptor ideState
- Ide.Types: [commandDesc] :: PluginCommand -> Text
+ Ide.Types: [commandDesc] :: PluginCommand ideState -> Text
- Ide.Types: [commandFunc] :: PluginCommand -> CommandFunction a
+ Ide.Types: [commandFunc] :: PluginCommand ideState -> CommandFunction ideState a
- Ide.Types: [commandId] :: PluginCommand -> CommandId
+ Ide.Types: [commandId] :: PluginCommand ideState -> CommandId
- Ide.Types: [ipMap] :: IdePlugins -> Map PluginId PluginDescriptor
+ Ide.Types: [ipMap] :: IdePlugins ideState -> Map PluginId (PluginDescriptor ideState)
- Ide.Types: [pluginCodeActionProvider] :: PluginDescriptor -> !Maybe CodeActionProvider
+ Ide.Types: [pluginCodeActionProvider] :: PluginDescriptor ideState -> !Maybe (CodeActionProvider ideState)
- Ide.Types: [pluginCodeLensProvider] :: PluginDescriptor -> !Maybe CodeLensProvider
+ Ide.Types: [pluginCodeLensProvider] :: PluginDescriptor ideState -> !Maybe (CodeLensProvider ideState)
- Ide.Types: [pluginCommands] :: PluginDescriptor -> ![PluginCommand]
+ Ide.Types: [pluginCommands] :: PluginDescriptor ideState -> ![PluginCommand ideState]
- Ide.Types: [pluginCompletionProvider] :: PluginDescriptor -> !Maybe CompletionProvider
+ Ide.Types: [pluginCompletionProvider] :: PluginDescriptor ideState -> !Maybe (CompletionProvider ideState)
- Ide.Types: [pluginDiagnosticProvider] :: PluginDescriptor -> !Maybe DiagnosticProvider
+ Ide.Types: [pluginDiagnosticProvider] :: PluginDescriptor ideState -> !Maybe DiagnosticProvider
- Ide.Types: [pluginFormattingProvider] :: PluginDescriptor -> !Maybe (FormattingProvider IO)
+ Ide.Types: [pluginFormattingProvider] :: PluginDescriptor ideState -> !Maybe (FormattingProvider ideState IO)
- Ide.Types: [pluginHoverProvider] :: PluginDescriptor -> !Maybe HoverProvider
+ Ide.Types: [pluginHoverProvider] :: PluginDescriptor ideState -> !Maybe (HoverProvider ideState)
- Ide.Types: [pluginId] :: PluginDescriptor -> !PluginId
+ Ide.Types: [pluginId] :: PluginDescriptor ideState -> !PluginId
- Ide.Types: [pluginRenameProvider] :: PluginDescriptor -> !Maybe RenameProvider
+ Ide.Types: [pluginRenameProvider] :: PluginDescriptor ideState -> !Maybe (RenameProvider ideState)
- Ide.Types: [pluginRules] :: PluginDescriptor -> !Rules ()
+ Ide.Types: [pluginRules] :: PluginDescriptor ideState -> !Rules ()
- Ide.Types: [pluginSymbolsProvider] :: PluginDescriptor -> !Maybe SymbolsProvider
+ Ide.Types: [pluginSymbolsProvider] :: PluginDescriptor ideState -> !Maybe (SymbolsProvider ideState)
- Ide.Types: data PluginCommand
+ Ide.Types: data PluginCommand ideState
- Ide.Types: data PluginDescriptor
+ Ide.Types: data PluginDescriptor ideState
- Ide.Types: defaultPluginDescriptor :: PluginId -> PluginDescriptor
+ Ide.Types: defaultPluginDescriptor :: PluginId -> PluginDescriptor ideState
- Ide.Types: newtype IdePlugins
+ Ide.Types: newtype IdePlugins ideState
- Ide.Types: type CodeActionProvider = LspFuncs Config -> IdeState -> PluginId -> TextDocumentIdentifier -> Range -> CodeActionContext -> IO (Either ResponseError (List CAResult))
+ Ide.Types: type CodeActionProvider ideState = LspFuncs Config -> ideState -> PluginId -> TextDocumentIdentifier -> Range -> CodeActionContext -> IO (Either ResponseError (List CAResult))
- Ide.Types: type CodeLensProvider = LspFuncs Config -> IdeState -> PluginId -> CodeLensParams -> IO (Either ResponseError (List CodeLens))
+ Ide.Types: type CodeLensProvider ideState = LspFuncs Config -> ideState -> PluginId -> CodeLensParams -> IO (Either ResponseError (List CodeLens))
- Ide.Types: type CommandFunction a = LspFuncs Config -> IdeState -> a -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
+ Ide.Types: type CommandFunction ideState a = LspFuncs Config -> ideState -> a -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
- Ide.Types: type CompletionProvider = LspFuncs Config -> IdeState -> CompletionParams -> IO (Either ResponseError CompletionResponseResult)
+ Ide.Types: type CompletionProvider ideState = LspFuncs Config -> ideState -> CompletionParams -> IO (Either ResponseError CompletionResponseResult)
- Ide.Types: type ExecuteCommandProvider = IdeState -> ExecuteCommandParams -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
+ Ide.Types: type ExecuteCommandProvider ideState = ideState -> ExecuteCommandParams -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
- Ide.Types: type FormattingProvider m = LspFuncs Config -> IdeState -> FormattingType " How much to format" -> Text " Text to format" -> NormalizedFilePath " location of the file being formatted" -> FormattingOptions " Options for the formatter" -> m (Either ResponseError (List TextEdit)) " Result of the formatting"
+ Ide.Types: type FormattingProvider ideState m = LspFuncs Config -> ideState -> FormattingType " How much to format
" -> Text " Text to format
" -> NormalizedFilePath " location of the file being formatted
" -> FormattingOptions " Options for the formatter
" -> m (Either ResponseError (List TextEdit)) " Result of the formatting
"
- Ide.Types: type HoverProvider = IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))
+ Ide.Types: type HoverProvider ideState = ideState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))
- Ide.Types: type RenameProvider = LspFuncs Config -> IdeState -> RenameParams -> IO (Either ResponseError WorkspaceEdit)
+ Ide.Types: type RenameProvider ideState = LspFuncs Config -> ideState -> RenameParams -> IO (Either ResponseError WorkspaceEdit)
- Ide.Types: type SymbolsProvider = LspFuncs Config -> IdeState -> DocumentSymbolParams -> IO (Either ResponseError [DocumentSymbol])
+ Ide.Types: type SymbolsProvider ideState = LspFuncs Config -> ideState -> DocumentSymbolParams -> IO (Either ResponseError [DocumentSymbol])
Files
- LICENSE +201/−201
- hls-plugin-api.cabal +62/−61
- src/Ide/Logger.hs +29/−43
- src/Ide/Plugin.hs +0/−603
- src/Ide/Plugin/Config.hs +196/−107
- src/Ide/Plugin/Formatter.hs +0/−110
- src/Ide/Plugin/GhcIde.hs +0/−65
- src/Ide/PluginUtils.hs +261/−110
- src/Ide/Types.hs +206/−204
LICENSE view
@@ -1,201 +1,201 @@- Apache License- Version 2.0, January 2004- http://www.apache.org/licenses/-- TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION-- 1. Definitions.-- "License" shall mean the terms and conditions for use, reproduction,- and distribution as defined by Sections 1 through 9 of this document.-- "Licensor" shall mean the copyright owner or entity authorized by- the copyright owner that is granting the License.-- "Legal Entity" shall mean the union of the acting entity and all- other entities that control, are controlled by, or are under common- control with that entity. For the purposes of this definition,- "control" means (i) the power, direct or indirect, to cause the- direction or management of such entity, whether by contract or- otherwise, or (ii) ownership of fifty percent (50%) or more of the- outstanding shares, or (iii) beneficial ownership of such entity.-- "You" (or "Your") shall mean an individual or Legal Entity- exercising permissions granted by this License.-- "Source" form shall mean the preferred form for making modifications,- including but not limited to software source code, documentation- source, and configuration files.-- "Object" form shall mean any form resulting from mechanical- transformation or translation of a Source form, including but- not limited to compiled object code, generated documentation,- and conversions to other media types.-- "Work" shall mean the work of authorship, whether in Source or- Object form, made available under the License, as indicated by a- copyright notice that is included in or attached to the work- (an example is provided in the Appendix below).-- "Derivative Works" shall mean any work, whether in Source or Object- form, that is based on (or derived from) the Work and for which the- editorial revisions, annotations, elaborations, or other modifications- represent, as a whole, an original work of authorship. For the purposes- of this License, Derivative Works shall not include works that remain- separable from, or merely link (or bind by name) to the interfaces of,- the Work and Derivative Works thereof.-- "Contribution" shall mean any work of authorship, including- the original version of the Work and any modifications or additions- to that Work or Derivative Works thereof, that is intentionally- submitted to Licensor for inclusion in the Work by the copyright owner- or by an individual or Legal Entity authorized to submit on behalf of- the copyright owner. For the purposes of this definition, "submitted"- means any form of electronic, verbal, or written communication sent- to the Licensor or its representatives, including but not limited to- communication on electronic mailing lists, source code control systems,- and issue tracking systems that are managed by, or on behalf of, the- Licensor for the purpose of discussing and improving the Work, but- excluding communication that is conspicuously marked or otherwise- designated in writing by the copyright owner as "Not a Contribution."-- "Contributor" shall mean Licensor and any individual or Legal Entity- on behalf of whom a Contribution has been received by Licensor and- subsequently incorporated within the Work.-- 2. Grant of Copyright License. Subject to the terms and conditions of- this License, each Contributor hereby grants to You a perpetual,- worldwide, non-exclusive, no-charge, royalty-free, irrevocable- copyright license to reproduce, prepare Derivative Works of,- publicly display, publicly perform, sublicense, and distribute the- Work and such Derivative Works in Source or Object form.-- 3. Grant of Patent License. Subject to the terms and conditions of- this License, each Contributor hereby grants to You a perpetual,- worldwide, non-exclusive, no-charge, royalty-free, irrevocable- (except as stated in this section) patent license to make, have made,- use, offer to sell, sell, import, and otherwise transfer the Work,- where such license applies only to those patent claims licensable- by such Contributor that are necessarily infringed by their- Contribution(s) alone or by combination of their Contribution(s)- with the Work to which such Contribution(s) was submitted. If You- institute patent litigation against any entity (including a- cross-claim or counterclaim in a lawsuit) alleging that the Work- or a Contribution incorporated within the Work constitutes direct- or contributory patent infringement, then any patent licenses- granted to You under this License for that Work shall terminate- as of the date such litigation is filed.-- 4. Redistribution. You may reproduce and distribute copies of the- Work or Derivative Works thereof in any medium, with or without- modifications, and in Source or Object form, provided that You- meet the following conditions:-- (a) You must give any other recipients of the Work or- Derivative Works a copy of this License; and-- (b) You must cause any modified files to carry prominent notices- stating that You changed the files; and-- (c) You must retain, in the Source form of any Derivative Works- that You distribute, all copyright, patent, trademark, and- attribution notices from the Source form of the Work,- excluding those notices that do not pertain to any part of- the Derivative Works; and-- (d) If the Work includes a "NOTICE" text file as part of its- distribution, then any Derivative Works that You distribute must- include a readable copy of the attribution notices contained- within such NOTICE file, excluding those notices that do not- pertain to any part of the Derivative Works, in at least one- of the following places: within a NOTICE text file distributed- as part of the Derivative Works; within the Source form or- documentation, if provided along with the Derivative Works; or,- within a display generated by the Derivative Works, if and- wherever such third-party notices normally appear. The contents- of the NOTICE file are for informational purposes only and- do not modify the License. You may add Your own attribution- notices within Derivative Works that You distribute, alongside- or as an addendum to the NOTICE text from the Work, provided- that such additional attribution notices cannot be construed- as modifying the License.-- You may add Your own copyright statement to Your modifications and- may provide additional or different license terms and conditions- for use, reproduction, or distribution of Your modifications, or- for any such Derivative Works as a whole, provided Your use,- reproduction, and distribution of the Work otherwise complies with- the conditions stated in this License.-- 5. Submission of Contributions. Unless You explicitly state otherwise,- any Contribution intentionally submitted for inclusion in the Work- by You to the Licensor shall be under the terms and conditions of- this License, without any additional terms or conditions.- Notwithstanding the above, nothing herein shall supersede or modify- the terms of any separate license agreement you may have executed- with Licensor regarding such Contributions.-- 6. Trademarks. This License does not grant permission to use the trade- names, trademarks, service marks, or product names of the Licensor,- except as required for reasonable and customary use in describing the- origin of the Work and reproducing the content of the NOTICE file.-- 7. Disclaimer of Warranty. Unless required by applicable law or- agreed to in writing, Licensor provides the Work (and each- Contributor provides its Contributions) on an "AS IS" BASIS,- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or- implied, including, without limitation, any warranties or conditions- of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A- PARTICULAR PURPOSE. You are solely responsible for determining the- appropriateness of using or redistributing the Work and assume any- risks associated with Your exercise of permissions under this License.-- 8. Limitation of Liability. In no event and under no legal theory,- whether in tort (including negligence), contract, or otherwise,- unless required by applicable law (such as deliberate and grossly- negligent acts) or agreed to in writing, shall any Contributor be- liable to You for damages, including any direct, indirect, special,- incidental, or consequential damages of any character arising as a- result of this License or out of the use or inability to use the- Work (including but not limited to damages for loss of goodwill,- work stoppage, computer failure or malfunction, or any and all- other commercial damages or losses), even if such Contributor- has been advised of the possibility of such damages.-- 9. Accepting Warranty or Additional Liability. While redistributing- the Work or Derivative Works thereof, You may choose to offer,- and charge a fee for, acceptance of support, warranty, indemnity,- or other liability obligations and/or rights consistent with this- License. However, in accepting such obligations, You may act only- on Your own behalf and on Your sole responsibility, not on behalf- of any other Contributor, and only if You agree to indemnify,- defend, and hold each Contributor harmless for any liability- incurred by, or claims asserted against, such Contributor by reason- of your accepting any such warranty or additional liability.-- END OF TERMS AND CONDITIONS-- APPENDIX: How to apply the Apache License to your work.-- To apply the Apache License to your work, attach the following- boilerplate notice, with the fields enclosed by brackets "[]"- replaced with your own identifying information. (Don't include- the brackets!) The text should be enclosed in the appropriate- comment syntax for the file format. We also recommend that a- file or class name and description of purpose be included on the- same "printed page" as the copyright notice for easier- identification within third-party archives.-- Copyright [yyyy] [name of copyright owner]-- Licensed under the Apache License, Version 2.0 (the "License");- you may not use this file except in compliance with the License.- You may obtain a copy of the License at-- http://www.apache.org/licenses/LICENSE-2.0-- Unless required by applicable law or agreed to in writing, software- distributed under the License is distributed on an "AS IS" BASIS,- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.- See the License for the specific language governing permissions and- limitations under the License.+ Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License.
hls-plugin-api.cabal view
@@ -1,61 +1,62 @@-cabal-version: 2.2-name: hls-plugin-api-version: 0.5.0.1-synopsis: Haskell Language Server API for plugin communication-description:- Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>-homepage: https://github.com/haskell/haskell-language-server/hls-plugin-api-bug-reports: https://github.com/haskell/haskell-language-server/issues-license: Apache-2.0-license-file: LICENSE-author: Many,TBD when we release-maintainer: alan.zimm@gmail.com (for now)-copyright: Alan Zimmerman-category: Web-build-type: Simple--flag pedantic- description: Enable -Werror- default: False- manual: True--source-repository head- type: git- location: https://github.com/haskell/haskell-language-server--library- exposed-modules:- Ide.Logger- Ide.Plugin- Ide.Plugin.Config- Ide.Plugin.Formatter- Ide.Plugin.GhcIde- Ide.PluginUtils- Ide.Types-- hs-source-dirs: src- build-depends:- , aeson- , base >=4.12 && <5- , containers- , data-default- , Diff- , ghc- , ghc-boot-th- , ghcide >=0.5- , haskell-lsp ^>=0.22- , hashable- , hslogger- , lens- , process- , regex-tdfa >=1.3.1.0- , shake >=0.17.5- , text- , unordered-containers-- ghc-options: -Wall -Wredundant-constraints -Wno-name-shadowing-- if flag(pedantic)- ghc-options: -Werror-- default-language: Haskell2010+cabal-version: 2.2 +name: hls-plugin-api +version: 0.6.0.0 +synopsis: Haskell Language Server API for plugin communication +description: + Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme> +homepage: https://github.com/haskell/haskell-language-server/hls-plugin-api +bug-reports: https://github.com/haskell/haskell-language-server/issues +license: Apache-2.0 +license-file: LICENSE +author: Many,TBD when we release +maintainer: alan.zimm@gmail.com (for now) +copyright: Alan Zimmerman +category: Web +build-type: Simple + +flag pedantic + description: Enable -Werror + default: False + manual: True + +source-repository head + type: git + location: https://github.com/haskell/haskell-language-server + +library + exposed-modules: + Ide.Logger + Ide.Plugin.Config + Ide.PluginUtils + Ide.Types + + hs-source-dirs: src + build-depends: + , aeson + , base >=4.12 && <5 + , containers + , data-default + , Diff + , haskell-lsp ^>=0.22 + , hashable + , hslogger + , lens + , process + , regex-tdfa >=1.3.1.0 + , shake >=0.17.5 + , text + , unordered-containers + + if os(windows) + build-depends: + Win32 + else + build-depends: + unix + + ghc-options: -Wall -Wredundant-constraints -Wno-name-shadowing + + if flag(pedantic) + ghc-options: -Werror + + default-language: Haskell2010
src/Ide/Logger.hs view
@@ -1,43 +1,29 @@-{- | Provides an implementation of the ghcide @Logger@ which uses- @System.Log.Logger@ under the hood.--}-module Ide.Logger- (- hlsLogger- , logm- , debugm- , warningm- , errorm- ) where--import Control.Monad.IO.Class-import qualified Data.Text as T-import qualified Development.IDE.Types.Logger as L-import System.Log.Logger---- -----------------------------------------------------------------------hlsLogger :: L.Logger-hlsLogger = L.Logger $ \pri txt ->- case pri of- L.Telemetry -> logm (T.unpack txt)- L.Debug -> debugm (T.unpack txt)- L.Info -> logm (T.unpack txt)- L.Warning -> warningm (T.unpack txt)- L.Error -> errorm (T.unpack txt)---- -----------------------------------------------------------------------logm :: MonadIO m => String -> m ()-logm s = liftIO $ infoM "hls" s--debugm :: MonadIO m => String -> m ()-debugm s = liftIO $ debugM "hls" s--warningm :: MonadIO m => String -> m ()-warningm s = liftIO $ warningM "hls" s--errorm :: MonadIO m => String -> m ()-errorm s = liftIO $ errorM "hls" s---- ---------------------------------------------------------------------+{- | Provides an implementation of the ghcide @Logger@ which uses + @System.Log.Logger@ under the hood. +-} +module Ide.Logger + ( + logm + , debugm + , warningm + , errorm + ) where + +import Control.Monad.IO.Class +import System.Log.Logger + +-- --------------------------------------------------------------------- + +logm :: MonadIO m => String -> m () +logm s = liftIO $ infoM "hls" s + +debugm :: MonadIO m => String -> m () +debugm s = liftIO $ debugM "hls" s + +warningm :: MonadIO m => String -> m () +warningm s = liftIO $ warningM "hls" s + +errorm :: MonadIO m => String -> m () +errorm s = liftIO $ errorM "hls" s + +-- ---------------------------------------------------------------------
− src/Ide/Plugin.hs
@@ -1,603 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Ide.Plugin- (- asGhcIdePlugin- , pluginDescToIdePlugins- , mkLspCommand- , mkLspCmdId- , allLspCmdIds- , allLspCmdIds'- , getPid- , responseError- , getClientConfig- , getClientConfigAction- ) where--import Control.Exception(SomeException, catch)-import Control.Lens ( (^.) )-import Control.Monad-import qualified Data.Aeson as J-import qualified Data.Default-import Data.Either-import Data.Hashable (unhashed)-import qualified Data.List as List-import qualified Data.Map as Map-import Data.Maybe-import qualified Data.Text as T-import Development.IDE hiding (pluginRules)-import Development.IDE.LSP.Server-import GHC.Generics-import Ide.Logger-import Ide.Plugin.Config-import Ide.Plugin.Formatter-import Ide.Types-import qualified Language.Haskell.LSP.Core as LSP-import Language.Haskell.LSP.Messages-import Language.Haskell.LSP.Types-import qualified Language.Haskell.LSP.Types as J-import qualified Language.Haskell.LSP.Types.Capabilities as C-import Language.Haskell.LSP.Types.Lens as L hiding (formatting, rangeFormatting)-import qualified Language.Haskell.LSP.VFS as VFS-import Text.Regex.TDFA.Text()---- ------------------------------------------------------------------------- | Map a set of plugins to the underlying ghcide engine. Main point is--- IdePlugins are arranged by kind of operation, 'Plugin' is arranged by message--- category ('Notifaction', 'Request' etc).-asGhcIdePlugin :: IdePlugins -> Plugin Config-asGhcIdePlugin mp =- mkPlugin rulesPlugins (Just . pluginRules) <>- mkPlugin executeCommandPlugins (Just . pluginCommands) <>- mkPlugin codeActionPlugins pluginCodeActionProvider <>- mkPlugin codeLensPlugins pluginCodeLensProvider <>- -- Note: diagnostics are provided via Rules from pluginDiagnosticProvider- mkPlugin hoverPlugins pluginHoverProvider <>- mkPlugin symbolsPlugins pluginSymbolsProvider <>- mkPlugin formatterPlugins pluginFormattingProvider <>- mkPlugin completionsPlugins pluginCompletionProvider <>- mkPlugin renamePlugins pluginRenameProvider- where- justs (p, Just x) = [(p, x)]- justs (_, Nothing) = []-- ls = Map.toList (ipMap mp)-- mkPlugin :: ([(PluginId, b)] -> Plugin Config) -> (PluginDescriptor -> Maybe b) -> Plugin Config- mkPlugin maker selector =- case concatMap (\(pid, p) -> justs (pid, selector p)) ls of- -- If there are no plugins that provide a descriptor, use mempty to- -- create the plugin – otherwise we we end up declaring handlers for- -- capabilities that there are no plugins for- [] -> mempty- xs -> maker xs---pluginDescToIdePlugins :: [PluginDescriptor] -> IdePlugins-pluginDescToIdePlugins plugins = IdePlugins $ Map.fromList $ map (\p -> (pluginId p, p)) plugins--allLspCmdIds' :: T.Text -> IdePlugins -> [T.Text]-allLspCmdIds' pid mp = mkPlugin (allLspCmdIds pid) (Just . pluginCommands)- where- justs (p, Just x) = [(p, x)]- justs (_, Nothing) = []-- ls = Map.toList (ipMap mp)-- mkPlugin maker selector- = maker $ concatMap (\(pid, p) -> justs (pid, selector p)) ls---- -----------------------------------------------------------------------rulesPlugins :: [(PluginId, Rules ())] -> Plugin Config-rulesPlugins rs = Plugin rules mempty- where- rules = mconcat $ map snd rs--codeActionPlugins :: [(PluginId, CodeActionProvider)] -> Plugin Config-codeActionPlugins cas = Plugin codeActionRules (codeActionHandlers cas)--codeActionRules :: Rules ()-codeActionRules = mempty--codeActionHandlers :: [(PluginId, CodeActionProvider)] -> PartialHandlers Config-codeActionHandlers cas = PartialHandlers $ \WithMessage{..} x -> return x- { LSP.codeActionHandler- = withResponse RspCodeAction (makeCodeAction cas)- }--makeCodeAction :: [(PluginId, CodeActionProvider)]- -> LSP.LspFuncs Config -> IdeState- -> CodeActionParams- -> IO (Either ResponseError (List CAResult))-makeCodeAction cas lf ideState (CodeActionParams docId range context _) = do- let caps = LSP.clientCapabilities lf- unL (List ls) = ls- r <- mapM (\(pid,provider) -> provider lf ideState pid docId range context) cas- let actions = filter wasRequested . concat $ map unL $ rights r- res <- send caps actions- return $ Right res- where- wasRequested :: CAResult -> Bool- wasRequested (CACommand _) = True- wasRequested (CACodeAction ca)- | Nothing <- only context = True- | Just (List allowed) <- only context- , Just caKind <- ca ^. kind = caKind `elem` allowed- | otherwise = False-- wrapCodeAction :: C.ClientCapabilities -> CAResult -> IO (Maybe CAResult)- wrapCodeAction _ (CACommand cmd) = return $ Just (CACommand cmd)- wrapCodeAction caps (CACodeAction action) = do-- let (C.ClientCapabilities _ textDocCaps _ _) = caps- let literalSupport = textDocCaps >>= C._codeAction >>= C._codeActionLiteralSupport-- case literalSupport of- Nothing -> do- let cmdParams = [J.toJSON (FallbackCodeActionParams (action ^. edit) (action ^. command))]- cmd <- mkLspCommand "hls" "fallbackCodeAction" (action ^. title) (Just cmdParams)- return $ Just (CACommand cmd)- Just _ -> return $ Just (CACodeAction action)-- send :: C.ClientCapabilities -> [CAResult] -> IO (List CAResult)- send caps codeActions = List . catMaybes <$> mapM (wrapCodeAction caps) codeActions--data FallbackCodeActionParams =- FallbackCodeActionParams- { fallbackWorkspaceEdit :: Maybe WorkspaceEdit- , fallbackCommand :: Maybe Command- }- deriving (Generic, J.ToJSON, J.FromJSON)---- -------------------------------------------------------------codeLensPlugins :: [(PluginId, CodeLensProvider)] -> Plugin Config-codeLensPlugins cas = Plugin codeLensRules (codeLensHandlers cas)--codeLensRules :: Rules ()-codeLensRules = mempty--codeLensHandlers :: [(PluginId, CodeLensProvider)] -> PartialHandlers Config-codeLensHandlers cas = PartialHandlers $ \WithMessage{..} x -> return x- { LSP.codeLensHandler- = withResponse RspCodeLens (makeCodeLens cas)- }--makeCodeLens :: [(PluginId, CodeLensProvider)]- -> LSP.LspFuncs Config- -> IdeState- -> CodeLensParams- -> IO (Either ResponseError (List CodeLens))-makeCodeLens cas lf ideState params = do- logInfo (ideLogger ideState) "Plugin.makeCodeLens (ideLogger)" -- AZ- let- makeLens (pid, provider) = do- r <- provider lf ideState pid params- return (pid, r)- breakdown :: [(PluginId, Either ResponseError a)] -> ([(PluginId, ResponseError)], [(PluginId, a)])- breakdown ls = (concatMap doOneLeft ls, concatMap doOneRight ls)- where- doOneLeft (pid, Left err) = [(pid,err)]- doOneLeft (_, Right _) = []-- doOneRight (pid, Right a) = [(pid,a)]- doOneRight (_, Left _) = []-- r <- mapM makeLens cas- case breakdown r of- ([],[]) -> return $ Right $ List []- (es,[]) -> return $ Left $ ResponseError InternalError (T.pack $ "codeLens failed:" ++ show es) Nothing- (_,rs) -> return $ Right $ List (concatMap (\(_,List cs) -> cs) rs)---- -------------------------------------------------------------executeCommandPlugins :: [(PluginId, [PluginCommand])] -> Plugin Config-executeCommandPlugins ecs = Plugin mempty (executeCommandHandlers ecs)--executeCommandHandlers :: [(PluginId, [PluginCommand])] -> PartialHandlers Config-executeCommandHandlers ecs = PartialHandlers $ \WithMessage{..} x -> return x{- LSP.executeCommandHandler = withResponseAndRequest RspExecuteCommand ReqApplyWorkspaceEdit (makeExecuteCommands ecs)- }---- type ExecuteCommandProvider = IdeState--- -> ExecuteCommandParams--- -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))-makeExecuteCommands :: [(PluginId, [PluginCommand])] -> LSP.LspFuncs Config -> ExecuteCommandProvider-makeExecuteCommands ecs lf ide = wrapUnhandledExceptions $ do- let- pluginMap = Map.fromList ecs- parseCmdId :: T.Text -> Maybe (PluginId, CommandId)- parseCmdId x = case T.splitOn ":" x of- [plugin, command] -> Just (PluginId plugin, CommandId command)- [_, plugin, command] -> Just (PluginId plugin, CommandId command)- _ -> Nothing-- execCmd :: ExecuteCommandParams -> IO (Either ResponseError J.Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))- execCmd (ExecuteCommandParams cmdId args _) = do- -- The parameters to the HIE command are always the first element- let cmdParams :: J.Value- cmdParams = case args of- Just (J.List (x:_)) -> x- _ -> J.Null-- case parseCmdId cmdId of- -- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions- Just ("hls", "fallbackCodeAction") ->- case J.fromJSON cmdParams of- J.Success (FallbackCodeActionParams mEdit mCmd) -> do-- -- Send off the workspace request if it has one- forM_ mEdit $ \edit -> do- let eParams = J.ApplyWorkspaceEditParams edit- reqId <- LSP.getNextReqId lf- LSP.sendFunc lf $ ReqApplyWorkspaceEdit $ RequestMessage "2.0" reqId WorkspaceApplyEdit eParams-- case mCmd of- -- If we have a command, continue to execute it- Just (J.Command _ innerCmdId innerArgs)- -> execCmd (ExecuteCommandParams innerCmdId innerArgs Nothing)- Nothing -> return (Right J.Null, Nothing)-- J.Error _str -> return (Right J.Null, Nothing)- -- Couldn't parse the fallback command params- -- _ -> liftIO $- -- LSP.sendErrorResponseS (LSP.sendFunc lf)- -- (J.responseId (req ^. J.id))- -- J.InvalidParams- -- "Invalid fallbackCodeAction params"-- -- Just an ordinary HIE command- Just (plugin, cmd) -> runPluginCommand pluginMap lf ide plugin cmd cmdParams-- -- Couldn't parse the command identifier- _ -> return (Left $ ResponseError InvalidParams "Invalid command identifier" Nothing, Nothing)-- execCmd--{-- ReqExecuteCommand req -> do- liftIO $ U.logs $ "reactor:got ExecuteCommandRequest:" ++ show req- lf <- asks lspFuncs-- let params = req ^. J.params-- parseCmdId :: T.Text -> Maybe (PluginId, CommandId)- parseCmdId x = case T.splitOn ":" x of- [plugin, command] -> Just (PluginId plugin, CommandId command)- [_, plugin, command] -> Just (PluginId plugin, CommandId command)- _ -> Nothing-- callback obj = do- liftIO $ U.logs $ "ExecuteCommand response got:r=" ++ show obj- case fromDynJSON obj :: Maybe J.WorkspaceEdit of- Just v -> do- lid <- nextLspReqId- reactorSend $ RspExecuteCommand $ Core.makeResponseMessage req (A.Object mempty)- let msg = fmServerApplyWorkspaceEditRequest lid $ J.ApplyWorkspaceEditParams v- liftIO $ U.logs $ "ExecuteCommand sending edit: " ++ show msg- reactorSend $ ReqApplyWorkspaceEdit msg- Nothing -> reactorSend $ RspExecuteCommand $ Core.makeResponseMessage req $ dynToJSON obj-- execCmd cmdId args = do- -- The parameters to the HIE command are always the first element- let cmdParams = case args of- Just (J.List (x:_)) -> x- _ -> A.Null-- case parseCmdId cmdId of- -- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions- Just ("hls", "fallbackCodeAction") -> do- case A.fromJSON cmdParams of- A.Success (FallbackCodeActionParams mEdit mCmd) -> do-- -- Send off the workspace request if it has one- forM_ mEdit $ \edit -> do- lid <- nextLspReqId- let eParams = J.ApplyWorkspaceEditParams edit- eReq = fmServerApplyWorkspaceEditRequest lid eParams- reactorSend $ ReqApplyWorkspaceEdit eReq-- case mCmd of- -- If we have a command, continue to execute it- Just (J.Command _ innerCmdId innerArgs) -> execCmd innerCmdId innerArgs-- -- Otherwise we need to send back a response oureslves- Nothing -> reactorSend $ RspExecuteCommand $ Core.makeResponseMessage req (A.Object mempty)-- -- Couldn't parse the fallback command params- _ -> liftIO $- Core.sendErrorResponseS (Core.sendFunc lf)- (J.responseId (req ^. J.id))- J.InvalidParams- "Invalid fallbackCodeAction params"- -- Just an ordinary HIE command- Just (plugin, cmd) ->- let preq = GReq tn "plugin" Nothing Nothing (Just $ req ^. J.id) callback (toDynJSON (Nothing :: Maybe J.WorkspaceEdit))- $ runPluginCommand plugin cmd cmdParams- in makeRequest preq-- -- Couldn't parse the command identifier- _ -> liftIO $- Core.sendErrorResponseS (Core.sendFunc lf)- (J.responseId (req ^. J.id))- J.InvalidParams- "Invalid command identifier"-- execCmd (params ^. J.command) (params ^. J.arguments)--}---- ------------------------------------------------------------wrapUnhandledExceptions ::- (a -> IO (Either ResponseError J.Value, Maybe b)) ->- a -> IO (Either ResponseError J.Value, Maybe b)-wrapUnhandledExceptions action input =- catch (action input) $ \(e::SomeException) -> do- let resp = ResponseError InternalError (T.pack $ show e) Nothing- return (Left resp, Nothing)----- | Runs a plugin command given a PluginId, CommandId and--- arguments in the form of a JSON object.-runPluginCommand :: Map.Map PluginId [PluginCommand]- -> LSP.LspFuncs Config- -> IdeState- -> PluginId- -> CommandId- -> J.Value- -> IO (Either ResponseError J.Value,- Maybe (ServerMethod, ApplyWorkspaceEditParams))-runPluginCommand m lf ide p@(PluginId p') com@(CommandId com') arg =- case Map.lookup p m of- Nothing -> return- (Left $ ResponseError InvalidRequest ("Plugin " <> p' <> " doesn't exist") Nothing, Nothing)- Just xs -> case List.find ((com ==) . commandId) xs of- Nothing -> return (Left $- ResponseError InvalidRequest ("Command " <> com' <> " isn't defined for plugin " <> p'- <> ". Legal commands are: " <> T.pack(show $ map commandId xs)) Nothing, Nothing)- Just (PluginCommand _ _ f) -> case J.fromJSON arg of- J.Error err -> return (Left $- ResponseError InvalidParams ("error while parsing args for " <> com' <> " in plugin " <> p'- <> ": " <> T.pack err- <> "\narg = " <> T.pack (show arg)) Nothing, Nothing)- J.Success a -> f lf ide a---- lsp-request: error while parsing args for typesignature.add in plugin ghcide:--- When parsing the record ExecuteCommandParams of type--- Language.Haskell.LSP.Types.DataTypesJSON.ExecuteCommandParams the key command--- was not present.---- -------------------------------------------------------------mkLspCommand :: PluginId -> CommandId -> T.Text -> Maybe [J.Value] -> IO Command-mkLspCommand plid cn title args' = do- pid <- getPid- let cmdId = mkLspCmdId pid plid cn- let args = List <$> args'- return $ Command title cmdId args--mkLspCmdId :: T.Text -> PluginId -> CommandId -> T.Text-mkLspCmdId pid (PluginId plid) (CommandId cid)- = pid <> ":" <> plid <> ":" <> cid--allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand])] -> [T.Text]-allLspCmdIds pid commands = concat $ map go commands- where- go (plid, cmds) = map (mkLspCmdId pid plid . commandId) cmds---- -----------------------------------------------------------------------hoverPlugins :: [(PluginId, HoverProvider)] -> Plugin Config-hoverPlugins hs = Plugin hoverRules (hoverHandlers hs)--hoverRules :: Rules ()-hoverRules = mempty--hoverHandlers :: [(PluginId, HoverProvider)] -> PartialHandlers Config-hoverHandlers hps = PartialHandlers $ \WithMessage{..} x ->- return x{LSP.hoverHandler = withResponse RspHover (makeHover hps)}--makeHover :: [(PluginId, HoverProvider)]- -> LSP.LspFuncs Config -> IdeState- -> TextDocumentPositionParams- -> IO (Either ResponseError (Maybe Hover))-makeHover hps _lf ideState params- = do- mhs <- mapM (\(_,p) -> p ideState params) hps- -- TODO: We should support ServerCapabilities and declare that- -- we don't support hover requests during initialization if we- -- don't have any hover providers- -- TODO: maybe only have provider give MarkedString and- -- work out range here?- let hs = catMaybes (rights mhs)- r = listToMaybe $ mapMaybe (^. range) hs- h = case mconcat ((map (^. contents) hs) :: [HoverContents]) of- HoverContentsMS (List []) -> Nothing- hh -> Just $ Hover hh r- return $ Right h---- ------------------------------------------------------------------------ -----------------------------------------------------------------------symbolsPlugins :: [(PluginId, SymbolsProvider)] -> Plugin Config-symbolsPlugins hs = Plugin symbolsRules (symbolsHandlers hs)--symbolsRules :: Rules ()-symbolsRules = mempty--symbolsHandlers :: [(PluginId, SymbolsProvider)] -> PartialHandlers Config-symbolsHandlers hps = PartialHandlers $ \WithMessage{..} x ->- return x {LSP.documentSymbolHandler = withResponse RspDocumentSymbols (makeSymbols hps)}--makeSymbols :: [(PluginId, SymbolsProvider)]- -> LSP.LspFuncs Config- -> IdeState- -> DocumentSymbolParams- -> IO (Either ResponseError DSResult)-makeSymbols sps lf ideState params- = do- let uri' = params ^. textDocument . uri- (C.ClientCapabilities _ tdc _ _) = LSP.clientCapabilities lf- supportsHierarchy = fromMaybe False $ tdc >>= C._documentSymbol- >>= C._hierarchicalDocumentSymbolSupport- convertSymbols :: [DocumentSymbol] -> DSResult- convertSymbols symbs- | supportsHierarchy = DSDocumentSymbols $ List symbs- | otherwise = DSSymbolInformation (List $ concatMap (go Nothing) symbs)- where- go :: Maybe T.Text -> DocumentSymbol -> [SymbolInformation]- go parent ds =- let children' :: [SymbolInformation]- children' = concatMap (go (Just name')) (fromMaybe mempty (ds ^. children))- loc = Location uri' (ds ^. range)- name' = ds ^. name- si = SymbolInformation name' (ds ^. kind) (ds ^. deprecated) loc parent- in [si] <> children'-- mhs <- mapM (\(_,p) -> p lf ideState params) sps- case rights mhs of- [] -> return $ Left $ responseError $ T.pack $ show $ lefts mhs- hs -> return $ Right $ convertSymbols $ concat hs----- ------------------------------------------------------------------------ -----------------------------------------------------------------------renamePlugins :: [(PluginId, RenameProvider)] -> Plugin Config-renamePlugins providers = Plugin rules handlers- where- rules = mempty- handlers = PartialHandlers $ \WithMessage{..} x -> return x- { LSP.renameHandler = withResponse RspRename (renameWith providers)}--renameWith ::- [(PluginId, RenameProvider)] ->- LSP.LspFuncs Config ->- IdeState ->- RenameParams ->- IO (Either ResponseError WorkspaceEdit)-renameWith providers lspFuncs state params = do- results <- mapM (\(_,p) -> p lspFuncs state params) providers- case partitionEithers results of- (errors, []) -> return $ Left $ responseError $ T.pack $ show $ errors- (_, edits) -> return $ Right $ mconcat edits---- ------------------------------------------------------------------------ -----------------------------------------------------------------------formatterPlugins :: [(PluginId, FormattingProvider IO)] -> Plugin Config-formatterPlugins providers- = Plugin formatterRules- (formatterHandlers (Map.fromList (("none",noneProvider):providers)))--formatterRules :: Rules ()-formatterRules = mempty--formatterHandlers :: Map.Map PluginId (FormattingProvider IO) -> PartialHandlers Config-formatterHandlers providers = PartialHandlers $ \WithMessage{..} x -> return x- { LSP.documentFormattingHandler- = withResponse RspDocumentFormatting (formatting providers)- , LSP.documentRangeFormattingHandler- = withResponse RspDocumentRangeFormatting (rangeFormatting providers)- }---- ------------------------------------------------------------------------ -----------------------------------------------------------------------completionsPlugins :: [(PluginId, CompletionProvider)] -> Plugin Config-completionsPlugins cs = Plugin completionsRules (completionsHandlers cs)--completionsRules :: Rules ()-completionsRules = mempty--completionsHandlers :: [(PluginId, CompletionProvider)] -> PartialHandlers Config-completionsHandlers cps = PartialHandlers $ \WithMessage{..} x ->- return x {LSP.completionHandler = withResponse RspCompletion (makeCompletions cps)}--makeCompletions :: [(PluginId, CompletionProvider)]- -> LSP.LspFuncs Config- -> IdeState- -> CompletionParams- -> IO (Either ResponseError CompletionResponseResult)-makeCompletions sps lf ideState params@(CompletionParams (TextDocumentIdentifier doc) pos _context _mt)- = do- mprefix <- getPrefixAtPos lf doc pos- _snippets <- WithSnippets <$> completionSnippetsOn <$> (getClientConfig lf)-- let- combine :: [CompletionResponseResult] -> CompletionResponseResult- combine cs = go (Completions $ List []) cs- where- go acc [] = acc- go (Completions (List ls)) (Completions (List ls2):rest)- = go (Completions (List (ls <> ls2))) rest- go (Completions (List ls)) (CompletionList (CompletionListType complete (List ls2)):rest)- = go (CompletionList $ CompletionListType complete (List (ls <> ls2))) rest- go (CompletionList (CompletionListType complete (List ls))) (CompletionList (CompletionListType complete2 (List ls2)):rest)- = go (CompletionList $ CompletionListType (complete || complete2) (List (ls <> ls2))) rest- go (CompletionList (CompletionListType complete (List ls))) (Completions (List ls2):rest)- = go (CompletionList $ CompletionListType complete (List (ls <> ls2))) rest-- case mprefix of- Nothing -> return $ Right $ Completions $ List []- Just _prefix -> do- mhs <- mapM (\(_,p) -> p lf ideState params) sps- case rights mhs of- [] -> return $ Left $ responseError $ T.pack $ show $ lefts mhs- hs -> return $ Right $ combine hs--{-- ReqCompletion req -> do- liftIO $ U.logs $ "reactor:got CompletionRequest:" ++ show req- let (_, doc, pos) = reqParams req-- mprefix <- getPrefixAtPos doc pos-- let callback compls = do- let rspMsg = Core.makeResponseMessage req- $ J.Completions $ J.List compls- reactorSend $ RspCompletion rspMsg- case mprefix of- Nothing -> callback []- Just prefix -> do- snippets <- Completions.WithSnippets <$> configVal completionSnippetsOn- let hreq = IReq tn "completion" (req ^. J.id) callback- $ lift $ Completions.getCompletions doc prefix snippets- makeRequest hreq--}--getPrefixAtPos :: LSP.LspFuncs Config -> Uri -> Position -> IO (Maybe VFS.PosPrefixInfo)-getPrefixAtPos lf uri pos = do- mvf <- (LSP.getVirtualFileFunc lf) (J.toNormalizedUri uri)- case mvf of- Just vf -> VFS.getCompletionPrefix pos vf- Nothing -> return Nothing---- ------------------------------------------------------------------------ | Returns the current client configuration. It is not wise to permanently--- cache the returned value of this function, as clients can at runitime change--- their configuration.------ If no custom configuration has been set by the client, this function returns--- our own defaults.-getClientConfig :: LSP.LspFuncs Config -> IO Config-getClientConfig lf = fromMaybe Data.Default.def <$> LSP.config lf---- | Returns the client configurarion stored in the IdeState.--- You can use this function to access it from shake Rules-getClientConfigAction :: Action Config-getClientConfigAction = do- mbVal <- unhashed <$> useNoFile_ GetClientSettings- logm $ "getClientConfigAction:clientSettings:" ++ show mbVal- case J.fromJSON <$> mbVal of- Just (J.Success c) -> return c- _ -> return Data.Default.def--- ---------------------------------------------------------------------
src/Ide/Plugin/Config.hs view
@@ -1,107 +1,196 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}-module Ide.Plugin.Config- (- getInitialConfig- , getConfigFromNotification- , Config(..)- ) where--import Control.Applicative-import qualified Data.Aeson as A-import Data.Aeson hiding ( Error )-import Data.Default-import qualified Data.Text as T-import Language.Haskell.LSP.Types---- ------------------------------------------------------------------------- | Given a DidChangeConfigurationNotification message, this function returns the parsed--- Config object if possible.-getConfigFromNotification :: DidChangeConfigurationNotification -> Either T.Text Config-getConfigFromNotification (NotificationMessage _ _ (DidChangeConfigurationParams p)) =- case fromJSON p of- A.Success c -> Right c- A.Error err -> Left $ T.pack err---- | Given an InitializeRequest message, this function returns the parsed--- Config object if possible. Otherwise, it returns the default configuration-getInitialConfig :: InitializeRequest -> Either T.Text Config-getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Nothing }) = Right def-getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Just opts}) =- case fromJSON opts of- A.Success c -> Right c- A.Error err -> Left $ T.pack err---- ------------------------------------------------------------------------- | We (initially anyway) mirror the hie configuration, so that existing--- clients can simply switch executable and not have any nasty surprises. There--- will be surprises relating to config options being ignored, initially though.-data Config =- Config- { hlintOn :: Bool- , diagnosticsOnChange :: Bool- , maxNumberOfProblems :: Int- , diagnosticsDebounceDuration :: Int- , liquidOn :: Bool- , completionSnippetsOn :: Bool- , formatOnImportOn :: Bool- , formattingProvider :: T.Text- } deriving (Show,Eq)--instance Default Config where- def = Config- { hlintOn = True- , diagnosticsOnChange = True- , maxNumberOfProblems = 100- , diagnosticsDebounceDuration = 350000- , liquidOn = False- , completionSnippetsOn = True- , formatOnImportOn = True- -- , formattingProvider = "brittany"- , formattingProvider = "ormolu"- -- , formattingProvider = "floskell"- -- , formattingProvider = "stylish-haskell"- }---- TODO: Add API for plugins to expose their own LSP config options-instance A.FromJSON Config where- parseJSON = A.withObject "Config" $ \v -> do- -- Officially, we use "haskell" as the section name but for- -- backwards compatibility we also accept "languageServerHaskell"- s <- v .: "haskell" <|> v .: "languageServerHaskell"- flip (A.withObject "Config.settings") s $ \o -> Config- <$> o .:? "hlintOn" .!= hlintOn def- <*> o .:? "diagnosticsOnChange" .!= diagnosticsOnChange def- <*> o .:? "maxNumberOfProblems" .!= maxNumberOfProblems def- <*> o .:? "diagnosticsDebounceDuration" .!= diagnosticsDebounceDuration def- <*> o .:? "liquidOn" .!= liquidOn def- <*> o .:? "completionSnippetsOn" .!= completionSnippetsOn def- <*> o .:? "formatOnImportOn" .!= formatOnImportOn def- <*> o .:? "formattingProvider" .!= formattingProvider def---- 2017-10-09 23:22:00.710515298 [ThreadId 11] - ---> {"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"haskell":{"maxNumberOfProblems":100,"hlintOn":true}}}}--- 2017-10-09 23:22:00.710667381 [ThreadId 15] - reactor:got didChangeConfiguration notification:--- NotificationMessage--- {_jsonrpc = "2.0"--- , _method = WorkspaceDidChangeConfiguration--- , _params = DidChangeConfigurationParams--- {_settings = Object (fromList [("haskell",Object (fromList [("hlintOn",Bool True)--- ,("maxNumberOfProblems",Number 100.0)]))])}}--instance A.ToJSON Config where- toJSON (Config h diag m d l c f fp) = object [ "haskell" .= r ]- where- r = object [ "hlintOn" .= h- , "diagnosticsOnChange" .= diag- , "maxNumberOfProblems" .= m- , "diagnosticsDebounceDuration" .= d- , "liquidOn" .= l- , "completionSnippetsOn" .= c- , "formatOnImportOn" .= f- , "formattingProvider" .= fp- ]+{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Ide.Plugin.Config + ( + getInitialConfig + , getConfigFromNotification + , Config(..) + , PluginConfig(..) + , CheckParents(..) + ) where + +import Control.Applicative +import qualified Data.Aeson as A +import Data.Aeson hiding ( Error ) +import Data.Default +import qualified Data.Text as T +import Language.Haskell.LSP.Types +import qualified Data.Map as Map +import GHC.Generics (Generic) + +-- --------------------------------------------------------------------- + +-- | Given a DidChangeConfigurationNotification message, this function returns the parsed +-- Config object if possible. +getConfigFromNotification :: DidChangeConfigurationNotification -> Either T.Text Config +getConfigFromNotification (NotificationMessage _ _ (DidChangeConfigurationParams p)) = + case fromJSON p of + A.Success c -> Right c + A.Error err -> Left $ T.pack err + +-- | Given an InitializeRequest message, this function returns the parsed +-- Config object if possible. Otherwise, it returns the default configuration +getInitialConfig :: InitializeRequest -> Either T.Text Config +getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Nothing }) = Right def +getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Just opts}) = + case fromJSON opts of + A.Success c -> Right c + A.Error err -> Left $ T.pack err + +-- --------------------------------------------------------------------- +data CheckParents + -- Note that ordering of constructors is meaningful and must be monotonically + -- increasing in the scenarios where parents are checked + = NeverCheck + | CheckOnClose + | CheckOnSaveAndClose + | AlwaysCheck + deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (FromJSON, ToJSON) + + +-- | We (initially anyway) mirror the hie configuration, so that existing +-- clients can simply switch executable and not have any nasty surprises. There +-- will be surprises relating to config options being ignored, initially though. +data Config = + Config + { checkParents :: CheckParents + , checkProject :: !Bool + , hlintOn :: !Bool + , diagnosticsOnChange :: !Bool + , maxNumberOfProblems :: !Int + , diagnosticsDebounceDuration :: !Int + , liquidOn :: !Bool + , completionSnippetsOn :: !Bool + , formatOnImportOn :: !Bool + , formattingProvider :: !T.Text + , plugins :: !(Map.Map T.Text PluginConfig) + } deriving (Show,Eq) + +instance Default Config where + def = Config + { checkParents = CheckOnSaveAndClose + , checkProject = True + , hlintOn = True + , diagnosticsOnChange = True + , maxNumberOfProblems = 100 + , diagnosticsDebounceDuration = 350000 + , liquidOn = False + , completionSnippetsOn = True + , formatOnImportOn = True + -- , formattingProvider = "brittany" + , formattingProvider = "ormolu" + -- , formattingProvider = "floskell" + -- , formattingProvider = "stylish-haskell" + , plugins = Map.empty + } + +-- TODO: Add API for plugins to expose their own LSP config options +instance A.FromJSON Config where + parseJSON = A.withObject "Config" $ \v -> do + -- Officially, we use "haskell" as the section name but for + -- backwards compatibility we also accept "languageServerHaskell" + s <- v .: "haskell" <|> v .: "languageServerHaskell" + flip (A.withObject "Config.settings") s $ \o -> Config + <$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents def + <*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject def + <*> o .:? "hlintOn" .!= hlintOn def + <*> o .:? "diagnosticsOnChange" .!= diagnosticsOnChange def + <*> o .:? "maxNumberOfProblems" .!= maxNumberOfProblems def + <*> o .:? "diagnosticsDebounceDuration" .!= diagnosticsDebounceDuration def + <*> o .:? "liquidOn" .!= liquidOn def + <*> o .:? "completionSnippetsOn" .!= completionSnippetsOn def + <*> o .:? "formatOnImportOn" .!= formatOnImportOn def + <*> o .:? "formattingProvider" .!= formattingProvider def + <*> o .:? "plugin" .!= plugins def + +-- 2017-10-09 23:22:00.710515298 [ThreadId 11] - ---> {"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"haskell":{"maxNumberOfProblems":100,"hlintOn":true}}}} +-- 2017-10-09 23:22:00.710667381 [ThreadId 15] - reactor:got didChangeConfiguration notification: +-- NotificationMessage +-- {_jsonrpc = "2.0" +-- , _method = WorkspaceDidChangeConfiguration +-- , _params = DidChangeConfigurationParams +-- {_settings = Object (fromList [("haskell",Object (fromList [("hlintOn",Bool True) +-- ,("maxNumberOfProblems",Number 100.0)]))])}} + +instance A.ToJSON Config where + toJSON Config{..} = + object [ "haskell" .= r ] + where + r = object [ "checkParents" .= checkParents + , "checkProject" .= checkProject + , "hlintOn" .= hlintOn + , "diagnosticsOnChange" .= diagnosticsOnChange + , "maxNumberOfProblems" .= maxNumberOfProblems + , "diagnosticsDebounceDuration" .= diagnosticsDebounceDuration + , "liquidOn" .= liquidOn + , "completionSnippetsOn" .= completionSnippetsOn + , "formatOnImportOn" .= formatOnImportOn + , "formattingProvider" .= formattingProvider + , "plugin" .= plugins + ] + +-- --------------------------------------------------------------------- + +-- | A PluginConfig is a generic configuration for a given HLS plugin. It +-- provides a "big switch" to turn it on or off as a whole, as well as small +-- switches per feature, and a slot for custom config. +-- This provides a regular naming scheme for all plugin config. +data PluginConfig = + PluginConfig + { plcGlobalOn :: !Bool + , plcCodeActionsOn :: !Bool + , plcCodeLensOn :: !Bool + , plcDiagnosticsOn :: !Bool + , plcHoverOn :: !Bool + , plcSymbolsOn :: !Bool + , plcCompletionOn :: !Bool + , plcRenameOn :: !Bool + , plcConfig :: !A.Object + } deriving (Show,Eq) + +instance Default PluginConfig where + def = PluginConfig + { plcGlobalOn = True + , plcCodeActionsOn = True + , plcCodeLensOn = True + , plcDiagnosticsOn = True + , plcHoverOn = True + , plcSymbolsOn = True + , plcCompletionOn = True + , plcRenameOn = True + , plcConfig = mempty + } + +instance A.ToJSON PluginConfig where + toJSON (PluginConfig g ca cl d h s c rn cfg) = r + where + r = object [ "globalOn" .= g + , "codeActionsOn" .= ca + , "codeLensOn" .= cl + , "diagnosticsOn" .= d + , "hoverOn" .= h + , "symbolsOn" .= s + , "completionOn" .= c + , "renameOn" .= rn + , "config" .= cfg + ] + +instance A.FromJSON PluginConfig where + parseJSON = A.withObject "PluginConfig" $ \o -> PluginConfig + <$> o .:? "globalOn" .!= plcGlobalOn def + <*> o .:? "codeActionsOn" .!= plcCodeActionsOn def + <*> o .:? "codeLensOn" .!= plcCodeLensOn def + <*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ + <*> o .:? "hoverOn" .!= plcHoverOn def + <*> o .:? "symbolsOn" .!= plcSymbolsOn def + <*> o .:? "completionOn" .!= plcCompletionOn def + <*> o .:? "renameOn" .!= plcRenameOn def + <*> o .:? "config" .!= plcConfig def + +-- ---------------------------------------------------------------------
− src/Ide/Plugin/Formatter.hs
@@ -1,110 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ViewPatterns #-}--module Ide.Plugin.Formatter- (- formatting- , rangeFormatting- , noneProvider- , responseError- , extractRange- , fullRange- )-where--import qualified Data.Map as Map-import qualified Data.Text as T-import Development.IDE-import Ide.Types-import Ide.Plugin.Config-import qualified Language.Haskell.LSP.Core as LSP-import Language.Haskell.LSP.Types-import Text.Regex.TDFA.Text()---- -----------------------------------------------------------------------formatting :: Map.Map PluginId (FormattingProvider IO)- -> LSP.LspFuncs Config -> IdeState -> DocumentFormattingParams- -> IO (Either ResponseError (List TextEdit))-formatting providers lf ideState- (DocumentFormattingParams (TextDocumentIdentifier uri) params _mprogress)- = doFormatting lf providers ideState FormatText uri params---- -----------------------------------------------------------------------rangeFormatting :: Map.Map PluginId (FormattingProvider IO)- -> LSP.LspFuncs Config -> IdeState -> DocumentRangeFormattingParams- -> IO (Either ResponseError (List TextEdit))-rangeFormatting providers lf ideState- (DocumentRangeFormattingParams (TextDocumentIdentifier uri) range params _mprogress)- = doFormatting lf providers ideState (FormatRange range) uri params---- -----------------------------------------------------------------------doFormatting :: LSP.LspFuncs Config -> Map.Map PluginId (FormattingProvider IO)- -> IdeState -> FormattingType -> Uri -> FormattingOptions- -> IO (Either ResponseError (List TextEdit))-doFormatting lf providers ideState ft uri params = do- mc <- LSP.config lf- let mf = maybe "none" formattingProvider mc- case Map.lookup (PluginId mf) providers of- Just provider ->- case uriToFilePath uri of- Just (toNormalizedFilePath -> fp) -> do- (_, mb_contents) <- runAction "Formatter" ideState $ getFileContents fp- case mb_contents of- Just contents -> do- logDebug (ideLogger ideState) $ T.pack $- "Formatter.doFormatting: contents=" ++ show contents -- AZ- provider lf ideState ft contents fp params- Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri- Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri- Nothing -> return $ Left $ responseError $ mconcat- [ "Formatter plugin: no formatter found for:["- , mf- , "]"- , if mf == "brittany"- then T.unlines- [ "\nThe haskell-language-server must be compiled with the agpl flag to provide Brittany."- , "Stack users add 'agpl: true' in the flags section of the 'stack.yaml' file."- , "The 'haskell-language-server.cabal' file already has this flag enabled by default."- , "For more information see: https://github.com/haskell/haskell-language-server/issues/269"- ]- else ""- ]---- -----------------------------------------------------------------------noneProvider :: FormattingProvider IO-noneProvider _ _ _ _ _ _ = return $ Right (List [])---- -----------------------------------------------------------------------responseError :: T.Text -> ResponseError-responseError txt = ResponseError InvalidParams txt Nothing---- -----------------------------------------------------------------------extractRange :: Range -> T.Text -> T.Text-extractRange (Range (Position sl _) (Position el _)) s = newS- where focusLines = take (el-sl+1) $ drop sl $ T.lines s- newS = T.unlines focusLines---- | Gets the range that covers the entire text-fullRange :: T.Text -> Range-fullRange s = Range startPos endPos- where startPos = Position 0 0- endPos = Position lastLine 0- {-- In order to replace everything including newline characters,- the end range should extend below the last line. From the specification:- "If you want to specify a range that contains a line including- the line ending character(s) then use an end position denoting- the start of the next line"- -}- lastLine = length $ T.lines s---- ---------------------------------------------------------------------
− src/Ide/Plugin/GhcIde.hs
@@ -1,65 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}-module Ide.Plugin.GhcIde- (- descriptor- ) where--import Data.Aeson-import Development.IDE-import Development.IDE.Plugin.Completions-import Development.IDE.Plugin.CodeAction-import Development.IDE.LSP.HoverDefinition-import Development.IDE.LSP.Outline-import Ide.Plugin-import Ide.Types-import Language.Haskell.LSP.Types-import Text.Regex.TDFA.Text()---- -----------------------------------------------------------------------descriptor :: PluginId -> PluginDescriptor-descriptor plId = (defaultPluginDescriptor plId)- { pluginCommands = [PluginCommand (CommandId "typesignature.add") "adds a signature" commandAddSignature]- , pluginCodeActionProvider = Just codeAction'- , pluginCodeLensProvider = Just codeLens'- , pluginHoverProvider = Just hover'- , pluginSymbolsProvider = Just symbolsProvider- , pluginCompletionProvider = Just getCompletionsLSP- }---- -----------------------------------------------------------------------hover' :: HoverProvider-hover' ideState params = do- logInfo (ideLogger ideState) "GhcIde.hover entered (ideLogger)" -- AZ- hover ideState params---- -----------------------------------------------------------------------commandAddSignature :: CommandFunction WorkspaceEdit-commandAddSignature lf ide params- = commandHandler lf ide (ExecuteCommandParams "typesignature.add" (Just (List [toJSON params])) Nothing)---- -----------------------------------------------------------------------codeAction' :: CodeActionProvider-codeAction' lf ide _ doc range context = fmap List <$> codeAction lf ide doc range context---- -----------------------------------------------------------------------codeLens' :: CodeLensProvider-codeLens' lf ide _ params = codeLens lf ide params---- -----------------------------------------------------------------------symbolsProvider :: SymbolsProvider-symbolsProvider ls ide params = do- ds <- moduleOutline ls ide params- case ds of- Right (DSDocumentSymbols (List ls)) -> return $ Right ls- Right (DSSymbolInformation (List _si)) ->- return $ Left $ responseError "GhcIde.symbolsProvider: DSSymbolInformation deprecated"- Left err -> return $ Left err---- ---------------------------------------------------------------------
src/Ide/PluginUtils.hs view
@@ -1,110 +1,261 @@-{-# LANGUAGE OverloadedStrings #-}-module Ide.PluginUtils where--import qualified Data.Text as T-import Data.Maybe-import Data.Algorithm.DiffOutput-import Data.Algorithm.Diff-import qualified Data.HashMap.Strict as H-import Language.Haskell.LSP.Types.Capabilities-import qualified Language.Haskell.LSP.Types as J-import Language.Haskell.LSP.Types---- ------------------------------------------------------------------------- | Extend to the line below and above to replace newline character.-normalize :: Range -> Range-normalize (Range (Position sl _) (Position el _)) =- Range (Position sl 0) (Position (el + 1) 0)---- -----------------------------------------------------------------------data WithDeletions = IncludeDeletions | SkipDeletions- deriving Eq---- | Generate a 'WorkspaceEdit' value from a pair of source Text-diffText :: ClientCapabilities -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit-diffText clientCaps old new withDeletions =- let- supports = clientSupportsDocumentChanges clientCaps- in diffText' supports old new withDeletions--makeDiffTextEdit :: T.Text -> T.Text -> List TextEdit-makeDiffTextEdit f1 f2 = diffTextEdit f1 f2 IncludeDeletions--makeDiffTextEditAdditive :: T.Text -> T.Text -> List TextEdit-makeDiffTextEditAdditive f1 f2 = diffTextEdit f1 f2 SkipDeletions--diffTextEdit :: T.Text -> T.Text -> WithDeletions -> List TextEdit-diffTextEdit fText f2Text withDeletions = J.List r- where- r = map diffOperationToTextEdit diffOps- d = getGroupedDiff (lines $ T.unpack fText) (lines $ T.unpack f2Text)-- diffOps = filter (\x -> (withDeletions == IncludeDeletions) || not (isDeletion x))- (diffToLineRanges d)-- isDeletion (Deletion _ _) = True- isDeletion _ = False--- diffOperationToTextEdit :: DiffOperation LineRange -> J.TextEdit- diffOperationToTextEdit (Change fm to) = J.TextEdit range nt- where- range = calcRange fm- nt = T.pack $ init $ unlines $ lrContents to-- {-- In order to replace everything including newline characters,- the end range should extend below the last line. From the specification:- "If you want to specify a range that contains a line including- the line ending character(s) then use an end position denoting- the start of the next line"- -}- diffOperationToTextEdit (Deletion (LineRange (sl, el) _) _) = J.TextEdit range ""- where- range = J.Range (J.Position (sl - 1) 0)- (J.Position el 0)-- diffOperationToTextEdit (Addition fm l) = J.TextEdit range nt- -- fm has a range wrt to the changed file, which starts in the current file at l + 1- -- So the range has to be shifted to start at l + 1- where- range = J.Range (J.Position l 0)- (J.Position l 0)- nt = T.pack $ unlines $ lrContents fm--- calcRange fm = J.Range s e- where- sl = fst $ lrNumbers fm- sc = 0- s = J.Position (sl - 1) sc -- Note: zero-based lines- el = snd $ lrNumbers fm- ec = length $ last $ lrContents fm- e = J.Position (el - 1) ec -- Note: zero-based lines----- | A pure version of 'diffText' for testing-diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit-diffText' supports (f,fText) f2Text withDeletions =- if supports- then WorkspaceEdit Nothing (Just docChanges)- else WorkspaceEdit (Just h) Nothing- where- diff = diffTextEdit fText f2Text withDeletions- h = H.singleton f diff- docChanges = J.List [docEdit]- docEdit = J.TextDocumentEdit (J.VersionedTextDocumentIdentifier f (Just 0)) diff---- -----------------------------------------------------------------------clientSupportsDocumentChanges :: ClientCapabilities -> Bool-clientSupportsDocumentChanges caps =- let ClientCapabilities mwCaps _ _ _ = caps- supports = do- wCaps <- mwCaps- WorkspaceEditClientCapabilities mDc <- _workspaceEdit wCaps- mDc- in- fromMaybe False supports+{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Ide.PluginUtils + ( WithDeletions(..), + getProcessID, + normalize, + makeDiffTextEdit, + makeDiffTextEditAdditive, + diffText, + diffText', + pluginDescToIdePlugins, + responseError, + getClientConfig, + getPluginConfig, + configForPlugin, + pluginEnabled, + extractRange, + fullRange, + mkLspCommand, + mkLspCmdId, + allLspCmdIds,allLspCmdIds',installSigUsr1Handler) +where + + +import Data.Algorithm.Diff +import Data.Algorithm.DiffOutput +import qualified Data.HashMap.Strict as H +import Data.Maybe +import qualified Data.Text as T +import Ide.Types +import Language.Haskell.LSP.Types +import qualified Language.Haskell.LSP.Types as J +import Language.Haskell.LSP.Types.Capabilities + +#ifdef mingw32_HOST_OS +import qualified System.Win32.Process as P (getCurrentProcessId) +#else +import System.Posix.Signals +import qualified System.Posix.Process as P (getProcessID) +#endif +import qualified Data.Aeson as J +import qualified Data.Default +import qualified Data.Map.Strict as Map +import Ide.Plugin.Config +import qualified Language.Haskell.LSP.Core as LSP +import Control.Monad (void) + +-- --------------------------------------------------------------------- + +-- | Extend to the line below and above to replace newline character. +normalize :: Range -> Range +normalize (Range (Position sl _) (Position el _)) = + Range (Position sl 0) (Position (el + 1) 0) + +-- --------------------------------------------------------------------- + +data WithDeletions = IncludeDeletions | SkipDeletions + deriving Eq + +-- | Generate a 'WorkspaceEdit' value from a pair of source Text +diffText :: ClientCapabilities -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit +diffText clientCaps old new withDeletions = + let + supports = clientSupportsDocumentChanges clientCaps + in diffText' supports old new withDeletions + +makeDiffTextEdit :: T.Text -> T.Text -> List TextEdit +makeDiffTextEdit f1 f2 = diffTextEdit f1 f2 IncludeDeletions + +makeDiffTextEditAdditive :: T.Text -> T.Text -> List TextEdit +makeDiffTextEditAdditive f1 f2 = diffTextEdit f1 f2 SkipDeletions + +diffTextEdit :: T.Text -> T.Text -> WithDeletions -> List TextEdit +diffTextEdit fText f2Text withDeletions = J.List r + where + r = map diffOperationToTextEdit diffOps + d = getGroupedDiff (lines $ T.unpack fText) (lines $ T.unpack f2Text) + + diffOps = filter (\x -> (withDeletions == IncludeDeletions) || not (isDeletion x)) + (diffToLineRanges d) + + isDeletion (Deletion _ _) = True + isDeletion _ = False + + + diffOperationToTextEdit :: DiffOperation LineRange -> J.TextEdit + diffOperationToTextEdit (Change fm to) = J.TextEdit range nt + where + range = calcRange fm + nt = T.pack $ init $ unlines $ lrContents to + + {- + In order to replace everything including newline characters, + the end range should extend below the last line. From the specification: + "If you want to specify a range that contains a line including + the line ending character(s) then use an end position denoting + the start of the next line" + -} + diffOperationToTextEdit (Deletion (LineRange (sl, el) _) _) = J.TextEdit range "" + where + range = J.Range (J.Position (sl - 1) 0) + (J.Position el 0) + + diffOperationToTextEdit (Addition fm l) = J.TextEdit range nt + -- fm has a range wrt to the changed file, which starts in the current file at l + 1 + -- So the range has to be shifted to start at l + 1 + where + range = J.Range (J.Position l 0) + (J.Position l 0) + nt = T.pack $ unlines $ lrContents fm + + + calcRange fm = J.Range s e + where + sl = fst $ lrNumbers fm + sc = 0 + s = J.Position (sl - 1) sc -- Note: zero-based lines + el = snd $ lrNumbers fm + ec = length $ last $ lrContents fm + e = J.Position (el - 1) ec -- Note: zero-based lines + + +-- | A pure version of 'diffText' for testing +diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit +diffText' supports (f,fText) f2Text withDeletions = + if supports + then WorkspaceEdit Nothing (Just docChanges) + else WorkspaceEdit (Just h) Nothing + where + diff = diffTextEdit fText f2Text withDeletions + h = H.singleton f diff + docChanges = J.List [docEdit] + docEdit = J.TextDocumentEdit (J.VersionedTextDocumentIdentifier f (Just 0)) diff + +-- --------------------------------------------------------------------- + +clientSupportsDocumentChanges :: ClientCapabilities -> Bool +clientSupportsDocumentChanges caps = + let ClientCapabilities mwCaps _ _ _ = caps + supports = do + wCaps <- mwCaps + WorkspaceEditClientCapabilities mDc <- _workspaceEdit wCaps + mDc + in + fromMaybe False supports + +-- --------------------------------------------------------------------- + +pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState +pluginDescToIdePlugins plugins = IdePlugins $ Map.fromList $ map (\p -> (pluginId p, p)) plugins + + +-- --------------------------------------------------------------------- + +responseError :: T.Text -> ResponseError +responseError txt = ResponseError InvalidParams txt Nothing + + +-- --------------------------------------------------------------------- +-- | Returns the current client configuration. It is not wise to permanently +-- cache the returned value of this function, as clients can at runitime change +-- their configuration. +-- +-- If no custom configuration has been set by the client, this function returns +-- our own defaults. +getClientConfig :: LSP.LspFuncs Config -> IO Config +getClientConfig lf = fromMaybe Data.Default.def <$> LSP.config lf + +-- --------------------------------------------------------------------- + +-- | Returns the current plugin configuration. It is not wise to permanently +-- cache the returned value of this function, as clients can change their +-- configuration at runtime. +-- +-- If no custom configuration has been set by the client, this function returns +-- our own defaults. +getPluginConfig :: LSP.LspFuncs Config -> PluginId -> IO PluginConfig +getPluginConfig lf plugin = do + config <- getClientConfig lf + return $ configForPlugin config plugin + +configForPlugin :: Config -> PluginId -> PluginConfig +configForPlugin config (PluginId plugin) + = Map.findWithDefault Data.Default.def plugin (plugins config) + +-- --------------------------------------------------------------------- + +-- | Checks that a given plugin is both enabled and the specific feature is +-- enabled +pluginEnabled :: PluginConfig -> (PluginConfig -> Bool) -> Bool +pluginEnabled pluginConfig f = plcGlobalOn pluginConfig && f pluginConfig + +-- --------------------------------------------------------------------- + +extractRange :: Range -> T.Text -> T.Text +extractRange (Range (Position sl _) (Position el _)) s = newS + where focusLines = take (el-sl+1) $ drop sl $ T.lines s + newS = T.unlines focusLines + +-- | Gets the range that covers the entire text +fullRange :: T.Text -> Range +fullRange s = Range startPos endPos + where startPos = Position 0 0 + endPos = Position lastLine 0 + {- + In order to replace everything including newline characters, + the end range should extend below the last line. From the specification: + "If you want to specify a range that contains a line including + the line ending character(s) then use an end position denoting + the start of the next line" + -} + lastLine = length $ T.lines s + +-- --------------------------------------------------------------------- + +allLspCmdIds' :: T.Text -> IdePlugins ideState -> [T.Text] +allLspCmdIds' pid mp = mkPlugin (allLspCmdIds pid) (Just . pluginCommands) + where + justs (p, Just x) = [(p, x)] + justs (_, Nothing) = [] + + ls = Map.toList (ipMap mp) + + mkPlugin maker selector + = maker $ concatMap (\(pid, p) -> justs (pid, selector p)) ls + + +allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand ideState])] -> [T.Text] +allLspCmdIds pid commands = concat $ map go commands + where + go (plid, cmds) = map (mkLspCmdId pid plid . commandId) cmds + +mkLspCommand :: PluginId -> CommandId -> T.Text -> Maybe [J.Value] -> IO Command +mkLspCommand plid cn title args' = do + pid <- getPid + let cmdId = mkLspCmdId pid plid cn + let args = List <$> args' + return $ Command title cmdId args + +mkLspCmdId :: T.Text -> PluginId -> CommandId -> T.Text +mkLspCmdId pid (PluginId plid) (CommandId cid) + = pid <> ":" <> plid <> ":" <> cid + +-- | Get the operating system process id for the running server +-- instance. This should be the same for the lifetime of the instance, +-- and different from that of any other currently running instance. +getPid :: IO T.Text +getPid = T.pack . show <$> getProcessID + +getProcessID :: IO Int +installSigUsr1Handler :: IO () -> IO () + +#ifdef mingw32_HOST_OS +getProcessID = fromIntegral <$> P.getCurrentProcessId +installSigUsr1Handler _ = return () + +#else +getProcessID = fromIntegral <$> P.getProcessID + +installSigUsr1Handler h = void $ installHandler sigUSR1 (Catch h) Nothing +#endif
src/Ide/Types.hs view
@@ -1,204 +1,206 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Ide.Types- (- IdePlugins(..)- , PluginDescriptor(..)- , defaultPluginDescriptor- , PluginCommand(..)- , PluginId(..)- , CommandId(..)- , DiagnosticProvider(..)- , DiagnosticProviderFunc(..)- , SymbolsProvider- , FormattingType(..)- , FormattingProvider- , HoverProvider- , CodeActionProvider- , CodeLensProvider- , CommandFunction- , ExecuteCommandProvider- , CompletionProvider- , RenameProvider- , WithSnippets(..)- ) where--import Data.Aeson hiding (defaultOptions)-import qualified Data.Map as Map-import qualified Data.Set as S-import Data.String-import qualified Data.Text as T-import Development.IDE-import Ide.Plugin.Config-import qualified Language.Haskell.LSP.Core as LSP-import Language.Haskell.LSP.Types-import Text.Regex.TDFA.Text()---- -----------------------------------------------------------------------newtype IdePlugins = IdePlugins- { ipMap :: Map.Map PluginId PluginDescriptor- }---- -----------------------------------------------------------------------data PluginDescriptor =- PluginDescriptor { pluginId :: !PluginId- , pluginRules :: !(Rules ())- , pluginCommands :: ![PluginCommand]- , pluginCodeActionProvider :: !(Maybe CodeActionProvider)- , pluginCodeLensProvider :: !(Maybe CodeLensProvider)- , pluginDiagnosticProvider :: !(Maybe DiagnosticProvider)- -- ^ TODO: diagnostics are generally provided via rules,- -- this is probably redundant.- , pluginHoverProvider :: !(Maybe HoverProvider)- , pluginSymbolsProvider :: !(Maybe SymbolsProvider)- , pluginFormattingProvider :: !(Maybe (FormattingProvider IO))- , pluginCompletionProvider :: !(Maybe CompletionProvider)- , pluginRenameProvider :: !(Maybe RenameProvider)- }--defaultPluginDescriptor :: PluginId -> PluginDescriptor-defaultPluginDescriptor plId =- PluginDescriptor- plId- mempty- mempty- Nothing- Nothing- Nothing- Nothing- Nothing- Nothing- Nothing- Nothing---- instance Show PluginCommand where--- show (PluginCommand i _ _) = "PluginCommand { name = " ++ show i ++ " }"---- newtype CommandId = CommandId T.Text--- deriving (Show, Read, Eq, Ord)--- instance IsString CommandId where--- fromString = CommandId . T.pack---- data PluginCommand = forall a b. (FromJSON a, ToJSON b, Typeable b) =>--- PluginCommand { commandId :: CommandId--- , commandDesc :: T.Text--- , commandFunc :: a -> IO (Either ResponseError b)--- }--newtype CommandId = CommandId T.Text- deriving (Show, Read, Eq, Ord)-instance IsString CommandId where- fromString = CommandId . T.pack--data PluginCommand = forall a. (FromJSON a) =>- PluginCommand { commandId :: CommandId- , commandDesc :: T.Text- , commandFunc :: CommandFunction a- }---- -----------------------------------------------------------------------type CommandFunction a = LSP.LspFuncs Config- -> IdeState- -> a- -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))--type CodeActionProvider = LSP.LspFuncs Config- -> IdeState- -> PluginId- -> TextDocumentIdentifier- -> Range- -> CodeActionContext- -> IO (Either ResponseError (List CAResult))--type CompletionProvider = LSP.LspFuncs Config- -> IdeState- -> CompletionParams- -> IO (Either ResponseError CompletionResponseResult)----type CodeLensProvider = LSP.LspFuncs Config- -> IdeState- -> PluginId- -> CodeLensParams- -> IO (Either ResponseError (List CodeLens))--type RenameProvider = LSP.LspFuncs Config- -> IdeState- -> RenameParams- -> IO (Either ResponseError WorkspaceEdit)--type DiagnosticProviderFuncSync- = DiagnosticTrigger -> Uri- -> IO (Either ResponseError (Map.Map Uri (S.Set Diagnostic)))--type DiagnosticProviderFuncAsync- = DiagnosticTrigger -> Uri- -> (Map.Map Uri (S.Set Diagnostic) -> IO ())- -> IO (Either ResponseError ())--data DiagnosticProviderFunc- = DiagnosticProviderSync DiagnosticProviderFuncSync- | DiagnosticProviderAsync DiagnosticProviderFuncAsync---data DiagnosticProvider = DiagnosticProvider- { dpTrigger :: S.Set DiagnosticTrigger -- AZ:should this be a NonEmptyList?- , dpFunc :: DiagnosticProviderFunc- }--data DiagnosticTrigger = DiagnosticOnOpen- | DiagnosticOnChange- | DiagnosticOnSave- deriving (Show,Ord,Eq)---- type HoverProvider = Uri -> Position -> IO (Either ResponseError [Hover])-type HoverProvider = IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))--type SymbolsProvider = LSP.LspFuncs Config- -> IdeState- -> DocumentSymbolParams- -> IO (Either ResponseError [DocumentSymbol])--type ExecuteCommandProvider = IdeState- -> ExecuteCommandParams- -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))--newtype WithSnippets = WithSnippets Bool---- -----------------------------------------------------------------------newtype PluginId = PluginId T.Text- deriving (Show, Read, Eq, Ord)-instance IsString PluginId where- fromString = PluginId . T.pack---- -------------------------------------------------------------------------- | Format the given Text as a whole or only a @Range@ of it.--- Range must be relative to the text to format.--- To format the whole document, read the Text from the file and use 'FormatText'--- as the FormattingType.-data FormattingType = FormatText- | FormatRange Range----- | To format a whole document, the 'FormatText' @FormattingType@ can be used.--- It is required to pass in the whole Document Text for that to happen, an empty text--- and file uri, does not suffice.-type FormattingProvider m- = LSP.LspFuncs Config- -> IdeState- -> FormattingType -- ^ How much to format- -> T.Text -- ^ Text to format- -> NormalizedFilePath -- ^ location of the file being formatted- -> FormattingOptions -- ^ Options for the formatter- -> m (Either ResponseError (List TextEdit)) -- ^ Result of the formatting---- ---------------------------------------------------------------------+{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Ide.Types + ( + IdePlugins(..) + , PluginDescriptor(..) + , defaultPluginDescriptor + , PluginCommand(..) + , PluginId(..) + , CommandId(..) + , DiagnosticProvider(..) + , DiagnosticProviderFunc(..) + , SymbolsProvider + , FormattingType(..) + , FormattingProvider + , noneProvider + , HoverProvider + , CodeActionProvider + , CodeLensProvider + , CommandFunction + , ExecuteCommandProvider + , CompletionProvider + , RenameProvider + , WithSnippets(..) + ) where + +import Data.Aeson hiding (defaultOptions) +import qualified Data.Map as Map +import qualified Data.Set as S +import Data.String +import qualified Data.Text as T +import Development.Shake +import Ide.Plugin.Config +import qualified Language.Haskell.LSP.Core as LSP +import Language.Haskell.LSP.Types +import Text.Regex.TDFA.Text() + +-- --------------------------------------------------------------------- + +newtype IdePlugins ideState = IdePlugins + { ipMap :: Map.Map PluginId (PluginDescriptor ideState)} + +-- --------------------------------------------------------------------- + +data PluginDescriptor ideState = + PluginDescriptor { pluginId :: !PluginId + , pluginRules :: !(Rules ()) + , pluginCommands :: ![PluginCommand ideState] + , pluginCodeActionProvider :: !(Maybe (CodeActionProvider ideState)) + , pluginCodeLensProvider :: !(Maybe (CodeLensProvider ideState)) + , pluginDiagnosticProvider :: !(Maybe DiagnosticProvider) + -- ^ TODO: diagnostics are generally provided via rules, + -- this is probably redundant. + , pluginHoverProvider :: !(Maybe (HoverProvider ideState)) + , pluginSymbolsProvider :: !(Maybe (SymbolsProvider ideState)) + , pluginFormattingProvider :: !(Maybe (FormattingProvider ideState IO)) + , pluginCompletionProvider :: !(Maybe (CompletionProvider ideState)) + , pluginRenameProvider :: !(Maybe (RenameProvider ideState)) + } + +defaultPluginDescriptor :: PluginId -> PluginDescriptor ideState +defaultPluginDescriptor plId = + PluginDescriptor + plId + mempty + mempty + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + +-- instance Show PluginCommand where +-- show (PluginCommand i _ _) = "PluginCommand { name = " ++ show i ++ " }" + +-- newtype CommandId = CommandId T.Text +-- deriving (Show, Read, Eq, Ord) +-- instance IsString CommandId where +-- fromString = CommandId . T.pack + +-- data PluginCommand = forall a b. (FromJSON a, ToJSON b, Typeable b) => +-- PluginCommand { commandId :: CommandId +-- , commandDesc :: T.Text +-- , commandFunc :: a -> IO (Either ResponseError b) +-- } + +newtype CommandId = CommandId T.Text + deriving (Show, Read, Eq, Ord) +instance IsString CommandId where + fromString = CommandId . T.pack + +data PluginCommand ideState = forall a. (FromJSON a) => + PluginCommand { commandId :: CommandId + , commandDesc :: T.Text + , commandFunc :: CommandFunction ideState a + } + + +-- --------------------------------------------------------------------- + +type CommandFunction ideState a = LSP.LspFuncs Config + -> ideState + -> a + -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams)) + +type CodeActionProvider ideState = LSP.LspFuncs Config + -> ideState + -> PluginId + -> TextDocumentIdentifier + -> Range + -> CodeActionContext + -> IO (Either ResponseError (List CAResult)) + +type CompletionProvider ideState = LSP.LspFuncs Config + -> ideState + -> CompletionParams + -> IO (Either ResponseError CompletionResponseResult) + + + +type CodeLensProvider ideState = LSP.LspFuncs Config + -> ideState + -> PluginId + -> CodeLensParams + -> IO (Either ResponseError (List CodeLens)) + +type RenameProvider ideState = LSP.LspFuncs Config + -> ideState + -> RenameParams + -> IO (Either ResponseError WorkspaceEdit) + +type DiagnosticProviderFuncSync + = DiagnosticTrigger -> Uri + -> IO (Either ResponseError (Map.Map Uri (S.Set Diagnostic))) + +type DiagnosticProviderFuncAsync + = DiagnosticTrigger -> Uri + -> (Map.Map Uri (S.Set Diagnostic) -> IO ()) + -> IO (Either ResponseError ()) + +data DiagnosticProviderFunc + = DiagnosticProviderSync DiagnosticProviderFuncSync + | DiagnosticProviderAsync DiagnosticProviderFuncAsync + + +data DiagnosticProvider = DiagnosticProvider + { dpTrigger :: S.Set DiagnosticTrigger -- AZ:should this be a NonEmptyList? + , dpFunc :: DiagnosticProviderFunc + } + +data DiagnosticTrigger = DiagnosticOnOpen + | DiagnosticOnChange + | DiagnosticOnSave + deriving (Show,Ord,Eq) + +-- type HoverProvider = Uri -> Position -> IO (Either ResponseError [Hover]) +type HoverProvider ideState = ideState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover)) + +type SymbolsProvider ideState = LSP.LspFuncs Config + -> ideState + -> DocumentSymbolParams + -> IO (Either ResponseError [DocumentSymbol]) + +type ExecuteCommandProvider ideState = ideState + -> ExecuteCommandParams + -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams)) + +newtype WithSnippets = WithSnippets Bool + +-- --------------------------------------------------------------------- + +newtype PluginId = PluginId T.Text + deriving (Show, Read, Eq, Ord) +instance IsString PluginId where + fromString = PluginId . T.pack + +-- --------------------------------------------------------------------- + + +-- | Format the given Text as a whole or only a @Range@ of it. +-- Range must be relative to the text to format. +-- To format the whole document, read the Text from the file and use 'FormatText' +-- as the FormattingType. +data FormattingType = FormatText + | FormatRange Range + + +-- | To format a whole document, the 'FormatText' @FormattingType@ can be used. +-- It is required to pass in the whole Document Text for that to happen, an empty text +-- and file uri, does not suffice. +type FormattingProvider ideState m + = LSP.LspFuncs Config + -> ideState + -> FormattingType -- ^ How much to format + -> T.Text -- ^ Text to format + -> NormalizedFilePath -- ^ location of the file being formatted + -> FormattingOptions -- ^ Options for the formatter + -> m (Either ResponseError (List TextEdit)) -- ^ Result of the formatting + +noneProvider :: FormattingProvider ideState IO +noneProvider _ _ _ _ _ _ = return $ Right (List [])