{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}

module Ide.Plugin.Splice (descriptor) where

import           Control.Applicative                   (Alternative ((<|>)))
import           Control.Arrow                         (Arrow (first))
import           Control.Exception                     (SomeException)
import qualified Control.Foldl                         as L
import           Control.Lens                          (Identity (..), ix, view,
                                                        (%~), (<&>), (^.))
import           Control.Monad                         (forM, guard, unless)
import           Control.Monad.Error.Class             (MonadError (throwError))
import           Control.Monad.Extra                   (eitherM)
import qualified Control.Monad.Fail                    as Fail
import           Control.Monad.IO.Unlift               (MonadIO (..),
                                                        askRunInIO)
import           Control.Monad.Trans.Class             (MonadTrans (lift))
import           Control.Monad.Trans.Except            (ExceptT (..),
                                                        runExceptT)
import           Control.Monad.Trans.Maybe
import           Data.Aeson                            hiding (Null)
import qualified Data.Bifunctor                        as B (first)
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.Core.PluginUtils
import           Development.IDE.GHC.Compat            as Compat
import           Development.IDE.GHC.Compat.ExactPrint
import qualified Development.IDE.GHC.Compat.Util       as Util
import           Development.IDE.GHC.ExactPrint
import           GHC.Exts
import qualified GHC.Types.Error                       as Error
import           Ide.Plugin.Error                      (PluginError (PluginInternalError))
import           Ide.Plugin.Splice.Types
import           Ide.Types
import qualified Language.LSP.Protocol.Lens            as J
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types

#if !MIN_VERSION_base(4,20,0)
import           Data.Foldable                         (Foldable (foldl'))
#endif

#if MIN_VERSION_ghc(9,4,1)
import           GHC.Data.Bag                          (Bag)
#endif

#if MIN_VERSION_ghc(9,9,0)
import           GHC.Parser.Annotation                 (EpAnn (..))
#else
import           GHC.Parser.Annotation                 (SrcSpanAnn' (..))
#endif


descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId =
    (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
"Provides a code action to evaluate a TemplateHaskell splice")
        { pluginCommands = commands
        , pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction codeAction
        }

commands :: [PluginCommand IdeState]
commands :: [PluginCommand IdeState]
commands =
    [ CommandId
-> Text
-> CommandFunction IdeState ExpandSpliceParams
-> PluginCommand IdeState
forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
expandInplaceId Text
inplaceCmdName (CommandFunction IdeState ExpandSpliceParams
 -> PluginCommand IdeState)
-> CommandFunction IdeState ExpandSpliceParams
-> PluginCommand IdeState
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
(==) = SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
(==) (SrcSpan -> SrcSpan -> Bool)
-> (SubSpan -> SrcSpan) -> SubSpan -> SubSpan -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SubSpan -> SrcSpan
runSubSpan

instance Ord SubSpan where
    <= :: SubSpan -> SubSpan -> Bool
(<=) = (SrcSpan -> SrcSpan -> Bool) -> SubSpan -> SubSpan -> Bool
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 Maybe ProgressToken
_ params :: ExpandSpliceParams
params@ExpandSpliceParams {RealSrcSpan
VersionedTextDocumentIdentifier
SpliceContext
verTxtDocId :: VersionedTextDocumentIdentifier
spliceSpan :: RealSrcSpan
spliceContext :: SpliceContext
verTxtDocId :: ExpandSpliceParams -> VersionedTextDocumentIdentifier
spliceSpan :: ExpandSpliceParams -> RealSrcSpan
spliceContext :: ExpandSpliceParams -> SpliceContext
..} = HandlerM Config (Either PluginError (Value |? Null))
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (HandlerM Config (Either PluginError (Value |? Null))
 -> ExceptT PluginError (HandlerM Config) (Value |? Null))
-> HandlerM Config (Either PluginError (Value |? Null))
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ do
    ClientCapabilities
clientCapabilities <- HandlerM Config ClientCapabilities
forall config. HandlerM config ClientCapabilities
pluginGetClientCapabilities
    HandlerM Config () -> IO ()
rio <- HandlerM Config (HandlerM Config () -> IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
    let reportEditor :: ReportEditor
        reportEditor :: ReportEditor
reportEditor MessageType
msgTy [Text]
msgs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HandlerM Config () -> IO ()
rio (HandlerM Config () -> IO ()) -> HandlerM Config () -> IO ()
forall a b. (a -> b) -> a -> b
$ SServerMethod 'Method_WindowShowMessage
-> MessageParams 'Method_WindowShowMessage -> HandlerM Config ()
forall (m :: Method 'ServerToClient 'Notification) config.
SServerMethod m -> MessageParams m -> HandlerM config ()
pluginSendNotification SServerMethod 'Method_WindowShowMessage
SMethod_WindowShowMessage (MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
msgTy ([Text] -> Text
T.unlines [Text]
msgs))
        expandManually :: NormalizedFilePath -> ExceptT PluginError IO WorkspaceEdit
        expandManually :: NormalizedFilePath -> ExceptT PluginError IO WorkspaceEdit
expandManually NormalizedFilePath
fp = do
            Maybe (TcModuleResult, PositionMapping)
mresl <-
                IO (Maybe (TcModuleResult, PositionMapping))
-> ExceptT PluginError IO (Maybe (TcModuleResult, PositionMapping))
forall a. IO a -> ExceptT PluginError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (TcModuleResult, PositionMapping))
 -> ExceptT
      PluginError IO (Maybe (TcModuleResult, PositionMapping)))
-> IO (Maybe (TcModuleResult, PositionMapping))
-> ExceptT PluginError IO (Maybe (TcModuleResult, PositionMapping))
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action (Maybe (TcModuleResult, PositionMapping))
-> IO (Maybe (TcModuleResult, PositionMapping))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.TypeCheck (stale)" IdeState
ideState (Action (Maybe (TcModuleResult, PositionMapping))
 -> IO (Maybe (TcModuleResult, PositionMapping)))
-> Action (Maybe (TcModuleResult, PositionMapping))
-> IO (Maybe (TcModuleResult, PositionMapping))
forall a b. (a -> b) -> a -> b
$ TypeCheck
-> NormalizedFilePath
-> Action (Maybe (TcModuleResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale TypeCheck
TypeCheck NormalizedFilePath
fp
            (TcModuleResult {Bool
RenamedSource
ModuleEnv ByteString
TcGblEnv
ParsedModule
Splices
tmrParsed :: ParsedModule
tmrRenamed :: RenamedSource
tmrTypechecked :: TcGblEnv
tmrTopLevelSplices :: Splices
tmrDeferredError :: Bool
tmrRuntimeModules :: ModuleEnv ByteString
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferredError :: TcModuleResult -> Bool
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
..}, PositionMapping
_) <-
                ExceptT PluginError IO (TcModuleResult, PositionMapping)
-> ((TcModuleResult, PositionMapping)
    -> ExceptT PluginError IO (TcModuleResult, PositionMapping))
-> Maybe (TcModuleResult, PositionMapping)
-> ExceptT PluginError IO (TcModuleResult, PositionMapping)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (PluginError
-> ExceptT PluginError IO (TcModuleResult, PositionMapping)
forall a. PluginError -> ExceptT PluginError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError IO (TcModuleResult, PositionMapping))
-> PluginError
-> ExceptT PluginError IO (TcModuleResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"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."
                )
                (TcModuleResult, PositionMapping)
-> ExceptT PluginError IO (TcModuleResult, PositionMapping)
forall a. a -> ExceptT PluginError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TcModuleResult, PositionMapping)
mresl
            MessageType -> [Text] -> ExceptT PluginError IO ()
ReportEditor
reportEditor
                MessageType
MessageType_Warning
                [ Text
"Expansion in type-checking phase failed;"
                , Text
"trying to expand manually, but note that it is less rigorous."
                ]
            ParsedModule
pm <- String
-> IdeState
-> ExceptT PluginError Action ParsedModule
-> ExceptT PluginError IO ParsedModule
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"expandTHSplice.fallback.GetParsedModule" IdeState
ideState (ExceptT PluginError Action ParsedModule
 -> ExceptT PluginError IO ParsedModule)
-> ExceptT PluginError Action ParsedModule
-> ExceptT PluginError IO ParsedModule
forall a b. (a -> b) -> a -> b
$
                        GetParsedModule
-> NormalizedFilePath -> ExceptT PluginError Action ParsedModule
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetParsedModule
GetParsedModule NormalizedFilePath
fp
            (ParsedSource
ps, HscEnv
hscEnv, DynFlags
_dflags) <- IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT PluginError IO (ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
pm

            ClientCapabilities
-> ReportEditor
-> Range
-> ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT PluginError IO WorkspaceEdit
manualCalcEdit
                ClientCapabilities
clientCapabilities
                MessageType -> [Text] -> m ()
ReportEditor
reportEditor
                Range
range
                ParsedSource
ps
                HscEnv
hscEnv
                TcGblEnv
tmrTypechecked
                RealSrcSpan
spliceSpan
                ExpandStyle
_eStyle
                ExpandSpliceParams
params

        withTypeChecked :: NormalizedFilePath
-> TcModuleResult -> ExceptT PluginError IO WorkspaceEdit
withTypeChecked NormalizedFilePath
fp TcModuleResult {Bool
RenamedSource
ModuleEnv ByteString
TcGblEnv
ParsedModule
Splices
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferredError :: TcModuleResult -> Bool
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
tmrParsed :: ParsedModule
tmrRenamed :: RenamedSource
tmrTypechecked :: TcGblEnv
tmrTopLevelSplices :: Splices
tmrDeferredError :: Bool
tmrRuntimeModules :: ModuleEnv ByteString
..} = do
            (ParsedSource
ps, HscEnv
_hscEnv, DynFlags
dflags) <- IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT PluginError IO (ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
tmrParsed
            let Splices {[(LHsExpr GhcTc, [LHsDecl GhcPs])]
[(LHsExpr GhcTc, LPat GhcPs)]
[(LHsExpr GhcTc, LHsExpr GhcPs)]
[(LHsExpr GhcTc, LHsType GhcPs)]
[(LHsExpr GhcTc, Serialized)]
exprSplices :: [(LHsExpr GhcTc, LHsExpr GhcPs)]
patSplices :: [(LHsExpr GhcTc, LPat GhcPs)]
typeSplices :: [(LHsExpr GhcTc, LHsType GhcPs)]
declSplices :: [(LHsExpr GhcTc, [LHsDecl GhcPs])]
awSplices :: [(LHsExpr GhcTc, Serialized)]
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)]
..} = Splices
tmrTopLevelSplices
            let exprSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))
exprSuperSpans =
                    [(SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))]
-> Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))
forall a. [a] -> Maybe a
listToMaybe ([(SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))]
 -> Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs)))
-> [(SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))]
-> Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> [(LHsExpr GhcTc, LocatedAn AnnListItem (HsExpr GhcPs))]
-> [(SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))]
forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LHsExpr GhcPs)]
[(LHsExpr GhcTc, LocatedAn AnnListItem (HsExpr GhcPs))]
exprSplices
                _patSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs))
_patSuperSpans =
                    [(SrcSpan, LocatedAn AnnListItem (Pat GhcPs))]
-> Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs))
forall a. [a] -> Maybe a
listToMaybe ([(SrcSpan, LocatedAn AnnListItem (Pat GhcPs))]
 -> Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs)))
-> [(SrcSpan, LocatedAn AnnListItem (Pat GhcPs))]
-> Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> [(LHsExpr GhcTc, LocatedAn AnnListItem (Pat GhcPs))]
-> [(SrcSpan, LocatedAn AnnListItem (Pat GhcPs))]
forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LPat GhcPs)]
[(LHsExpr GhcTc, LocatedAn AnnListItem (Pat GhcPs))]
patSplices
                typeSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs))
typeSuperSpans =
                    [(SrcSpan, LocatedAn AnnListItem (HsType GhcPs))]
-> Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs))
forall a. [a] -> Maybe a
listToMaybe ([(SrcSpan, LocatedAn AnnListItem (HsType GhcPs))]
 -> Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs)))
-> [(SrcSpan, LocatedAn AnnListItem (HsType GhcPs))]
-> Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> [(LHsExpr GhcTc, LocatedAn AnnListItem (HsType GhcPs))]
-> [(SrcSpan, LocatedAn AnnListItem (HsType GhcPs))]
forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LHsType GhcPs)]
[(LHsExpr GhcTc, LocatedAn AnnListItem (HsType GhcPs))]
typeSplices
                declSuperSpans :: Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
declSuperSpans =
                    [(SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
-> Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a. [a] -> Maybe a
listToMaybe ([(SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
 -> Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)]))
-> [(SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
-> Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> [(LHsExpr GhcTc, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
-> [(SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, [LHsDecl GhcPs])]
[(LHsExpr GhcTc, [GenLocated SrcSpanAnnA (HsDecl 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 Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> ((SrcSpan, LocatedAn AnnListItem (ast GhcPs))
    -> Either String WorkspaceEdit)
-> Maybe (Either String WorkspaceEdit)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SrcSpan
_, LocatedAn AnnListItem (ast GhcPs)
expanded) ->
                        DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (Either String) ParsedSource
-> ParsedSource
-> Either String WorkspaceEdit
transform
                            DynFlags
dflags
                            ClientCapabilities
clientCapabilities
                            VersionedTextDocumentIdentifier
verTxtDocId
                            (SrcSpan
-> LocatedAn AnnListItem (ast GhcPs)
-> Graft (Either String) ParsedSource
forall a.
Data a =>
SrcSpan
-> LocatedAn AnnListItem (ast GhcPs) -> Graft (Either String) a
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 Maybe BufSpan
forall a. Maybe a
Nothing) LocatedAn AnnListItem (ast GhcPs)
expanded)
                            ParsedSource
ps
            ExceptT PluginError IO WorkspaceEdit
-> (Either String WorkspaceEdit
    -> ExceptT PluginError IO WorkspaceEdit)
-> Maybe (Either String WorkspaceEdit)
-> ExceptT PluginError IO WorkspaceEdit
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PluginError -> ExceptT PluginError IO WorkspaceEdit
forall a. PluginError -> ExceptT PluginError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> ExceptT PluginError IO WorkspaceEdit)
-> PluginError -> ExceptT PluginError IO WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"No splice information found") ((String -> ExceptT PluginError IO WorkspaceEdit)
-> (WorkspaceEdit -> ExceptT PluginError IO WorkspaceEdit)
-> Either String WorkspaceEdit
-> ExceptT PluginError IO WorkspaceEdit
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PluginError -> ExceptT PluginError IO WorkspaceEdit
forall a. PluginError -> ExceptT PluginError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> ExceptT PluginError IO WorkspaceEdit)
-> (String -> PluginError)
-> String
-> ExceptT PluginError IO WorkspaceEdit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PluginError
PluginInternalError (Text -> PluginError) -> (String -> Text) -> String -> PluginError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) WorkspaceEdit -> ExceptT PluginError IO WorkspaceEdit
forall a. a -> ExceptT PluginError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Maybe (Either String WorkspaceEdit)
 -> ExceptT PluginError IO WorkspaceEdit)
-> Maybe (Either String WorkspaceEdit)
-> ExceptT PluginError IO WorkspaceEdit
forall a b. (a -> b) -> a -> b
$
                case SpliceContext
spliceContext of
                    SpliceContext
Expr -> Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))
-> Maybe (Either String WorkspaceEdit)
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 ->

                        Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs))
-> Maybe (Either String WorkspaceEdit)
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 -> Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs))
-> Maybe (Either String WorkspaceEdit)
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 Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ((SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
    -> Either String WorkspaceEdit)
-> Maybe (Either String WorkspaceEdit)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SrcSpan
_, [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
expanded) ->
                            DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (Either String) ParsedSource
-> ParsedSource
-> Either String WorkspaceEdit
transform
                                DynFlags
dflags
                                ClientCapabilities
clientCapabilities
                                VersionedTextDocumentIdentifier
verTxtDocId
                                (SrcSpan -> [LHsDecl GhcPs] -> Graft (Either String) ParsedSource
forall a.
HasDecls a =>
SrcSpan -> [LHsDecl GhcPs] -> Graft (Either String) a
graftDecls (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spliceSpan Maybe BufSpan
forall a. Maybe a
Nothing) [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
expanded)
                                ParsedSource
ps
                                Either String WorkspaceEdit
-> (WorkspaceEdit -> WorkspaceEdit) -> Either String WorkspaceEdit
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
                                -- FIXME: Why ghc-exactprint sweeps preceding comments?
                                Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange (VersionedTextDocumentIdentifier
verTxtDocId VersionedTextDocumentIdentifier
-> Getting Uri VersionedTextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri VersionedTextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' VersionedTextDocumentIdentifier Uri
J.uri) Range
range

    Maybe (Either PluginError WorkspaceEdit)
res <- IO (Maybe (Either PluginError WorkspaceEdit))
-> HandlerM Config (Maybe (Either PluginError WorkspaceEdit))
forall a. IO a -> HandlerM Config a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either PluginError WorkspaceEdit))
 -> HandlerM Config (Maybe (Either PluginError WorkspaceEdit)))
-> IO (Maybe (Either PluginError WorkspaceEdit))
-> HandlerM Config (Maybe (Either PluginError WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$ MaybeT IO (Either PluginError WorkspaceEdit)
-> IO (Maybe (Either PluginError WorkspaceEdit))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Either PluginError WorkspaceEdit)
 -> IO (Maybe (Either PluginError WorkspaceEdit)))
-> MaybeT IO (Either PluginError WorkspaceEdit)
-> IO (Maybe (Either PluginError WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$ do

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

            case Either PluginError WorkspaceEdit
eedits of
                Left PluginError
err -> do
                    MessageType -> [Text] -> MaybeT IO ()
ReportEditor
reportEditor
                        MessageType
MessageType_Error
                        [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Error during expanding splice: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Doc Any -> String
forall a. Show a => a -> String
show (PluginError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. PluginError -> Doc ann
pretty PluginError
err)]
                    Either PluginError WorkspaceEdit
-> MaybeT IO (Either PluginError WorkspaceEdit)
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PluginError -> Either PluginError WorkspaceEdit
forall a b. a -> Either a b
Left PluginError
err)
                Right WorkspaceEdit
edits ->
                    Either PluginError WorkspaceEdit
-> MaybeT IO (Either PluginError WorkspaceEdit)
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit -> Either PluginError WorkspaceEdit
forall a b. b -> Either a b
Right WorkspaceEdit
edits)
    case Maybe (Either PluginError WorkspaceEdit)
res of
      Maybe (Either PluginError WorkspaceEdit)
Nothing -> Either PluginError (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall a. a -> HandlerM Config a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PluginError (Value |? Null)
 -> HandlerM Config (Either PluginError (Value |? Null)))
-> Either PluginError (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall a b. (a -> b) -> a -> b
$ (Value |? Null) -> Either PluginError (Value |? Null)
forall a b. b -> Either a b
Right ((Value |? Null) -> Either PluginError (Value |? Null))
-> (Value |? Null) -> Either PluginError (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Null -> Value |? Null
forall a b. b -> a |? b
InR Null
Null
      Just (Left PluginError
err) -> Either PluginError (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall a. a -> HandlerM Config a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PluginError (Value |? Null)
 -> HandlerM Config (Either PluginError (Value |? Null)))
-> Either PluginError (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall a b. (a -> b) -> a -> b
$ PluginError -> Either PluginError (Value |? Null)
forall a b. a -> Either a b
Left (PluginError -> Either PluginError (Value |? Null))
-> PluginError -> Either PluginError (Value |? Null)
forall a b. (a -> b) -> a -> b
$ PluginError
err
      Just (Right WorkspaceEdit
edit) -> do
        LspId 'Method_WorkspaceApplyEdit
_ <- SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> (Either
      (TResponseError 'Method_WorkspaceApplyEdit)
      (MessageResult 'Method_WorkspaceApplyEdit)
    -> HandlerM Config ())
-> HandlerM Config (LspId 'Method_WorkspaceApplyEdit)
forall (m :: Method 'ServerToClient 'Request) config.
SServerMethod m
-> MessageParams m
-> (Either (TResponseError m) (MessageResult m)
    -> HandlerM config ())
-> HandlerM config (LspId m)
pluginSendRequest SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either
  (TResponseError 'Method_WorkspaceApplyEdit)
  (MessageResult 'Method_WorkspaceApplyEdit)
_ -> () -> HandlerM Config ()
forall a. a -> HandlerM Config a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        Either PluginError (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall a. a -> HandlerM Config a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PluginError (Value |? Null)
 -> HandlerM Config (Either PluginError (Value |? Null)))
-> Either PluginError (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall a b. (a -> b) -> a -> b
$ (Value |? Null) -> Either PluginError (Value |? Null)
forall a b. b -> Either a b
Right ((Value |? Null) -> Either PluginError (Value |? Null))
-> (Value |? Null) -> Either PluginError (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Null -> Value |? Null
forall a b. b -> a |? b
InR Null
Null

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


setupHscEnv
    :: IdeState
    -> NormalizedFilePath
    -> ParsedModule
    -> ExceptT PluginError IO (ParsedSource, HscEnv, DynFlags)
setupHscEnv :: IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT PluginError IO (ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
pm = do
    HscEnvEq
hscEnvEq <- String
-> IdeState
-> ExceptT PluginError Action HscEnvEq
-> ExceptT PluginError IO HscEnvEq
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"expandTHSplice.fallback.ghcSessionDeps" IdeState
ideState (ExceptT PluginError Action HscEnvEq
 -> ExceptT PluginError IO HscEnvEq)
-> ExceptT PluginError Action HscEnvEq
-> ExceptT PluginError IO HscEnvEq
forall a b. (a -> b) -> a -> b
$
                    GhcSessionDeps
-> NormalizedFilePath -> ExceptT PluginError Action HscEnvEq
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GhcSessionDeps
GhcSessionDeps NormalizedFilePath
fp
    let ps :: ParsedSource
ps = ParsedModule -> ParsedSource
annotateParsedSource ParsedModule
pm
        hscEnv0 :: HscEnv
hscEnv0 = HscEnvEq -> HscEnv
hscEnvWithImportPaths HscEnvEq
hscEnvEq
        modSum :: ModSummary
modSum = ParsedModule -> ModSummary
pm_mod_summary ParsedModule
pm
    HscEnv
hscEnv <- IO HscEnv -> ExceptT PluginError IO HscEnv
forall a. IO a -> ExceptT PluginError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnv -> ExceptT PluginError IO HscEnv)
-> IO HscEnv -> ExceptT PluginError IO HscEnv
forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike HscEnv
hscEnv0 (DynFlags -> IO HscEnv) -> DynFlags -> IO HscEnv
forall a b. (a -> b) -> a -> b
$ ModSummary -> DynFlags
ms_hspp_opts ModSummary
modSum
    (ParsedSource, HscEnv, DynFlags)
-> ExceptT PluginError IO (ParsedSource, HscEnv, DynFlags)
forall a. a -> ExceptT PluginError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 =
            (DynFlags -> GeneralFlag -> DynFlags)
-> DynFlags -> [GeneralFlag] -> DynFlags
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflags3a ([GeneralFlag] -> DynFlags) -> [GeneralFlag] -> DynFlags
forall a b. (a -> b) -> a -> b
$
                (Way -> [GeneralFlag]) -> Ways -> [GeneralFlag]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
wayGeneralFlags Platform
platform) Ways
hostFullWays
        dflags3c :: DynFlags
dflags3c =
            (DynFlags -> GeneralFlag -> DynFlags)
-> DynFlags -> [GeneralFlag] -> DynFlags
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
dflags3b ([GeneralFlag] -> DynFlags) -> [GeneralFlag] -> DynFlags
forall a b. (a -> b) -> a -> b
$
                (Way -> [GeneralFlag]) -> Ways -> [GeneralFlag]
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 (Map Uri [TextEdit])
mhult Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
mlt Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
x) =
    Maybe (Map Uri [TextEdit])
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (Map Uri [TextEdit] -> Map Uri [TextEdit]
adjustWS (Map Uri [TextEdit] -> Map Uri [TextEdit])
-> Maybe (Map Uri [TextEdit]) -> Maybe (Map Uri [TextEdit])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Map Uri [TextEdit])
mhult) (((TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile)))
 -> TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile)))
-> [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile)))
-> TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))
adjustDoc ([TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
 -> [TextDocumentEdit
     |? (CreateFile |? (RenameFile |? DeleteFile))])
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
mlt) Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
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 Fold TextEdit (Maybe Range) -> f TextEdit -> Maybe Range
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((TextEdit -> Range)
-> Fold Range (Maybe Range) -> Fold TextEdit (Maybe Range)
forall a b r. (a -> b) -> Fold b r -> Fold a r
L.premap (Getting Range TextEdit Range -> TextEdit -> Range
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Range TextEdit Range
forall s a. HasRange s a => Lens' s a
Lens' TextEdit Range
J.range) Fold Range (Maybe Range)
forall a. Ord a => Fold a (Maybe a)
L.minimum) f TextEdit
eds of
                        Maybe Range
Nothing -> String -> Range
forall a. HasCallStack => String -> a
error String
"impossible"
                        Just Range
v  -> Range
v
            in Range -> TextEdit -> TextEdit
adjustLine Range
minStart (TextEdit -> TextEdit) -> f TextEdit -> f TextEdit
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 = ((TextEdit |? AnnotatedTextEdit) -> TextEdit |? AnnotatedTextEdit)
-> f (TextEdit |? AnnotatedTextEdit)
-> f (TextEdit |? AnnotatedTextEdit)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((TextEdit |? AnnotatedTextEdit) -> TextEdit |? AnnotatedTextEdit)
 -> f (TextEdit |? AnnotatedTextEdit)
 -> f (TextEdit |? AnnotatedTextEdit))
-> ((TextEdit |? AnnotatedTextEdit)
    -> TextEdit |? AnnotatedTextEdit)
-> f (TextEdit |? AnnotatedTextEdit)
-> f (TextEdit |? AnnotatedTextEdit)
forall a b. (a -> b) -> a -> b
$ \case
          InL TextEdit
t -> TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. a -> a |? b
InL (TextEdit -> TextEdit |? AnnotatedTextEdit)
-> TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. (a -> b) -> a -> b
$ Identity TextEdit -> TextEdit
forall a. Identity a -> a
runIdentity (Identity TextEdit -> TextEdit) -> Identity TextEdit -> TextEdit
forall a b. (a -> b) -> a -> b
$ Identity TextEdit -> Identity TextEdit
forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits (TextEdit -> Identity TextEdit
forall a. a -> Identity a
Identity TextEdit
t)
          InR AnnotatedTextEdit{Range
_range :: Range
$sel:_range:AnnotatedTextEdit :: AnnotatedTextEdit -> Range
_range, Text
_newText :: Text
$sel:_newText:AnnotatedTextEdit :: AnnotatedTextEdit -> Text
_newText, ChangeAnnotationIdentifier
_annotationId :: ChangeAnnotationIdentifier
$sel:_annotationId:AnnotatedTextEdit :: AnnotatedTextEdit -> ChangeAnnotationIdentifier
_annotationId} ->
            let oldTE :: TextEdit
oldTE = TextEdit{Range
_range :: Range
$sel:_range:TextEdit :: Range
_range,Text
_newText :: Text
$sel:_newText:TextEdit :: Text
_newText}
              in let TextEdit{Range
$sel:_range:TextEdit :: TextEdit -> Range
_range :: Range
_range,Text
$sel:_newText:TextEdit :: TextEdit -> Text
_newText :: Text
_newText} = Identity TextEdit -> TextEdit
forall a. Identity a -> a
runIdentity (Identity TextEdit -> TextEdit) -> Identity TextEdit -> TextEdit
forall a b. (a -> b) -> a -> b
$ Identity TextEdit -> Identity TextEdit
forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits (TextEdit -> Identity TextEdit
forall a. a -> Identity a
Identity TextEdit
oldTE)
                in AnnotatedTextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. b -> a |? b
InR (AnnotatedTextEdit -> TextEdit |? AnnotatedTextEdit)
-> AnnotatedTextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. (a -> b) -> a -> b
$ AnnotatedTextEdit{Range
$sel:_range:AnnotatedTextEdit :: Range
_range :: Range
_range,Text
$sel:_newText:AnnotatedTextEdit :: Text
_newText :: Text
_newText,ChangeAnnotationIdentifier
_annotationId :: ChangeAnnotationIdentifier
$sel:_annotationId:AnnotatedTextEdit :: ChangeAnnotationIdentifier
_annotationId}

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

        adjustLine :: Range -> TextEdit -> TextEdit
        adjustLine :: Range -> TextEdit -> TextEdit
adjustLine Range
bad =
            (Range -> Identity Range) -> TextEdit -> Identity TextEdit
forall s a. HasRange s a => Lens' s a
Lens' TextEdit Range
J.range ((Range -> Identity Range) -> TextEdit -> Identity TextEdit)
-> (Range -> Range) -> TextEdit -> TextEdit
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Range
r ->
                if Range
r Range -> Range -> Bool
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,9,0)
pattern AsSrcSpan :: SrcSpan -> EpAnn ann
pattern AsSrcSpan locA <- (getLoc -> locA)
#else
pattern AsSrcSpan :: SrcSpan -> SrcSpanAnn' a
pattern $mAsSrcSpan :: forall {r} {a}.
SrcSpanAnn' a -> (SrcSpan -> r) -> ((# #) -> r) -> r
AsSrcSpan locA <- SrcSpanAnn {locA}
#endif

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

#if MIN_VERSION_ghc(9,5,0)
data HsSpliceCompat pass
  = UntypedSplice (HsUntypedSplice pass)
  | TypedSplice (LHsExpr pass)
#endif


class (Outputable (ast GhcRn), ASTElement l (ast GhcPs)) => HasSplice l ast where
    type SpliceOf ast :: Kinds.Type -> Kinds.Type
    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
#if MIN_VERSION_ghc(9,5,0)
    type SpliceOf HsExpr = HsSpliceCompat
    matchSplice :: Proxy# HsExpr -> HsExpr GhcPs -> Maybe (SpliceOf HsExpr GhcPs)
matchSplice Proxy# HsExpr
_ (HsUntypedSplice XUntypedSplice GhcPs
_ HsUntypedSplice GhcPs
spl) = HsSpliceCompat GhcPs -> Maybe (HsSpliceCompat GhcPs)
forall a. a -> Maybe a
Just (HsUntypedSplice GhcPs -> HsSpliceCompat GhcPs
forall pass. HsUntypedSplice pass -> HsSpliceCompat pass
UntypedSplice HsUntypedSplice GhcPs
spl)
    matchSplice Proxy# HsExpr
_ (HsTypedSplice XTypedSplice GhcPs
_ LHsExpr GhcPs
spl)   = HsSpliceCompat GhcPs -> Maybe (HsSpliceCompat GhcPs)
forall a. a -> Maybe a
Just (LHsExpr GhcPs -> HsSpliceCompat GhcPs
forall pass. LHsExpr pass -> HsSpliceCompat pass
TypedSplice LHsExpr GhcPs
spl)
#else
    type SpliceOf HsExpr = HsSplice
    matchSplice _ (HsSpliceE _ spl) = Just spl
#endif
    matchSplice Proxy# HsExpr
_ HsExpr GhcPs
_                 = Maybe (SpliceOf HsExpr GhcPs)
Maybe (HsSpliceCompat GhcPs)
forall a. Maybe a
Nothing
#if MIN_VERSION_ghc(9,5,0)
    expandSplice :: Proxy# HsExpr
-> SpliceOf HsExpr GhcPs
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
expandSplice Proxy# HsExpr
_ (UntypedSplice HsUntypedSplice GhcPs
e) = ((HsExpr GhcRn, FreeVars)
 -> (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars))
-> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HsExpr GhcRn -> Either (HsExpr GhcPs) (HsExpr GhcRn))
-> (HsExpr GhcRn, FreeVars)
-> (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first HsExpr GhcRn -> Either (HsExpr GhcPs) (HsExpr GhcRn)
forall a b. b -> Either a b
Right) (IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
 -> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars))
-> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
forall a b. (a -> b) -> a -> b
$ HsUntypedSplice GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
rnUntypedSpliceExpr HsUntypedSplice GhcPs
e
    expandSplice Proxy# HsExpr
_ (TypedSplice LHsExpr GhcPs
e) = ((HsExpr GhcRn, FreeVars)
 -> (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars))
-> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HsExpr GhcRn -> Either (HsExpr GhcPs) (HsExpr GhcRn))
-> (HsExpr GhcRn, FreeVars)
-> (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first HsExpr GhcRn -> Either (HsExpr GhcPs) (HsExpr GhcRn)
forall a b. b -> Either a b
Right) (IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
 -> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars))
-> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
rnTypedSplice LHsExpr GhcPs
e
#else
    expandSplice _ = fmap (first Right) . rnSpliceExpr
#endif

instance HasSplice AnnListItem Pat where
#if MIN_VERSION_ghc(9,5,0)
    type SpliceOf Pat = HsUntypedSplice
#else
    type SpliceOf Pat = HsSplice
#endif
    matchSplice :: Proxy# Pat -> Pat GhcPs -> Maybe (SpliceOf Pat GhcPs)
matchSplice Proxy# Pat
_ (SplicePat XSplicePat GhcPs
_ HsUntypedSplice GhcPs
spl) = HsUntypedSplice GhcPs -> Maybe (HsUntypedSplice GhcPs)
forall a. a -> Maybe a
Just HsUntypedSplice GhcPs
spl
    matchSplice Proxy# Pat
_ Pat GhcPs
_                 = Maybe (HsUntypedSplice GhcPs)
Maybe (SpliceOf Pat GhcPs)
forall a. Maybe a
Nothing
    expandSplice :: Proxy# Pat
-> SpliceOf Pat GhcPs
-> RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
expandSplice Proxy# Pat
_ =
#if MIN_VERSION_ghc(9,5,0)
      (((HsUntypedSplice GhcRn,
   HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs))),
  FreeVars)
 -> (Either (Pat GhcPs) (Pat GhcRn), FreeVars))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ((HsUntypedSplice GhcRn,
       HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs))),
      FreeVars)
-> RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((HsUntypedSplice GhcRn,
  HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs)))
 -> Either (Pat GhcPs) (Pat GhcRn))
-> ((HsUntypedSplice GhcRn,
     HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs))),
    FreeVars)
-> (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Pat GhcPs -> Either (Pat GhcPs) (Pat GhcRn)
forall a b. a -> Either a b
Left (Pat GhcPs -> Either (Pat GhcPs) (Pat GhcRn))
-> ((HsUntypedSplice GhcRn,
     HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs)))
    -> Pat GhcPs)
-> (HsUntypedSplice GhcRn,
    HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs)))
-> Either (Pat GhcPs) (Pat GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedAn AnnListItem (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc (LocatedAn AnnListItem (Pat GhcPs) -> Pat GhcPs)
-> ((HsUntypedSplice GhcRn,
     HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs)))
    -> LocatedAn AnnListItem (Pat GhcPs))
-> (HsUntypedSplice GhcRn,
    HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs)))
-> Pat GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs))
-> LocatedAn AnnListItem (Pat GhcPs)
forall thing. HsUntypedSpliceResult thing -> thing
utsplice_result (HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs))
 -> LocatedAn AnnListItem (Pat GhcPs))
-> ((HsUntypedSplice GhcRn,
     HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs)))
    -> HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs)))
-> (HsUntypedSplice GhcRn,
    HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs)))
-> LocatedAn AnnListItem (Pat GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsUntypedSplice GhcRn,
 HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs)))
-> HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs))
forall a b. (a, b) -> b
snd )) (IOEnv
   (Env TcGblEnv TcLclEnv)
   ((HsUntypedSplice GhcRn,
     HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs))),
    FreeVars)
 -> RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars))
-> (HsUntypedSplice GhcPs
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ((HsUntypedSplice GhcRn,
           HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs))),
          FreeVars))
-> HsUntypedSplice GhcPs
-> RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
#endif
      HsUntypedSplice GhcPs
-> RnM
     ((HsUntypedSplice GhcRn, HsUntypedSpliceResult (LPat GhcPs)),
      FreeVars)
HsUntypedSplice GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ((HsUntypedSplice GhcRn,
       HsUntypedSpliceResult (LocatedAn AnnListItem (Pat GhcPs))),
      FreeVars)
rnSplicePat


instance HasSplice AnnListItem HsType where
#if MIN_VERSION_ghc(9,5,0)
    type SpliceOf HsType = HsUntypedSplice
#else
    type SpliceOf HsType = HsSplice
#endif
    matchSplice :: Proxy# HsType -> HsType GhcPs -> Maybe (SpliceOf HsType GhcPs)
matchSplice Proxy# HsType
_ (HsSpliceTy XSpliceTy GhcPs
_ HsUntypedSplice GhcPs
spl) = HsUntypedSplice GhcPs -> Maybe (HsUntypedSplice GhcPs)
forall a. a -> Maybe a
Just HsUntypedSplice GhcPs
spl
    matchSplice Proxy# HsType
_ HsType GhcPs
_                  = Maybe (HsUntypedSplice GhcPs)
Maybe (SpliceOf HsType GhcPs)
forall a. Maybe a
Nothing
    expandSplice :: Proxy# HsType
-> SpliceOf HsType GhcPs
-> RnM (Either (HsType GhcPs) (HsType GhcRn), FreeVars)
expandSplice Proxy# HsType
_ = ((HsType GhcRn, FreeVars)
 -> (Either (HsType GhcPs) (HsType GhcRn), FreeVars))
-> IOEnv (Env TcGblEnv TcLclEnv) (HsType GhcRn, FreeVars)
-> RnM (Either (HsType GhcPs) (HsType GhcRn), FreeVars)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HsType GhcRn -> Either (HsType GhcPs) (HsType GhcRn))
-> (HsType GhcRn, FreeVars)
-> (Either (HsType GhcPs) (HsType GhcRn), FreeVars)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first HsType GhcRn -> Either (HsType GhcPs) (HsType GhcRn)
forall a b. b -> Either a b
Right) (IOEnv (Env TcGblEnv TcLclEnv) (HsType GhcRn, FreeVars)
 -> RnM (Either (HsType GhcPs) (HsType GhcRn), FreeVars))
-> (HsUntypedSplice GhcPs
    -> IOEnv (Env TcGblEnv TcLclEnv) (HsType GhcRn, FreeVars))
-> HsUntypedSplice GhcPs
-> RnM (Either (HsType GhcPs) (HsType GhcRn), FreeVars)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsUntypedSplice GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) (HsType GhcRn, FreeVars)
rnSpliceType

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

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

manualCalcEdit ::
    ClientCapabilities ->
    ReportEditor ->
    Range ->
    ParsedSource ->
    HscEnv ->
    TcGblEnv ->
    RealSrcSpan ->
    ExpandStyle ->
    ExpandSpliceParams ->
    ExceptT PluginError IO WorkspaceEdit
manualCalcEdit :: ClientCapabilities
-> ReportEditor
-> Range
-> ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT PluginError IO WorkspaceEdit
manualCalcEdit ClientCapabilities
clientCapabilities ReportEditor
reportEditor Range
ran ParsedSource
ps HscEnv
hscEnv TcGblEnv
typechkd RealSrcSpan
srcSpan ExpandStyle
_eStyle ExpandSpliceParams {RealSrcSpan
VersionedTextDocumentIdentifier
SpliceContext
verTxtDocId :: ExpandSpliceParams -> VersionedTextDocumentIdentifier
spliceSpan :: ExpandSpliceParams -> RealSrcSpan
spliceContext :: ExpandSpliceParams -> SpliceContext
verTxtDocId :: VersionedTextDocumentIdentifier
spliceSpan :: RealSrcSpan
spliceContext :: SpliceContext
..} = do
    (Bag (MsgEnvelope TcRnMessage)
warns, WorkspaceEdit
resl) <-
        IO
  (Either PluginError (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit))
-> ExceptT
     PluginError IO (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO
   (Either PluginError (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit))
 -> ExceptT
      PluginError IO (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit))
-> IO
     (Either PluginError (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit))
-> ExceptT
     PluginError IO (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$ do
            (Messages TcRnMessage
msgs, Maybe (Either String WorkspaceEdit)
eresl) <-
                HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM (Either String WorkspaceEdit)
-> IO (Messages TcRnMessage, Maybe (Either String WorkspaceEdit))
forall r.
HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM r
-> IO (Messages TcRnMessage, Maybe r)
initTcWithGbl HscEnv
hscEnv TcGblEnv
typechkd RealSrcSpan
srcSpan (TcM (Either String WorkspaceEdit)
 -> IO (Messages TcRnMessage, Maybe (Either String WorkspaceEdit)))
-> TcM (Either String WorkspaceEdit)
-> IO (Messages TcRnMessage, Maybe (Either String WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$
                    case SpliceContext -> SpliceClass
classifyAST SpliceContext
spliceContext of
                        SpliceClass
IsHsDecl -> (Either String WorkspaceEdit -> Either String WorkspaceEdit)
-> TcM (Either String WorkspaceEdit)
-> TcM (Either String WorkspaceEdit)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WorkspaceEdit -> WorkspaceEdit)
-> Either String WorkspaceEdit -> Either String WorkspaceEdit
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WorkspaceEdit -> WorkspaceEdit)
 -> Either String WorkspaceEdit -> Either String WorkspaceEdit)
-> (WorkspaceEdit -> WorkspaceEdit)
-> Either String WorkspaceEdit
-> Either String WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange (VersionedTextDocumentIdentifier
verTxtDocId VersionedTextDocumentIdentifier
-> Getting Uri VersionedTextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri VersionedTextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' VersionedTextDocumentIdentifier Uri
J.uri) Range
ran) (TcM (Either String WorkspaceEdit)
 -> TcM (Either String WorkspaceEdit))
-> TcM (Either String WorkspaceEdit)
-> TcM (Either String WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$
                            (Graft (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
 -> ParsedSource -> TcM (Either String WorkspaceEdit))
-> ParsedSource
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> TcM (Either String WorkspaceEdit)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> ParsedSource
-> TcM (Either String WorkspaceEdit)
forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (ExceptStringT m) ParsedSource
-> ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
clientCapabilities VersionedTextDocumentIdentifier
verTxtDocId) ParsedSource
ps (Graft (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
 -> TcM (Either String WorkspaceEdit))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> TcM (Either String WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$
                                SrcSpan
-> (LHsDecl GhcPs
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Maybe [LHsDecl GhcPs]))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
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 Maybe BufSpan
forall a. Maybe a
Nothing) ((LHsDecl GhcPs
  -> TransformT
       (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
       (Maybe [LHsDecl GhcPs]))
 -> Graft
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource)
-> (LHsDecl GhcPs
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Maybe [LHsDecl GhcPs]))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
forall a b. (a -> b) -> a -> b
$ \case
                                    (L SrcSpanAnnA
_spn (SpliceD XSpliceD GhcPs
_ (SpliceDecl XSpliceDecl GhcPs
_ (L SrcSpanAnnA
_ HsUntypedSplice GhcPs
spl) SpliceDecoration
_))) -> do
                                        [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
eExpr <-
                                            (SomeException
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM (String
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a.
String
-> TransformT (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (SomeException -> String)
-> SomeException
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a.
a -> TransformT (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                                                (TransformT
   (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
   (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ RWST
  ()
  [String]
  Int
  (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
  (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT (RWST
   ()
   [String]
   Int
   (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
   (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)]))
-> RWST
     ()
     [String]
     Int
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b. (a -> b) -> a -> b
$ ExceptStringT
  (IOEnv (Env TcGblEnv TcLclEnv))
  (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> RWST
     ()
     [String]
     Int
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall (m :: * -> *) a. Monad m => m a -> RWST () [String] Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
                                                    ( IOEnv
  (Env TcGblEnv TcLclEnv)
  (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ExceptStringT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv
   (Env TcGblEnv TcLclEnv)
   (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
 -> ExceptStringT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)]))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ExceptStringT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b. (a -> b) -> a -> b
$
                                                        forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
Util.try @_ @SomeException (IOEnv
   (Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)]))
-> IOEnv
     (Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Either SomeException [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b. (a -> b) -> a -> b
$
                                                            (([GenLocated SrcSpanAnnA (HsDecl GhcPs)], FreeVars)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a, b) -> a
fst (([GenLocated SrcSpanAnnA (HsDecl GhcPs)], FreeVars)
 -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated SrcSpanAnnA (HsDecl GhcPs)], FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsUntypedSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
rnTopSpliceDecls HsUntypedSplice GhcPs
spl)
                                                    )
                                        Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a.
a -> TransformT (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]))
-> Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> Maybe a
Just [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
eExpr
                                    LHsDecl GhcPs
_ -> Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a.
a -> TransformT (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. Maybe a
Nothing
                        OneToOneAST Proxy# ast
astP ->
                            (Graft (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
 -> ParsedSource -> TcM (Either String WorkspaceEdit))
-> ParsedSource
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> TcM (Either String WorkspaceEdit)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> ParsedSource
-> TcM (Either String WorkspaceEdit)
forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (ExceptStringT m) ParsedSource
-> ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
clientCapabilities VersionedTextDocumentIdentifier
verTxtDocId) ParsedSource
ps (Graft (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
 -> TcM (Either String WorkspaceEdit))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> TcM (Either String WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$
                                SrcSpan
-> (LocatedAn AnnListItem (ast GhcPs)
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Maybe (LocatedAn AnnListItem (ast GhcPs))))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
forall ast (m :: * -> *) a l.
(MonadFail m, Data a, ASTElement l ast) =>
SrcSpan
-> (LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast)))
-> Graft m a
graftWithM (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
srcSpan Maybe BufSpan
forall a. Maybe a
Nothing) ((LocatedAn AnnListItem (ast GhcPs)
  -> TransformT
       (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
       (Maybe (LocatedAn AnnListItem (ast GhcPs))))
 -> Graft
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource)
-> (LocatedAn AnnListItem (ast GhcPs)
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Maybe (LocatedAn AnnListItem (ast GhcPs))))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
forall a b. (a -> b) -> a -> b
$ \case
                                    (L SrcSpanAnnA
_spn (Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs)
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 <-
                                            (SomeException
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Either (ast GhcPs) (ast GhcRn)))
-> (Either (ast GhcPs) (ast GhcRn)
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Either (ast GhcPs) (ast GhcRn)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either (ast GhcPs) (ast GhcRn))
forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM (String
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either (ast GhcPs) (ast GhcRn))
forall a.
String
-> TransformT (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Either (ast GhcPs) (ast GhcRn)))
-> (SomeException -> String)
-> SomeException
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either (ast GhcPs) (ast GhcRn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) Either (ast GhcPs) (ast GhcRn)
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either (ast GhcPs) (ast GhcRn))
forall a.
a -> TransformT (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                                                (TransformT
   (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
   (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Either (ast GhcPs) (ast GhcRn)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either (ast GhcPs) (ast GhcRn))
forall a b. (a -> b) -> a -> b
$ RWST
  ()
  [String]
  Int
  (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
  (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT (RWST
   ()
   [String]
   Int
   (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
   (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Either SomeException (Either (ast GhcPs) (ast GhcRn))))
-> RWST
     ()
     [String]
     Int
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
forall a b. (a -> b) -> a -> b
$ ExceptStringT
  (IOEnv (Env TcGblEnv TcLclEnv))
  (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> RWST
     ()
     [String]
     Int
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
forall (m :: * -> *) a. Monad m => m a -> RWST () [String] Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
                                                    ( IOEnv
  (Env TcGblEnv TcLclEnv)
  (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> ExceptStringT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv
   (Env TcGblEnv TcLclEnv)
   (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
 -> ExceptStringT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (Either SomeException (Either (ast GhcPs) (ast GhcRn))))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> ExceptStringT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
forall a b. (a -> b) -> a -> b
$
                                                        forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
Util.try @_ @SomeException (IOEnv (Env TcGblEnv TcLclEnv) (Either (ast GhcPs) (ast GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (Either SomeException (Either (ast GhcPs) (ast GhcRn))))
-> IOEnv (Env TcGblEnv TcLclEnv) (Either (ast GhcPs) (ast GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
forall a b. (a -> b) -> a -> b
$
                                                            ((Either (ast GhcPs) (ast GhcRn), FreeVars)
-> Either (ast GhcPs) (ast GhcRn)
forall a b. (a, b) -> a
fst ((Either (ast GhcPs) (ast GhcRn), FreeVars)
 -> Either (ast GhcPs) (ast GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Either (ast GhcPs) (ast GhcRn), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Either (ast GhcPs) (ast GhcRn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy# ast
-> SpliceOf ast GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Either (ast GhcPs) (ast GhcRn), FreeVars)
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)
                                                    )
                                        LocatedAn AnnListItem (ast GhcPs)
-> Maybe (LocatedAn AnnListItem (ast GhcPs))
forall a. a -> Maybe a
Just (LocatedAn AnnListItem (ast GhcPs)
 -> Maybe (LocatedAn AnnListItem (ast GhcPs)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (LocatedAn AnnListItem (ast GhcPs))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Maybe (LocatedAn AnnListItem (ast GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Either (ast GhcPs) (ast GhcRn)
eExpr of
                                            Left ast GhcPs
x  -> LocatedAn AnnListItem (ast GhcPs)
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (LocatedAn AnnListItem (ast GhcPs))
forall a.
a -> TransformT (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocatedAn AnnListItem (ast GhcPs)
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (LocatedAn AnnListItem (ast GhcPs)))
-> LocatedAn AnnListItem (ast GhcPs)
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (LocatedAn AnnListItem (ast GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> ast GhcPs -> LocatedAn AnnListItem (ast GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
_spn ast GhcPs
x
                                            Right ast GhcRn
y -> DynFlags
-> ast GhcRn
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (LocatedAn AnnListItem (ast GhcPs))
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)
_ -> Maybe (LocatedAn AnnListItem (ast GhcPs))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Maybe (LocatedAn AnnListItem (ast GhcPs)))
forall a.
a -> TransformT (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LocatedAn AnnListItem (ast GhcPs))
forall a. Maybe a
Nothing
            let (Bag (MsgEnvelope TcRnMessage)
warns, Bag (MsgEnvelope TcRnMessage)
errs) =
                                (Messages TcRnMessage -> Bag (MsgEnvelope TcRnMessage)
forall e. Diagnostic e => Messages e -> Bag (MsgEnvelope e)
Error.getWarningMessages Messages TcRnMessage
msgs, Messages TcRnMessage -> Bag (MsgEnvelope TcRnMessage)
forall e. Diagnostic e => Messages e -> Bag (MsgEnvelope e)
Error.getErrorMessages Messages TcRnMessage
msgs)
            Either PluginError (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit)
-> IO
     (Either PluginError (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PluginError (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit)
 -> IO
      (Either
         PluginError (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit)))
-> Either
     PluginError (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit)
-> IO
     (Either PluginError (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$ (Bag (MsgEnvelope TcRnMessage)
warns,) (WorkspaceEdit -> (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit))
-> Either PluginError WorkspaceEdit
-> Either
     PluginError (Bag (MsgEnvelope TcRnMessage), WorkspaceEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either PluginError WorkspaceEdit
-> (Either String WorkspaceEdit
    -> Either PluginError WorkspaceEdit)
-> Maybe (Either String WorkspaceEdit)
-> Either PluginError WorkspaceEdit
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PluginError -> Either PluginError WorkspaceEdit
forall a. PluginError -> Either PluginError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> Either PluginError WorkspaceEdit)
-> PluginError -> Either PluginError WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError (Text -> PluginError) -> Text -> PluginError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Bag (MsgEnvelope TcRnMessage) -> String
showErrors Bag (MsgEnvelope TcRnMessage)
errs)
                                    ((String -> PluginError)
-> Either String WorkspaceEdit -> Either PluginError WorkspaceEdit
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
B.first (Text -> PluginError
PluginInternalError (Text -> PluginError) -> (String -> Text) -> String -> PluginError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)) Maybe (Either String WorkspaceEdit)
eresl

    Bool -> ExceptT PluginError IO () -> ExceptT PluginError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
        (Bag (MsgEnvelope TcRnMessage) -> Bool
forall a. Bag a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Bag (MsgEnvelope TcRnMessage)
warns)
        (ExceptT PluginError IO () -> ExceptT PluginError IO ())
-> ExceptT PluginError IO () -> ExceptT PluginError IO ()
forall a b. (a -> b) -> a -> b
$ MessageType -> [Text] -> ExceptT PluginError IO ()
ReportEditor
reportEditor
            MessageType
MessageType_Warning
            [ Text
"Warning during expanding: "
            , Text
""
            , String -> Text
T.pack (Bag (MsgEnvelope TcRnMessage) -> String
showErrors Bag (MsgEnvelope TcRnMessage)
warns)
            ]
    WorkspaceEdit -> ExceptT PluginError IO WorkspaceEdit
forall a. a -> ExceptT PluginError IO a
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 :: Bag (MsgEnvelope TcRnMessage) -> String
showErrors = Bag (MsgEnvelope TcRnMessage) -> String
forall a. Diagnostic a => Bag (MsgEnvelope a) -> String
showBag
#else
        showErrors = show
#endif

#if MIN_VERSION_ghc(9,4,1)
showBag :: Error.Diagnostic a => Bag (Error.MsgEnvelope a) -> String
showBag :: forall a. Diagnostic a => Bag (MsgEnvelope a) -> String
showBag = Bag (MsgEnvelope DiagnosticMessage) -> String
forall a. Show a => a -> String
show (Bag (MsgEnvelope DiagnosticMessage) -> String)
-> (Bag (MsgEnvelope a) -> Bag (MsgEnvelope DiagnosticMessage))
-> Bag (MsgEnvelope a)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MsgEnvelope a -> MsgEnvelope DiagnosticMessage)
-> Bag (MsgEnvelope a) -> Bag (MsgEnvelope DiagnosticMessage)
forall a b. (a -> b) -> Bag a -> Bag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> DiagnosticMessage)
-> MsgEnvelope a -> MsgEnvelope DiagnosticMessage
forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> DiagnosticMessage
forall a. Diagnostic a => a -> DiagnosticMessage
toDiagnosticMessage)

toDiagnosticMessage :: forall a. Error.Diagnostic a => a -> Error.DiagnosticMessage
toDiagnosticMessage :: forall a. Diagnostic a => a -> DiagnosticMessage
toDiagnosticMessage a
message =
    Error.DiagnosticMessage
        { diagMessage :: DecoratedSDoc
diagMessage = DiagnosticOpts a -> a -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
Error.diagnosticMessage
#if MIN_VERSION_ghc(9,5,0)
                          (forall a. Diagnostic a => DiagnosticOpts a
Error.defaultDiagnosticOpts @a)
#endif
                          a
message

        , diagReason :: DiagnosticReason
diagReason  = a -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
Error.diagnosticReason  a
message
        , diagHints :: [GhcHint]
diagHints   = a -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
Error.diagnosticHints   a
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 <- SrcSpan -> String
forall a. Show a => a -> String
show (SrcSpan -> String) -> TransformT m SrcSpan -> TransformT m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransformT m SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
    LocatedAn l (ast GhcPs)
expr' <-
        (Messages GhcMessage -> TransformT m (LocatedAn l (ast GhcPs)))
-> (LocatedAn l (ast GhcPs)
    -> TransformT m (LocatedAn l (ast GhcPs)))
-> Either (Messages GhcMessage) (LocatedAn l (ast GhcPs))
-> TransformT m (LocatedAn l (ast GhcPs))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> TransformT m (LocatedAn l (ast GhcPs))
forall a. String -> TransformT m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> TransformT m (LocatedAn l (ast GhcPs)))
-> (Messages GhcMessage -> String)
-> Messages GhcMessage
-> TransformT m (LocatedAn l (ast GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Messages GhcMessage -> String
showErrors) LocatedAn l (ast GhcPs) -> TransformT m (LocatedAn l (ast GhcPs))
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Messages GhcMessage) (LocatedAn l (ast GhcPs))
 -> TransformT m (LocatedAn l (ast GhcPs)))
-> Either (Messages GhcMessage) (LocatedAn l (ast GhcPs))
-> TransformT m (LocatedAn l (ast GhcPs))
forall a b. (a -> b) -> a -> b
$
        forall l ast. ASTElement l ast => Parser (LocatedAn l ast)
parseAST @_ @(ast GhcPs) DynFlags
dflags String
uniq (String -> Either (Messages GhcMessage) (LocatedAn l (ast GhcPs)))
-> String -> Either (Messages GhcMessage) (LocatedAn l (ast GhcPs))
forall a b. (a -> b) -> a -> b
$
            DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ ast GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr ast GhcRn
expr
    LocatedAn l (ast GhcPs) -> TransformT m (LocatedAn l (ast GhcPs))
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l (ast GhcPs)
expr'
  where
#if MIN_VERSION_ghc(9,4,1)
    showErrors :: Messages GhcMessage -> String
showErrors = Bag (MsgEnvelope GhcMessage) -> String
forall a. Diagnostic a => Bag (MsgEnvelope a) -> String
showBag (Bag (MsgEnvelope GhcMessage) -> String)
-> (Messages GhcMessage -> Bag (MsgEnvelope GhcMessage))
-> Messages GhcMessage
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Messages GhcMessage -> Bag (MsgEnvelope GhcMessage)
forall e. Messages e -> Bag (MsgEnvelope e)
Error.getMessages
#else
    showErrors = show
#endif

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

fromSearchResult :: SearchResult a -> Maybe a
fromSearchResult :: forall a. SearchResult a -> Maybe a
fromSearchResult (Here a
r) = a -> Maybe a
forall a. a -> Maybe a
Just a
r
fromSearchResult SearchResult a
_        = Maybe 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 Method_TextDocumentCodeAction
codeAction :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeAction IdeState
state PluginId
plId (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ TextDocumentIdentifier
docId Range
ran CodeActionContext
_) = do
    VersionedTextDocumentIdentifier
verTxtDocId <- HandlerM Config VersionedTextDocumentIdentifier
-> ExceptT
     PluginError (HandlerM Config) VersionedTextDocumentIdentifier
forall (m :: * -> *) a. Monad m => m a -> ExceptT PluginError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HandlerM Config VersionedTextDocumentIdentifier
 -> ExceptT
      PluginError (HandlerM Config) VersionedTextDocumentIdentifier)
-> HandlerM Config VersionedTextDocumentIdentifier
-> ExceptT
     PluginError (HandlerM Config) VersionedTextDocumentIdentifier
forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
-> HandlerM Config VersionedTextDocumentIdentifier
forall config.
TextDocumentIdentifier
-> HandlerM config VersionedTextDocumentIdentifier
pluginGetVersionedTextDoc TextDocumentIdentifier
docId
    IO ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a. IO a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (HandlerM Config) ([Command |? CodeAction] |? Null))
-> IO ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ (Maybe ([Command |? CodeAction] |? Null)
 -> [Command |? CodeAction] |? Null)
-> IO (Maybe ([Command |? CodeAction] |? Null))
-> IO ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Command |? CodeAction] |? Null)
-> Maybe ([Command |? CodeAction] |? Null)
-> [Command |? CodeAction] |? Null
forall a. a -> Maybe a -> a
fromMaybe ( [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL [])) (IO (Maybe ([Command |? CodeAction] |? Null))
 -> IO ([Command |? CodeAction] |? Null))
-> IO (Maybe ([Command |? CodeAction] |? Null))
-> IO ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$
        MaybeT IO ([Command |? CodeAction] |? Null)
-> IO (Maybe ([Command |? CodeAction] |? Null))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO ([Command |? CodeAction] |? Null)
 -> IO (Maybe ([Command |? CodeAction] |? Null)))
-> MaybeT IO ([Command |? CodeAction] |? Null)
-> IO (Maybe ([Command |? CodeAction] |? Null))
forall a b. (a -> b) -> a -> b
$ do
            NormalizedFilePath
fp <- IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath)
-> IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath))
-> Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath)
forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath (NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri -> Maybe NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
theUri
            ParsedModule {[String]
()
ParsedSource
ModSummary
pm_mod_summary :: ParsedModule -> ModSummary
pm_mod_summary :: ModSummary
pm_parsed_source :: ParsedSource
pm_extra_src_files :: [String]
pm_annotations :: ()
pm_parsed_source :: ParsedModule -> ParsedSource
pm_extra_src_files :: ParsedModule -> [String]
pm_annotations :: ParsedModule -> ()
..} <-
                IO (Maybe ParsedModule) -> MaybeT IO ParsedModule
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe ParsedModule) -> MaybeT IO ParsedModule)
-> (Action (Maybe ParsedModule) -> IO (Maybe ParsedModule))
-> Action (Maybe ParsedModule)
-> MaybeT IO ParsedModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> IdeState
-> Action (Maybe ParsedModule)
-> IO (Maybe ParsedModule)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"splice.codeAction.GitHieAst" IdeState
state (Action (Maybe ParsedModule) -> MaybeT IO ParsedModule)
-> Action (Maybe ParsedModule) -> MaybeT IO ParsedModule
forall a b. (a -> b) -> a -> b
$
                    GetParsedModule
-> NormalizedFilePath -> Action (Maybe ParsedModule)
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 = GenericQ (SearchResult (RealSrcSpan, SpliceContext))
-> GenericQ (Maybe (RealSrcSpan, SpliceContext))
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 <- Maybe (RealSrcSpan, SpliceContext)
-> ((RealSrcSpan, SpliceContext)
    -> MaybeT IO [Command |? CodeAction])
-> MaybeT IO (Maybe [Command |? CodeAction])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (RealSrcSpan, SpliceContext)
mouterSplice (((RealSrcSpan, SpliceContext)
  -> MaybeT IO [Command |? CodeAction])
 -> MaybeT IO (Maybe [Command |? CodeAction]))
-> ((RealSrcSpan, SpliceContext)
    -> MaybeT IO [Command |? CodeAction])
-> MaybeT IO (Maybe [Command |? CodeAction])
forall a b. (a -> b) -> a -> b
$
                \(RealSrcSpan
spliceSpan, SpliceContext
spliceContext) ->
                    [(ExpandStyle, (Text, CommandId))]
-> ((ExpandStyle, (Text, CommandId))
    -> MaybeT IO (Command |? CodeAction))
-> MaybeT IO [Command |? CodeAction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(ExpandStyle, (Text, CommandId))]
expandStyles (((ExpandStyle, (Text, CommandId))
  -> MaybeT IO (Command |? CodeAction))
 -> MaybeT IO [Command |? CodeAction])
-> ((ExpandStyle, (Text, CommandId))
    -> MaybeT IO (Command |? CodeAction))
-> MaybeT IO [Command |? CodeAction]
forall a b. (a -> b) -> a -> b
$ \(ExpandStyle
_, (Text
title, CommandId
cmdId)) -> do
                        let params :: ExpandSpliceParams
params = ExpandSpliceParams {VersionedTextDocumentIdentifier
verTxtDocId :: VersionedTextDocumentIdentifier
verTxtDocId :: VersionedTextDocumentIdentifier
verTxtDocId, RealSrcSpan
SpliceContext
spliceSpan :: RealSrcSpan
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
spliceContext :: SpliceContext
..}
                            act :: Command
act = PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plId CommandId
cmdId Text
title ([Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [ExpandSpliceParams -> Value
forall a. ToJSON a => a -> Value
toJSON ExpandSpliceParams
params])
                        (Command |? CodeAction) -> MaybeT IO (Command |? CodeAction)
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Command |? CodeAction) -> MaybeT IO (Command |? CodeAction))
-> (Command |? CodeAction) -> MaybeT IO (Command |? CodeAction)
forall a b. (a -> b) -> a -> b
$
                            CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> CodeAction -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$
                                Text
-> Maybe CodeActionKind
-> Maybe [Diagnostic]
-> Maybe Bool
-> Maybe CodeActionDisabled
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction Text
title (CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionKind_RefactorRewrite) Maybe [Diagnostic]
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe CodeActionDisabled
forall a. Maybe a
Nothing Maybe WorkspaceEdit
forall a. Maybe a
Nothing (Command -> Maybe Command
forall a. a -> Maybe a
Just Command
act) Maybe Value
forall a. Maybe a
Nothing

            ([Command |? CodeAction] |? Null)
-> MaybeT IO ([Command |? CodeAction] |? Null)
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Command |? CodeAction] |? Null)
 -> MaybeT IO ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> MaybeT IO ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL ([Command |? CodeAction] -> [Command |? CodeAction] |? Null)
-> [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction]
-> Maybe [Command |? CodeAction] -> [Command |? CodeAction]
forall a. a -> Maybe a -> a
fromMaybe [Command |? CodeAction]
forall a. Monoid a => a
mempty Maybe [Command |? CodeAction]
mcmds
    where
        theUri :: Uri
theUri = TextDocumentIdentifier
docId TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
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 Maybe BufSpan
forall a. Maybe a
Nothing SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
x
          in
            SearchResult (RealSrcSpan, SpliceContext)
-> (LocatedAn AnnListItem (HsExpr GhcPs)
    -> SearchResult (RealSrcSpan, SpliceContext))
-> a
-> SearchResult (RealSrcSpan, SpliceContext)
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ
                SearchResult (RealSrcSpan, SpliceContext)
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
#if MIN_VERSION_ghc(9,5,0)
                                HsTypedSplice{}   -> (RealSrcSpan, SpliceContext)
-> SearchResult (RealSrcSpan, SpliceContext)
forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Expr)
                                HsUntypedSplice{} -> (RealSrcSpan, SpliceContext)
-> SearchResult (RealSrcSpan, SpliceContext)
forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Expr)
#else
                                HsSpliceE {}      -> Here (spLoc, Expr)
#endif
                                HsExpr GhcPs
_                 -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Continue
                    LocatedAn AnnListItem (HsExpr GhcPs)
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Stop
                )
                (a -> SearchResult (RealSrcSpan, SpliceContext))
-> (LocatedAn AnnListItem (Pat GhcPs)
    -> SearchResult (RealSrcSpan, SpliceContext))
-> a
-> SearchResult (RealSrcSpan, SpliceContext)
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` \case
                    (L (AsSrcSpan l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc Maybe BufSpan
_)) Pat GhcPs
pat :: LPat GhcPs)
                        | SrcSpan -> Bool
spanIsRelevant SrcSpan
l ->
                            case Pat GhcPs
pat of
                                SplicePat{} -> (RealSrcSpan, SpliceContext)
-> SearchResult (RealSrcSpan, SpliceContext)
forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Pat)
                                Pat GhcPs
_           -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Continue
                    LocatedAn AnnListItem (Pat GhcPs)
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Stop
                (a -> SearchResult (RealSrcSpan, SpliceContext))
-> (LocatedAn AnnListItem (HsType GhcPs)
    -> SearchResult (RealSrcSpan, SpliceContext))
-> a
-> SearchResult (RealSrcSpan, SpliceContext)
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`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 {} -> (RealSrcSpan, SpliceContext)
-> SearchResult (RealSrcSpan, SpliceContext)
forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
HsType)
                                HsType GhcPs
_             -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Continue
                    LocatedAn AnnListItem (HsType GhcPs)
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Stop
                (a -> SearchResult (RealSrcSpan, SpliceContext))
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> SearchResult (RealSrcSpan, SpliceContext))
-> a
-> SearchResult (RealSrcSpan, SpliceContext)
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`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 {} -> (RealSrcSpan, SpliceContext)
-> SearchResult (RealSrcSpan, SpliceContext)
forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
HsDecl)
                                HsDecl GhcPs
_          -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Continue
                    GenLocated SrcSpanAnnA (HsDecl GhcPs)
_ -> SearchResult (RealSrcSpan, SpliceContext)
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 =  a -> Maybe a
GenericQ (Maybe a)
go
    where
        go :: GenericQ (Maybe a)
        go :: GenericQ (Maybe a)
go a
x =
            case a -> SearchResult a
GenericQ (SearchResult a)
f a
x of
              SearchResult a
Stop -> Maybe a
forall a. Maybe a
Nothing
              SearchResult a
resl -> (Maybe a -> Maybe a -> Maybe a) -> Maybe a -> [Maybe a] -> Maybe a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Maybe a -> Maybe a -> Maybe a) -> Maybe a -> Maybe a -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)) (SearchResult a -> Maybe a
forall a. SearchResult a -> Maybe a
fromSearchResult SearchResult a
resl) (GenericQ (Maybe a) -> a -> [Maybe a]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
forall u. (forall d. Data d => d -> u) -> a -> [u]
gmapQ d -> Maybe a
GenericQ (Maybe a)
go a
x)