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

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                   ( guard, unless, forM )
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.Foldable                   (Foldable (foldl'))
import           Data.Function
import           Data.Generics
import qualified Data.Kind                       as Kinds
import           Data.List                       (sortOn)
import           Data.Maybe                      (fromMaybe, listToMaybe,
                                                  mapMaybe)
import qualified Data.Text                       as T
import           Development.IDE
import           Development.IDE.Core.PluginUtils
import           Development.IDE.GHC.Compat      as Compat hiding (getLoc)
import           Development.IDE.GHC.Compat.ExactPrint
import qualified Development.IDE.GHC.Compat.Util as Util
import           Development.IDE.GHC.ExactPrint
import           Language.Haskell.GHC.ExactPrint.Transform (TransformT(TransformT))

#if MIN_VERSION_ghc(9,4,1)

import           GHC.Data.Bag (Bag)

#endif

import           GHC.Exts


import           GHC.Parser.Annotation (SrcSpanAnn'(..))
import qualified GHC.Types.Error as Error


import           Ide.Plugin.Splice.Types
import           Ide.Types
import           Language.Haskell.GHC.ExactPrint (uniqueSrcSpanT)
import           Language.LSP.Server
import           Language.LSP.Protocol.Types
import           Language.LSP.Protocol.Message
import qualified Language.LSP.Protocol.Lens         as J
import Ide.Plugin.Error (PluginError(PluginInternalError))

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
..} = LspM Config (Either PluginError (Value |? Null))
-> ExceptT PluginError (LspM Config) (Value |? Null)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (LspM Config (Either PluginError (Value |? Null))
 -> ExceptT PluginError (LspM Config) (Value |? Null))
-> LspM Config (Either PluginError (Value |? Null))
-> ExceptT PluginError (LspM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ do
    ClientCapabilities
clientCapabilities <- LspT Config IO ClientCapabilities
forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
    LspT Config IO () -> IO ()
rio <- LspT Config IO (LspT Config IO () -> 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
$ LspT Config IO () -> IO ()
rio (LspT Config IO () -> IO ()) -> LspT Config IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SServerMethod 'Method_WindowShowMessage
-> MessageParams 'Method_WindowShowMessage -> LspT Config IO ()
forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
sendNotification 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
tmrDeferredError :: TcModuleResult -> Bool
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrTypechecked :: TcModuleResult -> TcGblEnv
..}, 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
            (Annotated ParsedSource
ps, HscEnv
hscEnv, DynFlags
_dflags) <- IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT
     PluginError IO (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
pm

            ClientCapabilities
-> ReportEditor
-> Range
-> Annotated ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT PluginError IO WorkspaceEdit
manualCalcEdit
                ClientCapabilities
clientCapabilities
                MessageType -> [Text] -> m ()
ReportEditor
reportEditor
                Range
range
                Annotated 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
tmrDeferredError :: TcModuleResult -> Bool
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrParsed :: ParsedModule
tmrRenamed :: RenamedSource
tmrTypechecked :: TcGblEnv
tmrTopLevelSplices :: Splices
tmrDeferredError :: Bool
tmrRuntimeModules :: ModuleEnv ByteString
..} = do
            (Annotated ParsedSource
ps, HscEnv
_hscEnv, DynFlags
dflags) <- IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT
     PluginError IO (Annotated 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)]
awSplices :: Splices -> [(LHsExpr GhcTc, Serialized)]
declSplices :: Splices -> [(LHsExpr GhcTc, [LHsDecl GhcPs])]
exprSplices :: Splices -> [(LHsExpr GhcTc, LHsExpr GhcPs)]
patSplices :: Splices -> [(LHsExpr GhcTc, LPat GhcPs)]
typeSplices :: Splices -> [(LHsExpr GhcTc, LHsType GhcPs)]
..} = 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
-> Annotated 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)
                            Annotated 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
-> Annotated 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)
                                Annotated 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))
-> LspT Config IO (Maybe (Either PluginError WorkspaceEdit))
forall a. IO a -> LspT Config IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either PluginError WorkspaceEdit))
 -> LspT Config IO (Maybe (Either PluginError WorkspaceEdit)))
-> IO (Maybe (Either PluginError WorkspaceEdit))
-> LspT Config IO (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 ann. PluginError -> Doc ann
forall a ann. Pretty a => a -> 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)
-> LspM Config (Either PluginError (Value |? Null))
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PluginError (Value |? Null)
 -> LspM Config (Either PluginError (Value |? Null)))
-> Either PluginError (Value |? Null)
-> LspM 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)
-> LspM Config (Either PluginError (Value |? Null))
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PluginError (Value |? Null)
 -> LspM Config (Either PluginError (Value |? Null)))
-> Either PluginError (Value |? Null)
-> LspM 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 ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
    -> LspT Config IO ())
-> LspT Config IO (LspId 'Method_WorkspaceApplyEdit)
forall (m :: Method 'ServerToClient 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (MessageResult m) -> f ())
-> f (LspId m)
sendRequest SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
_ -> () -> LspT Config IO ()
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        Either PluginError (Value |? Null)
-> LspM Config (Either PluginError (Value |? Null))
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PluginError (Value |? Null)
 -> LspM Config (Either PluginError (Value |? Null)))
-> Either PluginError (Value |? Null)
-> LspM 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 (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv :: IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT
     PluginError IO (Annotated 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 :: Annotated ParsedSource
ps = ParsedModule -> Annotated ParsedSource
annotateParsedSource ParsedModule
pm
        hscEnv0 :: HscEnv
hscEnv0 = HscEnvEq -> HscEnv
hscEnvWithImportPaths HscEnvEq
hscEnvEq
        modSum :: ModSummary
modSum = ParsedModule -> ModSummary
pm_mod_summary ParsedModule
pm
    HscEnv
hscEnv <- 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
    (Annotated ParsedSource, HscEnv, DynFlags)
-> ExceptT
     PluginError IO (Annotated ParsedSource, HscEnv, DynFlags)
forall a. a -> ExceptT PluginError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotated ParsedSource
ps, HscEnv
hscEnv, HscEnv -> DynFlags
hsc_dflags HscEnv
hscEnv)

setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike HscEnv
env DynFlags
dflags = do
    let dflags3 :: DynFlags
dflags3 = DynFlags -> DynFlags
setInterpreterLinkerOptions DynFlags
dflags
        platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags3
        dflags3a :: DynFlags
dflags3a = Ways -> DynFlags -> DynFlags
setWays Ways
hostFullWays DynFlags
dflags3
        dflags3b :: DynFlags
dflags3b =
            (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 Index (Map Uri [TextEdit])
Uri
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 #-}
pattern AsSrcSpan :: SrcSpan -> SrcSpanAnn' a
pattern $mAsSrcSpan :: forall {r} {a}.
SrcSpanAnn' a -> (SrcSpan -> r) -> ((# #) -> r) -> r
AsSrcSpan locA <- SrcSpanAnn {locA}

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 ->
    Annotated ParsedSource ->
    HscEnv ->
    TcGblEnv ->
    RealSrcSpan ->
    ExpandStyle ->
    ExpandSpliceParams ->
    ExceptT PluginError IO WorkspaceEdit
manualCalcEdit :: ClientCapabilities
-> ReportEditor
-> Range
-> Annotated ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT PluginError IO WorkspaceEdit
manualCalcEdit ClientCapabilities
clientCapabilities ReportEditor
reportEditor Range
ran Annotated 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
 -> Annotated ParsedSource -> TcM (Either String WorkspaceEdit))
-> Annotated 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
-> Annotated ParsedSource
-> TcM (Either String WorkspaceEdit)
forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
clientCapabilities VersionedTextDocumentIdentifier
verTxtDocId) Annotated 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
 -> Annotated ParsedSource -> TcM (Either String WorkspaceEdit))
-> Annotated 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
-> Annotated ParsedSource
-> TcM (Either String WorkspaceEdit)
forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
clientCapabilities VersionedTextDocumentIdentifier
verTxtDocId) Annotated 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 <- LspM Config VersionedTextDocumentIdentifier
-> ExceptT
     PluginError (LspM 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 (LspM Config VersionedTextDocumentIdentifier
 -> ExceptT
      PluginError (LspM Config) VersionedTextDocumentIdentifier)
-> LspM Config VersionedTextDocumentIdentifier
-> ExceptT
     PluginError (LspM Config) VersionedTextDocumentIdentifier
forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
-> LspM Config VersionedTextDocumentIdentifier
forall config (m :: * -> *).
MonadLsp config m =>
TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedTextDoc TextDocumentIdentifier
docId
    IO ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (LspM Config) ([Command |? CodeAction] |? Null)
forall a. IO a -> ExceptT PluginError (LspM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (LspM Config) ([Command |? CodeAction] |? Null))
-> IO ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (LspM 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_annotations :: ParsedModule -> ()
pm_extra_src_files :: ParsedModule -> [String]
pm_parsed_source :: ParsedModule -> ParsedSource
..} <-
                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 (Rec (("reason" .== Text) .+ Empty))
-> 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 (Rec (("reason" .== Text) .+ Empty))
Maybe (Rec ('R '["reason" ':-> Text]))
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)