{-# 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 (liftIO))
import           Control.Monad.Trans.Except     (ExceptT)
import           Data.Foldable                  (asum)
import qualified Data.HashMap.Strict            as Map
import           Data.Maybe                     (mapMaybe)
import           Data.Text                      (Text)
import qualified Data.Text                      as T
import           Development.IDE                (realSrcSpanToRange)
import           Development.IDE.Core.RuleTypes (GetParsedModule (GetParsedModule))
import           Development.IDE.Core.Service   (IdeState, runAction)
import           Development.IDE.Core.Shake     (use)
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Util       (printOutputable)
import           Generics.SYB                   (extQ, something)
import           Ide.PluginUtils                (getNormalizedFilePath,
                                                 handleMaybeM, response)
import           Ide.Types                      (PluginDescriptor (..),
                                                 PluginId, PluginMethodHandler,
                                                 defaultPluginDescriptor,
                                                 mkPluginHandler)
import           Language.LSP.Types
import           Text.Regex.TDFA                ((=~))

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId) { pluginHandlers :: PluginHandlers IdeState
pluginHandlers = SClientMethod 'TextDocumentCodeAction
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentCodeAction
STextDocumentCodeAction PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionHandler }

codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionHandler IdeState
ideState PluginId
plId CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext (List diags) _} = ExceptT String (LspT Config IO) (List (Command |? CodeAction))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall (m :: * -> *) a.
Monad m =>
ExceptT String m a -> m (Either ResponseError a)
response (ExceptT String (LspT Config IO) (List (Command |? CodeAction))
 -> LspT
      Config IO (Either ResponseError (List (Command |? CodeAction))))
-> ExceptT String (LspT Config IO) (List (Command |? CodeAction))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ do
      NormalizedFilePath
nfp <- PluginId
-> TextDocumentIdentifier
-> ExceptT String (LspT Config IO) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
PluginId
-> TextDocumentIdentifier -> ExceptT String m NormalizedFilePath
getNormalizedFilePath PluginId
plId (Uri -> TextDocumentIdentifier
TextDocumentIdentifier Uri
uri)
      [LHsDecl GhcPs]
decls <- IdeState
-> NormalizedFilePath
-> ExceptT String (LspT Config IO) [LHsDecl GhcPs]
forall (m :: * -> *).
MonadIO m =>
IdeState -> NormalizedFilePath -> ExceptT String m [LHsDecl GhcPs]
getDecls 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 (SigName =>
Uri
-> [LHsDecl GhcPs] -> Diagnostic -> Maybe (Command |? CodeAction)
Uri
-> [LHsDecl GhcPs] -> Diagnostic -> Maybe (Command |? CodeAction)
generateAction Uri
uri [LHsDecl GhcPs]
decls) [Diagnostic]
diags
      List (Command |? CodeAction)
-> ExceptT String (LspT Config IO) (List (Command |? CodeAction))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List (Command |? CodeAction)
 -> ExceptT String (LspT Config IO) (List (Command |? CodeAction)))
-> List (Command |? CodeAction)
-> ExceptT String (LspT Config IO) (List (Command |? CodeAction))
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> List (Command |? CodeAction)
forall a. [a] -> List a
List [Command |? CodeAction]
actions

getDecls :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m [LHsDecl GhcPs]
getDecls :: IdeState -> NormalizedFilePath -> ExceptT String m [LHsDecl GhcPs]
getDecls IdeState
state = String
-> m (Maybe [LHsDecl GhcPs]) -> ExceptT String m [LHsDecl GhcPs]
forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Error: Could not get Parsed Module"
    (m (Maybe [LHsDecl GhcPs]) -> ExceptT String m [LHsDecl GhcPs])
-> (NormalizedFilePath -> m (Maybe [LHsDecl GhcPs]))
-> NormalizedFilePath
-> ExceptT String m [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe [LHsDecl GhcPs]) -> m (Maybe [LHsDecl GhcPs])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO (Maybe [LHsDecl GhcPs]) -> m (Maybe [LHsDecl GhcPs]))
-> (NormalizedFilePath -> IO (Maybe [LHsDecl GhcPs]))
-> NormalizedFilePath
-> m (Maybe [LHsDecl GhcPs])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ParsedModule -> Maybe [LHsDecl GhcPs])
-> IO (Maybe ParsedModule) -> IO (Maybe [LHsDecl GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ParsedModule -> [LHsDecl GhcPs])
-> Maybe ParsedModule -> Maybe [LHsDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HsModule GhcPs -> [LHsDecl GhcPs]
forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls (HsModule GhcPs -> [LHsDecl GhcPs])
-> (ParsedModule -> HsModule GhcPs)
-> ParsedModule
-> [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedSource -> HsModule GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ParsedSource -> HsModule GhcPs)
-> (ParsedModule -> ParsedSource) -> ParsedModule -> HsModule GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ParsedSource
pm_parsed_source))
    (IO (Maybe ParsedModule) -> IO (Maybe [LHsDecl GhcPs]))
-> (NormalizedFilePath -> IO (Maybe ParsedModule))
-> NormalizedFilePath
-> IO (Maybe [LHsDecl GhcPs])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> IdeState
-> Action (Maybe ParsedModule)
-> IO (Maybe ParsedModule)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"changeSignature.GetParsedModule" IdeState
state
    (Action (Maybe ParsedModule) -> IO (Maybe ParsedModule))
-> (NormalizedFilePath -> Action (Maybe ParsedModule))
-> NormalizedFilePath
-> IO (Maybe ParsedModule)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetParsedModule
-> NormalizedFilePath -> Action (Maybe ParsedModule)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use 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 -> ExpectedSig
expectedType  :: ExpectedSig
                         -- | the Actual Type based on definition
                         , ChangeSignature -> ExpectedSig
actualType  :: ActualSig
                         -- | the declaration name to be updated
                         , ChangeSignature -> ExpectedSig
declName    :: DeclName
                         -- | the location of the declaration signature
                         , ChangeSignature -> RealSrcSpan
declSrcSpan :: RealSrcSpan
                         -- | the diagnostic to solve
                         , ChangeSignature -> Diagnostic
diagnostic  :: Diagnostic
                         }

-- | Constraint needed to trackdown OccNames in signatures
type SigName = (HasOccName (IdP GhcPs))

-- | Create a CodeAction from a Diagnostic
generateAction :: SigName => Uri -> [LHsDecl GhcPs] -> Diagnostic -> Maybe (Command |? CodeAction)
generateAction :: Uri
-> [LHsDecl GhcPs] -> Diagnostic -> Maybe (Command |? CodeAction)
generateAction Uri
uri [LHsDecl GhcPs]
decls Diagnostic
diag = Uri -> ChangeSignature -> Command |? CodeAction
changeSigToCodeAction 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
SigName => [LHsDecl GhcPs] -> Diagnostic -> Maybe ChangeSignature
diagnosticToChangeSig [LHsDecl GhcPs]
decls Diagnostic
diag

-- | Convert a diagnostic into a ChangeSignature and add the proper SrcSpan
diagnosticToChangeSig :: SigName => [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
    (ExpectedSig
expectedType, ExpectedSig
actualType, ExpectedSig
declName) <- Diagnostic -> Maybe (ExpectedSig, ExpectedSig, ExpectedSig)
matchingDiagnostic Diagnostic
diagnostic
    -- Find the definition and it's location
    RealSrcSpan
declSrcSpan <- [LHsDecl GhcPs] -> ExpectedSig -> String -> Maybe RealSrcSpan
SigName =>
[LHsDecl GhcPs] -> ExpectedSig -> String -> Maybe RealSrcSpan
findSigLocOfStringDecl [LHsDecl GhcPs]
decls ExpectedSig
expectedType (ExpectedSig -> String
T.unpack ExpectedSig
declName)
    ChangeSignature -> Maybe ChangeSignature
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChangeSignature -> Maybe ChangeSignature)
-> ChangeSignature -> Maybe ChangeSignature
forall a b. (a -> b) -> a -> b
$ ChangeSignature :: ExpectedSig
-> ExpectedSig
-> ExpectedSig
-> RealSrcSpan
-> Diagnostic
-> ChangeSignature
ChangeSignature{ExpectedSig
RealSrcSpan
Diagnostic
declSrcSpan :: RealSrcSpan
declName :: ExpectedSig
actualType :: ExpectedSig
expectedType :: ExpectedSig
diagnostic :: Diagnostic
diagnostic :: Diagnostic
declSrcSpan :: RealSrcSpan
declName :: ExpectedSig
actualType :: ExpectedSig
expectedType :: ExpectedSig
..}


-- | If a diagnostic has the proper message create a ChangeSignature from it
matchingDiagnostic :: Diagnostic -> Maybe (ExpectedSig, ActualSig, DeclName)
matchingDiagnostic :: Diagnostic -> Maybe (ExpectedSig, ExpectedSig, ExpectedSig)
matchingDiagnostic Diagnostic{ExpectedSig
$sel:_message:Diagnostic :: Diagnostic -> ExpectedSig
_message :: ExpectedSig
_message} = [Maybe (ExpectedSig, ExpectedSig, ExpectedSig)]
-> Maybe (ExpectedSig, ExpectedSig, ExpectedSig)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe (ExpectedSig, ExpectedSig, ExpectedSig)]
 -> Maybe (ExpectedSig, ExpectedSig, ExpectedSig))
-> [Maybe (ExpectedSig, ExpectedSig, ExpectedSig)]
-> Maybe (ExpectedSig, ExpectedSig, ExpectedSig)
forall a b. (a -> b) -> a -> b
$ (ExpectedSig -> Maybe (ExpectedSig, ExpectedSig, ExpectedSig))
-> [ExpectedSig] -> [Maybe (ExpectedSig, ExpectedSig, ExpectedSig)]
forall a b. (a -> b) -> [a] -> [b]
map ((ExpectedSig, ExpectedSig, ExpectedSig, [ExpectedSig])
-> Maybe (ExpectedSig, ExpectedSig, ExpectedSig)
unwrapMatch ((ExpectedSig, ExpectedSig, ExpectedSig, [ExpectedSig])
 -> Maybe (ExpectedSig, ExpectedSig, ExpectedSig))
-> (ExpectedSig
    -> (ExpectedSig, ExpectedSig, ExpectedSig, [ExpectedSig]))
-> ExpectedSig
-> Maybe (ExpectedSig, ExpectedSig, ExpectedSig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpectedSig
-> ExpectedSig
-> (ExpectedSig, ExpectedSig, ExpectedSig, [ExpectedSig])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
(=~) ExpectedSig
_message) [ExpectedSig]
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 :: (ExpectedSig, ExpectedSig, ExpectedSig, [ExpectedSig])
-> Maybe (ExpectedSig, ExpectedSig, ExpectedSig)
unwrapMatch (ExpectedSig
_, ExpectedSig
_, ExpectedSig
_, [ExpectedSig
expect, ExpectedSig
actual, ExpectedSig
_, ExpectedSig
name]) = (ExpectedSig, ExpectedSig, ExpectedSig)
-> Maybe (ExpectedSig, ExpectedSig, ExpectedSig)
forall a. a -> Maybe a
Just (ExpectedSig
expect, ExpectedSig
actual, ExpectedSig
name)
        unwrapMatch (ExpectedSig, ExpectedSig, ExpectedSig, [ExpectedSig])
_                              = Maybe (ExpectedSig, ExpectedSig, ExpectedSig)
forall a. Maybe a
Nothing

-- | List of regexes that match various Error Messages
errorMessageRegexes :: [Text]
errorMessageRegexes :: [ExpectedSig]
errorMessageRegexes = [ -- be sure to add new Error Messages Regexes at the bottom to not fail any existing tests
    ExpectedSig
"Expected type: (.+)\n +Actual type: (.+)\n(.|\n)+In an equation for ‘(.+)’"
    , ExpectedSig
"Couldn't match expected type ‘(.+)’ with actual type ‘(.+)’\n(.|\n)+In an equation for ‘(.+)’"
    -- GHC >9.2 version of the first error regex
    , ExpectedSig
"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 :: SigName => [LHsDecl GhcPs] -> ExpectedSig -> String -> Maybe RealSrcSpan
findSigLocOfStringDecl :: [LHsDecl GhcPs] -> ExpectedSig -> String -> Maybe RealSrcSpan
findSigLocOfStringDecl [LHsDecl GhcPs]
decls ExpectedSig
expectedType String
declName = GenericQ (Maybe RealSrcSpan)
-> [LHsDecl GhcPs] -> 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)
-> (LHsDecl GhcPs -> Maybe RealSrcSpan) -> a -> Maybe RealSrcSpan
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` LHsDecl GhcPs -> Maybe RealSrcSpan
findSig (a -> Maybe RealSrcSpan)
-> (LSig GhcPs -> Maybe RealSrcSpan) -> a -> Maybe RealSrcSpan
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` LSig GhcPs -> Maybe RealSrcSpan
findLocalSig) [LHsDecl GhcPs]
decls
    where
        -- search for Top Level Signatures
        findSig :: LHsDecl GhcPs -> Maybe RealSrcSpan
        findSig :: LHsDecl GhcPs -> Maybe RealSrcSpan
findSig = \case
            L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
rss Maybe BufSpan
_)) (SigD XSigD GhcPs
_ Sig GhcPs
sig) -> case Sig GhcPs
sig of
              ts :: Sig GhcPs
ts@(TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
idsSig LHsSigWcType GhcPs
_) -> Sig GhcPs -> [GenLocated SrcSpan RdrName] -> Maybe BufSpan
forall (t :: * -> *) name l.
(Foldable t, HasOccName name) =>
Sig GhcPs -> t (GenLocated l name) -> Maybe BufSpan
isMatch Sig GhcPs
ts [Located (IdP GhcPs)]
[GenLocated SrcSpan RdrName]
idsSig Maybe BufSpan -> Maybe RealSrcSpan -> Maybe RealSrcSpan
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RealSrcSpan -> Maybe RealSrcSpan
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 (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
rss Maybe BufSpan
_)) ts :: Sig GhcPs
ts@(TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
idsSig LHsSigWcType GhcPs
_)) -> Sig GhcPs -> [GenLocated SrcSpan RdrName] -> Maybe BufSpan
forall (t :: * -> *) name l.
(Foldable t, HasOccName name) =>
Sig GhcPs -> t (GenLocated l name) -> Maybe BufSpan
isMatch Sig GhcPs
ts [Located (IdP GhcPs)]
[GenLocated SrcSpan RdrName]
idsSig Maybe BufSpan -> Maybe RealSrcSpan -> Maybe RealSrcSpan
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RealSrcSpan -> Maybe RealSrcSpan
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 BufSpan
isMatch Sig GhcPs
ts t (GenLocated l name)
idsSig = do
                ExpectedSig
ghcSig <- Sig GhcPs -> Maybe ExpectedSig
sigToText Sig GhcPs
ts
                Bool -> Maybe BufSpan
forall (f :: * -> *). Alternative f => Bool -> f BufSpan
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
&& ExpectedSig
expectedType ExpectedSig -> ExpectedSig -> Bool
forall a. Eq a => a -> a -> Bool
== ExpectedSig
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 ExpectedSig
sigToText = \case
  ts :: Sig GhcPs
ts@TypeSig {} -> ExpectedSig -> Maybe ExpectedSig
forall a. a -> Maybe a
Just (ExpectedSig -> Maybe ExpectedSig)
-> ExpectedSig -> Maybe ExpectedSig
forall a b. (a -> b) -> a -> b
$ ExpectedSig -> ExpectedSig
stripSignature (ExpectedSig -> ExpectedSig) -> ExpectedSig -> ExpectedSig
forall a b. (a -> b) -> a -> b
$ Sig GhcPs -> ExpectedSig
forall a. Outputable a => a -> ExpectedSig
printOutputable Sig GhcPs
ts
  Sig GhcPs
_             -> Maybe ExpectedSig
forall a. Maybe a
Nothing

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

changeSigToCodeAction :: Uri -> ChangeSignature -> Command |? CodeAction
changeSigToCodeAction :: Uri -> ChangeSignature -> Command |? CodeAction
changeSigToCodeAction Uri
uri ChangeSignature{ExpectedSig
RealSrcSpan
Diagnostic
diagnostic :: Diagnostic
declSrcSpan :: RealSrcSpan
declName :: ExpectedSig
actualType :: ExpectedSig
expectedType :: ExpectedSig
diagnostic :: ChangeSignature -> Diagnostic
declSrcSpan :: ChangeSignature -> RealSrcSpan
declName :: ChangeSignature -> ExpectedSig
actualType :: ChangeSignature -> ExpectedSig
expectedType :: ChangeSignature -> ExpectedSig
..} = CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR CodeAction :: ExpectedSig
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction { $sel:_title:CodeAction :: ExpectedSig
_title       = ExpectedSig -> ExpectedSig -> ExpectedSig
mkChangeSigTitle ExpectedSig
declName ExpectedSig
actualType
                                                               , $sel:_kind:CodeAction :: Maybe CodeActionKind
_kind        = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just (ExpectedSig -> CodeActionKind
CodeActionUnknown ExpectedSig
"quickfix.changeSignature")
                                                               , $sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
_diagnostics = List Diagnostic -> Maybe (List Diagnostic)
forall a. a -> Maybe a
Just (List Diagnostic -> Maybe (List Diagnostic))
-> List Diagnostic -> Maybe (List Diagnostic)
forall a b. (a -> b) -> a -> b
$ [Diagnostic] -> List Diagnostic
forall a. [a] -> List a
List [Diagnostic
diagnostic]
                                                               , $sel:_isPreferred:CodeAction :: Maybe Bool
_isPreferred = Maybe Bool
forall a. Maybe a
Nothing
                                                               , $sel:_disabled:CodeAction :: Maybe Reason
_disabled    = Maybe Reason
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 -> ExpectedSig -> WorkspaceEdit
mkChangeSigEdit Uri
uri RealSrcSpan
declSrcSpan (ExpectedSig -> ExpectedSig -> ExpectedSig
mkNewSignature ExpectedSig
declName ExpectedSig
actualType)
                                                               , $sel:_command:CodeAction :: Maybe Command
_command     = Maybe Command
forall a. Maybe a
Nothing
                                                               , $sel:_xdata:CodeAction :: Maybe Value
_xdata       = Maybe Value
forall a. Maybe a
Nothing
                                                               }

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

mkChangeSigEdit :: Uri -> RealSrcSpan -> Text -> WorkspaceEdit
mkChangeSigEdit :: Uri -> RealSrcSpan -> ExpectedSig -> WorkspaceEdit
mkChangeSigEdit Uri
uri RealSrcSpan
ss ExpectedSig
replacement =
        let txtEdit :: TextEdit
txtEdit = Range -> ExpectedSig -> TextEdit
TextEdit (RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
ss) ExpectedSig
replacement
            changes :: Maybe (HashMap Uri (List TextEdit))
changes = HashMap Uri (List TextEdit) -> Maybe (HashMap Uri (List TextEdit))
forall a. a -> Maybe a
Just (HashMap Uri (List TextEdit)
 -> Maybe (HashMap Uri (List TextEdit)))
-> HashMap Uri (List TextEdit)
-> Maybe (HashMap Uri (List TextEdit))
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> HashMap Uri (List TextEdit)
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
txtEdit])
        in Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit Maybe (HashMap Uri (List TextEdit))
changes Maybe (List DocumentChange)
forall a. Maybe a
Nothing Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing

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