{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

module Ide.Plugin.Splice
    ( descriptor,
    )
where

import           Control.Applicative             (Alternative ((<|>)))
import           Control.Arrow
import           Control.Exception
import qualified Control.Foldl                   as L
import           Control.Lens                    (Identity (..), ix, view, (%~),
                                                  (<&>), (^.))
import           Control.Monad
import           Control.Monad.Extra             (eitherM)
import qualified Control.Monad.Fail              as Fail
import           Control.Monad.IO.Unlift
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           Control.Monad.Trans.Maybe
import           Data.Aeson
import           Data.Foldable                   (Foldable (foldl'))
import           Data.Function
import           Data.Generics
import qualified Data.Kind                       as Kinds
import           Data.List                       (sortOn)
import           Data.Maybe                      (fromMaybe, listToMaybe,
                                                  mapMaybe)
import qualified Data.Text                       as T
import           Development.IDE
import           Development.IDE.GHC.Compat      as Compat hiding (getLoc)
import           Development.IDE.GHC.Compat.ExactPrint
import qualified Development.IDE.GHC.Compat.Util as Util
import           Development.IDE.GHC.ExactPrint
#if MIN_VERSION_ghc(9,4,1)
import           GHC.Data.Bag (Bag)
#endif
import           GHC.Exts
#if MIN_VERSION_ghc(9,2,0)
import           GHC.Parser.Annotation (SrcSpanAnn'(..))
import qualified GHC.Types.Error as Error
#endif
import           Ide.Plugin.Splice.Types
import           Ide.Types
import           Language.Haskell.GHC.ExactPrint (uniqueSrcSpanT)
import           Language.LSP.Server
import           Language.LSP.Types
import           Language.LSP.Types.Capabilities
import qualified Language.LSP.Types.Lens         as J

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId =
    (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
        { pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState]
commands
        , pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentCodeAction
STextDocumentCodeAction PluginMethodHandler IdeState 'TextDocumentCodeAction
codeAction
        }

commands :: [PluginCommand IdeState]
commands :: [PluginCommand IdeState]
commands =
    [ forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
expandInplaceId Text
inplaceCmdName forall a b. (a -> b) -> a -> b
$ ExpandStyle -> CommandFunction IdeState ExpandSpliceParams
expandTHSplice ExpandStyle
Inplace
    -- , PluginCommand expandCommentedId commentedCmdName $ expandTHSplice Commented
    ]

newtype SubSpan = SubSpan {SubSpan -> SrcSpan
runSubSpan :: SrcSpan}

instance Eq SubSpan where
    == :: SubSpan -> SubSpan -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SubSpan -> SrcSpan
runSubSpan

instance Ord SubSpan where
    <= :: SubSpan -> SubSpan -> Bool
(<=) = coerce :: forall a b. Coercible a b => a -> b
coerce SrcSpan -> SrcSpan -> Bool
isSubspanOf

expandTHSplice ::
    -- | Inplace?
    ExpandStyle ->
    CommandFunction IdeState ExpandSpliceParams
expandTHSplice :: ExpandStyle -> CommandFunction IdeState ExpandSpliceParams
expandTHSplice ExpandStyle
_eStyle IdeState
ideState params :: ExpandSpliceParams
params@ExpandSpliceParams {RealSrcSpan
Uri
SpliceContext
spliceContext :: ExpandSpliceParams -> SpliceContext
spliceSpan :: ExpandSpliceParams -> RealSrcSpan
uri :: ExpandSpliceParams -> Uri
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
uri :: Uri
..} = do
    ClientCapabilities
clientCapabilities <- forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
    LspT Config IO () -> IO ()
rio <- forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
    let reportEditor :: ReportEditor
        reportEditor :: ReportEditor
reportEditor MessageType
msgTy [Text]
msgs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ LspT Config IO () -> IO ()
rio forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
sendNotification SMethod 'WindowShowMessage
SWindowShowMessage (MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
msgTy ([Text] -> Text
T.unlines [Text]
msgs))
        expandManually :: NormalizedFilePath -> ExceptT String IO WorkspaceEdit
expandManually NormalizedFilePath
fp = do
            Maybe (TcModuleResult, PositionMapping)
mresl <-
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.TypeCheck (stale)" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale TypeCheck
TypeCheck NormalizedFilePath
fp
            (TcModuleResult {Bool
RenamedSource
ParsedModule
TcGblEnv
ModuleEnv ByteString
Splices
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferredError :: TcModuleResult -> Bool
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
tmrRuntimeModules :: ModuleEnv ByteString
tmrDeferredError :: Bool
tmrTopLevelSplices :: Splices
tmrTypechecked :: TcGblEnv
tmrRenamed :: RenamedSource
tmrParsed :: ParsedModule
..}, PositionMapping
_) <-
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"Splice expansion: Type-checking information not found in cache.\nYou can once delete or replace the macro with placeholder, convince the type checker and then revert to original (erroneous) macro and expand splice again."
                )
                forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TcModuleResult, PositionMapping)
mresl
            ReportEditor
reportEditor
                MessageType
MtWarning
                [ Text
"Expansion in type-checking phase failed;"
                , Text
"trying to expand manually, but note that it is less rigorous."
                ]
            ParsedModule
pm <-
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                    forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.GetParsedModule" IdeState
ideState forall a b. (a -> b) -> a -> b
$
                        forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetParsedModule
GetParsedModule NormalizedFilePath
fp
            (Annotated ParsedSource
ps, HscEnv
hscEnv, DynFlags
_dflags) <- IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
pm

            ClientCapabilities
-> ReportEditor
-> Range
-> Annotated ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT String IO WorkspaceEdit
manualCalcEdit
                ClientCapabilities
clientCapabilities
                ReportEditor
reportEditor
                Range
range
                Annotated ParsedSource
ps
                HscEnv
hscEnv
                TcGblEnv
tmrTypechecked
                RealSrcSpan
spliceSpan
                ExpandStyle
_eStyle
                ExpandSpliceParams
params

        withTypeChecked :: NormalizedFilePath
-> TcModuleResult -> ExceptT String IO WorkspaceEdit
withTypeChecked NormalizedFilePath
fp TcModuleResult {Bool
RenamedSource
ParsedModule
TcGblEnv
ModuleEnv ByteString
Splices
tmrRuntimeModules :: ModuleEnv ByteString
tmrDeferredError :: Bool
tmrTopLevelSplices :: Splices
tmrTypechecked :: TcGblEnv
tmrRenamed :: RenamedSource
tmrParsed :: ParsedModule
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferredError :: TcModuleResult -> Bool
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
..} = do
            (Annotated ParsedSource
ps, HscEnv
_hscEnv, DynFlags
dflags) <- IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
tmrParsed
            let Splices {[(LHsExpr GhcTc, [LHsDecl GhcPs])]
[(LHsExpr GhcTc, Serialized)]
[(LHsExpr GhcTc, LHsType GhcPs)]
[(LHsExpr GhcTc, LPat GhcPs)]
[(LHsExpr GhcTc, LHsExpr GhcPs)]
exprSplices :: Splices -> [(LHsExpr GhcTc, LHsExpr GhcPs)]
patSplices :: Splices -> [(LHsExpr GhcTc, LPat GhcPs)]
typeSplices :: Splices -> [(LHsExpr GhcTc, LHsType GhcPs)]
declSplices :: Splices -> [(LHsExpr GhcTc, [LHsDecl GhcPs])]
awSplices :: Splices -> [(LHsExpr GhcTc, Serialized)]
awSplices :: [(LHsExpr GhcTc, Serialized)]
declSplices :: [(LHsExpr GhcTc, [LHsDecl GhcPs])]
typeSplices :: [(LHsExpr GhcTc, LHsType GhcPs)]
patSplices :: [(LHsExpr GhcTc, LPat GhcPs)]
exprSplices :: [(LHsExpr GhcTc, LHsExpr GhcPs)]
..} = Splices
tmrTopLevelSplices
            let exprSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))
exprSuperSpans =
                    forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LHsExpr GhcPs)]
exprSplices
                _patSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs))
_patSuperSpans =
                    forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LPat GhcPs)]
patSplices
                typeSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs))
typeSuperSpans =
                    forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LHsType GhcPs)]
typeSplices
                declSuperSpans :: Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
declSuperSpans =
                    forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, [LHsDecl GhcPs])]
declSplices

                graftSpliceWith ::
                    forall ast.
                    HasSplice AnnListItem ast =>
                    Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs)) ->
                    Maybe (Either String WorkspaceEdit)
                graftSpliceWith :: forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
expandeds =
                    Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
expandeds forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SrcSpan
_, LocatedAn AnnListItem (ast GhcPs)
expanded) ->
                        DynFlags
-> ClientCapabilities
-> Uri
-> Graft (Either String) ParsedSource
-> Annotated ParsedSource
-> Either String WorkspaceEdit
transform
                            DynFlags
dflags
                            ClientCapabilities
clientCapabilities
                            Uri
uri
                            (forall l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spliceSpan forall a. Maybe a
Nothing) LocatedAn AnnListItem (ast GhcPs)
expanded)
                            Annotated ParsedSource
ps
            forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"No splice information found") (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall a b. (a -> b) -> a -> b
$
                case SpliceContext
spliceContext of
                    SpliceContext
Expr -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))
exprSuperSpans
                    SpliceContext
Pat ->

                        forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs))
_patSuperSpans

                    SpliceContext
HsType -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs))
typeSuperSpans
                    SpliceContext
HsDecl ->
                        Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
declSuperSpans forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SrcSpan
_, [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
expanded) ->
                            DynFlags
-> ClientCapabilities
-> Uri
-> Graft (Either String) ParsedSource
-> Annotated ParsedSource
-> Either String WorkspaceEdit
transform
                                DynFlags
dflags
                                ClientCapabilities
clientCapabilities
                                Uri
uri
                                (forall a.
HasDecls a =>
SrcSpan -> [LHsDecl GhcPs] -> Graft (Either String) a
graftDecls (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spliceSpan forall a. Maybe a
Nothing) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
expanded)
                                Annotated ParsedSource
ps
                                forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
                                -- FIXME: Why ghc-exactprint sweeps preceding comments?
                                Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange Uri
uri Range
range

    Maybe (Either ResponseError WorkspaceEdit)
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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

            NormalizedFilePath
fp <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
            Either String WorkspaceEdit
eedits <-
                ( forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath
-> TcModuleResult -> ExceptT String IO WorkspaceEdit
withTypeChecked NormalizedFilePath
fp
                        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT
                            (forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.TypeCheck" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck NormalizedFilePath
fp)
                    )
                    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> ExceptT String IO WorkspaceEdit
expandManually NormalizedFilePath
fp)

            case Either String WorkspaceEdit
eedits of
                Left String
err -> do
                    ReportEditor
reportEditor
                        MessageType
MtError
                        [Text
"Error during expanding splice: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err]
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
responseError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err)
                Right WorkspaceEdit
edits ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right WorkspaceEdit
edits)
    case Maybe (Either ResponseError WorkspaceEdit)
res of
      Maybe (Either ResponseError WorkspaceEdit)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Value
Null
      Just (Left ResponseError
err) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ResponseError
err
      Just (Right WorkspaceEdit
edit) -> do
        LspId 'WorkspaceApplyEdit
_ <- forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
sendRequest SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Value
Null

    where
        range :: Range
range = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
spliceSpan
        srcSpan :: SrcSpan
srcSpan = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spliceSpan forall a. Maybe a
Nothing


setupHscEnv
    :: IdeState
    -> NormalizedFilePath
    -> ParsedModule
    -> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv :: IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
pm = do
    HscEnvEq
hscEnvEq <-
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.ghcSessionDeps" IdeState
ideState forall a b. (a -> b) -> a -> b
$
                forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSessionDeps
GhcSessionDeps NormalizedFilePath
fp
    let ps :: Annotated ParsedSource
ps = ParsedModule -> Annotated ParsedSource
annotateParsedSource ParsedModule
pm
        hscEnv0 :: HscEnv
hscEnv0 = HscEnvEq -> HscEnv
hscEnvWithImportPaths HscEnvEq
hscEnvEq
        modSum :: ModSummary
modSum = ParsedModule -> ModSummary
pm_mod_summary ParsedModule
pm
    HscEnv
hscEnv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike HscEnv
hscEnv0 forall a b. (a -> b) -> a -> b
$ ModSummary -> DynFlags
ms_hspp_opts ModSummary
modSum
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotated ParsedSource
ps, HscEnv
hscEnv, HscEnv -> DynFlags
hsc_dflags HscEnv
hscEnv)

setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike HscEnv
env DynFlags
dflags = do
    let dflags3 :: DynFlags
dflags3 = DynFlags -> DynFlags
setInterpreterLinkerOptions DynFlags
dflags
        platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags3
        dflags3a :: DynFlags
dflags3a = Ways -> DynFlags -> DynFlags
setWays Ways
hostFullWays DynFlags
dflags3
        dflags3b :: DynFlags
dflags3b =
            forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflags3a forall a b. (a -> b) -> a -> b
$
                forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
wayGeneralFlags Platform
platform) Ways
hostFullWays
        dflags3c :: DynFlags
dflags3c =
            forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
dflags3b forall a b. (a -> b) -> a -> b
$
                forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
wayUnsetGeneralFlags Platform
platform) Ways
hostFullWays
        dflags4 :: DynFlags
dflags4 =
            DynFlags
dflags3c
                DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_ImplicitImportQualified
                DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_IgnoreOptimChanges
                DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_IgnoreHpcChanges
                DynFlags -> GeneralFlag -> DynFlags
`gopt_unset` GeneralFlag
Opt_DiagnosticsShowCaret
    HscEnv -> IO HscEnv
initializePlugins (DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags4 HscEnv
env)

adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange Uri
uri Range
ran (WorkspaceEdit Maybe WorkspaceEditMap
mhult Maybe (List DocumentChange)
mlt Maybe ChangeAnnotationMap
x) =
    Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> WorkspaceEditMap
adjustWS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe WorkspaceEditMap
mhult) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocumentChange -> DocumentChange
adjustDoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (List DocumentChange)
mlt) Maybe ChangeAnnotationMap
x
    where
        adjustTextEdits :: Traversable f => f TextEdit -> f TextEdit
        adjustTextEdits :: forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits f TextEdit
eds =
            let minStart :: Range
minStart =
                    case forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (forall a b r. (a -> b) -> Fold b r -> Fold a r
L.premap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasRange s a => Lens' s a
J.range) forall a. Ord a => Fold a (Maybe a)
L.minimum) f TextEdit
eds of
                        Maybe Range
Nothing -> forall a. HasCallStack => String -> a
error String
"impossible"
                        Just Range
v -> Range
v
            in Range -> TextEdit -> TextEdit
adjustLine Range
minStart forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f TextEdit
eds

        adjustATextEdits :: Traversable f => f (TextEdit |? AnnotatedTextEdit) -> f (TextEdit |? AnnotatedTextEdit)
        adjustATextEdits :: forall (f :: * -> *).
Traversable f =>
f (TextEdit |? AnnotatedTextEdit)
-> f (TextEdit |? AnnotatedTextEdit)
adjustATextEdits = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \case
          InL TextEdit
t -> forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits (forall a. a -> Identity a
Identity TextEdit
t)
          InR AnnotatedTextEdit{Range
$sel:_range:AnnotatedTextEdit :: AnnotatedTextEdit -> Range
_range :: Range
_range, Text
$sel:_newText:AnnotatedTextEdit :: AnnotatedTextEdit -> Text
_newText :: Text
_newText, ChangeAnnotationIdentifier
$sel:_annotationId:AnnotatedTextEdit :: AnnotatedTextEdit -> ChangeAnnotationIdentifier
_annotationId :: ChangeAnnotationIdentifier
_annotationId} ->
            let oldTE :: TextEdit
oldTE = TextEdit{Range
$sel:_range:TextEdit :: Range
_range :: Range
_range,Text
$sel:_newText:TextEdit :: Text
_newText :: Text
_newText}
              in let TextEdit{Range
_range :: Range
$sel:_range:TextEdit :: TextEdit -> Range
_range,Text
_newText :: Text
$sel:_newText:TextEdit :: TextEdit -> Text
_newText} = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits (forall a. a -> Identity a
Identity TextEdit
oldTE)
                in forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ AnnotatedTextEdit{Range
_range :: Range
$sel:_range:AnnotatedTextEdit :: Range
_range,Text
_newText :: Text
$sel:_newText:AnnotatedTextEdit :: Text
_newText,ChangeAnnotationIdentifier
$sel:_annotationId:AnnotatedTextEdit :: ChangeAnnotationIdentifier
_annotationId :: ChangeAnnotationIdentifier
_annotationId}

        adjustWS :: WorkspaceEditMap -> WorkspaceEditMap
adjustWS = forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Uri
uri forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits
        adjustDoc :: DocumentChange -> DocumentChange
        adjustDoc :: DocumentChange -> DocumentChange
adjustDoc (InR CreateFile |? (RenameFile |? DeleteFile)
es) = forall a b. b -> a |? b
InR CreateFile |? (RenameFile |? DeleteFile)
es
        adjustDoc (InL TextDocumentEdit
es)
            | TextDocumentEdit
es forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri forall a. Eq a => a -> a -> Bool
== Uri
uri =
                forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ TextDocumentEdit
es forall a b. a -> (a -> b) -> b
& forall s a. HasEdits s a => Lens' s a
J.edits forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *).
Traversable f =>
f (TextEdit |? AnnotatedTextEdit)
-> f (TextEdit |? AnnotatedTextEdit)
adjustATextEdits
            | Bool
otherwise = forall a b. a -> a |? b
InL TextDocumentEdit
es

        adjustLine :: Range -> TextEdit -> TextEdit
        adjustLine :: Range -> TextEdit -> TextEdit
adjustLine Range
bad =
            forall s a. HasRange s a => Lens' s a
J.range forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Range
r ->
                if Range
r forall a. Eq a => a -> a -> Bool
== Range
bad then Range
ran else Range
bad

-- Define a pattern to get hold of a `SrcSpan` from the location part of a
-- `GenLocated`. In GHC >= 9.2 this will be a SrcSpanAnn', with annotations;
-- earlier it will just be a plain `SrcSpan`.
{-# COMPLETE AsSrcSpan #-}
#if MIN_VERSION_ghc(9,2,0)
pattern AsSrcSpan :: SrcSpan -> SrcSpanAnn' a
pattern $mAsSrcSpan :: forall {r} {a}.
SrcSpanAnn' a -> (SrcSpan -> r) -> ((# #) -> r) -> r
AsSrcSpan locA <- SrcSpanAnn {locA}
#else
pattern AsSrcSpan :: SrcSpan -> SrcSpan
pattern AsSrcSpan loc <- loc
#endif

findSubSpansDesc :: SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc :: forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan =
    forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SubSpan
SubSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
            ( \(L (AsSrcSpan SrcSpan
spn) HsExpr GhcTc
_, a
e) -> do
                forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SrcSpan
spn SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
srcSpan)
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpan
spn, a
e)
            )

data SpliceClass where
    OneToOneAST :: HasSplice AnnListItem ast => Proxy# ast -> SpliceClass
    IsHsDecl :: SpliceClass

class (Outputable (ast GhcRn), ASTElement l (ast GhcPs)) => HasSplice l ast where
    type SpliceOf ast :: Kinds.Type -> Kinds.Type
    type SpliceOf ast = HsSplice
    matchSplice :: Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs)
    expandSplice :: Proxy# ast -> SpliceOf ast GhcPs -> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars)

instance HasSplice AnnListItem HsExpr where
    matchSplice :: Proxy# HsExpr -> HsExpr GhcPs -> Maybe (SpliceOf HsExpr GhcPs)
matchSplice Proxy# HsExpr
_ (HsSpliceE XSpliceE GhcPs
_ HsSplice GhcPs
spl) = forall a. a -> Maybe a
Just HsSplice GhcPs
spl
    matchSplice Proxy# HsExpr
_ HsExpr GhcPs
_                 = forall a. Maybe a
Nothing
    expandSplice :: Proxy# HsExpr
-> SpliceOf HsExpr GhcPs
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
expandSplice Proxy# HsExpr
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnSpliceExpr

instance HasSplice AnnListItem Pat where
    matchSplice :: Proxy# Pat -> Pat GhcPs -> Maybe (SpliceOf Pat GhcPs)
matchSplice Proxy# Pat
_ (SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
spl) = forall a. a -> Maybe a
Just HsSplice GhcPs
spl
    matchSplice Proxy# Pat
_ Pat GhcPs
_                 = forall a. Maybe a
Nothing
    expandSplice :: Proxy# Pat
-> SpliceOf Pat GhcPs
-> RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
expandSplice Proxy# Pat
_ = HsSplice GhcPs -> RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
rnSplicePat


instance HasSplice AnnListItem HsType where
    matchSplice :: Proxy# HsType -> HsType GhcPs -> Maybe (SpliceOf HsType GhcPs)
matchSplice Proxy# HsType
_ (HsSpliceTy XSpliceTy GhcPs
_ HsSplice GhcPs
spl) = forall a. a -> Maybe a
Just HsSplice GhcPs
spl
    matchSplice Proxy# HsType
_ HsType GhcPs
_                  = forall a. Maybe a
Nothing
    expandSplice :: Proxy# HsType
-> SpliceOf HsType GhcPs
-> RnM (Either (HsType GhcPs) (HsType GhcRn), FreeVars)
expandSplice Proxy# HsType
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars)
rnSpliceType

classifyAST :: SpliceContext -> SpliceClass
classifyAST :: SpliceContext -> SpliceClass
classifyAST = \case
    SpliceContext
Expr   -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Proxy# ast -> SpliceClass
OneToOneAST @HsExpr forall {k} (a :: k). Proxy# a
proxy#
    SpliceContext
HsDecl -> SpliceClass
IsHsDecl
    SpliceContext
Pat    -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Proxy# ast -> SpliceClass
OneToOneAST @Pat forall {k} (a :: k). Proxy# a
proxy#
    SpliceContext
HsType -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Proxy# ast -> SpliceClass
OneToOneAST @HsType forall {k} (a :: k). Proxy# a
proxy#

type ReportEditor = forall m. MonadIO m => MessageType -> [T.Text] -> m ()

manualCalcEdit ::
    ClientCapabilities ->
    ReportEditor ->
    Range ->
    Annotated ParsedSource ->
    HscEnv ->
    TcGblEnv ->
    RealSrcSpan ->
    ExpandStyle ->
    ExpandSpliceParams ->
    ExceptT String IO WorkspaceEdit
manualCalcEdit :: ClientCapabilities
-> ReportEditor
-> Range
-> Annotated ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT String IO WorkspaceEdit
manualCalcEdit ClientCapabilities
clientCapabilities ReportEditor
reportEditor Range
ran Annotated ParsedSource
ps HscEnv
hscEnv TcGblEnv
typechkd RealSrcSpan
srcSpan ExpandStyle
_eStyle ExpandSpliceParams {RealSrcSpan
Uri
SpliceContext
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
uri :: Uri
spliceContext :: ExpandSpliceParams -> SpliceContext
spliceSpan :: ExpandSpliceParams -> RealSrcSpan
uri :: ExpandSpliceParams -> Uri
..} = do
    (Bag (MsgEnvelope DecoratedSDoc)
warns, WorkspaceEdit
resl) <-
        forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
            (Messages DecoratedSDoc
msgs, Maybe (Either String WorkspaceEdit)
eresl) <-
                forall r.
HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM r
-> IO (Messages DecoratedSDoc, Maybe r)
initTcWithGbl HscEnv
hscEnv TcGblEnv
typechkd RealSrcSpan
srcSpan forall a b. (a -> b) -> a -> b
$
                    case SpliceContext -> SpliceClass
classifyAST SpliceContext
spliceContext of
                        SpliceClass
IsHsDecl -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange Uri
uri Range
ran) forall a b. (a -> b) -> a -> b
$
                            forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> Uri
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
clientCapabilities Uri
uri) Annotated ParsedSource
ps forall a b. (a -> b) -> a -> b
$
                                forall a (m :: * -> *).
(HasDecls a, MonadFail m) =>
SrcSpan
-> (LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs]))
-> Graft m a
graftDeclsWithM (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
srcSpan forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ \case
                                    (L SrcSpanAnnA
_spn (SpliceD XSpliceD GhcPs
_ (SpliceDecl XSpliceDecl GhcPs
_ (L SrcSpanAnnA
_ HsSplice GhcPs
spl) SpliceExplicitFlag
_))) -> do
                                        [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
eExpr <-
                                            forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure
                                                forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
                                                    ( forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
                                                        forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Util.try @_ @SomeException forall a b. (a -> b) -> a -> b
$
                                                            (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
rnTopSpliceDecls HsSplice GhcPs
spl)
                                                    )
                                        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
eExpr
                                    LHsDecl GhcPs
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
                        OneToOneAST Proxy# ast
astP ->
                            forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> Uri
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
clientCapabilities Uri
uri) Annotated ParsedSource
ps forall a b. (a -> b) -> a -> b
$
                                forall ast (m :: * -> *) a l.
(MonadFail m, Data a, Typeable l, ASTElement l ast) =>
SrcSpan
-> (LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast)))
-> Graft m a
graftWithM (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
srcSpan forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ \case
                                    (L SrcSpanAnnA
_spn (forall l (ast :: * -> *).
HasSplice l ast =>
Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs)
matchSplice Proxy# ast
astP -> Just SpliceOf ast GhcPs
spl)) -> do
                                        Either (ast GhcPs) (ast GhcRn)
eExpr <-
                                            forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure
                                                forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
                                                    ( forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
                                                        forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Util.try @_ @SomeException forall a b. (a -> b) -> a -> b
$
                                                            (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall l (ast :: * -> *).
HasSplice l ast =>
Proxy# ast
-> SpliceOf ast GhcPs
-> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars)
expandSplice Proxy# ast
astP SpliceOf ast GhcPs
spl)
                                                    )
                                        forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Either (ast GhcPs) (ast GhcRn)
eExpr of
                                            Left ast GhcPs
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
_spn ast GhcPs
x
                                            Right ast GhcRn
y -> forall (ast :: * -> *) (m :: * -> *) l.
(MonadFail m, HasSplice l ast) =>
DynFlags -> ast GhcRn -> TransformT m (LocatedAn l (ast GhcPs))
unRenamedE DynFlags
dflags ast GhcRn
y
                                    LocatedAn AnnListItem (ast GhcPs)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
            let (Bag (MsgEnvelope DecoratedSDoc)
warns, Bag (MsgEnvelope DecoratedSDoc)
errs) =
#if MIN_VERSION_ghc(9,2,0)
                                (forall e. Messages e -> Bag (MsgEnvelope e)
Error.getWarningMessages Messages DecoratedSDoc
msgs, forall e. Messages e -> Bag (MsgEnvelope e)
Error.getErrorMessages Messages DecoratedSDoc
msgs)
#else
                                msgs
#endif
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Bag (MsgEnvelope DecoratedSDoc)
warns,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors Bag (MsgEnvelope DecoratedSDoc)
errs) Maybe (Either String WorkspaceEdit)
eresl

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
        (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Bag (MsgEnvelope DecoratedSDoc)
warns)
        forall a b. (a -> b) -> a -> b
$ ReportEditor
reportEditor
            MessageType
MtWarning
            [ Text
"Warning during expanding: "
            , Text
""
            , String -> Text
T.pack (Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors Bag (MsgEnvelope DecoratedSDoc)
warns)
            ]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkspaceEdit
resl
    where
        dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hscEnv

#if MIN_VERSION_ghc(9,4,1)
        showErrors = showBag
#else
        showErrors :: Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors = forall a. Show a => a -> String
show
#endif

#if MIN_VERSION_ghc(9,4,1)
showBag :: Error.Diagnostic a => Bag (Error.MsgEnvelope a) -> String
showBag = show . fmap (fmap toDiagnosticMessage)

toDiagnosticMessage :: Error.Diagnostic a => a -> Error.DiagnosticMessage
toDiagnosticMessage message =
    Error.DiagnosticMessage
        { diagMessage = Error.diagnosticMessage message
        , diagReason  = Error.diagnosticReason  message
        , diagHints   = Error.diagnosticHints   message
        }
#endif

-- | FIXME:  Is thereAny "clever" way to do this exploiting TTG?
unRenamedE ::
    forall ast m l.
    (Fail.MonadFail m, HasSplice l ast) =>
    DynFlags ->
    ast GhcRn ->
    TransformT m (LocatedAn l (ast GhcPs))
unRenamedE :: forall (ast :: * -> *) (m :: * -> *) l.
(MonadFail m, HasSplice l ast) =>
DynFlags -> ast GhcRn -> TransformT m (LocatedAn l (ast GhcPs))
unRenamedE DynFlags
dflags ast GhcRn
expr = do
    String
uniq <- forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
#if MIN_VERSION_ghc(9,2,0)
    LocatedAn l (ast GhcPs)
expr' <-
#else
    (_anns, expr') <-
#endif
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall l ast. ASTElement l ast => Parser (LocatedAn l ast)
parseAST @_ @(ast GhcPs) DynFlags
dflags String
uniq forall a b. (a -> b) -> a -> b
$
            DynFlags -> SDoc -> String
showSDoc DynFlags
dflags forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr ast GhcRn
expr
    forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l (ast GhcPs)
expr'
  where
#if MIN_VERSION_ghc(9,4,1)
    showErrors = showBag . Error.getMessages
#else
    showErrors :: Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors = forall a. Show a => a -> String
show
#endif

data SearchResult r =
    Continue | Stop | Here r
    deriving (ReadPrec [SearchResult r]
ReadPrec (SearchResult r)
ReadS [SearchResult r]
forall r. Read r => ReadPrec [SearchResult r]
forall r. Read r => ReadPrec (SearchResult r)
forall r. Read r => Int -> ReadS (SearchResult r)
forall r. Read r => ReadS [SearchResult r]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SearchResult r]
$creadListPrec :: forall r. Read r => ReadPrec [SearchResult r]
readPrec :: ReadPrec (SearchResult r)
$creadPrec :: forall r. Read r => ReadPrec (SearchResult r)
readList :: ReadS [SearchResult r]
$creadList :: forall r. Read r => ReadS [SearchResult r]
readsPrec :: Int -> ReadS (SearchResult r)
$creadsPrec :: forall r. Read r => Int -> ReadS (SearchResult r)
Read, Int -> SearchResult r -> ShowS
forall r. Show r => Int -> SearchResult r -> ShowS
forall r. Show r => [SearchResult r] -> ShowS
forall r. Show r => SearchResult r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchResult r] -> ShowS
$cshowList :: forall r. Show r => [SearchResult r] -> ShowS
show :: SearchResult r -> String
$cshow :: forall r. Show r => SearchResult r -> String
showsPrec :: Int -> SearchResult r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> SearchResult r -> ShowS
Show, SearchResult r -> SearchResult r -> Bool
forall r. Eq r => SearchResult r -> SearchResult r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchResult r -> SearchResult r -> Bool
$c/= :: forall r. Eq r => SearchResult r -> SearchResult r -> Bool
== :: SearchResult r -> SearchResult r -> Bool
$c== :: forall r. Eq r => SearchResult r -> SearchResult r -> Bool
Eq, SearchResult r -> SearchResult r -> Bool
SearchResult r -> SearchResult r -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {r}. Ord r => Eq (SearchResult r)
forall r. Ord r => SearchResult r -> SearchResult r -> Bool
forall r. Ord r => SearchResult r -> SearchResult r -> Ordering
forall r.
Ord r =>
SearchResult r -> SearchResult r -> SearchResult r
min :: SearchResult r -> SearchResult r -> SearchResult r
$cmin :: forall r.
Ord r =>
SearchResult r -> SearchResult r -> SearchResult r
max :: SearchResult r -> SearchResult r -> SearchResult r
$cmax :: forall r.
Ord r =>
SearchResult r -> SearchResult r -> SearchResult r
>= :: SearchResult r -> SearchResult r -> Bool
$c>= :: forall r. Ord r => SearchResult r -> SearchResult r -> Bool
> :: SearchResult r -> SearchResult r -> Bool
$c> :: forall r. Ord r => SearchResult r -> SearchResult r -> Bool
<= :: SearchResult r -> SearchResult r -> Bool
$c<= :: forall r. Ord r => SearchResult r -> SearchResult r -> Bool
< :: SearchResult r -> SearchResult r -> Bool
$c< :: forall r. Ord r => SearchResult r -> SearchResult r -> Bool
compare :: SearchResult r -> SearchResult r -> Ordering
$ccompare :: forall r. Ord r => SearchResult r -> SearchResult r -> Ordering
Ord, SearchResult r -> DataType
SearchResult r -> Constr
forall {r}. Data r => Typeable (SearchResult r)
forall r. Data r => SearchResult r -> DataType
forall r. Data r => SearchResult r -> Constr
forall r.
Data r =>
(forall b. Data b => b -> b) -> SearchResult r -> SearchResult r
forall r u.
Data r =>
Int -> (forall d. Data d => d -> u) -> SearchResult r -> u
forall r u.
Data r =>
(forall d. Data d => d -> u) -> SearchResult r -> [u]
forall r r r'.
Data r =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
forall r r r'.
Data r =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
forall r (m :: * -> *).
(Data r, Monad m) =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
forall r (m :: * -> *).
(Data r, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
forall r (c :: * -> *).
Data r =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SearchResult r)
forall r (c :: * -> *).
Data r =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r)
forall r (t :: * -> *) (c :: * -> *).
(Data r, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SearchResult r))
forall r (t :: * -> * -> *) (c :: * -> *).
(Data r, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SearchResult r))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SearchResult r)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SearchResult r))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
$cgmapMo :: forall r (m :: * -> *).
(Data r, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
$cgmapMp :: forall r (m :: * -> *).
(Data r, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
$cgmapM :: forall r (m :: * -> *).
(Data r, Monad m) =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SearchResult r -> u
$cgmapQi :: forall r u.
Data r =>
Int -> (forall d. Data d => d -> u) -> SearchResult r -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SearchResult r -> [u]
$cgmapQ :: forall r u.
Data r =>
(forall d. Data d => d -> u) -> SearchResult r -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
$cgmapQr :: forall r r r'.
Data r =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
$cgmapQl :: forall r r r'.
Data r =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
gmapT :: (forall b. Data b => b -> b) -> SearchResult r -> SearchResult r
$cgmapT :: forall r.
Data r =>
(forall b. Data b => b -> b) -> SearchResult r -> SearchResult r
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SearchResult r))
$cdataCast2 :: forall r (t :: * -> * -> *) (c :: * -> *).
(Data r, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SearchResult r))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SearchResult r))
$cdataCast1 :: forall r (t :: * -> *) (c :: * -> *).
(Data r, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SearchResult r))
dataTypeOf :: SearchResult r -> DataType
$cdataTypeOf :: forall r. Data r => SearchResult r -> DataType
toConstr :: SearchResult r -> Constr
$ctoConstr :: forall r. Data r => SearchResult r -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SearchResult r)
$cgunfold :: forall r (c :: * -> *).
Data r =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SearchResult r)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r)
$cgfoldl :: forall r (c :: * -> *).
Data r =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r)
Data, Typeable)

fromSearchResult :: SearchResult a -> Maybe a
fromSearchResult :: forall a. SearchResult a -> Maybe a
fromSearchResult (Here a
r) = forall a. a -> Maybe a
Just a
r
fromSearchResult SearchResult a
_        = forall a. Maybe a
Nothing

-- TODO: workaround when HieAst unavailable (e.g. when the module itself errors)
-- TODO: Declaration Splices won't appear in HieAst; perhaps we must just use Parsed/Renamed ASTs?
codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction
codeAction :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeAction IdeState
state PluginId
plId (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ TextDocumentIdentifier
docId Range
ran CodeActionContext
_) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List []) forall a b. b -> Either a b
Right) 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
            NormalizedFilePath
fp <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
theUri
            ParsedModule {[String]
()
ModSummary
ParsedSource
pm_parsed_source :: ParsedModule -> ParsedSource
pm_extra_src_files :: ParsedModule -> [String]
pm_annotations :: ParsedModule -> ()
pm_annotations :: ()
pm_extra_src_files :: [String]
pm_parsed_source :: ParsedSource
pm_mod_summary :: ModSummary
pm_mod_summary :: ParsedModule -> ModSummary
..} <-
                forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> IdeState -> Action a -> IO a
runAction String
"splice.codeAction.GitHieAst" IdeState
state forall a b. (a -> b) -> a -> b
$
                    forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModule
GetParsedModule NormalizedFilePath
fp
            let spn :: RealSrcSpan
spn = NormalizedFilePath -> Range -> RealSrcSpan
rangeToRealSrcSpan NormalizedFilePath
fp Range
ran
                mouterSplice :: Maybe (RealSrcSpan, SpliceContext)
mouterSplice = forall a. GenericQ (SearchResult a) -> GenericQ (Maybe a)
something' (RealSrcSpan -> GenericQ (SearchResult (RealSrcSpan, SpliceContext))
detectSplice RealSrcSpan
spn) ParsedSource
pm_parsed_source
            Maybe [Command |? CodeAction]
mcmds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (RealSrcSpan, SpliceContext)
mouterSplice forall a b. (a -> b) -> a -> b
$
                \(RealSrcSpan
spliceSpan, SpliceContext
spliceContext) ->
                    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(ExpandStyle, (Text, CommandId))]
expandStyles forall a b. (a -> b) -> a -> b
$ \(ExpandStyle
_, (Text
title, CommandId
cmdId)) -> do
                        let params :: ExpandSpliceParams
params = ExpandSpliceParams {uri :: Uri
uri = Uri
theUri, RealSrcSpan
SpliceContext
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
..}
                            act :: Command
act = PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plId CommandId
cmdId Text
title (forall a. a -> Maybe a
Just [forall a. ToJSON a => a -> Value
toJSON ExpandSpliceParams
params])
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
                            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 (forall a. a -> Maybe a
Just CodeActionKind
CodeActionRefactorRewrite) forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Command
act) forall a. Maybe a
Nothing

            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. [a] -> List a
List Maybe [Command |? CodeAction]
mcmds
    where
        theUri :: Uri
theUri = TextDocumentIdentifier
docId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
J.uri
        detectSplice ::
            RealSrcSpan ->
            GenericQ (SearchResult (RealSrcSpan, SpliceContext))
        detectSplice :: RealSrcSpan -> GenericQ (SearchResult (RealSrcSpan, SpliceContext))
detectSplice RealSrcSpan
spn =
          let
            spanIsRelevant :: SrcSpan -> Bool
spanIsRelevant SrcSpan
x = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spn forall a. Maybe a
Nothing SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
x
          in
            forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ
                forall r. SearchResult r
Continue
                ( \case
                    (L (AsSrcSpan l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc Maybe BufSpan
_)) HsExpr GhcPs
expr :: LHsExpr GhcPs)
                        | SrcSpan -> Bool
spanIsRelevant SrcSpan
l ->
                            case HsExpr GhcPs
expr of
                                HsSpliceE {} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Expr)
                                HsExpr GhcPs
_            -> forall r. SearchResult r
Continue
                    LocatedAn AnnListItem (HsExpr GhcPs)
_ -> forall r. SearchResult r
Stop
                )
                forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` \case
#if __GLASGOW_HASKELL__ == 808
                    (dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc _) pat :: Located (Pat GhcPs))
#else
                    (L (AsSrcSpan l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc Maybe BufSpan
_)) Pat GhcPs
pat :: LPat GhcPs)
#endif
                        | SrcSpan -> Bool
spanIsRelevant SrcSpan
l ->
                            case Pat GhcPs
pat of
                                SplicePat{} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Pat)
                                Pat GhcPs
_           -> forall r. SearchResult r
Continue
                    LocatedAn AnnListItem (Pat GhcPs)
_ -> forall r. SearchResult r
Stop
                forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` \case
                    (L (AsSrcSpan l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc Maybe BufSpan
_)) HsType GhcPs
ty :: LHsType GhcPs)
                        | SrcSpan -> Bool
spanIsRelevant SrcSpan
l ->
                            case HsType GhcPs
ty of
                                HsSpliceTy {} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
HsType)
                                HsType GhcPs
_             -> forall r. SearchResult r
Continue
                    LocatedAn AnnListItem (HsType GhcPs)
_ -> forall r. SearchResult r
Stop
                forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` \case
                    (L (AsSrcSpan l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc Maybe BufSpan
_)) HsDecl GhcPs
decl :: LHsDecl GhcPs)
                        | SrcSpan -> Bool
spanIsRelevant SrcSpan
l ->
                            case HsDecl GhcPs
decl of
                                SpliceD {} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
HsDecl)
                                HsDecl GhcPs
_          -> forall r. SearchResult r
Continue
                    GenLocated SrcSpanAnnA (HsDecl GhcPs)
_ -> forall r. SearchResult r
Stop

-- | Like 'something', but performs top-down searching, cutoffs when 'Stop' received,
--   and picks innermost result.
something' :: forall a. GenericQ (SearchResult a) -> GenericQ (Maybe a)
something' :: forall a. GenericQ (SearchResult a) -> GenericQ (Maybe a)
something' GenericQ (SearchResult a)
f =  GenericQ (Maybe a)
go
    where
        go :: GenericQ (Maybe a)
        go :: GenericQ (Maybe a)
go a
x =
            case GenericQ (SearchResult a)
f a
x of
              SearchResult a
Stop -> forall a. Maybe a
Nothing
              SearchResult a
resl -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)) (forall a. SearchResult a -> Maybe a
fromSearchResult SearchResult a
resl) (forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ GenericQ (Maybe a)
go a
x)