{-# LANGUAGE LambdaCase   #-}
{-# LANGUAGE ViewPatterns #-}
-- | An HLS plugin to provide code actions to change type signatures
module Ide.Plugin.ChangeTypeSignature (descriptor
                                      -- * For Unit Tests
                                      , errorMessageRegexes
                                      ) where

import           Control.Monad                    (guard)
import           Control.Monad.IO.Class           (MonadIO)
import           Control.Monad.Trans.Except       (ExceptT)
import           Data.Foldable                    (asum)
import qualified Data.Map                         as Map
import           Data.Maybe                       (mapMaybe)
import           Data.Text                        (Text)
import qualified Data.Text                        as T
import           Development.IDE                  (realSrcSpanToRange)
import           Development.IDE.Core.PluginUtils
import           Development.IDE.Core.RuleTypes   (GetParsedModule (GetParsedModule))
import           Development.IDE.Core.Service     (IdeState)
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Util         (printOutputable)
import           Generics.SYB                     (extQ, something)
import           Ide.Plugin.Error                 (PluginError,
                                                   getNormalizedFilePathE)
import           Ide.Types                        (PluginDescriptor (..),
                                                   PluginId (PluginId),
                                                   PluginMethodHandler,
                                                   defaultPluginDescriptor,
                                                   mkPluginHandler)
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types
import           Text.Regex.TDFA                  ((=~))

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
"Provides a code action to change the type signature of a binding if it is wrong")
  { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction (codeActionHandler plId) }

codeActionHandler :: PluginId -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionHandler :: PluginId
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionHandler PluginId
plId IdeState
ideState PluginId
_ CodeActionParams {$sel:_textDocument:CodeActionParams :: CodeActionParams -> TextDocumentIdentifier
_textDocument = TextDocumentIdentifier Uri
uri, $sel:_context:CodeActionParams :: CodeActionParams -> CodeActionContext
_context = CodeActionContext [Diagnostic]
diags Maybe [CodeActionKind]
_ Maybe CodeActionTriggerKind
_} = do
      NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (HandlerM Config) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
      [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls <- PluginId
-> IdeState
-> NormalizedFilePath
-> ExceptT PluginError (HandlerM Config) [LHsDecl GhcPs]
forall (m :: * -> *).
MonadIO m =>
PluginId
-> IdeState
-> NormalizedFilePath
-> ExceptT PluginError m [LHsDecl GhcPs]
getDecls PluginId
plId IdeState
ideState NormalizedFilePath
nfp
      let actions :: [Command |? CodeAction]
actions = (Diagnostic -> Maybe (Command |? CodeAction))
-> [Diagnostic] -> [Command |? CodeAction]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PluginId
-> Uri
-> [LHsDecl GhcPs]
-> Diagnostic
-> Maybe (Command |? CodeAction)
generateAction PluginId
plId Uri
uri [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls) [Diagnostic]
diags
      ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (HandlerM Config) ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL [Command |? CodeAction]
actions

getDecls :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m [LHsDecl GhcPs]
getDecls :: forall (m :: * -> *).
MonadIO m =>
PluginId
-> IdeState
-> NormalizedFilePath
-> ExceptT PluginError m [LHsDecl GhcPs]
getDecls (PluginId Text
changeTypeSignatureId) IdeState
state =
    String
-> IdeState
-> ExceptT
     PluginError Action [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ExceptT PluginError m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE (Text -> String
T.unpack Text
changeTypeSignatureId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".GetParsedModule") IdeState
state
    (ExceptT PluginError Action [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> ExceptT PluginError m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (NormalizedFilePath
    -> ExceptT
         PluginError Action [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> NormalizedFilePath
-> ExceptT PluginError m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedModule -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ExceptT PluginError Action ParsedModule
-> ExceptT
     PluginError Action [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b.
(a -> b)
-> ExceptT PluginError Action a -> ExceptT PluginError Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HsModule GhcPs -> [LHsDecl GhcPs]
HsModule GhcPs -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall p. HsModule p -> [LHsDecl p]
hsmodDecls (HsModule GhcPs -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (ParsedModule -> HsModule GhcPs)
-> ParsedModule
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs)
-> (ParsedModule -> GenLocated SrcSpan (HsModule GhcPs))
-> ParsedModule
-> HsModule GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> GenLocated SrcSpan (HsModule GhcPs)
pm_parsed_source)
    (ExceptT PluginError Action ParsedModule
 -> ExceptT
      PluginError Action [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (NormalizedFilePath -> ExceptT PluginError Action ParsedModule)
-> NormalizedFilePath
-> ExceptT
     PluginError Action [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetParsedModule
-> NormalizedFilePath -> ExceptT PluginError Action ParsedModule
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetParsedModule
GetParsedModule

-- | Text representing a Declaration's Name
type DeclName = Text
-- | The signature provided by GHC Error Message (Expected type)
type ExpectedSig = Text
-- | The signature provided by GHC Error Message (Actual type)
type ActualSig = Text

-- | DataType that encodes the necessary information for changing a type signature
data ChangeSignature = ChangeSignature {
                         -- | The expected type based on Signature
                         ChangeSignature -> Text
expectedType  :: ExpectedSig
                         -- | the Actual Type based on definition
                         , ChangeSignature -> Text
actualType  :: ActualSig
                         -- | the declaration name to be updated
                         , ChangeSignature -> Text
declName    :: DeclName
                         -- | the location of the declaration signature
                         , ChangeSignature -> RealSrcSpan
declSrcSpan :: RealSrcSpan
                         -- | the diagnostic to solve
                         , ChangeSignature -> Diagnostic
diagnostic  :: Diagnostic
                         }

-- | Create a CodeAction from a Diagnostic
generateAction :: PluginId -> Uri -> [LHsDecl GhcPs] -> Diagnostic -> Maybe (Command |? CodeAction)
generateAction :: PluginId
-> Uri
-> [LHsDecl GhcPs]
-> Diagnostic
-> Maybe (Command |? CodeAction)
generateAction PluginId
plId Uri
uri [LHsDecl GhcPs]
decls Diagnostic
diag = PluginId -> Uri -> ChangeSignature -> Command |? CodeAction
changeSigToCodeAction PluginId
plId Uri
uri (ChangeSignature -> Command |? CodeAction)
-> Maybe ChangeSignature -> Maybe (Command |? CodeAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs] -> Diagnostic -> Maybe ChangeSignature
diagnosticToChangeSig [LHsDecl GhcPs]
decls Diagnostic
diag

-- | Convert a diagnostic into a ChangeSignature and add the proper SrcSpan
diagnosticToChangeSig :: [LHsDecl GhcPs] -> Diagnostic -> Maybe ChangeSignature
diagnosticToChangeSig :: [LHsDecl GhcPs] -> Diagnostic -> Maybe ChangeSignature
diagnosticToChangeSig [LHsDecl GhcPs]
decls Diagnostic
diagnostic = do
    -- regex match on the GHC Error Message
    (Text
expectedType, Text
actualType, Text
declName) <- Diagnostic -> Maybe (Text, Text, Text)
matchingDiagnostic Diagnostic
diagnostic
    -- Find the definition and it's location
    RealSrcSpan
declSrcSpan <- [LHsDecl GhcPs] -> Text -> String -> Maybe RealSrcSpan
findSigLocOfStringDecl [LHsDecl GhcPs]
decls Text
expectedType (Text -> String
T.unpack Text
declName)
    ChangeSignature -> Maybe ChangeSignature
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChangeSignature -> Maybe ChangeSignature)
-> ChangeSignature -> Maybe ChangeSignature
forall a b. (a -> b) -> a -> b
$ ChangeSignature{Text
RealSrcSpan
Diagnostic
expectedType :: Text
actualType :: Text
declName :: Text
declSrcSpan :: RealSrcSpan
diagnostic :: Diagnostic
diagnostic :: Diagnostic
expectedType :: Text
actualType :: Text
declName :: Text
declSrcSpan :: RealSrcSpan
..}


-- | If a diagnostic has the proper message create a ChangeSignature from it
matchingDiagnostic :: Diagnostic -> Maybe (ExpectedSig, ActualSig, DeclName)
matchingDiagnostic :: Diagnostic -> Maybe (Text, Text, Text)
matchingDiagnostic Diagnostic{Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message} = [Maybe (Text, Text, Text)] -> Maybe (Text, Text, Text)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe (Text, Text, Text)] -> Maybe (Text, Text, Text))
-> [Maybe (Text, Text, Text)] -> Maybe (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe (Text, Text, Text))
-> [Text] -> [Maybe (Text, Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text, Text, Text, [Text]) -> Maybe (Text, Text, Text)
unwrapMatch ((Text, Text, Text, [Text]) -> Maybe (Text, Text, Text))
-> (Text -> (Text, Text, Text, [Text]))
-> Text
-> Maybe (Text, Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> (Text, Text, Text, [Text])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
(=~) Text
_message) [Text]
errorMessageRegexes
    where
        unwrapMatch :: (Text, Text, Text, [Text]) -> Maybe (ExpectedSig, ActualSig, DeclName)
        -- due to using (.|\n) in regex we have to drop the erroneous, but necessary ("." doesn't match newlines), match
        unwrapMatch :: (Text, Text, Text, [Text]) -> Maybe (Text, Text, Text)
unwrapMatch (Text
_, Text
_, Text
_, [Text
expect, Text
actual, Text
_, Text
name]) = (Text, Text, Text) -> Maybe (Text, Text, Text)
forall a. a -> Maybe a
Just (Text
expect, Text
actual, Text
name)
        unwrapMatch (Text, Text, Text, [Text])
_                              = Maybe (Text, Text, Text)
forall a. Maybe a
Nothing

-- | List of regexes that match various Error Messages
errorMessageRegexes :: [Text]
errorMessageRegexes :: [Text]
errorMessageRegexes = [ -- be sure to add new Error Messages Regexes at the bottom to not fail any existing tests
    Text
"Expected type: (.+)\n +Actual type: (.+)\n(.|\n)+In an equation for ‘(.+)’"
    , Text
"Couldn't match expected type ‘(.+)’ with actual type ‘(.+)’\n(.|\n)+In an equation for ‘(.+)’"
    -- GHC >9.2 version of the first error regex
    , Text
"Expected: (.+)\n +Actual: (.+)\n(.|\n)+In an equation for ‘(.+)’"
    ]

-- | Given a String with the name of a declaration, GHC's "Expected Type", find the declaration that matches
-- both the name given and the Expected Type, and return the type signature location
findSigLocOfStringDecl :: [LHsDecl GhcPs] -> ExpectedSig -> String -> Maybe RealSrcSpan
findSigLocOfStringDecl :: [LHsDecl GhcPs] -> Text -> String -> Maybe RealSrcSpan
findSigLocOfStringDecl [LHsDecl GhcPs]
decls Text
expectedType String
declName = GenericQ (Maybe RealSrcSpan) -> GenericQ (Maybe RealSrcSpan)
forall u. GenericQ (Maybe u) -> GenericQ (Maybe u)
something (Maybe RealSrcSpan -> a -> Maybe RealSrcSpan
forall a b. a -> b -> a
const Maybe RealSrcSpan
forall a. Maybe a
Nothing (a -> Maybe RealSrcSpan)
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Maybe RealSrcSpan)
-> a
-> Maybe RealSrcSpan
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` LHsDecl GhcPs -> Maybe RealSrcSpan
GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Maybe RealSrcSpan
findSig (a -> Maybe RealSrcSpan)
-> (GenLocated SrcSpanAnnA (Sig GhcPs) -> Maybe RealSrcSpan)
-> a
-> Maybe RealSrcSpan
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` LSig GhcPs -> Maybe RealSrcSpan
GenLocated SrcSpanAnnA (Sig GhcPs) -> Maybe RealSrcSpan
findLocalSig) [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
    where
        -- search for Top Level Signatures
        findSig :: LHsDecl GhcPs -> Maybe RealSrcSpan
        findSig :: LHsDecl GhcPs -> Maybe RealSrcSpan
findSig = \case
            L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
rss Maybe BufSpan
_)) (SigD XSigD GhcPs
_ Sig GhcPs
sig) -> case Sig GhcPs
sig of
              ts :: Sig GhcPs
ts@(TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
idsSig LHsSigWcType GhcPs
_) -> Sig GhcPs -> [GenLocated SrcSpanAnnN RdrName] -> Maybe ()
forall {t :: * -> *} {name} {l}.
(Foldable t, HasOccName name) =>
Sig GhcPs -> t (GenLocated l name) -> Maybe ()
isMatch Sig GhcPs
ts [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
idsSig Maybe () -> Maybe RealSrcSpan -> Maybe RealSrcSpan
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RealSrcSpan
rss
              Sig GhcPs
_                       -> Maybe RealSrcSpan
forall a. Maybe a
Nothing
            LHsDecl GhcPs
_ -> Maybe RealSrcSpan
forall a. Maybe a
Nothing

        -- search for Local Signatures
        findLocalSig :: LSig GhcPs -> Maybe RealSrcSpan
        findLocalSig :: LSig GhcPs -> Maybe RealSrcSpan
findLocalSig = \case
          (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
rss Maybe BufSpan
_)) ts :: Sig GhcPs
ts@(TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
idsSig LHsSigWcType GhcPs
_)) -> Sig GhcPs -> [GenLocated SrcSpanAnnN RdrName] -> Maybe ()
forall {t :: * -> *} {name} {l}.
(Foldable t, HasOccName name) =>
Sig GhcPs -> t (GenLocated l name) -> Maybe ()
isMatch Sig GhcPs
ts [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
idsSig Maybe () -> Maybe RealSrcSpan -> Maybe RealSrcSpan
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RealSrcSpan
rss
          LSig GhcPs
_          -> Maybe RealSrcSpan
forall a. Maybe a
Nothing

        -- Does the declName match? and does the expected signature match?
        isMatch :: Sig GhcPs -> t (GenLocated l name) -> Maybe ()
isMatch Sig GhcPs
ts t (GenLocated l name)
idsSig = do
                Text
ghcSig <- Sig GhcPs -> Maybe Text
sigToText Sig GhcPs
ts
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((GenLocated l name -> Bool) -> t (GenLocated l name) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GenLocated l name -> Bool
forall {name} {l}. HasOccName name => GenLocated l name -> Bool
compareId t (GenLocated l name)
idsSig Bool -> Bool -> Bool
&& Text
expectedType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ghcSig)

        -- Given an IdP check to see if it matches the declName
        compareId :: GenLocated l name -> Bool
compareId (L l
_ name
id') = String
declName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== OccName -> String
occNameString (name -> OccName
forall name. HasOccName name => name -> OccName
occName name
id')


-- | Pretty Print the Type Signature (to validate GHC Error Message)
sigToText :: Sig GhcPs -> Maybe Text
sigToText :: Sig GhcPs -> Maybe Text
sigToText = \case
  ts :: Sig GhcPs
ts@TypeSig {} -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripSignature (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Sig GhcPs -> Text
forall a. Outputable a => a -> Text
printOutputable Sig GhcPs
ts
  Sig GhcPs
_             -> Maybe Text
forall a. Maybe a
Nothing

stripSignature :: Text -> Text
-- for whatever reason incoming signatures MAY have new lines after "::" or "=>"
stripSignature :: Text -> Text
stripSignature ((Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') -> Text
sig) = if Text -> Text -> Bool
T.isInfixOf Text
" => " Text
sig
                                                -- remove constraints
                                                then Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
" => " Text
sig
                                                else Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
" :: " Text
sig

changeSigToCodeAction :: PluginId -> Uri -> ChangeSignature -> Command |? CodeAction
changeSigToCodeAction :: PluginId -> Uri -> ChangeSignature -> Command |? CodeAction
changeSigToCodeAction (PluginId Text
changeTypeSignatureId) Uri
uri ChangeSignature{Text
RealSrcSpan
Diagnostic
expectedType :: ChangeSignature -> Text
actualType :: ChangeSignature -> Text
declName :: ChangeSignature -> Text
declSrcSpan :: ChangeSignature -> RealSrcSpan
diagnostic :: ChangeSignature -> Diagnostic
expectedType :: Text
actualType :: Text
declName :: Text
declSrcSpan :: RealSrcSpan
diagnostic :: Diagnostic
..} =
    CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR CodeAction { $sel:_title:CodeAction :: Text
_title       = Text -> Text -> Text
mkChangeSigTitle Text
declName Text
actualType
                   , $sel:_kind:CodeAction :: Maybe CodeActionKind
_kind        = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just (Text -> CodeActionKind
CodeActionKind_Custom (Text
"quickfix." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
changeTypeSignatureId))
                   , $sel:_diagnostics:CodeAction :: Maybe [Diagnostic]
_diagnostics = [Diagnostic] -> Maybe [Diagnostic]
forall a. a -> Maybe a
Just [Diagnostic
diagnostic]
                   , $sel:_isPreferred:CodeAction :: Maybe Bool
_isPreferred = Maybe Bool
forall a. Maybe a
Nothing
                   , $sel:_disabled:CodeAction :: Maybe CodeActionDisabled
_disabled    = Maybe CodeActionDisabled
forall a. Maybe a
Nothing
                   , $sel:_edit:CodeAction :: Maybe WorkspaceEdit
_edit        = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just (WorkspaceEdit -> Maybe WorkspaceEdit)
-> WorkspaceEdit -> Maybe WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Uri -> RealSrcSpan -> Text -> WorkspaceEdit
mkChangeSigEdit Uri
uri RealSrcSpan
declSrcSpan (Text -> Text -> Text
mkNewSignature Text
declName Text
actualType)
                   , $sel:_command:CodeAction :: Maybe Command
_command     = Maybe Command
forall a. Maybe a
Nothing
                   , $sel:_data_:CodeAction :: Maybe Value
_data_       = Maybe Value
forall a. Maybe a
Nothing
                   }

mkChangeSigTitle :: Text -> Text -> Text
mkChangeSigTitle :: Text -> Text -> Text
mkChangeSigTitle Text
declName Text
actualType = Text
"Change signature for ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
declName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’ to: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
actualType

mkChangeSigEdit :: Uri -> RealSrcSpan -> Text -> WorkspaceEdit
mkChangeSigEdit :: Uri -> RealSrcSpan -> Text -> WorkspaceEdit
mkChangeSigEdit Uri
uri RealSrcSpan
ss Text
replacement =
        let txtEdit :: TextEdit
txtEdit = Range -> Text -> TextEdit
TextEdit (RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
ss) Text
replacement
            changes :: Maybe (Map Uri [TextEdit])
changes = Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit]))
-> Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a b. (a -> b) -> a -> b
$ Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton Uri
uri [TextEdit
txtEdit]
        in Maybe (Map Uri [TextEdit])
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit Maybe (Map Uri [TextEdit])
changes Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing

mkNewSignature :: Text -> Text -> Text
mkNewSignature :: Text -> Text -> Text
mkNewSignature Text
declName Text
actualType = Text
declName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
actualType