15
15
{-# LANGUAGE ScopedTypeVariables #-}
16
16
{-# LANGUAGE StrictData #-}
17
17
{-# LANGUAGE TupleSections #-}
18
+ {-# LANGUAGE TypeApplications #-}
18
19
{-# LANGUAGE TypeFamilies #-}
19
20
{-# LANGUAGE ViewPatterns #-}
20
-
21
21
{-# OPTIONS_GHC -Wno-orphans #-}
22
22
23
23
-- On 9.4 we get a new redundant constraint warning, but deleting the
@@ -423,7 +423,7 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context
423
423
424
424
where
425
425
applyAllAction verTxtDocId =
426
- let args = Just $ toJSON (AA verTxtDocId)
426
+ let args = Just $ toJSON (ApplyHint verTxtDocId Nothing )
427
427
in LSP. CodeAction " Apply all hints" (Just LSP. CodeActionKind_QuickFix ) Nothing Nothing Nothing Nothing Nothing args
428
428
429
429
-- | Some hints do not have an associated refactoring
@@ -435,23 +435,21 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context
435
435
diags = context ^. LSP. diagnostics
436
436
437
437
resolveProvider :: Recorder (WithPriority Log ) -> PluginMethodHandler IdeState Method_CodeActionResolve
438
- resolveProvider recorder ideState _pluginId ca@ CodeAction {_data_ = Just data_} = pluginResponse $ do
439
- case fromJSON data_ of
440
- (Success (AA verTxtDocId@ (VersionedTextDocumentIdentifier uri _))) -> do
441
- file <- getNormalizedFilePath uri
442
- edit <- ExceptT $ liftIO $ applyHint recorder ideState file Nothing verTxtDocId
443
- pure $ ca & LSP. edit ?~ edit
444
- (Success (AO verTxtDocId@ (VersionedTextDocumentIdentifier uri _) pos hintTitle)) -> do
445
- let oneHint = OneHint pos hintTitle
446
- file <- getNormalizedFilePath uri
447
- edit <- ExceptT $ liftIO $ applyHint recorder ideState file (Just oneHint) verTxtDocId
438
+ resolveProvider recorder ideState _
439
+ ca@ CodeAction {_data_ = Just (fromJSON -> (Success (ApplyHint verTxtDocId oneHint)))} = pluginResponse $ do
440
+ file <- getNormalizedFilePath (verTxtDocId ^. LSP. uri)
441
+ edit <- ExceptT $ liftIO $ applyHint recorder ideState file oneHint verTxtDocId
448
442
pure $ ca & LSP. edit ?~ edit
449
- (Success (IH verTxtDocId@ (VersionedTextDocumentIdentifier uri _) hintTitle )) -> do
450
- file <- getNormalizedFilePath uri
443
+ resolveProvider recorder ideState _
444
+ ca@ CodeAction {_data_ = Just (fromJSON -> (Success (IgnoreHint verTxtDocId hintTitle)))} = pluginResponse $ do
445
+ file <- getNormalizedFilePath (verTxtDocId ^. LSP. uri)
451
446
edit <- ExceptT $ liftIO $ ignoreHint recorder ideState file verTxtDocId hintTitle
452
447
pure $ ca & LSP. edit ?~ edit
453
- Error s-> throwE (" JSON decoding error: " <> s)
454
- resolveProvider _ _ _ _ = pluginResponse $ throwE " CodeAction with no data field"
448
+ resolveProvider _ _ _
449
+ CodeAction {_data_ = Just (fromJSON @ HlintResolveCommands -> (Error (T. pack -> str)))} =
450
+ pure $ Left $ ResponseError (InR ErrorCodes_ParseError ) str Nothing
451
+ resolveProvider _ _ _ CodeAction {_data_ = _} =
452
+ pure $ Left $ ResponseError (InR ErrorCodes_InvalidParams ) " Unexpected argument for code action resolve handler: (Probably Nothing)" Nothing
455
453
456
454
-- | Convert a hlint diagnostic into an apply and an ignore code action
457
455
-- if applicable
@@ -461,13 +459,13 @@ diagnosticToCodeActions verTxtDocId diagnostic
461
459
, let isHintApplicable = " refact:" `T.isPrefixOf` code
462
460
, let hint = T. replace " refact:" " " code
463
461
, let suppressHintTitle = " Ignore hint \" " <> hint <> " \" in this module"
464
- , let suppressHintArguments = IH verTxtDocId hint
462
+ , let suppressHintArguments = IgnoreHint verTxtDocId hint
465
463
= catMaybes
466
464
-- Applying the hint is marked preferred because it addresses the underlying error.
467
465
-- Disabling the rule isn't, because less often used and configuration can be adapted.
468
466
[ if | isHintApplicable
469
467
, let applyHintTitle = " Apply hint \" " <> hint <> " \" "
470
- applyHintArguments = AO verTxtDocId start hint ->
468
+ applyHintArguments = ApplyHint verTxtDocId ( Just $ OneHint start hint) ->
471
469
Just (mkCodeAction applyHintTitle diagnostic (Just (toJSON applyHintArguments)) True )
472
470
| otherwise -> Nothing
473
471
, Just (mkCodeAction suppressHintTitle diagnostic (Just (toJSON suppressHintArguments)) False )
@@ -525,22 +523,25 @@ ignoreHint _recorder ideState nfp verTxtDocId ignoreHintTitle = do
525
523
Nothing -> pure $ Left " Unable to get fileContents"
526
524
527
525
-- ---------------------------------------------------------------------
528
- data HlintResolveCommands = AA { verTxtDocId :: VersionedTextDocumentIdentifier }
529
- | AO { verTxtDocId :: VersionedTextDocumentIdentifier
530
- , start_pos :: Position
531
- -- | There can be more than one hint suggested at the same position, so HintTitle is used to distinguish between them.
532
- , hintTitle :: HintTitle
533
- }
534
- | IH { verTxtDocId :: VersionedTextDocumentIdentifier
535
- , ignoreHintTitle :: HintTitle
536
- } deriving (Generic , ToJSON , FromJSON )
526
+ data HlintResolveCommands =
527
+ ApplyHint
528
+ { verTxtDocId :: VersionedTextDocumentIdentifier
529
+ -- | If Nothing, apply all hints, otherise only apply
530
+ -- the given hint
531
+ , oneHint :: Maybe OneHint
532
+ }
533
+ | IgnoreHint
534
+ { verTxtDocId :: VersionedTextDocumentIdentifier
535
+ , ignoreHintTitle :: HintTitle
536
+ } deriving (Generic , ToJSON , FromJSON )
537
537
538
538
type HintTitle = T. Text
539
539
540
- data OneHint = OneHint
541
- { oneHintPos :: Position
542
- , oneHintTitle :: HintTitle
543
- } deriving (Eq , Show )
540
+ data OneHint =
541
+ OneHint
542
+ { oneHintPos :: Position
543
+ , oneHintTitle :: HintTitle
544
+ } deriving (Generic , Eq , Show , ToJSON , FromJSON )
544
545
545
546
applyHint :: Recorder (WithPriority Log ) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either String WorkspaceEdit )
546
547
applyHint recorder ide nfp mhint verTxtDocId =
0 commit comments