packages feed

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 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 [])