From a47da196143c200970a0c3716031b468fe80404b Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Sun, 28 Nov 2021 23:43:19 -0500 Subject: [PATCH] Centralize common Functions. `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. --- hls-plugin-api/hls-plugin-api.cabal | 2 ++ hls-plugin-api/src/Ide/PluginUtils.hs | 20 ++++++++++++++++++ .../hls-alternate-number-format-plugin.cabal | 2 -- .../src/Ide/Plugin/AlternateNumberFormat.hs | 2 +- .../src/Ide/Plugin/Eval/CodeLens.hs | 8 +++---- .../src/Ide/Plugin/Eval/Util.hs | 20 +----------------- .../hls-rename-plugin/hls-rename-plugin.cabal | 1 - .../src/Ide/Plugin/Rename.hs | 1 - .../src/Ide/Plugin/Retrie.hs | 21 +++---------------- 9 files changed, 31 insertions(+), 46 deletions(-) diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 153631a05c..a8670669f0 100644 --- 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 index 66d6f30144..924e92dabb 100644 --- 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 index 634cb3acae..20bd4be3d3 100644 --- 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 index ee2c203b70..53056164e2 100644 --- 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 index 5912bba2d7..744d039542 100644 --- 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 index a249aa1214..c33d6cbc68 100644 --- 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 index e08d0b86da..467eae9d43 100644 --- 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 index dee36366cd..b1d068a964 100644 --- 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 index 5771964067..322bb5f778 100644 --- 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