66
77module Ide.Plugin.Cabal (descriptor , haskellInteractionDescriptor , Log (.. )) where
88
9+ import Control.Applicative ((<|>) )
910import Control.Lens ((^.) )
11+ import Control.Monad.Except (runExceptT )
1012import Control.Monad.Extra
1113import Control.Monad.IO.Class
1214import Control.Monad.Trans.Class (lift )
15+ import Control.Monad.Trans.Except (ExceptT )
1316import Control.Monad.Trans.Maybe (runMaybeT )
17+ import Data.Foldable (foldl' )
1418import Data.HashMap.Strict (HashMap )
1519import qualified Data.List as List
20+ import qualified Data.Map.Strict as Map
1621import qualified Data.Maybe as Maybe
1722import qualified Data.Text ()
1823import qualified Data.Text as T
1924import Development.IDE as D
2025import Development.IDE.Core.FileStore (getVersionedTextDoc )
2126import Development.IDE.Core.PluginUtils
2227import Development.IDE.Core.Shake (restartShakeSession )
28+ import qualified Development.IDE.Core.Shake as Shake
2329import Development.IDE.Graph (Key )
2430import Development.IDE.LSP.HoverDefinition (foundHover )
2531import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
@@ -33,6 +39,7 @@ import Distribution.PackageDescription.Configuration (flattenPackageDe
3339import qualified Distribution.Parsec.Position as Syntax
3440import qualified Ide.Plugin.Cabal.CabalAdd.CodeAction as CabalAdd
3541import qualified Ide.Plugin.Cabal.CabalAdd.Command as CabalAdd
42+ import qualified Ide.Plugin.Cabal.CabalAdd.Rename as Rename
3643import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
3744import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
3845import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
@@ -70,7 +77,11 @@ data Log
7077 | LogCompletionContext Types. Context Position
7178 | LogCompletions Types. Log
7279 | LogCabalAdd CabalAdd. Log
73- deriving (Show )
80+ | LogDidRename Rename. Log
81+ | LogShake Shake. Log
82+ | LogSessionRestart
83+ | LogNoCabalFile FilePath
84+ | LogCabalRenameFailed T. Text PluginError
7485
7586instance Pretty Log where
7687 pretty = \ case
@@ -95,6 +106,11 @@ instance Pretty Log where
95106 <+> pretty position
96107 LogCompletions logs -> pretty logs
97108 LogCabalAdd logs -> pretty logs
109+ LogDidRename logs -> pretty logs
110+ LogSessionRestart -> " Restarting shake session globally"
111+ LogShake logs -> pretty logs
112+ LogNoCabalFile file -> " Cannot find responsible cabal file for" <+> pretty file
113+ LogCabalRenameFailed file err -> " Rename of file" <+> pretty file <+> " failed with error:" <+> pretty err
98114
99115{- | Some actions in cabal files can be triggered from haskell files.
100116This descriptor allows us to hook into the diagnostics of haskell source files and
@@ -128,6 +144,7 @@ descriptor recorder plId =
128144 , mkPluginHandler LSP. SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
129145 , mkPluginHandler LSP. SMethod_TextDocumentDefinition gotoDefinition
130146 , mkPluginHandler LSP. SMethod_TextDocumentHover hover
147+ , mkPluginHandler LSP. SMethod_WorkspaceWillRenameFiles $ renameModulesHandler recorder
131148 ]
132149 , pluginNotificationHandlers =
133150 mconcat
@@ -165,7 +182,6 @@ descriptor recorder plId =
165182 log' = logWith recorder
166183 ruleRecorder = cmapWithPrio LogRule recorder
167184 ofInterestRecorder = cmapWithPrio LogOfInterest recorder
168-
169185 whenUriFile :: Uri -> (NormalizedFilePath -> IO () ) -> IO ()
170186 whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath'
171187
@@ -300,6 +316,38 @@ cabalAddModuleCodeAction recorder state plId (CodeActionParams _ _ (TextDocument
300316 pure $ InL $ fmap InR actions
301317 Nothing -> pure $ InL []
302318
319+ renameModulesHandler :: Recorder (WithPriority Log ) -> PluginMethodHandler IdeState LSP. Method_WorkspaceWillRenameFiles
320+ renameModulesHandler recorder ideState _plId (RenameFilesParams renames) = do
321+ renamedEdits <- traverse (renameModuleHelper recorder ideState) renames
322+ pure $ InL $ foldl' combineTextEdits (WorkspaceEdit mempty mempty mempty ) renamedEdits
323+
324+ renameModuleHelper :: Recorder (WithPriority Log ) -> IdeState -> FileRename -> ExceptT PluginError (HandlerM Config ) WorkspaceEdit
325+ renameModuleHelper recorder ideState (FileRename oldUri newUri) = do
326+ caps <- lift pluginGetClientCapabilities
327+ renameResult <- runExceptT $ do
328+ oldHaskellFilePath <- uriToFilePathE $ Uri oldUri
329+ newHaskellFilePath <- uriToFilePathE $ Uri newUri
330+ mbCabalFile <- liftIO $ CabalAdd. findResponsibleCabalFile oldHaskellFilePath
331+ case mbCabalFile of
332+ Nothing -> do
333+ logWith recorder Debug $ LogNoCabalFile oldHaskellFilePath
334+ pure mempty
335+ Just cabalFilePath ->
336+ Rename. renameHandler
337+ (cmapWithPrio LogDidRename recorder)
338+ ideState
339+ caps
340+ oldHaskellFilePath
341+ newHaskellFilePath
342+ cabalFilePath
343+ ideState
344+ case renameResult of
345+ Left err -> do
346+ logWith recorder Debug $ LogCabalRenameFailed oldUri err
347+ pure mempty
348+ Right edit -> do
349+ pure edit
350+
303351{- | Handler for hover messages.
304352
305353If the cursor is hovering on a dependency, add a documentation link to that dependency.
@@ -410,3 +458,14 @@ computeCompletionsAt recorder ide prefInfo fp fields matcher = do
410458 pos = Types. completionCursorPosition prefInfo
411459 context fields = Completions. getContext completerRecorder prefInfo fields
412460 completerRecorder = cmapWithPrio LogCompletions recorder
461+
462+ combineTextEdits :: WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit
463+ combineTextEdits (WorkspaceEdit c1 dc1 ca1) (WorkspaceEdit c2 dc2 ca2) =
464+ WorkspaceEdit c dc ca
465+ where
466+ c = liftA2 (Map. unionWith (<>) ) c1 c2 <|> c1 <|> c2
467+ dc = dc1 <> dc2
468+ -- We know this might result in information loss due to the monad instance of map,
469+ -- but we do not expect our use of workspacedit combination to contain two changeAnnotations
470+ -- for the same edit.
471+ ca = ca1 <> ca2
0 commit comments