Centralize common Functions. (#2433)

`response`, `handleMaybe`, `handleMaybeM` are three functions that pop up in a variety of plugins. This commit centralizes these three functions into one module, and makes the change across the related plugins. Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> Co-authored-by: Javier Neira <atreyu.bbb@gmail.com>
haskell · Dec 4, 2021 · 77d0429 · 77d0429
1 parent 8441ef2
commit 77d0429
Show file tree

Hide file tree

Showing 9 changed files with 31 additions and 46 deletions.
diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal
@@ -43,6 +43,7 @@ library
     , dependent-sum
     , Diff                  ^>=0.4.0
     , dlist
+    , extra
     , ghc
     , hashable
     , hls-graph             >=1.4 && < 1.6
@@ -54,6 +55,7 @@ library
     , process
     , regex-tdfa            >=1.3.1.0
     , text
+    , transformers
     , unordered-containers
 
   if os(windows)

diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs
@@ -26,14 +26,22 @@ module Ide.PluginUtils
     installSigUsr1Handler,
     subRange,
     usePropertyLsp,
+    response,
+    handleMaybe,
+    handleMaybeM,
     )
 where
 
 
+import           Control.Monad.Extra             (maybeM)
+import           Control.Monad.Trans.Class       (lift)
+import           Control.Monad.Trans.Except      (ExceptT, runExceptT, throwE)
 import           Data.Algorithm.Diff
 import           Data.Algorithm.DiffOutput
+import           Data.Bifunctor                  (Bifunctor (first))
 import           Data.Containers.ListUtils       (nubOrdOn)
 import qualified Data.HashMap.Strict             as H
+import           Data.String                     (IsString (fromString))
 import qualified Data.Text                       as T
 import           Ide.Plugin.Config
 import           Ide.Plugin.Properties
@@ -236,3 +244,15 @@ allLspCmdIds pid commands = concatMap go commands
   where
     go (plid, cmds) = map (mkLspCmdId pid plid . commandId) cmds
 
+-- ---------------------------------------------------------------------
+
+handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
+handleMaybe msg = maybe (throwE msg) return
+
+handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
+handleMaybeM msg act = maybeM (throwE msg) return $ lift act
+
+response :: Monad m => ExceptT String m a -> m (Either ResponseError a)
+response =
+  fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing))
+    . runExceptT
diff --git a/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal b/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal
@@ -29,7 +29,6 @@ library
     , ghc-boot-th
     , hls-graph
     , hls-plugin-api       >=1.1 && < 1.3
-    , hls-retrie-plugin
     , hie-compat
     , lens
     , lsp
@@ -41,7 +40,6 @@ library
 
   default-language: Haskell2010
   default-extensions:
-    CPP
     LambdaCase
     NamedFieldPuns
     OverloadedStrings

diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs
@@ -23,7 +23,7 @@ import           Ide.Plugin.Conversion           (FormatType, alternateFormat,
                                                   toFormatTypes)
 import           Ide.Plugin.Literals             (Literal (..), collectLiterals,
                                                   getSrcSpan, getSrcText)
-import           Ide.Plugin.Retrie               (handleMaybe, handleMaybeM,
+import           Ide.PluginUtils                 (handleMaybe, handleMaybeM,
                                                   response)
 import           Ide.Types
 import           Language.LSP.Types

diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs
@@ -90,10 +90,10 @@ import           Ide.Plugin.Eval.Parse.Comments  (commentsToSections)
 import           Ide.Plugin.Eval.Parse.Option    (parseSetFlags)
 import           Ide.Plugin.Eval.Rules           (queueForEvaluation)
 import           Ide.Plugin.Eval.Types
-import           Ide.Plugin.Eval.Util            (asS, gStrictTry, handleMaybe,
-                                                  handleMaybeM, isLiterate,
-                                                  logWith, response, response',
-                                                  timed)
+import           Ide.Plugin.Eval.Util            (asS, gStrictTry, isLiterate,
+                                                  logWith, response', timed)
+import           Ide.PluginUtils                 (handleMaybe, handleMaybeM,
+                                                  response)
 import           Ide.Types
 import           Language.LSP.Server
 import           Language.LSP.Types              hiding

diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs
@@ -7,22 +7,15 @@ module Ide.Plugin.Eval.Util (
     asS,
     timed,
     isLiterate,
-    handleMaybe,
-    handleMaybeM,
-    response,
     response',
     gStrictTry,
     logWith,
 ) where
 
 import           Control.Exception               (SomeException, evaluate)
-import           Control.Monad.Extra             (maybeM)
 import           Control.Monad.IO.Class          (MonadIO (liftIO))
-import           Control.Monad.Trans.Class       (lift)
-import           Control.Monad.Trans.Except      (ExceptT (..), runExceptT,
-                                                  throwE)
+import           Control.Monad.Trans.Except      (ExceptT (..), runExceptT)
 import           Data.Aeson                      (Value (Null))
-import           Data.Bifunctor                  (first)
 import           Data.String                     (IsString (fromString))
 import qualified Data.Text                       as T
 import           Development.IDE                 (IdeState, Priority (..),
@@ -71,17 +64,6 @@ logLevel = Debug -- Info
 isLiterate :: FilePath -> Bool
 isLiterate x = takeExtension x `elem` [".lhs", ".lhs-boot"]
 
-handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
-handleMaybe msg = maybe (throwE msg) return
-
-handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
-handleMaybeM msg act = maybeM (throwE msg) return $ lift act
-
-response :: Functor f => ExceptT String f c -> f (Either ResponseError c)
-response =
-    fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing))
-        . runExceptT
-
 response' :: ExceptT String (LspM c) WorkspaceEdit -> LspM c (Either ResponseError Value)
 response' act = do
     res <- runExceptT act

diff --git a/plugins/hls-rename-plugin/hls-rename-plugin.cabal b/plugins/hls-rename-plugin/hls-rename-plugin.cabal
@@ -28,7 +28,6 @@ library
     , ghcide                >=1.4     && <1.6
     , hiedb
     , hls-plugin-api        ^>=1.2
-    , hls-retrie-plugin     >=1.0.1.1
     , lsp
     , lsp-types
     , syb

diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs
@@ -27,7 +27,6 @@ import           Name
 #endif
 import           HieDb.Query
 import           Ide.Plugin.Config
-import           Ide.Plugin.Retrie                    hiding (descriptor)
 import           Ide.PluginUtils
 import           Ide.Types
 import           Language.Haskell.GHC.ExactPrint

diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs
@@ -14,18 +14,17 @@
 
 {-# OPTIONS -Wno-orphans #-}
 
-module Ide.Plugin.Retrie (descriptor, response, handleMaybe, handleMaybeM) where
+module Ide.Plugin.Retrie (descriptor) where
 
 import           Control.Concurrent.Extra             (readVar)
 import           Control.Exception.Safe               (Exception (..),
                                                        SomeException, catch,
                                                        throwIO, try)
 import           Control.Monad                        (forM, unless)
-import           Control.Monad.Extra                  (maybeM)
 import           Control.Monad.IO.Class               (MonadIO (liftIO))
 import           Control.Monad.Trans.Class            (MonadTrans (lift))
-import           Control.Monad.Trans.Except           (ExceptT (..), runExceptT,
-                                                       throwE)
+import           Control.Monad.Trans.Except           (ExceptT (ExceptT),
+                                                       runExceptT)
 import           Control.Monad.Trans.Maybe
 import           Data.Aeson                           (FromJSON (..),
                                                        ToJSON (..),
@@ -499,20 +498,6 @@ _useRuleStale label state rule f =
 -- | Chosen approach for calling ghcide Shake rules
 useRule label = _useRuleStale ("Retrie." <> label)
 
--------------------------------------------------------------------------------
--- Error handling combinators
-
-handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
-handleMaybe msg = maybe (throwE msg) return
-
-handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
-handleMaybeM msg act = maybeM (throwE msg) return $ lift act
-
-response :: Monad m => ExceptT String m a -> m (Either ResponseError a)
-response =
-  fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing))
-    . runExceptT
-
 -------------------------------------------------------------------------------
 -- Serialization wrappers and instances