packages feed

hls-plugin-api 0.7.1.0 → 1.0.0.0

raw patch · 6 files changed

+1070/−1077 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Ide.PluginUtils: getClientConfig :: MonadLsp Config m => m Config
+ Ide.PluginUtils: getClientConfig :: MonadLsp Config m => m (Maybe Config)
- Ide.PluginUtils: getPluginConfig :: MonadLsp Config m => PluginId -> m PluginConfig
+ Ide.PluginUtils: getPluginConfig :: MonadLsp Config m => PluginId -> m (Maybe PluginConfig)

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,67 +1,67 @@-cabal-version: 2.2-name:          hls-plugin-api-version:       0.7.1.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:        The Haskell IDE Team-maintainer:    alan.zimm@gmail.com-copyright:     The Haskell IDE Team-category:      Development-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-    , lsp                   ^>=1.1.0-    , hashable-    , hslogger-    , lens-    , process-    , regex-tdfa            >=1.3.1.0-    , shake                 >=0.17.5-    , text-    , unordered-containers-    , dependent-map-    , dependent-sum-    , dlist-    , opentelemetry--  if os(windows)-      build-depends:-        Win32-  else-      build-depends:-        unix--  ghc-options:      -Wall -Wredundant-constraints -Wno-name-shadowing -Wno-unticked-promoted-constructors--  if flag(pedantic)-    ghc-options: -Werror--  default-language: Haskell2010-  default-extensions: DataKinds, KindSignatures, TypeOperators+cabal-version: 2.2
+name:          hls-plugin-api
+version:       1.0.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:        The Haskell IDE Team
+maintainer:    alan.zimm@gmail.com
+copyright:     The Haskell IDE Team
+category:      Development
+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
+    , lsp                   ^>=1.1.0
+    , hashable
+    , hslogger
+    , lens
+    , process
+    , regex-tdfa            >=1.3.1.0
+    , shake                 >=0.17.5
+    , text
+    , unordered-containers
+    , dependent-map
+    , dependent-sum
+    , dlist
+    , opentelemetry
+
+  if os(windows)
+      build-depends:
+        Win32
+  else
+      build-depends:
+        unix
+
+  ghc-options:      -Wall -Wredundant-constraints -Wno-name-shadowing -Wno-unticked-promoted-constructors
+
+  if flag(pedantic)
+    ghc-options: -Werror
+
+  default-language: Haskell2010
+  default-extensions: DataKinds, KindSignatures, TypeOperators
src/Ide/Logger.hs view
@@ -1,29 +1,29 @@-{- | 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---- ---------------------------------------------------------------------+{- | 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/Config.hs view
@@ -1,181 +1,182 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}-module Ide.Plugin.Config-    ( getConfigFromNotification-    , Config(..)-    , parseConfig-    , PluginConfig(..)-    , CheckParents(..)-    ) where--import           Control.Applicative-import qualified Data.Aeson                    as A-import qualified Data.Aeson.Types              as A-import           Data.Aeson              hiding ( Error )-import           Data.Default-import qualified Data.Text                     as T-import qualified Data.Map as Map-import GHC.Generics (Generic)---- ------------------------------------------------------------------------- | Given a DidChangeConfigurationNotification message, this function returns the parsed--- Config object if possible.-getConfigFromNotification :: Config -> A.Value -> Either T.Text Config-getConfigFromNotification defaultValue p =-  case A.parse (parseConfig defaultValue) p 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-    , maxCompletions              :: !Int-    , 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"-    , maxCompletions              = 40-    , plugins                     = Map.empty-    }---- TODO: Add API for plugins to expose their own LSP config options-parseConfig :: Config -> Value -> A.Parser Config-parseConfig defValue = A.withObject "Config" $ \v -> do-    -- Officially, we use "haskell" as the section name but for-    -- backwards compatibility we also accept "languageServerHaskell"-    c <- v .: "haskell" <|> v .:? "languageServerHaskell"-    case c of-      Nothing -> return defValue-      Just s -> flip (A.withObject "Config.settings") s $ \o -> Config-        <$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents defValue-        <*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject defValue-        <*> o .:? "hlintOn"                                 .!= hlintOn defValue-        <*> o .:? "diagnosticsOnChange"                     .!= diagnosticsOnChange defValue-        <*> o .:? "maxNumberOfProblems"                     .!= maxNumberOfProblems defValue-        <*> o .:? "diagnosticsDebounceDuration"             .!= diagnosticsDebounceDuration defValue-        <*> o .:? "liquidOn"                                .!= liquidOn defValue-        <*> o .:? "completionSnippetsOn"                    .!= completionSnippetsOn defValue-        <*> o .:? "formatOnImportOn"                        .!= formatOnImportOn defValue-        <*> o .:? "formattingProvider"                      .!= formattingProvider defValue-        <*> o .:? "maxCompletions"                          .!= maxCompletions defValue-        <*> o .:? "plugin"                                  .!= plugins defValue--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---- ---------------------------------------------------------------------+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+module Ide.Plugin.Config
+    ( getConfigFromNotification
+    , Config(..)
+    , parseConfig
+    , PluginConfig(..)
+    , CheckParents(..)
+    ) where
+
+import           Control.Applicative
+import qualified Data.Aeson                    as A
+import qualified Data.Aeson.Types              as A
+import           Data.Aeson              hiding ( Error )
+import           Data.Default
+import qualified Data.Text                     as T
+import qualified Data.Map as Map
+import GHC.Generics (Generic)
+
+-- ---------------------------------------------------------------------
+
+-- | Given a DidChangeConfigurationNotification message, this function returns the parsed
+-- Config object if possible.
+getConfigFromNotification :: Config -> A.Value -> Either T.Text Config
+getConfigFromNotification defaultValue p =
+  case A.parse (parseConfig defaultValue) p 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
+    , maxCompletions              :: !Int
+    , 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"
+    , maxCompletions              = 40
+    , plugins                     = Map.empty
+    }
+
+-- TODO: Add API for plugins to expose their own LSP config options
+parseConfig :: Config -> Value -> A.Parser Config
+parseConfig defValue = A.withObject "Config" $ \v -> do
+    -- Officially, we use "haskell" as the section name but for
+    -- backwards compatibility we also accept "languageServerHaskell"
+    c <- v .: "haskell" <|> v .:? "languageServerHaskell"
+    case c of
+      Nothing -> return defValue
+      Just s -> flip (A.withObject "Config.settings") s $ \o -> Config
+        <$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents defValue
+        <*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject defValue
+        <*> o .:? "hlintOn"                                 .!= hlintOn defValue
+        <*> o .:? "diagnosticsOnChange"                     .!= diagnosticsOnChange defValue
+        <*> o .:? "maxNumberOfProblems"                     .!= maxNumberOfProblems defValue
+        <*> o .:? "diagnosticsDebounceDuration"             .!= diagnosticsDebounceDuration defValue
+        <*> o .:? "liquidOn"                                .!= liquidOn defValue
+        <*> o .:? "completionSnippetsOn"                    .!= completionSnippetsOn defValue
+        <*> o .:? "formatOnImportOn"                        .!= formatOnImportOn defValue
+        <*> o .:? "formattingProvider"                      .!= formattingProvider defValue
+        <*> o .:? "maxCompletions"                          .!= maxCompletions defValue
+        <*> o .:? "plugin"                                  .!= plugins defValue
+
+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
+                 , "maxCompletions"              .= maxCompletions
+                 , "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/PluginUtils.hs view
@@ -1,220 +1,213 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}-module Ide.PluginUtils-  ( WithDeletions(..),-    getProcessID,-    normalize,-    makeDiffTextEdit,-    makeDiffTextEditAdditive,-    diffText,-    diffText',-    pluginDescToIdePlugins,-    responseError,-    getClientConfig,-    getPluginConfig,-    configForPlugin,-    pluginEnabled,-    extractRange,-    fullRange,-    mkLspCommand,-    mkLspCmdId,-    getPid,-  allLspCmdIds,allLspCmdIds',installSigUsr1Handler, subRange)-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.LSP.Types-import qualified Language.LSP.Types              as J-import           Language.LSP.Types.Capabilities--import qualified Data.Default-import qualified Data.Map.Strict                         as Map-import           Ide.Plugin.Config-import Language.LSP.Server---- ------------------------------------------------------------------------- | 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 [InL 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----- ------------------------------------------------------------------------ | 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 :: MonadLsp Config m => m Config-getClientConfig = fromMaybe Data.Default.def <$> getConfig---- ------------------------------------------------------------------------- | 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 :: MonadLsp Config m => PluginId -> m PluginConfig-getPluginConfig plugin = do-    config <- getClientConfig-    return $ configForPlugin config plugin---- -----------------------------------------------------------------------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--subRange :: Range -> Range -> Bool-subRange smallRange range =-     positionInRange (_start smallRange) range-  && positionInRange (_end smallRange) range--positionInRange :: Position -> Range -> Bool-positionInRange (Position pl po) (Range (Position sl so) (Position el eo)) =-     pl >  sl && pl <  el-  || pl == sl && pl == el && po >= so && po <= eo-  || pl == sl && po >= so-  || pl == el && po <= eo---- -----------------------------------------------------------------------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-+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Ide.PluginUtils
+  ( WithDeletions(..),
+    getProcessID,
+    normalize,
+    makeDiffTextEdit,
+    makeDiffTextEditAdditive,
+    diffText,
+    diffText',
+    pluginDescToIdePlugins,
+    responseError,
+    getClientConfig,
+    getPluginConfig,
+    configForPlugin,
+    pluginEnabled,
+    extractRange,
+    fullRange,
+    mkLspCommand,
+    mkLspCmdId,
+    getPid,
+  allLspCmdIds,allLspCmdIds',installSigUsr1Handler, subRange)
+where
+
+
+import           Data.Algorithm.Diff
+import           Data.Algorithm.DiffOutput
+import qualified Data.HashMap.Strict             as H
+import qualified Data.Text                       as T
+import           Ide.Types
+import           Language.LSP.Types
+import qualified Language.LSP.Types              as J
+import           Language.LSP.Types.Capabilities
+
+import qualified Data.Map.Strict                 as Map
+import           Ide.Plugin.Config
+import           Language.LSP.Server
+
+-- ---------------------------------------------------------------------
+
+-- | 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 [InL 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
+    Just True == supports
+
+-- ---------------------------------------------------------------------
+
+pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
+pluginDescToIdePlugins plugins = IdePlugins $ Map.fromList $ map (\p -> (pluginId p, p)) plugins
+
+
+-- ---------------------------------------------------------------------
+-- | 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.
+--
+getClientConfig :: MonadLsp Config m => m (Maybe Config)
+getClientConfig = getConfig
+
+-- ---------------------------------------------------------------------
+
+-- | 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.
+getPluginConfig :: MonadLsp Config m => PluginId -> m (Maybe PluginConfig)
+getPluginConfig plugin = do
+    config <- getClientConfig
+    return $ flip configForPlugin plugin <$> config
+
+-- ---------------------------------------------------------------------
+
+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
+
+subRange :: Range -> Range -> Bool
+subRange smallRange range =
+     positionInRange (_start smallRange) range
+  && positionInRange (_end smallRange) range
+
+positionInRange :: Position -> Range -> Bool
+positionInRange (Position pl po) (Range (Position sl so) (Position el eo)) =
+     pl >  sl && pl <  el
+  || pl == sl && pl == el && po >= so && po <= eo
+  || pl == sl && po >= so
+  || pl == el && po <= eo
+
+-- ---------------------------------------------------------------------
+
+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 = concatMap go commands
+  where
+    go (plid, cmds) = map (mkLspCmdId pid plid . commandId) cmds
+
src/Ide/Types.hs view
@@ -1,379 +1,378 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}--module Ide.Types-    where--#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           Data.Aeson                    hiding (defaultOptions)-import           GHC.Generics-import qualified Data.Map  as Map-import           Data.String-import qualified Data.Text                     as T-import           Development.Shake hiding (command)-import           Ide.Plugin.Config-import           Language.LSP.Types-import           Language.LSP.VFS-import           Language.LSP.Types.Lens as J hiding (id)-import           Language.LSP.Types.Capabilities-import           Language.LSP.Server (LspM, getVirtualFile)-import           Text.Regex.TDFA.Text()-import           Data.Dependent.Map (DMap)-import qualified Data.Dependent.Map as DMap-import Data.List.NonEmpty (NonEmpty(..), toList)-import Data.GADT.Compare-import Data.Maybe-import Data.Semigroup-import Control.Lens ((^.))-import qualified Data.DList as DList-import qualified Data.Default-import System.IO.Unsafe-import Control.Monad-import OpenTelemetry.Eventlog-import Data.Text.Encoding (encodeUtf8)---- -----------------------------------------------------------------------newtype IdePlugins ideState = IdePlugins-  { ipMap :: Map.Map PluginId (PluginDescriptor ideState)}---- -----------------------------------------------------------------------data PluginDescriptor ideState =-  PluginDescriptor { pluginId          :: !PluginId-                   , pluginRules       :: !(Rules ())-                   , pluginCommands    :: ![PluginCommand ideState]-                   , pluginHandlers    :: PluginHandlers ideState-                   }---- | Methods that can be handled by plugins.--- 'ExtraParams' captures any extra data the IDE passes to the handlers for this method--- Only methods for which we know how to combine responses can be instances of 'PluginMethod'-class HasTracing (MessageParams m) => PluginMethod m where--  -- | Parse the configuration to check if this plugin is enabled-  pluginEnabled :: SMethod m -> PluginId -> Config -> Bool--  -- | How to combine responses from different plugins-  combineResponses-    :: SMethod m-    -> Config -- ^ IDE Configuration-    -> ClientCapabilities-    -> MessageParams m-    -> NonEmpty (ResponseResult m) -> ResponseResult m--  default combineResponses :: Semigroup (ResponseResult m)-    => SMethod m -> Config -> ClientCapabilities -> MessageParams m -> NonEmpty (ResponseResult m) -> ResponseResult m-  combineResponses _method _config _caps _params = sconcat--instance PluginMethod TextDocumentCodeAction where-  pluginEnabled _ = pluginEnabledConfig plcCodeActionsOn-  combineResponses _method _config (ClientCapabilities _ textDocCaps _ _) (CodeActionParams _ _ _ _ context) resps =-      fmap compat $ List $ filter wasRequested $ (\(List x) -> x) $ sconcat resps-    where--      compat :: (Command |? CodeAction) -> (Command |? CodeAction)-      compat x@(InL _) = x-      compat x@(InR action)-        | Just _ <- textDocCaps >>= _codeAction >>= _codeActionLiteralSupport-        = x-        | otherwise = InL cmd-        where-          cmd = mkLspCommand "hls" "fallbackCodeAction" (action ^. title) (Just cmdParams)-          cmdParams = [toJSON (FallbackCodeActionParams (action ^. edit) (action ^. command))]--      wasRequested :: (Command |? CodeAction) -> Bool-      wasRequested (InL _) = True-      wasRequested (InR ca)-        | Nothing <- _only context = True-        | Just (List allowed) <- _only context-        , Just caKind <- ca ^. kind = caKind `elem` allowed-        | otherwise = False--instance PluginMethod TextDocumentCodeLens where-  pluginEnabled _ = pluginEnabledConfig plcCodeLensOn-instance PluginMethod TextDocumentRename where-  pluginEnabled _ = pluginEnabledConfig plcRenameOn-instance PluginMethod TextDocumentHover where-  pluginEnabled _ = pluginEnabledConfig plcHoverOn-  combineResponses _ _ _ _ (catMaybes . toList -> hs) = h-    where-      r = listToMaybe $ mapMaybe (^. range) hs-      h = case foldMap (^. contents) hs of-            HoverContentsMS (List []) -> Nothing-            hh                        -> Just $ Hover hh r--instance PluginMethod TextDocumentDocumentSymbol where-  pluginEnabled _ = pluginEnabledConfig plcSymbolsOn-  combineResponses _ _ (ClientCapabilities _ tdc _ _) params xs = res-    where-      uri' = params ^. textDocument . uri-      supportsHierarchy = Just True == (tdc >>= _documentSymbol >>= _hierarchicalDocumentSymbolSupport)-      dsOrSi = fmap toEither xs-      res-        | supportsHierarchy = InL $ sconcat $ fmap (either id (fmap siToDs)) dsOrSi-        | otherwise = InR $ sconcat $ fmap (either (List . concatMap dsToSi) id) dsOrSi-      siToDs (SymbolInformation name kind dep (Location _uri range) cont)-        = DocumentSymbol name cont kind dep range range Nothing-      dsToSi = go Nothing-      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'--instance PluginMethod TextDocumentCompletion where-  pluginEnabled _ = pluginEnabledConfig plcCompletionOn-  combineResponses _ conf _ _ (toList -> xs) = snd $ consumeCompletionResponse limit $ combine xs-      where-        limit = maxCompletions conf-        combine :: [List CompletionItem |? CompletionList] -> ((List CompletionItem) |? CompletionList)-        combine cs = go True mempty cs--        go !comp acc [] =-          InR (CompletionList comp (List $ DList.toList acc))-        go comp acc (InL (List ls) : rest) =-          go comp (acc <> DList.fromList ls) rest-        go comp acc (InR (CompletionList comp' (List ls)) : rest) =-          go (comp && comp') (acc <> DList.fromList ls) rest--        -- boolean disambiguators-        isCompleteResponse, isIncompleteResponse :: Bool-        isIncompleteResponse = True-        isCompleteResponse = False--        consumeCompletionResponse limit it@(InR (CompletionList _ (List xx))) =-          case splitAt limit xx of-            -- consumed all the items, return the result as is-            (_, []) -> (limit - length xx, it)-            -- need to crop the response, set the 'isIncomplete' flag-            (xx', _) -> (0, InR (CompletionList isIncompleteResponse (List xx')))-        consumeCompletionResponse n (InL (List xx)) =-          consumeCompletionResponse n (InR (CompletionList isCompleteResponse (List xx)))--instance PluginMethod TextDocumentFormatting where-  pluginEnabled _ pid conf = (PluginId $ formattingProvider conf) == pid-  combineResponses _ _ _ _ (x :| _) = x--instance PluginMethod TextDocumentRangeFormatting where-  pluginEnabled _ pid conf = (PluginId $ formattingProvider conf) == pid-  combineResponses _ _ _ _ (x :| _) = x---- | Methods which have a PluginMethod instance-data IdeMethod (m :: Method FromClient Request) = PluginMethod m => IdeMethod (SMethod m)-instance GEq IdeMethod where-  geq (IdeMethod a) (IdeMethod b) = geq a b-instance GCompare IdeMethod where-  gcompare (IdeMethod a) (IdeMethod b) = gcompare a b---- | Combine handlers for the-newtype PluginHandler a (m :: Method FromClient Request)-  = PluginHandler (PluginId -> a -> MessageParams m -> LspM Config (NonEmpty (Either ResponseError (ResponseResult m))))--newtype PluginHandlers a = PluginHandlers (DMap IdeMethod (PluginHandler a))--instance Semigroup (PluginHandlers a) where-  (PluginHandlers a) <> (PluginHandlers b) = PluginHandlers $ DMap.unionWithKey go a b-    where-      go _ (PluginHandler f) (PluginHandler g) = PluginHandler $ \pid ide params ->-        (<>) <$> f pid ide params <*> g pid ide params--instance Monoid (PluginHandlers a) where-  mempty = PluginHandlers mempty--type PluginMethodHandler a m = a -> PluginId -> MessageParams m -> LspM Config (Either ResponseError (ResponseResult m))---- | Make a handler for plugins with no extra data-mkPluginHandler-  :: PluginMethod m-  => SClientMethod m-  -> PluginMethodHandler ideState m-  -> PluginHandlers ideState-mkPluginHandler m f = PluginHandlers $ DMap.singleton (IdeMethod m) (PluginHandler f')-  where-    f' pid ide params = pure <$> f ide pid params--defaultPluginDescriptor :: PluginId -> PluginDescriptor ideState-defaultPluginDescriptor plId =-  PluginDescriptor-    plId-    mempty-    mempty-    mempty--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-  = ideState-  -> a-  -> LspM Config (Either ResponseError Value)--newtype WithSnippets = WithSnippets Bool---- -----------------------------------------------------------------------newtype PluginId = PluginId T.Text-  deriving (Show, Read, Eq, Ord)-instance IsString PluginId where-  fromString = PluginId . T.pack--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-pluginEnabledConfig :: (PluginConfig -> Bool) -> PluginId -> Config -> Bool-pluginEnabledConfig f pid config = plcGlobalOn pluginConfig && f pluginConfig-  where-    pluginConfig = configForPlugin config pid---- ------------------------------------------------------------------------- | 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---type FormattingMethod m =-  ( J.HasOptions (MessageParams m) FormattingOptions-  , J.HasTextDocument (MessageParams m) TextDocumentIdentifier-  , ResponseResult m ~ List TextEdit-  )--type FormattingHandler a-  =  a-  -> FormattingType-  -> T.Text-  -> NormalizedFilePath-  -> FormattingOptions-  -> LspM Config (Either ResponseError (List TextEdit))--mkFormattingHandlers :: forall a. FormattingHandler a -> PluginHandlers a-mkFormattingHandlers f = mkPluginHandler STextDocumentFormatting (provider STextDocumentFormatting)-                      <> mkPluginHandler STextDocumentRangeFormatting (provider STextDocumentRangeFormatting)-  where-    provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler a m-    provider m ide _pid params-      | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do-        mf <- getVirtualFile $ toNormalizedUri uri-        case mf of-          Just vf -> do-            let typ = case m of-                  STextDocumentFormatting -> FormatText-                  STextDocumentRangeFormatting -> FormatRange (params ^. J.range)-                  _ -> error "mkFormattingHandlers: impossible"-            f ide typ (virtualFileText vf) nfp opts-          Nothing -> pure $ Left $ responseError $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri--      | otherwise = pure $ Left $ responseError $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri-      where-        uri = params ^. J.textDocument . J.uri-        opts = params ^. J.options---- -----------------------------------------------------------------------responseError :: T.Text -> ResponseError-responseError txt = ResponseError InvalidParams txt Nothing---- -----------------------------------------------------------------------data FallbackCodeActionParams =-  FallbackCodeActionParams-    { fallbackWorkspaceEdit :: Maybe WorkspaceEdit-    , fallbackCommand       :: Maybe Command-    }-  deriving (Generic, ToJSON, FromJSON)---- -----------------------------------------------------------------------otSetUri :: SpanInFlight -> Uri -> IO ()-otSetUri sp (Uri t) = setTag sp "uri" (encodeUtf8 t)--class HasTracing a where-  traceWithSpan :: SpanInFlight -> a -> IO ()-  traceWithSpan _ _ = pure ()--instance {-# OVERLAPPABLE #-} (HasTextDocument a doc, HasUri doc Uri) => HasTracing a where-  traceWithSpan sp a = otSetUri sp (a ^. J.textDocument . J.uri)--instance HasTracing Value-instance HasTracing ExecuteCommandParams-instance HasTracing DidChangeWatchedFilesParams-instance HasTracing DidChangeWorkspaceFoldersParams-instance HasTracing DidChangeConfigurationParams-instance HasTracing InitializeParams-instance HasTracing (Maybe InitializedParams)-instance HasTracing WorkspaceSymbolParams where-  traceWithSpan sp (WorkspaceSymbolParams _ _ query) = setTag sp "query" (encodeUtf8 query)---- -----------------------------------------------------------------------{-# NOINLINE pROCESS_ID #-}-pROCESS_ID :: T.Text-pROCESS_ID = unsafePerformIO getPid--mkLspCommand :: PluginId -> CommandId -> T.Text -> Maybe [Value] -> Command-mkLspCommand plid cn title args' = Command title cmdId args-  where-    cmdId = mkLspCmdId pROCESS_ID plid cn-    args = List <$> 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+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Ide.Types
+    where
+
+#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           Data.Aeson                    hiding (defaultOptions)
+import           GHC.Generics
+import qualified Data.Map  as Map
+import           Data.String
+import qualified Data.Text                     as T
+import           Development.Shake hiding (command)
+import           Ide.Plugin.Config
+import           Language.LSP.Types
+import           Language.LSP.VFS
+import           Language.LSP.Types.Lens as J hiding (id)
+import           Language.LSP.Types.Capabilities
+import           Language.LSP.Server (LspM, getVirtualFile)
+import           Text.Regex.TDFA.Text()
+import           Data.Dependent.Map (DMap)
+import qualified Data.Dependent.Map as DMap
+import Data.List.NonEmpty (NonEmpty(..), toList)
+import Data.GADT.Compare
+import Data.Maybe
+import Data.Semigroup
+import Control.Lens ((^.))
+import qualified Data.DList as DList
+import qualified Data.Default
+import System.IO.Unsafe
+import Control.Monad
+import OpenTelemetry.Eventlog
+import Data.Text.Encoding (encodeUtf8)
+
+-- ---------------------------------------------------------------------
+
+newtype IdePlugins ideState = IdePlugins
+  { ipMap :: Map.Map PluginId (PluginDescriptor ideState)}
+
+-- ---------------------------------------------------------------------
+
+data PluginDescriptor ideState =
+  PluginDescriptor { pluginId          :: !PluginId
+                   , pluginRules       :: !(Rules ())
+                   , pluginCommands    :: ![PluginCommand ideState]
+                   , pluginHandlers    :: PluginHandlers ideState
+                   }
+
+-- | Methods that can be handled by plugins.
+-- 'ExtraParams' captures any extra data the IDE passes to the handlers for this method
+-- Only methods for which we know how to combine responses can be instances of 'PluginMethod'
+class HasTracing (MessageParams m) => PluginMethod m where
+
+  -- | Parse the configuration to check if this plugin is enabled
+  pluginEnabled :: SMethod m -> PluginId -> Config -> Bool
+
+  -- | How to combine responses from different plugins
+  combineResponses
+    :: SMethod m
+    -> Config -- ^ IDE Configuration
+    -> ClientCapabilities
+    -> MessageParams m
+    -> NonEmpty (ResponseResult m) -> ResponseResult m
+
+  default combineResponses :: Semigroup (ResponseResult m)
+    => SMethod m -> Config -> ClientCapabilities -> MessageParams m -> NonEmpty (ResponseResult m) -> ResponseResult m
+  combineResponses _method _config _caps _params = sconcat
+
+instance PluginMethod TextDocumentCodeAction where
+  pluginEnabled _ = pluginEnabledConfig plcCodeActionsOn
+  combineResponses _method _config (ClientCapabilities _ textDocCaps _ _) (CodeActionParams _ _ _ _ context) resps =
+      fmap compat $ List $ filter wasRequested $ (\(List x) -> x) $ sconcat resps
+    where
+
+      compat :: (Command |? CodeAction) -> (Command |? CodeAction)
+      compat x@(InL _) = x
+      compat x@(InR action)
+        | Just _ <- textDocCaps >>= _codeAction >>= _codeActionLiteralSupport
+        = x
+        | otherwise = InL cmd
+        where
+          cmd = mkLspCommand "hls" "fallbackCodeAction" (action ^. title) (Just cmdParams)
+          cmdParams = [toJSON (FallbackCodeActionParams (action ^. edit) (action ^. command))]
+
+      wasRequested :: (Command |? CodeAction) -> Bool
+      wasRequested (InL _) = True
+      wasRequested (InR ca)
+        | Nothing <- _only context = True
+        | Just (List allowed) <- _only context
+        , Just caKind <- ca ^. kind = caKind `elem` allowed
+        | otherwise = False
+
+instance PluginMethod TextDocumentCodeLens where
+  pluginEnabled _ = pluginEnabledConfig plcCodeLensOn
+instance PluginMethod TextDocumentRename where
+  pluginEnabled _ = pluginEnabledConfig plcRenameOn
+instance PluginMethod TextDocumentHover where
+  pluginEnabled _ = pluginEnabledConfig plcHoverOn
+  combineResponses _ _ _ _ (catMaybes . toList -> hs) = h
+    where
+      r = listToMaybe $ mapMaybe (^. range) hs
+      h = case foldMap (^. contents) hs of
+            HoverContentsMS (List []) -> Nothing
+            hh                        -> Just $ Hover hh r
+
+instance PluginMethod TextDocumentDocumentSymbol where
+  pluginEnabled _ = pluginEnabledConfig plcSymbolsOn
+  combineResponses _ _ (ClientCapabilities _ tdc _ _) params xs = res
+    where
+      uri' = params ^. textDocument . uri
+      supportsHierarchy = Just True == (tdc >>= _documentSymbol >>= _hierarchicalDocumentSymbolSupport)
+      dsOrSi = fmap toEither xs
+      res
+        | supportsHierarchy = InL $ sconcat $ fmap (either id (fmap siToDs)) dsOrSi
+        | otherwise = InR $ sconcat $ fmap (either (List . concatMap dsToSi) id) dsOrSi
+      siToDs (SymbolInformation name kind dep (Location _uri range) cont)
+        = DocumentSymbol name cont kind dep range range Nothing
+      dsToSi = go Nothing
+      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'
+
+instance PluginMethod TextDocumentCompletion where
+  pluginEnabled _ = pluginEnabledConfig plcCompletionOn
+  combineResponses _ conf _ _ (toList -> xs) = snd $ consumeCompletionResponse limit $ combine xs
+      where
+        limit = maxCompletions conf
+        combine :: [List CompletionItem |? CompletionList] -> ((List CompletionItem) |? CompletionList)
+        combine cs = go True mempty cs
+
+        go !comp acc [] =
+          InR (CompletionList comp (List $ DList.toList acc))
+        go comp acc (InL (List ls) : rest) =
+          go comp (acc <> DList.fromList ls) rest
+        go comp acc (InR (CompletionList comp' (List ls)) : rest) =
+          go (comp && comp') (acc <> DList.fromList ls) rest
+
+        -- boolean disambiguators
+        isCompleteResponse, isIncompleteResponse :: Bool
+        isIncompleteResponse = True
+        isCompleteResponse = False
+
+        consumeCompletionResponse limit it@(InR (CompletionList _ (List xx))) =
+          case splitAt limit xx of
+            -- consumed all the items, return the result as is
+            (_, []) -> (limit - length xx, it)
+            -- need to crop the response, set the 'isIncomplete' flag
+            (xx', _) -> (0, InR (CompletionList isIncompleteResponse (List xx')))
+        consumeCompletionResponse n (InL (List xx)) =
+          consumeCompletionResponse n (InR (CompletionList isCompleteResponse (List xx)))
+
+instance PluginMethod TextDocumentFormatting where
+  pluginEnabled _ pid conf = (PluginId $ formattingProvider conf) == pid
+  combineResponses _ _ _ _ (x :| _) = x
+
+instance PluginMethod TextDocumentRangeFormatting where
+  pluginEnabled _ pid conf = (PluginId $ formattingProvider conf) == pid
+  combineResponses _ _ _ _ (x :| _) = x
+
+-- | Methods which have a PluginMethod instance
+data IdeMethod (m :: Method FromClient Request) = PluginMethod m => IdeMethod (SMethod m)
+instance GEq IdeMethod where
+  geq (IdeMethod a) (IdeMethod b) = geq a b
+instance GCompare IdeMethod where
+  gcompare (IdeMethod a) (IdeMethod b) = gcompare a b
+
+-- | Combine handlers for the
+newtype PluginHandler a (m :: Method FromClient Request)
+  = PluginHandler (PluginId -> a -> MessageParams m -> LspM Config (NonEmpty (Either ResponseError (ResponseResult m))))
+
+newtype PluginHandlers a = PluginHandlers (DMap IdeMethod (PluginHandler a))
+
+instance Semigroup (PluginHandlers a) where
+  (PluginHandlers a) <> (PluginHandlers b) = PluginHandlers $ DMap.unionWithKey go a b
+    where
+      go _ (PluginHandler f) (PluginHandler g) = PluginHandler $ \pid ide params ->
+        (<>) <$> f pid ide params <*> g pid ide params
+
+instance Monoid (PluginHandlers a) where
+  mempty = PluginHandlers mempty
+
+type PluginMethodHandler a m = a -> PluginId -> MessageParams m -> LspM Config (Either ResponseError (ResponseResult m))
+
+-- | Make a handler for plugins with no extra data
+mkPluginHandler
+  :: PluginMethod m
+  => SClientMethod m
+  -> PluginMethodHandler ideState m
+  -> PluginHandlers ideState
+mkPluginHandler m f = PluginHandlers $ DMap.singleton (IdeMethod m) (PluginHandler f')
+  where
+    f' pid ide params = pure <$> f ide pid params
+
+defaultPluginDescriptor :: PluginId -> PluginDescriptor ideState
+defaultPluginDescriptor plId =
+  PluginDescriptor
+    plId
+    mempty
+    mempty
+    mempty
+
+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
+  = ideState
+  -> a
+  -> LspM Config (Either ResponseError Value)
+
+newtype WithSnippets = WithSnippets Bool
+
+-- ---------------------------------------------------------------------
+
+newtype PluginId = PluginId T.Text
+  deriving (Show, Read, Eq, Ord)
+instance IsString PluginId where
+  fromString = PluginId . T.pack
+
+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
+pluginEnabledConfig :: (PluginConfig -> Bool) -> PluginId -> Config -> Bool
+pluginEnabledConfig f pid config = plcGlobalOn pluginConfig && f pluginConfig
+  where
+    pluginConfig = configForPlugin config pid
+
+-- ---------------------------------------------------------------------
+
+-- | 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
+
+
+type FormattingMethod m =
+  ( J.HasOptions (MessageParams m) FormattingOptions
+  , J.HasTextDocument (MessageParams m) TextDocumentIdentifier
+  , ResponseResult m ~ List TextEdit
+  )
+
+type FormattingHandler a
+  =  a
+  -> FormattingType
+  -> T.Text
+  -> NormalizedFilePath
+  -> FormattingOptions
+  -> LspM Config (Either ResponseError (List TextEdit))
+
+mkFormattingHandlers :: forall a. FormattingHandler a -> PluginHandlers a
+mkFormattingHandlers f = mkPluginHandler STextDocumentFormatting (provider STextDocumentFormatting)
+                      <> mkPluginHandler STextDocumentRangeFormatting (provider STextDocumentRangeFormatting)
+  where
+    provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler a m
+    provider m ide _pid params
+      | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do
+        mf <- getVirtualFile $ toNormalizedUri uri
+        case mf of
+          Just vf -> do
+            let typ = case m of
+                  STextDocumentFormatting -> FormatText
+                  STextDocumentRangeFormatting -> FormatRange (params ^. J.range)
+                  _ -> error "mkFormattingHandlers: impossible"
+            f ide typ (virtualFileText vf) nfp opts
+          Nothing -> pure $ Left $ responseError $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri
+
+      | otherwise = pure $ Left $ responseError $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri
+      where
+        uri = params ^. J.textDocument . J.uri
+        opts = params ^. J.options
+
+-- ---------------------------------------------------------------------
+
+responseError :: T.Text -> ResponseError
+responseError txt = ResponseError InvalidParams txt Nothing
+
+-- ---------------------------------------------------------------------
+
+data FallbackCodeActionParams =
+  FallbackCodeActionParams
+    { fallbackWorkspaceEdit :: Maybe WorkspaceEdit
+    , fallbackCommand       :: Maybe Command
+    }
+  deriving (Generic, ToJSON, FromJSON)
+
+-- ---------------------------------------------------------------------
+
+otSetUri :: SpanInFlight -> Uri -> IO ()
+otSetUri sp (Uri t) = setTag sp "uri" (encodeUtf8 t)
+
+class HasTracing a where
+  traceWithSpan :: SpanInFlight -> a -> IO ()
+  traceWithSpan _ _ = pure ()
+
+instance {-# OVERLAPPABLE #-} (HasTextDocument a doc, HasUri doc Uri) => HasTracing a where
+  traceWithSpan sp a = otSetUri sp (a ^. J.textDocument . J.uri)
+
+instance HasTracing Value
+instance HasTracing ExecuteCommandParams
+instance HasTracing DidChangeWatchedFilesParams
+instance HasTracing DidChangeWorkspaceFoldersParams
+instance HasTracing DidChangeConfigurationParams
+instance HasTracing InitializeParams
+instance HasTracing (Maybe InitializedParams)
+instance HasTracing WorkspaceSymbolParams where
+  traceWithSpan sp (WorkspaceSymbolParams _ _ query) = setTag sp "query" (encodeUtf8 query)
+
+-- ---------------------------------------------------------------------
+
+{-# NOINLINE pROCESS_ID #-}
+pROCESS_ID :: T.Text
+pROCESS_ID = unsafePerformIO getPid
+
+mkLspCommand :: PluginId -> CommandId -> T.Text -> Maybe [Value] -> Command
+mkLspCommand plid cn title args' = Command title cmdId args
+  where
+    cmdId = mkLspCmdId pROCESS_ID plid cn
+    args = List <$> 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