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.Compat.ExactPrint
import           Development.IDE.GHC.ExactPrint
#if !MIN_VERSION_ghc(9,3,0)
import           Development.IDE.Plugin.CodeAction.ExactPrint (Rewrite,
                                                               rewriteToEdit)
#endif
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 :: forall (m :: * -> *).
MonadLsp Config m =>
IdeState
-> MessageParams 'TextDocumentCodeAction
-> GhcideCodeAction
-> m GhcideCodeActionResult
runGhcideCodeAction IdeState
state (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ (TextDocumentIdentifier Uri
uri) Range
_range CodeActionContext {$sel:_diagnostics:CodeActionContext :: CodeActionContext -> List Diagnostic
_diagnostics = List [Diagnostic]
diags}) GhcideCodeAction
codeAction = do
  let mbFile :: Maybe NormalizedFilePath
mbFile = FilePath -> NormalizedFilePath
toNormalizedFilePath' 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 = forall a. FilePath -> IdeState -> Action a -> IO a
runAction (FilePath
"GhcideCodeActions." forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show k
key) IdeState
state forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NormalizedFilePath
mbFile) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use k
key
  IO (Maybe HscEnvEq)
caaGhcSession <- forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$ 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 <-
    forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$
      IO (Maybe HscEnvEq)
caaGhcSession 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 <- forall a. TVar a -> IO a
readTVarIO (ShakeExtras -> TVar ExportsMap
exportsMap forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
state)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ExportsMap
localExports forall a. Semigroup a => a -> a -> a
<> ExportsMap
pkgExports
        Maybe HscEnvEq
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  IO IdeOptions
caaIdeOptions <- forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"GhcideCodeActions.getIdeOptions" IdeState
state Action IdeOptions
getIdeOptions
  IO (Maybe ParsedModule)
caaParsedModule <- forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$ 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 <-
    forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$
      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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (FileVersion
_, Maybe Text
txt) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
txt
        Maybe (FileVersion, Maybe Text)
_             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  IO (Maybe DynFlags)
caaDf <- forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModSummary -> DynFlags
ms_hspp_opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe ParsedModule)
caaParsedModule
#if !MIN_VERSION_ghc(9,3,0)
  IO (Maybe (Annotated ParsedSource))
caaAnnSource <- forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$ 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
#endif
  IO (Maybe TcModuleResult)
caaTmr <- forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO forall a b. (a -> b) -> a -> b
$ 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
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ 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 (Maybe Text)
IO (Maybe ParsedModule)
IO (Maybe DynFlags)
IO (Maybe GlobalBindingTypeSigsResult)
IO (Maybe TcModuleResult)
IO (Maybe HieAstResult)
IO (Maybe Bindings)
IO (Maybe HscEnvEq)
IO (Maybe (Annotated ParsedSource))
IO IdeOptions
IO ExportsMap
Diagnostic
$sel:caaDiagnostic:CodeActionArgs :: Diagnostic
$sel:caaGblSigs:CodeActionArgs :: IO (Maybe GlobalBindingTypeSigsResult)
$sel:caaBindings:CodeActionArgs :: IO (Maybe Bindings)
$sel:caaHar:CodeActionArgs :: IO (Maybe HieAstResult)
$sel:caaTmr:CodeActionArgs :: IO (Maybe TcModuleResult)
$sel:caaAnnSource:CodeActionArgs :: IO (Maybe (Annotated ParsedSource))
$sel:caaDf:CodeActionArgs :: IO (Maybe DynFlags)
$sel:caaContents:CodeActionArgs :: IO (Maybe Text)
$sel:caaParsedModule:CodeActionArgs :: IO (Maybe ParsedModule)
$sel:caaIdeOptions:CodeActionArgs :: IO IdeOptions
$sel:caaGhcSession:CodeActionArgs :: IO (Maybe HscEnvEq)
$sel:caaExportsMap:CodeActionArgs :: 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 =
  forall a b. b -> a |? b
InR 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 (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [Diagnostic]
diags) Maybe Bool
isPreferred forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just WorkspaceEdit
edit) forall a. Maybe a
Nothing forall a. Maybe a
Nothing

mkGhcideCAPlugin :: GhcideCodeAction -> PluginId -> PluginDescriptor IdeState
mkGhcideCAPlugin :: GhcideCodeAction -> PluginId -> PluginDescriptor IdeState
mkGhcideCAPlugin GhcideCodeAction
codeAction PluginId
plId =
  (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
    { pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentCodeAction
STextDocumentCodeAction forall a b. (a -> b) -> a -> b
$
        \IdeState
state PluginId
_ params :: MessageParams 'TextDocumentCodeAction
params@(CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ (TextDocumentIdentifier Uri
uri) Range
_ CodeActionContext {$sel:_diagnostics:CodeActionContext :: CodeActionContext -> List Diagnostic
_diagnostics = List [Diagnostic]
diags}) -> do
          GhcideCodeActionResult
results <- forall (m :: * -> *).
MonadLsp Config m =>
IdeState
-> MessageParams 'TextDocumentCodeAction
-> GhcideCodeAction
-> m GhcideCodeActionResult
runGhcideCodeAction IdeState
state MessageParams 'TextDocumentCodeAction
params GhcideCodeAction
codeAction
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
              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 (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [TextEdit]
tedit) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                ]
    }

mkGhcideCAsPlugin :: [GhcideCodeAction] -> PluginId -> PluginDescriptor IdeState
mkGhcideCAsPlugin :: [GhcideCodeAction] -> PluginId -> PluginDescriptor IdeState
mkGhcideCAsPlugin [GhcideCodeAction]
codeActions = GhcideCodeAction -> PluginId -> PluginDescriptor IdeState
mkGhcideCAPlugin forall a b. (a -> b) -> a -> b
$ 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
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure

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

instance ToTextEdit a => ToTextEdit [a] where
  toTextEdit :: CodeActionArgs -> [a] -> IO [TextEdit]
toTextEdit CodeActionArgs
caa = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. ToTextEdit a => CodeActionArgs -> a -> IO [TextEdit]
toTextEdit CodeActionArgs
caa) (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),
#if MIN_VERSION_ghc(9,3,0)
    caaAnnSource    :: IO (Maybe ParsedSource),
#else
    CodeActionArgs -> IO (Maybe (Annotated ParsedSource))
caaAnnSource    :: IO (Maybe (Annotated ParsedSource)),
#endif
    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 :: forall (m :: * -> *) a. MonadIO m => IO a -> m (IO a)
onceIO IO a
io = do
  IORef (Maybe a)
var <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall a. IORef a -> IO a
readIORef IORef (Maybe a)
var forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
      Maybe a
_      -> IO a
io forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> forall a. IORef a -> a -> IO ()
writeIORef' IORef (Maybe a)
var (forall a. a -> Maybe a
Just a
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

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

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

class ToCodeAction a where
  toCodeAction :: a -> GhcideCodeAction

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

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

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

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

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

instance ToTextEdit a => ToCodeAction (CodeActionTitle, a) where
  toCodeAction :: (Text, a) -> GhcideCodeAction
toCodeAction (Text
title, a
te) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
title,forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix,forall a. Maybe a
Nothing,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
title,forall a. a -> Maybe a
Just CodeActionKind
kind,forall a. Maybe a
Nothing,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
title,forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix,forall a. a -> Maybe a
Just Bool
isPreferred,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
title,forall a. a -> Maybe a
Just CodeActionKind
kind,forall a. a -> Maybe a
Just Bool
isPreferred,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 CodeActionArgs -> IO (Maybe a)
get Maybe a -> r
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> CodeActionArgs -> IO (Maybe a)
get CodeActionArgs
caa forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CodeActionArgs
caa forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction 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 :: forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe a)
get a -> r
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa ->
  CodeActionArgs -> IO (Maybe a)
get CodeActionArgs
caa forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just a
x -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CodeActionArgs
caa forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> r
f forall a b. (a -> b) -> a -> b
$ a
x
    Maybe a
_      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []

toCodeAction3 :: (ToCodeAction r) => (CodeActionArgs -> IO a) -> (a -> r) -> GhcideCodeAction
toCodeAction3 :: forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO a) -> (a -> r) -> GhcideCodeAction
toCodeAction3 CodeActionArgs -> IO a
get a -> r
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \CodeActionArgs
caa -> CodeActionArgs -> IO a
get CodeActionArgs
caa forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CodeActionArgs
caa forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction 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
#if !MIN_VERSION_ghc(9,3,0)
  toCodeAction :: (ParsedSource -> r) -> GhcideCodeAction
toCodeAction ParsedSource -> r
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \caa :: CodeActionArgs
caa@CodeActionArgs {$sel:caaAnnSource:CodeActionArgs :: CodeActionArgs -> IO (Maybe (Annotated ParsedSource))
caaAnnSource = IO (Maybe (Annotated ParsedSource))
x} ->
    IO (Maybe (Annotated ParsedSource))
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Annotated ParsedSource
s -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CodeActionArgs
caa forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedSource -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ast. Annotated ast -> ast
astA forall a b. (a -> b) -> a -> b
$ Annotated ParsedSource
s
      Maybe (Annotated ParsedSource)
_      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
#else
  toCodeAction f = ReaderT $ \caa@CodeActionArgs {caaParsedModule = x} ->
    x >>= \case
      Just s -> flip runReaderT caa . toCodeAction . f . pm_parsed_source $ s
      _      -> pure []
#endif

instance ToCodeAction r => ToCodeAction (ExportsMap -> r) where
  toCodeAction :: (ExportsMap -> r) -> GhcideCodeAction
toCodeAction = 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 = 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 = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \caa :: CodeActionArgs
caa@CodeActionArgs {$sel:caaDiagnostic:CodeActionArgs :: CodeActionArgs -> Diagnostic
caaDiagnostic = Diagnostic
x} -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CodeActionArgs
caa forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCodeAction a => a -> GhcideCodeAction
toCodeAction 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 = 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 = 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 = 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 = 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 = 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 = forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe DynFlags)
caaDf

#if !MIN_VERSION_ghc(9,3,0)
instance ToCodeAction r => ToCodeAction (Maybe (Annotated ParsedSource) -> r) where
  toCodeAction :: (Maybe (Annotated ParsedSource) -> r) -> GhcideCodeAction
toCodeAction = 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 = forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction
toCodeAction2 CodeActionArgs -> IO (Maybe (Annotated ParsedSource))
caaAnnSource
#endif

instance ToCodeAction r => ToCodeAction (Maybe TcModuleResult -> r) where
  toCodeAction :: (Maybe TcModuleResult -> r) -> GhcideCodeAction
toCodeAction = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = forall r a.
ToCodeAction r =>
(CodeActionArgs -> IO (Maybe a))
-> (Maybe a -> r) -> GhcideCodeAction
toCodeAction1 ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) HscEnvEq -> HscEnv
hscEnv CodeActionArgs -> IO (Maybe HscEnvEq)
caaGhcSession)