refactor kicks to use runWithsignal

haskell · Aug 1, 2024 · faec0ab · faec0ab
1 parent 85c13dc
commit faec0ab
Show file tree

Hide file tree

Showing 4 changed files with 12 additions and 15 deletions.
diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -74,7 +74,7 @@ module Development.IDE.Core.Shake(
     Log(..),
     VFSModified(..), getClientConfigAction,
     ThreadQueue(..),
-    kickSignal
+    runWithSignal
     ) where
 
 import           Control.Concurrent.Async
@@ -124,6 +124,7 @@ import           Development.IDE.Core.FileUtils         (getModTime)
 import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.ProgressReporting
 import           Development.IDE.Core.RuleTypes
+import           Development.IDE.Types.Options          as Options
 import qualified Language.LSP.Protocol.Message          as LSP
 import qualified Language.LSP.Server                    as LSP
 
@@ -151,7 +152,6 @@ import qualified Development.IDE.Types.Exports          as ExportsMap
 import           Development.IDE.Types.KnownTargets
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Monitoring       (Monitoring (..))
-import           Development.IDE.Types.Options
 import           Development.IDE.Types.Shake
 import qualified Focus
 import           GHC.Fingerprint
@@ -170,7 +170,6 @@ import qualified Language.LSP.Protocol.Lens             as L
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
 import qualified Language.LSP.Protocol.Types            as LSP
-import qualified Language.LSP.Server                    as LSP
 import           Language.LSP.VFS                       hiding (start)
 import qualified "list-t" ListT
 import           OpenTelemetry.Eventlog                 hiding (addEvent)
@@ -1456,3 +1455,11 @@ kickSignal :: KnownSymbol s => Bool -> Maybe (LSP.LanguageContextEnv c) -> [Norm
 kickSignal testing lspEnv files msg = when testing $ liftIO $ mRunLspT lspEnv $
   LSP.sendNotification (LSP.SMethod_CustomMethod msg) $
   toJSON $ map fromNormalizedFilePath files
+
+-- | Add kick start/done signal to rule
+runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Proxy s0 -> Proxy s1 -> [NormalizedFilePath] -> k -> Action ()
+runWithSignal msgStart msgEnd files rule = do
+  ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- getShakeExtras
+  kickSignal testing lspEnv files msgStart
+  void $ uses rule files
+  kickSignal testing lspEnv files msgEnd
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
@@ -714,7 +714,6 @@ library hls-hlint-plugin
     , hlint                 >= 3.5 && < 3.9
     , hls-plugin-api        == 2.9.0.1
     , lens
-    , lsp
     , mtl
     , refact
     , regex-tdfa

diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
@@ -27,7 +27,6 @@ import           Development.IDE.Core.Shake                  (restartShakeSessio
 import qualified Development.IDE.Core.Shake                  as Shake
 import           Development.IDE.Graph                       (Key, alwaysRerun)
 import qualified Development.IDE.Plugin.Completions.Logic    as Ghcide
-import qualified Development.IDE.Types.Options               as Options
 import           Development.IDE.Types.Shake                 (toKey)
 import qualified Distribution.Fields                         as Syntax
 import qualified Distribution.Parsec.Position                as Syntax
@@ -230,10 +229,7 @@ function invocation.
 kick :: Action ()
 kick = do
   files <- HashMap.keys <$> getCabalFilesOfInterestUntracked
-  Shake.ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- Shake.getShakeExtras
-  Shake.kickSignal testing lspEnv files (Proxy @"kick/start/cabal")
-  void $ uses Types.ParseCabalFile files
-  Shake.kickSignal testing lspEnv files (Proxy @"kick/done/cabal")
+  Shake.runWithSignal (Proxy @"kick/start/cabal") (Proxy @"kick/done/cabal") files Types.ParseCabalFile
 
 -- ----------------------------------------------------------------
 -- Code Actions

diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
@@ -29,7 +29,6 @@ import           Control.Concurrent.STM
 import           Control.DeepSeq
 import           Control.Exception
 import           Control.Lens                                       ((?~), (^.))
-import           Control.Monad
 import           Control.Monad.Error.Class                          (MonadError (throwError))
 import           Control.Monad.IO.Class                             (MonadIO (liftIO))
 import           Control.Monad.Trans.Class                          (MonadTrans (lift))
@@ -118,7 +117,6 @@ import           System.Environment                                 (setEnv,
                                                                      unsetEnv)
 #endif
 import           Development.IDE.Core.PluginUtils                   as PluginUtils
-import qualified Development.IDE.Types.Options                      as Options
 import           Text.Regex.TDFA.Text                               ()
 
 -- ---------------------------------------------------------------------
@@ -205,10 +203,7 @@ rules recorder plugin = do
 
   action $ do
     files <- Map.keys <$> getFilesOfInterestUntracked
-    Shake.ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- Shake.getShakeExtras
-    Shake.kickSignal testing lspEnv files (Proxy @"kick/start/hlint")
-    void $ uses GetHlintDiagnostics files
-    Shake.kickSignal testing lspEnv files (Proxy @"kick/done/hlint")
+    Shake.runWithSignal (Proxy @"kick/start/hlint") (Proxy @"kick/done/hlint") files GetHlintDiagnostics
 
   where