{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleInstances #-}

module Development.IDE.Plugin.CodeAction.Args
  ( CodeActionTitle,
    CodeActionPreferred,
    GhcideCodeActionResult,
    GhcideCodeAction,
    mkGhcideCAPlugin,
    mkGhcideCAsPlugin,
    ToTextEdit (..),
    ToCodeAction (..),
    wrap,
    mkCA,
  )
where

import           Control.Concurrent.STM.Stats                 (readTVarIO)
import           Control.Monad.Reader
import           Control.Monad.Trans.Maybe
import           Data.Either                                  (fromRight)
import qualified Data.HashMap.Strict                          as Map
import           Data.IORef.Extra
import           Data.Maybe                                   (fromMaybe)
import qualified Data.Text                                    as T
import           Development.IDE                              hiding
                                                              (pluginHandlers)
import           Development.IDE.Core.Shake
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.ExactPrint
import           Development.IDE.Plugin.CodeAction.ExactPrint (Rewrite,
                                                               rewriteToEdit)
import           Development.IDE.Plugin.TypeLenses            (GetGlobalBindingTypeSigs (GetGlobalBindingTypeSigs),
                                                               GlobalBindingTypeSigsResult)
import           Development.IDE.Spans.LocalBindings          (Bindings)
import           Development.IDE.Types.Exports                (ExportsMap)
import           Development.IDE.Types.Options                (IdeOptions)
import           Ide.Plugin.Config                            (Config)
import           Ide.Types
import qualified Language.LSP.Server                          as LSP
import           Language.LSP.Types

type CodeActionTitle = T.Text

type CodeActionPreferred = Bool

type GhcideCodeActionResult = [(CodeActionTitle, Maybe CodeActionKind, Maybe CodeActionPreferred, [TextEdit])]

type GhcideCodeAction = ReaderT CodeActionArgs IO GhcideCodeActionResult

-------------------------------------------------------------------------------------------------

{-# ANN runGhcideCodeAction ("HLint: ignore Move guards forward" :: String) #-}
runGhcideCodeAction :: LSP.MonadLsp Config m => IdeState -> MessageParams TextDocumentCodeAction -> GhcideCodeAction -> m GhcideCodeActionResult
runGhcideCodeAction :: IdeState
-> MessageParams 'TextDocumentCodeAction
-> GhcideCodeAction
-> m GhcideCodeActionResult
runGhcideCodeAction IdeState
state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext {_diagnostics = List diags}) GhcideCodeAction
codeAction = do
  let mbFile :: Maybe NormalizedFilePath
mbFile = FilePath -> NormalizedFilePath
toNormalizedFilePath' (FilePath -> NormalizedFilePath)
-> Maybe FilePath -> Maybe NormalizedFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> Maybe FilePath
uriToFilePath Uri
uri
      runRule :: k -> IO (Maybe (RuleResult k))
runRule k
key = FilePath
-> IdeState
-> Action (Maybe (RuleResult k))
-> IO (Maybe (RuleResult k))
forall a. FilePath -> IdeState -> Action a -> IO a
runAction (FilePath
"GhcideCodeActions." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> k -> FilePath
forall a. Show a => a -> FilePath
show k
key) IdeState
state (Action (Maybe (RuleResult k)) -> IO (Maybe (RuleResult k)))
-> Action (Maybe (RuleResult k)) -> IO (Maybe (RuleResult k))
forall a b. (a -> b) -> a -> b
$ MaybeT Action (RuleResult k) -> Action (Maybe (RuleResult k))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Action (RuleResult k) -> Action (Maybe (RuleResult k)))
-> MaybeT Action (RuleResult k) -> Action (Maybe (RuleResult k))
forall a b. (a -> b) -> a -> b
$ Action (Maybe NormalizedFilePath)
-> MaybeT Action NormalizedFilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NormalizedFilePath
mbFile) MaybeT Action NormalizedFilePath
-> (NormalizedFilePath -> MaybeT Action (RuleResult k))
-> MaybeT Action (RuleResult k)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Action (Maybe (RuleResult k)) -> MaybeT Action (RuleResult k)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe (RuleResult k)) -> MaybeT Action (RuleResult k))
-> (NormalizedFilePath -> Action (Maybe (RuleResult k)))
-> NormalizedFilePath
-> MaybeT Action (RuleResult k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> NormalizedFilePath -> Action (Maybe (RuleResult k))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use k
key
  IO (Maybe HscEnvEq)
caaGhcSession <- IO (Maybe HscEnvEq) -> m (IO (Maybe HscEnvEq))
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO (Maybe HscEnvEq) -> m (IO (Maybe HscEnvEq)))
-> IO (Maybe HscEnvEq) -> m (IO (Maybe HscEnvEq))
forall a b. (a -> b) -> a -> b
$ GhcSession -> IO (Maybe (RuleResult GhcSession))
forall k.
(Hashable k, Show k, Show (RuleResult k), Typeable k,
 Typeable (RuleResult k), NFData k, NFData (RuleResult k)) =>
k -> IO (Maybe (RuleResult k))
runRule GhcSession
GhcSession
  IO ExportsMap
caaExportsMap <-
    IO ExportsMap -> m (IO ExportsMap)
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO ExportsMap -> m (IO ExportsMap))
-> IO ExportsMap -> m (IO ExportsMap)
forall a b. (a -> b) -> a -> b
$
      IO (Maybe HscEnvEq)
caaGhcSession IO (Maybe HscEnvEq)
-> (Maybe HscEnvEq -> IO ExportsMap) -> IO ExportsMap
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just HscEnvEq
env -> do
          ExportsMap
pkgExports <- HscEnvEq -> IO ExportsMap
envPackageExports HscEnvEq
env
          ExportsMap
localExports <- TVar ExportsMap -> IO ExportsMap
forall a. TVar a -> IO a
readTVarIO (ShakeExtras -> TVar ExportsMap
exportsMap (ShakeExtras -> TVar ExportsMap) -> ShakeExtras -> TVar ExportsMap
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
state)
          ExportsMap -> IO ExportsMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExportsMap -> IO ExportsMap) -> ExportsMap -> IO ExportsMap
forall a b. (a -> b) -> a -> b
$ ExportsMap
localExports ExportsMap -> ExportsMap -> ExportsMap
forall a. Semigroup a => a -> a -> a
<> ExportsMap
pkgExports
        Maybe HscEnvEq
_ -> ExportsMap -> IO ExportsMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExportsMap
forall a. Monoid a => a
mempty
  IO IdeOptions
caaIdeOptions <- IO IdeOptions -> m (IO IdeOptions)
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO IdeOptions -> m (IO IdeOptions))
-> IO IdeOptions -> m (IO IdeOptions)
forall a b. (a -> b) -> a -> b
$ FilePath -> IdeState -> Action IdeOptions -> IO IdeOptions
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"GhcideCodeActions.getIdeOptions" IdeState
state Action IdeOptions
getIdeOptions
  IO (Maybe ParsedModule)
caaParsedModule <- IO (Maybe ParsedModule) -> m (IO (Maybe ParsedModule))
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO (Maybe ParsedModule) -> m (IO (Maybe ParsedModule)))
-> IO (Maybe ParsedModule) -> m (IO (Maybe ParsedModule))
forall a b. (a -> b) -> a -> b
$ GetParsedModuleWithComments
-> IO (Maybe (RuleResult GetParsedModuleWithComments))
forall k.
(Hashable k, Show k, Show (RuleResult k), Typeable k,
 Typeable (RuleResult k), NFData k, NFData (RuleResult k)) =>
k -> IO (Maybe (RuleResult k))
runRule GetParsedModuleWithComments
GetParsedModuleWithComments
  IO (Maybe Text)
caaContents <-
    IO (Maybe Text) -> m (IO (Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO (Maybe Text) -> m (IO (Maybe Text)))
-> IO (Maybe Text) -> m (IO (Maybe Text))
forall a b. (a -> b) -> a -> b
$
      GetFileContents -> IO (Maybe (RuleResult GetFileContents))
forall k.
(Hashable k, Show k, Show (RuleResult k), Typeable k,
 Typeable (RuleResult k), NFData k, NFData (RuleResult k)) =>
k -> IO (Maybe (RuleResult k))
runRule GetFileContents
GetFileContents IO (Maybe (FileVersion, Maybe Text))
-> (Maybe (FileVersion, Maybe Text) -> IO (Maybe Text))
-> IO (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (FileVersion
_, Maybe Text
txt) -> Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
txt
        Maybe (FileVersion, Maybe Text)
_             -> Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
  IO (Maybe DynFlags)
caaDf <- IO (Maybe DynFlags) -> m (IO (Maybe DynFlags))
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO (Maybe DynFlags) -> m (IO (Maybe DynFlags)))
-> IO (Maybe DynFlags) -> m (IO (Maybe DynFlags))
forall a b. (a -> b) -> a -> b
$ (ParsedModule -> DynFlags) -> Maybe ParsedModule -> Maybe DynFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModSummary -> DynFlags
ms_hspp_opts (ModSummary -> DynFlags)
-> (ParsedModule -> ModSummary) -> ParsedModule -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary) (Maybe ParsedModule -> Maybe DynFlags)
-> IO (Maybe ParsedModule) -> IO (Maybe DynFlags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe ParsedModule)
caaParsedModule
  IO (Maybe (Annotated ParsedSource))
caaAnnSource <- IO (Maybe (Annotated ParsedSource))
-> m (IO (Maybe (Annotated ParsedSource)))
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO (Maybe (Annotated ParsedSource))
 -> m (IO (Maybe (Annotated ParsedSource))))
-> IO (Maybe (Annotated ParsedSource))
-> m (IO (Maybe (Annotated ParsedSource)))
forall a b. (a -> b) -> a -> b
$ GetAnnotatedParsedSource
-> IO (Maybe (RuleResult GetAnnotatedParsedSource))
forall k.
(Hashable k, Show k, Show (RuleResult k), Typeable k,
 Typeable (RuleResult k), NFData k, NFData (RuleResult k)) =>
k -> IO (Maybe (RuleResult k))
runRule GetAnnotatedParsedSource
GetAnnotatedParsedSource
  IO (Maybe TcModuleResult)
caaTmr <- IO (Maybe TcModuleResult) -> m (IO (Maybe TcModuleResult))
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO (Maybe TcModuleResult) -> m (IO (Maybe TcModuleResult)))
-> IO (Maybe TcModuleResult) -> m (IO (Maybe TcModuleResult))
forall a b. (a -> b) -> a -> b
$ TypeCheck -> IO (Maybe (RuleResult TypeCheck))
forall k.
(Hashable k, Show k, Show (RuleResult k), Typeable k,
 Typeable (RuleResult k), NFData k, NFData (RuleResult k)) =>
k -> IO (Maybe (RuleResult k))
runRule TypeCheck
TypeCheck
  IO (Maybe HieAstResult)
caaHar <- IO (Maybe HieAstResult) -> m (IO (Maybe HieAstResult))
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO (Maybe HieAstResult) -> m (IO (Maybe HieAstResult)))
-> IO (Maybe HieAstResult) -> m (IO (Maybe HieAstResult))
forall a b. (a -> b) -> a -> b
$ GetHieAst -> IO (Maybe (RuleResult GetHieAst))
forall k.
(Hashable k, Show k, Show (RuleResult k), Typeable k,
 Typeable (RuleResult k), NFData k, NFData (RuleResult k)) =>
k -> IO (Maybe (RuleResult k))
runRule GetHieAst
GetHieAst
  IO (Maybe Bindings)
caaBindings <- IO (Maybe Bindings) -> m (IO (Maybe Bindings))
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO (Maybe Bindings) -> m (IO (Maybe Bindings)))
-> IO (Maybe Bindings) -> m (IO (Maybe Bindings))
forall a b. (a -> b) -> a -> b
$ GetBindings -> IO (Maybe (RuleResult GetBindings))
forall k.
(Hashable k, Show k, Show (RuleResult k), Typeable k,
 Typeable (RuleResult k), NFData k, NFData (RuleResult k)) =>
k -> IO (Maybe (RuleResult k))
runRule GetBindings
GetBindings
  IO (Maybe GlobalBindingTypeSigsResult)
caaGblSigs <- IO (Maybe GlobalBindingTypeSigsResult)
-> m (IO (Maybe GlobalBindingTypeSigsResult))
forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO (IO (Maybe GlobalBindingTypeSigsResult)
 -> m (IO (Maybe GlobalBindingTypeSigsResult)))
-> IO (Maybe GlobalBindingTypeSigsResult)
-> m (IO (Maybe GlobalBindingTypeSigsResult))
forall a b. (a -> b) -> a -> b
$ GetGlobalBindingTypeSigs
-> IO (Maybe (RuleResult GetGlobalBindingTypeSigs))
forall k.
(Hashable k, Show k, Show (RuleResult k), Typeable k,
 Typeable (RuleResult k), NFData k, NFData (RuleResult k)) =>
k -> IO (Maybe (RuleResult k))
runRule GetGlobalBindingTypeSigs
GetGlobalBindingTypeSigs
  IO GhcideCodeActionResult -> m GhcideCodeActionResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GhcideCodeActionResult -> m GhcideCodeActionResult)
-> IO GhcideCodeActionResult -> m GhcideCodeActionResult
forall a b. (a -> b) -> a -> b
$
    [GhcideCodeActionResult] -> GhcideCodeActionResult
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      ([GhcideCodeActionResult] -> GhcideCodeActionResult)
-> IO [GhcideCodeActionResult] -> IO GhcideCodeActionResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO GhcideCodeActionResult] -> IO [GhcideCodeActionResult]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT GhcideCodeAction
codeAction CodeActionArgs
caa
          | Diagnostic
caaDiagnostic <- [Diagnostic]
diags,
            let caa :: CodeActionArgs
caa = CodeActionArgs :: IO ExportsMap
-> IO (Maybe HscEnvEq)
-> IO IdeOptions
-> IO (Maybe ParsedModule)
-> IO (Maybe Text)
-> IO (Maybe DynFlags)
-> IO (Maybe (Annotated ParsedSource))
-> IO (Maybe TcModuleResult)
-> IO (Maybe HieAstResult)
-> IO (Maybe Bindings)
-> IO (Maybe GlobalBindingTypeSigsResult)
-> Diagnostic
-> CodeActionArgs
CodeActionArgs {IO (Maybe Text)
IO (Maybe ParsedModule)
IO (Maybe DynFlags)
IO (Maybe (Annotated ParsedSource))
IO (Maybe HscEnvEq)
IO (Maybe Bindings)
IO (Maybe HieAstResult)
IO (Maybe TcModuleResult)
IO (Maybe GlobalBindingTypeSigsResult)
IO ExportsMap
IO IdeOptions
Diagnostic
caaDiagnostic :: Diagnostic
caaGblSigs :: IO (Maybe GlobalBindingTypeSigsResult)
caaBindings :: IO (Maybe Bindings)
caaHar :: IO (Maybe HieAstResult)
caaTmr :: IO (Maybe TcModuleResult)
caaAnnSource :: IO (Maybe (Annotated ParsedSource))
caaDf :: IO (Maybe DynFlags)
caaContents :: IO (Maybe Text)
caaParsedModule :: IO (Maybe ParsedModule)
caaIdeOptions :: IO IdeOptions
caaGhcSession :: IO (Maybe HscEnvEq)
caaExportsMap :: IO ExportsMap
caaDiagnostic :: Diagnostic
caaGblSigs :: IO (Maybe GlobalBindingTypeSigsResult)
caaBindings :: IO (Maybe Bindings)
caaHar :: IO (Maybe HieAstResult)
caaTmr :: IO (Maybe TcModuleResult)
caaAnnSource :: IO (Maybe (Annotated ParsedSource))
caaDf :: IO (Maybe DynFlags)
caaContents :: IO (Maybe Text)
caaParsedModule :: IO (Maybe ParsedModule)
caaIdeOptions :: IO IdeOptions
caaExportsMap :: IO ExportsMap
caaGhcSession :: IO (Maybe HscEnvEq)
..}
        ]

mkCA :: T.Text -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction)
mkCA :: Text
-> Maybe CodeActionKind
-> Maybe Bool
-> [Diagnostic]
-> WorkspaceEdit
-> Command |? CodeAction
mkCA Text
title Maybe CodeActionKind
kind Maybe Bool
isPreferred [Diagnostic]
diags WorkspaceEdit
edit =
  CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> CodeAction -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction Text
title Maybe CodeActionKind
kind (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]
diags) Maybe Bool
isPreferred Maybe Reason
forall a. Maybe a
Nothing (WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit
edit) Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing

mkGhcideCAPlugin :: GhcideCodeAction -> PluginId -> PluginDescriptor IdeState
mkGhcideCAPlugin :: GhcideCodeAction -> PluginId -> PluginDescriptor IdeState
mkGhcideCAPlugin GhcideCodeAction
codeAction 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
 -> PluginHandlers IdeState)
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
-> PluginHandlers IdeState
forall a b. (a -> b) -> a -> b
$
        \IdeState
state PluginId
_ params :: MessageParams 'TextDocumentCodeAction
params@(CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext {_diagnostics = List diags}) -> do
          GhcideCodeActionResult
results <- IdeState
-> MessageParams 'TextDocumentCodeAction
-> GhcideCodeAction
-> LspT Config IO GhcideCodeActionResult
forall (m :: * -> *).
MonadLsp Config m =>
IdeState
-> MessageParams 'TextDocumentCodeAction
-> GhcideCodeAction
-> m GhcideCodeActionResult
runGhcideCodeAction IdeState
state MessageParams 'TextDocumentCodeAction
params GhcideCodeAction
codeAction
          Either ResponseError (List (Command |? CodeAction))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (List (Command |? CodeAction))
 -> LspT
      Config IO (Either ResponseError (List (Command |? CodeAction))))
-> Either ResponseError (List (Command |? CodeAction))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$
            List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. b -> Either a b
Right (List (Command |? CodeAction)
 -> Either ResponseError (List (Command |? CodeAction)))
-> List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. (a -> b) -> a -> b
$
              [Command |? CodeAction] -> List (Command |? CodeAction)
forall a. [a] -> List a
List
                [ Text
-> Maybe CodeActionKind
-> Maybe Bool
-> [Diagnostic]
-> WorkspaceEdit
-> Command |? CodeAction
mkCA Text
title Maybe CodeActionKind
kind Maybe Bool
isPreferred [Diagnostic]
diags WorkspaceEdit
edit
                  | (Text
title, Maybe CodeActionKind
kind, Maybe Bool
isPreferred, [TextEdit]
tedit) <- GhcideCodeActionResult
results,
                    let edit :: WorkspaceEdit
edit = Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit) Maybe (List DocumentChange)
forall a. Maybe a
Nothing Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
                ]
    }

mkGhcideCAsPlugin :: [GhcideCodeAction] -> PluginId -> PluginDescriptor IdeState
mkGhcideCAsPlugin :: [GhcideCodeAction] -> PluginId -> PluginDescriptor IdeState
mkGhcideCAsPlugin [GhcideCodeAction]
codeActions = GhcideCodeAction -> PluginId -> PluginDescriptor IdeState
mkGhcideCAPlugin (GhcideCodeAction -> PluginId -> PluginDescriptor IdeState)
-> GhcideCodeAction -> PluginId -> PluginDescriptor IdeState
forall a b. (a -> b) -> a -> b
$ [GhcideCodeAction] -> GhcideCodeAction
forall a. Monoid a => [a] -> a
mconcat [GhcideCodeAction]
codeActions

-------------------------------------------------------------------------------------------------

class ToTextEdit a where
  toTextEdit :: CodeActionArgs -> a -> IO [TextEdit]

instance ToTextEdit TextEdit where
  toTextEdit :: CodeActionArgs -> TextEdit -> IO [TextEdit]
toTextEdit CodeActionArgs
_ = [TextEdit] -> IO [TextEdit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TextEdit] -> IO [TextEdit])
-> (TextEdit -> [TextEdit]) -> TextEdit -> IO [TextEdit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEdit -> [TextEdit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance ToTextEdit Rewrite where
  toTextEdit :: CodeActionArgs -> Rewrite -> IO [TextEdit]
toTextEdit CodeActionArgs {IO (Maybe Text)
IO (Maybe ParsedModule)
IO (Maybe DynFlags)
IO (Maybe (Annotated ParsedSource))
IO (Maybe HscEnvEq)
IO (Maybe Bindings)
IO (Maybe HieAstResult)
IO (Maybe TcModuleResult)
IO (Maybe GlobalBindingTypeSigsResult)
IO ExportsMap
IO IdeOptions
Diagnostic
caaDiagnostic :: Diagnostic
caaGblSigs :: IO (Maybe GlobalBindingTypeSigsResult)
caaBindings :: IO (Maybe Bindings)
caaHar :: IO (Maybe HieAstResult)
caaTmr :: IO (Maybe TcModuleResult)
caaAnnSource :: IO (Maybe (Annotated ParsedSource))
caaDf :: IO (Maybe DynFlags)
caaContents :: IO (Maybe Text)
caaParsedModule :: IO (Maybe ParsedModule)
caaIdeOptions :: IO IdeOptions
caaGhcSession :: IO (Maybe HscEnvEq)
caaExportsMap :: IO ExportsMap
caaDiagnostic :: CodeActionArgs -> Diagnostic
caaGblSigs :: CodeActionArgs -> IO (Maybe GlobalBindingTypeSigsResult)
caaBindings :: CodeActionArgs -> IO (Maybe Bindings)
caaHar :: CodeActionArgs -> IO (Maybe HieAstResult)
caaTmr :: CodeActionArgs -> IO (Maybe TcModuleResult)
caaAnnSource :: CodeActionArgs -> IO (Maybe (Annotated ParsedSource))
caaDf :: CodeActionArgs -> IO (Maybe DynFlags)
caaContents :: CodeActionArgs -> IO (Maybe Text)
caaParsedModule :: CodeActionArgs -> IO (Maybe ParsedModule)
caaIdeOptions :: CodeActionArgs -> IO IdeOptions
caaGhcSession :: CodeActionArgs -> IO (Maybe HscEnvEq)
caaExportsMap :: CodeActionArgs -> IO ExportsMap
..} Rewrite
rw = (Maybe [TextEdit] -> [TextEdit])
-> IO (Maybe [TextEdit]) -> IO [TextEdit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([TextEdit] -> Maybe [TextEdit] -> [TextEdit]
forall a. a -> Maybe a -> a
fromMaybe []) (IO (Maybe [TextEdit]) -> IO [TextEdit])
-> IO (Maybe [TextEdit]) -> IO [TextEdit]
forall a b. (a -> b) -> a -> b
$
    MaybeT IO [TextEdit] -> IO (Maybe [TextEdit])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO [TextEdit] -> IO (Maybe [TextEdit]))
-> MaybeT IO [TextEdit] -> IO (Maybe [TextEdit])
forall a b. (a -> b) -> a -> b
$ do
      DynFlags
df <- IO (Maybe DynFlags) -> MaybeT IO DynFlags
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT IO (Maybe DynFlags)
caaDf
#if !MIN_VERSION_ghc(9,2,0)
      Annotated ParsedSource
ps <- IO (Maybe (Annotated ParsedSource))
-> MaybeT IO (Annotated ParsedSource)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT IO (Maybe (Annotated ParsedSource))
caaAnnSource
      let r :: Either FilePath [TextEdit]
r = HasCallStack =>
DynFlags -> Anns -> Rewrite -> Either FilePath [TextEdit]
DynFlags -> Anns -> Rewrite -> Either FilePath [TextEdit]
rewriteToEdit DynFlags
df (Annotated ParsedSource -> Anns
forall ast. Annotated ast -> Anns
annsA Annotated ParsedSource
ps) Rewrite
rw
#else
      let r = rewriteToEdit df rw
#endif
      [TextEdit] -> MaybeT IO [TextEdit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TextEdit] -> MaybeT IO [TextEdit])
-> [TextEdit] -> MaybeT IO [TextEdit]
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> Either FilePath [TextEdit] -> [TextEdit]
forall b a. b -> Either a b -> b
fromRight [] Either FilePath [TextEdit]
r

instance ToTextEdit a => ToTextEdit [a] where
  toTextEdit :: CodeActionArgs -> [a] -> IO [TextEdit]
toTextEdit CodeActionArgs
caa = (a -> IO [TextEdit]) -> [a] -> IO [TextEdit]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CodeActionArgs -> a -> IO [TextEdit]
forall a. ToTextEdit a => CodeActionArgs -> a -> IO [TextEdit]
toTextEdit CodeActionArgs
caa)

instance ToTextEdit a => ToTextEdit (Maybe a) where
  toTextEdit :: CodeActionArgs -> Maybe a -> IO [TextEdit]
toTextEdit CodeActionArgs
caa = IO [TextEdit] -> (a -> IO [TextEdit]) -> Maybe a -> IO [TextEdit]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([TextEdit] -> IO [TextEdit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (CodeActionArgs -> a -> IO [TextEdit]
forall a. ToTextEdit a => CodeActionArgs -> a -> IO [TextEdit]
toTextEdit CodeActionArgs
caa)

instance (ToTextEdit a, ToTextEdit b) => ToTextEdit (Either a b) where
  toTextEdit :: CodeActionArgs -> Either a b -> IO [TextEdit]
toTextEdit CodeActionArgs
caa = (a -> IO [TextEdit])
-> (b -> IO [TextEdit]) -> Either a b -> IO [TextEdit]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CodeActionArgs -> a -> IO [TextEdit]
forall a. ToTextEdit a => CodeActionArgs -> a -> IO [TextEdit]
toTextEdit CodeActionArgs
caa) (CodeActionArgs -> b -> IO [TextEdit]
forall a. ToTextEdit a => CodeActionArgs -> a -> IO [TextEdit]
toTextEdit CodeActionArgs
caa)

-------------------------------------------------------------------------------------------------

data CodeActionArgs = CodeActionArgs
  { CodeActionArgs -> IO ExportsMap
caaExportsMap   :: IO ExportsMap,
    CodeActionArgs -> IO (Maybe HscEnvEq)
caaGhcSession   :: IO (Maybe HscEnvEq),
    CodeActionArgs -> IO IdeOptions
caaIdeOptions   :: IO IdeOptions,
    CodeActionArgs -> IO (Maybe ParsedModule)
caaParsedModule :: IO (Maybe ParsedModule),
    CodeActionArgs -> IO (Maybe Text)
caaContents     :: IO (Maybe T.Text),
    CodeActionArgs -> IO (Maybe DynFlags)
caaDf           :: IO (Maybe DynFlags),
    CodeActionArgs -> IO (Maybe (Annotated ParsedSource))
caaAnnSource    :: IO (Maybe (Annotated ParsedSource)),
    CodeActionArgs -> IO (Maybe TcModuleResult)
caaTmr          :: IO (Maybe TcModuleResult),
    CodeActionArgs -> IO (Maybe HieAstResult)
caaHar          :: IO (Maybe HieAstResult),
    CodeActionArgs -> IO (Maybe Bindings)
caaBindings     :: IO (Maybe Bindings),
    CodeActionArgs -> IO (Maybe GlobalBindingTypeSigsResult)
caaGblSigs      :: IO (Maybe GlobalBindingTypeSigsResult),
    CodeActionArgs -> Diagnostic
caaDiagnostic   :: Diagnostic
  }

-- | There's no concurrency in each provider,
-- so we don't need to be thread-safe here
onceIO :: MonadIO m => IO a -> m (IO a)
onceIO :: IO a -> m (IO a)
onceIO IO a
io = do
  IORef (Maybe a)
var <- IO (IORef (Maybe a)) -> m (IORef (Maybe a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe a)) -> m (IORef (Maybe a)))
-> IO (IORef (Maybe a)) -> m (IORef (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> IO (IORef (Maybe a))
forall a. a -> IO (IORef a)
newIORef Maybe a
forall a. Maybe a
Nothing
  IO a -> m (IO a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO a -> m (IO a)) -> IO a -> m (IO a)
forall a b. (a -> b) -> a -> b
$
    IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef IORef (Maybe a)
var IO (Maybe a) -> (Maybe a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just a
x -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
      Maybe a
_      -> IO a
io IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef' IORef (Maybe a)
var (a -> Maybe a
forall a. a -> Maybe a
Just a
x) IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-------------------------------------------------------------------------------------------------

wrap :: (ToCodeAction a) => a -> GhcideCodeAction
wrap :: a -> GhcideCodeAction
wrap = a -> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction

class ToCodeAction a where
  toCodeAction :: a -> GhcideCodeAction

instance ToCodeAction GhcideCodeAction where
  toCodeAction :: GhcideCodeAction -> GhcideCodeAction
toCodeAction = GhcideCodeAction -> GhcideCodeAction
forall a. a -> a
id

instance Semigroup GhcideCodeAction where
  GhcideCodeAction
a <> :: GhcideCodeAction -> GhcideCodeAction -> GhcideCodeAction
<> GhcideCodeAction
b = [GhcideCodeAction] -> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction [GhcideCodeAction
a, GhcideCodeAction
b]

instance Monoid GhcideCodeAction where
  mempty :: GhcideCodeAction
mempty = GhcideCodeActionResult -> GhcideCodeAction
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

instance ToCodeAction a => ToCodeAction [a] where
  toCodeAction :: [a] -> GhcideCodeAction
toCodeAction = ([GhcideCodeActionResult] -> GhcideCodeActionResult)
-> ReaderT CodeActionArgs IO [GhcideCodeActionResult]
-> GhcideCodeAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GhcideCodeActionResult] -> GhcideCodeActionResult
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ReaderT CodeActionArgs IO [GhcideCodeActionResult]
 -> GhcideCodeAction)
-> ([a] -> ReaderT CodeActionArgs IO [GhcideCodeActionResult])
-> [a]
-> GhcideCodeAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> GhcideCodeAction)
-> [a] -> ReaderT CodeActionArgs IO [GhcideCodeActionResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction

instance ToCodeAction a => ToCodeAction (Maybe a) where
  toCodeAction :: Maybe a -> GhcideCodeAction
toCodeAction = GhcideCodeAction
-> (a -> GhcideCodeAction) -> Maybe a -> GhcideCodeAction
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GhcideCodeActionResult -> GhcideCodeAction
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) a -> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction

instance ToTextEdit a => ToCodeAction (CodeActionTitle, a) where
  toCodeAction :: (Text, a) -> GhcideCodeAction
toCodeAction (Text
title, a
te) = (CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction)
-> (CodeActionArgs -> IO GhcideCodeActionResult)
-> GhcideCodeAction
forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> (Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])
-> GhcideCodeActionResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])
 -> GhcideCodeActionResult)
-> ([TextEdit]
    -> (Text, Maybe CodeActionKind, Maybe Bool, [TextEdit]))
-> [TextEdit]
-> GhcideCodeActionResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
title,CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix,Maybe Bool
forall a. Maybe a
Nothing,) ([TextEdit] -> GhcideCodeActionResult)
-> IO [TextEdit] -> IO GhcideCodeActionResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeActionArgs -> a -> IO [TextEdit]
forall a. ToTextEdit a => CodeActionArgs -> a -> IO [TextEdit]
toTextEdit CodeActionArgs
caa a
te

instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, a) where
  toCodeAction :: (Text, CodeActionKind, a) -> GhcideCodeAction
toCodeAction (Text
title, CodeActionKind
kind, a
te) = (CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction)
-> (CodeActionArgs -> IO GhcideCodeActionResult)
-> GhcideCodeAction
forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> (Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])
-> GhcideCodeActionResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])
 -> GhcideCodeActionResult)
-> ([TextEdit]
    -> (Text, Maybe CodeActionKind, Maybe Bool, [TextEdit]))
-> [TextEdit]
-> GhcideCodeActionResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
title,CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
kind,Maybe Bool
forall a. Maybe a
Nothing,) ([TextEdit] -> GhcideCodeActionResult)
-> IO [TextEdit] -> IO GhcideCodeActionResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeActionArgs -> a -> IO [TextEdit]
forall a. ToTextEdit a => CodeActionArgs -> a -> IO [TextEdit]
toTextEdit CodeActionArgs
caa a
te

instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionPreferred, a) where
  toCodeAction :: (Text, Bool, a) -> GhcideCodeAction
toCodeAction (Text
title, Bool
isPreferred, a
te) = (CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction)
-> (CodeActionArgs -> IO GhcideCodeActionResult)
-> GhcideCodeAction
forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> (Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])
-> GhcideCodeActionResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])
 -> GhcideCodeActionResult)
-> ([TextEdit]
    -> (Text, Maybe CodeActionKind, Maybe Bool, [TextEdit]))
-> [TextEdit]
-> GhcideCodeActionResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
title,CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix,Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
isPreferred,) ([TextEdit] -> GhcideCodeActionResult)
-> IO [TextEdit] -> IO GhcideCodeActionResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeActionArgs -> a -> IO [TextEdit]
forall a. ToTextEdit a => CodeActionArgs -> a -> IO [TextEdit]
toTextEdit CodeActionArgs
caa a
te

instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, CodeActionPreferred, a) where
  toCodeAction :: (Text, CodeActionKind, Bool, a) -> GhcideCodeAction
toCodeAction (Text
title, CodeActionKind
kind, Bool
isPreferred, a
te) = (CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction)
-> (CodeActionArgs -> IO GhcideCodeActionResult)
-> GhcideCodeAction
forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> (Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])
-> GhcideCodeActionResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])
 -> GhcideCodeActionResult)
-> ([TextEdit]
    -> (Text, Maybe CodeActionKind, Maybe Bool, [TextEdit]))
-> [TextEdit]
-> GhcideCodeActionResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
title,CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
kind,Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
isPreferred,) ([TextEdit] -> GhcideCodeActionResult)
-> IO [TextEdit] -> IO GhcideCodeActionResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeActionArgs -> a -> IO [TextEdit]
forall a. ToTextEdit a => CodeActionArgs -> a -> IO [TextEdit]
toTextEdit CodeActionArgs
caa a
te

-------------------------------------------------------------------------------------------------

toCodeAction1 :: (ToCodeAction r) => (CodeActionArgs -> IO (Maybe a)) -> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 :: (CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe a)
get Maybe a -> r
f = (CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction)
-> (CodeActionArgs -> IO GhcideCodeActionResult)
-> GhcideCodeAction
forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> CodeActionArgs -> IO (Maybe a)
get CodeActionArgs
caa IO (Maybe a)
-> (Maybe a -> IO GhcideCodeActionResult)
-> IO GhcideCodeActionResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult)
-> CodeActionArgs -> GhcideCodeAction -> IO GhcideCodeActionResult
forall a b c. (a -> b -> c) -> b -> a -> c
flip GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CodeActionArgs
caa (GhcideCodeAction -> IO GhcideCodeActionResult)
-> (Maybe a -> GhcideCodeAction)
-> Maybe a
-> IO GhcideCodeActionResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction (r -> GhcideCodeAction)
-> (Maybe a -> r) -> Maybe a -> GhcideCodeAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> r
f

toCodeAction2 :: (ToCodeAction r) => (CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 :: (CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe a)
get a -> r
f = (CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction)
-> (CodeActionArgs -> IO GhcideCodeActionResult)
-> GhcideCodeAction
forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa ->
  CodeActionArgs -> IO (Maybe a)
get CodeActionArgs
caa IO (Maybe a)
-> (Maybe a -> IO GhcideCodeActionResult)
-> IO GhcideCodeActionResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just a
x -> (GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult)
-> CodeActionArgs -> GhcideCodeAction -> IO GhcideCodeActionResult
forall a b c. (a -> b -> c) -> b -> a -> c
flip GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CodeActionArgs
caa (GhcideCodeAction -> IO GhcideCodeActionResult)
-> (a -> GhcideCodeAction) -> a -> IO GhcideCodeActionResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction (r -> GhcideCodeAction) -> (a -> r) -> a -> GhcideCodeAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> r
f (a -> IO GhcideCodeActionResult) -> a -> IO GhcideCodeActionResult
forall a b. (a -> b) -> a -> b
$ a
x
    Maybe a
_      -> GhcideCodeActionResult -> IO GhcideCodeActionResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

toCodeAction3 :: (ToCodeAction r) => (CodeActionArgs -> IO a) -> (a -> r) -> GhcideCodeAction
toCodeAction3 :: (CodeActionArgs -> IO a) -> (a -> r) -> GhcideCodeAction
toCodeAction3 CodeActionArgs -> IO a
get a -> r
f = (CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction)
-> (CodeActionArgs -> IO GhcideCodeActionResult)
-> GhcideCodeAction
forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> CodeActionArgs -> IO a
get CodeActionArgs
caa IO a
-> (a -> IO GhcideCodeActionResult) -> IO GhcideCodeActionResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult)
-> CodeActionArgs -> GhcideCodeAction -> IO GhcideCodeActionResult
forall a b c. (a -> b -> c) -> b -> a -> c
flip GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CodeActionArgs
caa (GhcideCodeAction -> IO GhcideCodeActionResult)
-> (a -> GhcideCodeAction) -> a -> IO GhcideCodeActionResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction (r -> GhcideCodeAction) -> (a -> r) -> a -> GhcideCodeAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> r
f

-- | this instance returns a delta AST, useful for exactprint transforms
instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where
  toCodeAction :: (ParsedSource -> r) -> GhcideCodeAction
toCodeAction ParsedSource -> r
f = (CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction)
-> (CodeActionArgs -> IO GhcideCodeActionResult)
-> GhcideCodeAction
forall a b. (a -> b) -> a -> b
$ \caa :: CodeActionArgs
caa@CodeActionArgs {caaAnnSource :: CodeActionArgs -> IO (Maybe (Annotated ParsedSource))
caaAnnSource = IO (Maybe (Annotated ParsedSource))
x} ->
    IO (Maybe (Annotated ParsedSource))
x IO (Maybe (Annotated ParsedSource))
-> (Maybe (Annotated ParsedSource) -> IO GhcideCodeActionResult)
-> IO GhcideCodeActionResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Annotated ParsedSource
s -> (GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult)
-> CodeActionArgs -> GhcideCodeAction -> IO GhcideCodeActionResult
forall a b c. (a -> b -> c) -> b -> a -> c
flip GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CodeActionArgs
caa (GhcideCodeAction -> IO GhcideCodeActionResult)
-> (Annotated ParsedSource -> GhcideCodeAction)
-> Annotated ParsedSource
-> IO GhcideCodeActionResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction (r -> GhcideCodeAction)
-> (Annotated ParsedSource -> r)
-> Annotated ParsedSource
-> GhcideCodeAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedSource -> r
f (ParsedSource -> r)
-> (Annotated ParsedSource -> ParsedSource)
-> Annotated ParsedSource
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated ParsedSource -> ParsedSource
forall ast. Annotated ast -> ast
astA (Annotated ParsedSource -> IO GhcideCodeActionResult)
-> Annotated ParsedSource -> IO GhcideCodeActionResult
forall a b. (a -> b) -> a -> b
$ Annotated ParsedSource
s
      Maybe (Annotated ParsedSource)
_      -> GhcideCodeActionResult -> IO GhcideCodeActionResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

instance ToCodeAction r => ToCodeAction (ExportsMap -> r) where
  toCodeAction :: (ExportsMap -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO ExportsMap)
-> (ExportsMap -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO a) -> (a -> r) -> GhcideCodeAction
toCodeAction3 CodeActionArgs -> IO ExportsMap
caaExportsMap

instance ToCodeAction r => ToCodeAction (IdeOptions -> r) where
  toCodeAction :: (IdeOptions -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO IdeOptions)
-> (IdeOptions -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO a) -> (a -> r) -> GhcideCodeAction
toCodeAction3 CodeActionArgs -> IO IdeOptions
caaIdeOptions

instance ToCodeAction r => ToCodeAction (Diagnostic -> r) where
  toCodeAction :: (Diagnostic -> r) -> GhcideCodeAction
toCodeAction Diagnostic -> r
f = (CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((CodeActionArgs -> IO GhcideCodeActionResult) -> GhcideCodeAction)
-> (CodeActionArgs -> IO GhcideCodeActionResult)
-> GhcideCodeAction
forall a b. (a -> b) -> a -> b
$ \caa :: CodeActionArgs
caa@CodeActionArgs {caaDiagnostic :: CodeActionArgs -> Diagnostic
caaDiagnostic = Diagnostic
x} -> (GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult)
-> CodeActionArgs -> GhcideCodeAction -> IO GhcideCodeActionResult
forall a b c. (a -> b -> c) -> b -> a -> c
flip GhcideCodeAction -> CodeActionArgs -> IO GhcideCodeActionResult
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CodeActionArgs
caa (GhcideCodeAction -> IO GhcideCodeActionResult)
-> (r -> GhcideCodeAction) -> r -> IO GhcideCodeActionResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction (r -> IO GhcideCodeActionResult) -> r -> IO GhcideCodeActionResult
forall a b. (a -> b) -> a -> b
$ Diagnostic -> r
f Diagnostic
x

instance ToCodeAction r => ToCodeAction (Maybe ParsedModule -> r) where
  toCodeAction :: (Maybe ParsedModule -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe ParsedModule))
-> (Maybe ParsedModule -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe ParsedModule)
caaParsedModule

instance ToCodeAction r => ToCodeAction (ParsedModule -> r) where
  toCodeAction :: (ParsedModule -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe ParsedModule))
-> (ParsedModule -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe ParsedModule)
caaParsedModule

instance ToCodeAction r => ToCodeAction (Maybe T.Text -> r) where
  toCodeAction :: (Maybe Text -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe Text))
-> (Maybe Text -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe Text)
caaContents

instance ToCodeAction r => ToCodeAction (T.Text -> r) where
  toCodeAction :: (Text -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe Text))
-> (Text -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe Text)
caaContents

instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where
  toCodeAction :: (Maybe DynFlags -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe DynFlags))
-> (Maybe DynFlags -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe DynFlags)
caaDf

instance ToCodeAction r => ToCodeAction (DynFlags -> r) where
  toCodeAction :: (DynFlags -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe DynFlags))
-> (DynFlags -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe DynFlags)
caaDf

instance ToCodeAction r => ToCodeAction (Maybe (Annotated ParsedSource) -> r) where
  toCodeAction :: (Maybe (Annotated ParsedSource) -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe (Annotated ParsedSource)))
-> (Maybe (Annotated ParsedSource) -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe (Annotated ParsedSource))
caaAnnSource

instance ToCodeAction r => ToCodeAction (Annotated ParsedSource -> r) where
  toCodeAction :: (Annotated ParsedSource -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe (Annotated ParsedSource)))
-> (Annotated ParsedSource -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe (Annotated ParsedSource))
caaAnnSource

instance ToCodeAction r => ToCodeAction (Maybe TcModuleResult -> r) where
  toCodeAction :: (Maybe TcModuleResult -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe TcModuleResult))
-> (Maybe TcModuleResult -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe TcModuleResult)
caaTmr

instance ToCodeAction r => ToCodeAction (TcModuleResult -> r) where
  toCodeAction :: (TcModuleResult -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe TcModuleResult))
-> (TcModuleResult -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe TcModuleResult)
caaTmr

instance ToCodeAction r => ToCodeAction (Maybe HieAstResult -> r) where
  toCodeAction :: (Maybe HieAstResult -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe HieAstResult))
-> (Maybe HieAstResult -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe HieAstResult)
caaHar

instance ToCodeAction r => ToCodeAction (HieAstResult -> r) where
  toCodeAction :: (HieAstResult -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe HieAstResult))
-> (HieAstResult -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe HieAstResult)
caaHar

instance ToCodeAction r => ToCodeAction (Maybe Bindings -> r) where
  toCodeAction :: (Maybe Bindings -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe Bindings))
-> (Maybe Bindings -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe Bindings)
caaBindings

instance ToCodeAction r => ToCodeAction (Bindings -> r) where
  toCodeAction :: (Bindings -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe Bindings))
-> (Bindings -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe Bindings)
caaBindings

instance ToCodeAction r => ToCodeAction (Maybe GlobalBindingTypeSigsResult -> r) where
  toCodeAction :: (Maybe GlobalBindingTypeSigsResult -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe GlobalBindingTypeSigsResult))
-> (Maybe GlobalBindingTypeSigsResult -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe GlobalBindingTypeSigsResult)
caaGblSigs

instance ToCodeAction r => ToCodeAction (GlobalBindingTypeSigsResult -> r) where
  toCodeAction :: (GlobalBindingTypeSigsResult -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe GlobalBindingTypeSigsResult))
-> (GlobalBindingTypeSigsResult -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe GlobalBindingTypeSigsResult)
caaGblSigs

instance ToCodeAction r => ToCodeAction (Maybe HscEnvEq -> r) where
  toCodeAction :: (Maybe HscEnvEq -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe HscEnvEq))
-> (Maybe HscEnvEq -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe HscEnvEq)
caaGhcSession

instance ToCodeAction r => ToCodeAction (Maybe HscEnv -> r) where
  toCodeAction :: (Maybe HscEnv -> r) -> GhcideCodeAction
toCodeAction = (CodeActionArgs -> IO (Maybe HscEnv))
-> (Maybe HscEnv -> r) -> GhcideCodeAction
forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 (((IO (Maybe HscEnvEq) -> IO (Maybe HscEnv))
-> (CodeActionArgs -> IO (Maybe HscEnvEq))
-> CodeActionArgs
-> IO (Maybe HscEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((IO (Maybe HscEnvEq) -> IO (Maybe HscEnv))
 -> (CodeActionArgs -> IO (Maybe HscEnvEq))
 -> CodeActionArgs
 -> IO (Maybe HscEnv))
-> ((HscEnvEq -> HscEnv)
    -> IO (Maybe HscEnvEq) -> IO (Maybe HscEnv))
-> (HscEnvEq -> HscEnv)
-> (CodeActionArgs -> IO (Maybe HscEnvEq))
-> CodeActionArgs
-> IO (Maybe HscEnv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe HscEnvEq -> Maybe HscEnv)
-> IO (Maybe HscEnvEq) -> IO (Maybe HscEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Maybe HscEnvEq -> Maybe HscEnv)
 -> IO (Maybe HscEnvEq) -> IO (Maybe HscEnv))
-> ((HscEnvEq -> HscEnv) -> Maybe HscEnvEq -> Maybe HscEnv)
-> (HscEnvEq -> HscEnv)
-> IO (Maybe HscEnvEq)
-> IO (Maybe HscEnv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(HscEnvEq -> HscEnv) -> Maybe HscEnvEq -> Maybe HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) HscEnvEq -> HscEnv
hscEnv CodeActionArgs -> IO (Maybe HscEnvEq)
caaGhcSession)