{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Ide.Plugin.Splice
( descriptor,
)
where
import Control.Applicative (Alternative ((<|>)))
import Control.Arrow ( 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
#if MIN_VERSION_ghc(9,2,0)
import GHC.Parser.Annotation (SrcSpanAnn'(..))
import qualified GHC.Types.Error as Error
#endif
import Ide.Plugin.Splice.Types
import Ide.Types
import Language.Haskell.GHC.ExactPrint (uniqueSrcSpanT)
import Language.LSP.Server
import Language.LSP.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 =
(forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
{ pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState]
commands
, pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeAction
}
commands :: [PluginCommand IdeState]
commands :: [PluginCommand IdeState]
commands =
[ forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
expandInplaceId Text
inplaceCmdName forall a b. (a -> b) -> a -> b
$ ExpandStyle -> CommandFunction IdeState ExpandSpliceParams
expandTHSplice ExpandStyle
Inplace
]
newtype SubSpan = SubSpan {SubSpan -> SrcSpan
runSubSpan :: SrcSpan}
instance Eq SubSpan where
== :: SubSpan -> SubSpan -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SubSpan -> SrcSpan
runSubSpan
instance Ord SubSpan where
<= :: SubSpan -> SubSpan -> Bool
(<=) = coerce :: forall a b. Coercible a b => a -> b
coerce SrcSpan -> SrcSpan -> Bool
isSubspanOf
expandTHSplice ::
ExpandStyle ->
CommandFunction IdeState ExpandSpliceParams
expandTHSplice :: ExpandStyle -> CommandFunction IdeState ExpandSpliceParams
expandTHSplice ExpandStyle
_eStyle IdeState
ideState params :: ExpandSpliceParams
params@ExpandSpliceParams {RealSrcSpan
VersionedTextDocumentIdentifier
SpliceContext
spliceContext :: ExpandSpliceParams -> SpliceContext
spliceSpan :: ExpandSpliceParams -> RealSrcSpan
verTxtDocId :: ExpandSpliceParams -> VersionedTextDocumentIdentifier
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
verTxtDocId :: VersionedTextDocumentIdentifier
..} = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
ClientCapabilities
clientCapabilities <- forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
LspT Config IO () -> IO ()
rio <- forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
let reportEditor :: ReportEditor
reportEditor :: ReportEditor
reportEditor MessageType
msgTy [Text]
msgs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ LspT Config IO () -> IO ()
rio forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
sendNotification SMethod '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 <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.TypeCheck (stale)" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale TypeCheck
TypeCheck NormalizedFilePath
fp
(TcModuleResult {Bool
RenamedSource
ParsedModule
TcGblEnv
ModuleEnv ByteString
Splices
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferredError :: TcModuleResult -> Bool
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
tmrRuntimeModules :: ModuleEnv ByteString
tmrDeferredError :: Bool
tmrTopLevelSplices :: Splices
tmrTypechecked :: TcGblEnv
tmrRenamed :: RenamedSource
tmrParsed :: ParsedModule
..}, PositionMapping
_) <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError 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."
)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TcModuleResult, PositionMapping)
mresl
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 <- forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"expandTHSplice.fallback.GetParsedModule" IdeState
ideState forall a b. (a -> b) -> a -> b
$
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
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
ParsedModule
TcGblEnv
ModuleEnv ByteString
Splices
tmrRuntimeModules :: ModuleEnv ByteString
tmrDeferredError :: Bool
tmrTopLevelSplices :: Splices
tmrTypechecked :: TcGblEnv
tmrRenamed :: RenamedSource
tmrParsed :: ParsedModule
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferredError :: TcModuleResult -> Bool
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
..} = do
(Annotated ParsedSource
ps, HscEnv
_hscEnv, DynFlags
dflags) <- IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT
PluginError IO (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
tmrParsed
let Splices {[(LHsExpr GhcTc, [LHsDecl GhcPs])]
[(LHsExpr GhcTc, Serialized)]
[(LHsExpr GhcTc, LHsType GhcPs)]
[(LHsExpr GhcTc, LPat GhcPs)]
[(LHsExpr GhcTc, LHsExpr GhcPs)]
exprSplices :: Splices -> [(LHsExpr GhcTc, LHsExpr GhcPs)]
patSplices :: Splices -> [(LHsExpr GhcTc, LPat GhcPs)]
typeSplices :: Splices -> [(LHsExpr GhcTc, LHsType GhcPs)]
declSplices :: Splices -> [(LHsExpr GhcTc, [LHsDecl GhcPs])]
awSplices :: Splices -> [(LHsExpr GhcTc, Serialized)]
awSplices :: [(LHsExpr GhcTc, Serialized)]
declSplices :: [(LHsExpr GhcTc, [LHsDecl GhcPs])]
typeSplices :: [(LHsExpr GhcTc, LHsType GhcPs)]
patSplices :: [(LHsExpr GhcTc, LPat GhcPs)]
exprSplices :: [(LHsExpr GhcTc, LHsExpr GhcPs)]
..} = Splices
tmrTopLevelSplices
let exprSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))
exprSuperSpans =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LHsExpr GhcPs)]
exprSplices
_patSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs))
_patSuperSpans =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LPat GhcPs)]
patSplices
typeSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs))
typeSuperSpans =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LHsType GhcPs)]
typeSplices
declSuperSpans :: Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
declSuperSpans =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, [LHsDecl GhcPs])]
declSplices
graftSpliceWith ::
forall ast.
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs)) ->
Maybe (Either String WorkspaceEdit)
graftSpliceWith :: forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
expandeds =
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
expandeds forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SrcSpan
_, LocatedAn AnnListItem (ast GhcPs)
expanded) ->
DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (Either String) ParsedSource
-> Annotated ParsedSource
-> Either String WorkspaceEdit
transform
DynFlags
dflags
ClientCapabilities
clientCapabilities
VersionedTextDocumentIdentifier
verTxtDocId
(forall l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spliceSpan forall a. Maybe a
Nothing) LocatedAn AnnListItem (ast GhcPs)
expanded)
Annotated ParsedSource
ps
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"No splice information found") (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PluginError
PluginInternalError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall a b. (a -> b) -> a -> b
$
case SpliceContext
spliceContext of
SpliceContext
Expr -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))
exprSuperSpans
SpliceContext
Pat ->
forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs))
_patSuperSpans
SpliceContext
HsType -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs))
typeSuperSpans
SpliceContext
HsDecl ->
Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
declSuperSpans forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SrcSpan
_, [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
expanded) ->
DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (Either String) ParsedSource
-> Annotated ParsedSource
-> Either String WorkspaceEdit
transform
DynFlags
dflags
ClientCapabilities
clientCapabilities
VersionedTextDocumentIdentifier
verTxtDocId
(forall a.
HasDecls a =>
SrcSpan -> [LHsDecl GhcPs] -> Graft (Either String) a
graftDecls (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spliceSpan forall a. Maybe a
Nothing) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
expanded)
Annotated ParsedSource
ps
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange (VersionedTextDocumentIdentifier
verTxtDocId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
J.uri) Range
range
Maybe (Either PluginError WorkspaceEdit)
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
NormalizedFilePath
fp <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri (VersionedTextDocumentIdentifier
verTxtDocId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
J.uri)
Either PluginError WorkspaceEdit
eedits <-
( forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath
-> TcModuleResult -> ExceptT PluginError IO WorkspaceEdit
withTypeChecked NormalizedFilePath
fp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT
(forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.TypeCheck" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck NormalizedFilePath
fp)
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> ExceptT PluginError IO WorkspaceEdit
expandManually NormalizedFilePath
fp)
case Either PluginError WorkspaceEdit
eedits of
Left PluginError
err -> do
ReportEditor
reportEditor
MessageType
MessageType_Error
[String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Error during expanding splice: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall a ann. Pretty a => a -> Doc ann
pretty PluginError
err)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left PluginError
err)
Right WorkspaceEdit
edits ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right WorkspaceEdit
edits)
case Maybe (Either PluginError WorkspaceEdit)
res of
Maybe (Either PluginError WorkspaceEdit)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR Null
Null
Just (Left PluginError
err) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ PluginError
err
Just (Right WorkspaceEdit
edit) -> do
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 SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ 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 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 <- forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"expandTHSplice.fallback.ghcSessionDeps" IdeState
ideState forall a b. (a -> b) -> a -> b
$
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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike HscEnv
hscEnv0 forall a b. (a -> b) -> a -> b
$ ModSummary -> DynFlags
ms_hspp_opts ModSummary
modSum
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotated ParsedSource
ps, HscEnv
hscEnv, HscEnv -> DynFlags
hsc_dflags HscEnv
hscEnv)
setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike HscEnv
env DynFlags
dflags = do
let dflags3 :: DynFlags
dflags3 = DynFlags -> DynFlags
setInterpreterLinkerOptions DynFlags
dflags
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags3
dflags3a :: DynFlags
dflags3a = Ways -> DynFlags -> DynFlags
setWays Ways
hostFullWays DynFlags
dflags3
dflags3b :: DynFlags
dflags3b =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflags3a forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
wayGeneralFlags Platform
platform) Ways
hostFullWays
dflags3c :: DynFlags
dflags3c =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
dflags3b forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
wayUnsetGeneralFlags Platform
platform) Ways
hostFullWays
dflags4 :: DynFlags
dflags4 =
DynFlags
dflags3c
DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_ImplicitImportQualified
DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_IgnoreOptimChanges
DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_IgnoreHpcChanges
DynFlags -> GeneralFlag -> DynFlags
`gopt_unset` GeneralFlag
Opt_DiagnosticsShowCaret
HscEnv -> IO HscEnv
initializePlugins (DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags4 HscEnv
env)
adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange Uri
uri Range
ran (WorkspaceEdit Maybe (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Map Uri [TextEdit])
mhult) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile)))
-> TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))
adjustDoc 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 forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (forall a b r. (a -> b) -> Fold b r -> Fold a r
L.premap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasRange s a => Lens' s a
J.range) forall a. Ord a => Fold a (Maybe a)
L.minimum) f TextEdit
eds of
Maybe Range
Nothing -> forall a. HasCallStack => String -> a
error String
"impossible"
Just Range
v -> Range
v
in Range -> TextEdit -> TextEdit
adjustLine Range
minStart forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f TextEdit
eds
adjustATextEdits :: Traversable f => f (TextEdit |? AnnotatedTextEdit) -> f (TextEdit |? AnnotatedTextEdit)
adjustATextEdits :: forall (f :: * -> *).
Traversable f =>
f (TextEdit |? AnnotatedTextEdit)
-> f (TextEdit |? AnnotatedTextEdit)
adjustATextEdits = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \case
InL TextEdit
t -> forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits (forall a. a -> Identity a
Identity TextEdit
t)
InR AnnotatedTextEdit{Range
$sel:_range:AnnotatedTextEdit :: AnnotatedTextEdit -> Range
_range :: Range
_range, Text
$sel:_newText:AnnotatedTextEdit :: AnnotatedTextEdit -> Text
_newText :: Text
_newText, ChangeAnnotationIdentifier
$sel:_annotationId:AnnotatedTextEdit :: AnnotatedTextEdit -> ChangeAnnotationIdentifier
_annotationId :: ChangeAnnotationIdentifier
_annotationId} ->
let oldTE :: TextEdit
oldTE = TextEdit{Range
$sel:_range:TextEdit :: Range
_range :: Range
_range,Text
$sel:_newText:TextEdit :: Text
_newText :: Text
_newText}
in let TextEdit{Range
_range :: Range
$sel:_range:TextEdit :: TextEdit -> Range
_range,Text
_newText :: Text
$sel:_newText:TextEdit :: TextEdit -> Text
_newText} = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits (forall a. a -> Identity a
Identity TextEdit
oldTE)
in forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ AnnotatedTextEdit{Range
_range :: Range
$sel:_range:AnnotatedTextEdit :: Range
_range,Text
_newText :: Text
$sel:_newText:AnnotatedTextEdit :: Text
_newText,ChangeAnnotationIdentifier
$sel:_annotationId:AnnotatedTextEdit :: ChangeAnnotationIdentifier
_annotationId :: ChangeAnnotationIdentifier
_annotationId}
adjustWS :: Map Uri [TextEdit] -> Map Uri [TextEdit]
adjustWS = forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Uri
uri forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits
adjustDoc :: DocumentChange -> DocumentChange
adjustDoc :: (TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile)))
-> TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))
adjustDoc (InR CreateFile |? (RenameFile |? DeleteFile)
es) = forall a b. b -> a |? b
InR CreateFile |? (RenameFile |? DeleteFile)
es
adjustDoc (InL TextDocumentEdit
es)
| TextDocumentEdit
es forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri forall a. Eq a => a -> a -> Bool
== Uri
uri =
forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ TextDocumentEdit
es forall a b. a -> (a -> b) -> b
& forall s a. HasEdits s a => Lens' s a
J.edits forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *).
Traversable f =>
f (TextEdit |? AnnotatedTextEdit)
-> f (TextEdit |? AnnotatedTextEdit)
adjustATextEdits
| Bool
otherwise = forall a b. a -> a |? b
InL TextDocumentEdit
es
adjustLine :: Range -> TextEdit -> TextEdit
adjustLine :: Range -> TextEdit -> TextEdit
adjustLine Range
bad =
forall s a. HasRange s a => Lens' s a
J.range forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Range
r ->
if Range
r forall a. Eq a => a -> a -> Bool
== Range
bad then Range
ran else Range
bad
{-# COMPLETE AsSrcSpan #-}
#if MIN_VERSION_ghc(9,2,0)
pattern AsSrcSpan :: SrcSpan -> SrcSpanAnn' a
pattern $mAsSrcSpan :: forall {r} {a}.
SrcSpanAnn' a -> (SrcSpan -> r) -> ((# #) -> r) -> r
AsSrcSpan locA <- SrcSpanAnn {locA}
#else
pattern AsSrcSpan :: SrcSpan -> SrcSpan
pattern AsSrcSpan loc <- loc
#endif
findSubSpansDesc :: SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc :: forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan =
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SubSpan
SubSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
( \(L (AsSrcSpan SrcSpan
spn) HsExpr GhcTc
_, a
e) -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SrcSpan
spn SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
srcSpan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpan
spn, a
e)
)
data SpliceClass where
OneToOneAST :: HasSplice AnnListItem ast => Proxy# ast -> SpliceClass
IsHsDecl :: SpliceClass
#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 _ (HsUntypedSplice _ spl) = Just (UntypedSplice spl)
matchSplice _ (HsTypedSplice _ spl) = Just (TypedSplice spl)
#else
type SpliceOf HsExpr = HsSplice
matchSplice :: Proxy# HsExpr -> HsExpr GhcPs -> Maybe (SpliceOf HsExpr GhcPs)
matchSplice Proxy# HsExpr
_ (HsSpliceE XSpliceE GhcPs
_ HsSplice GhcPs
spl) = forall a. a -> Maybe a
Just HsSplice GhcPs
spl
#endif
matchSplice Proxy# HsExpr
_ HsExpr GhcPs
_ = forall a. Maybe a
Nothing
#if MIN_VERSION_ghc(9,5,0)
expandSplice _ (UntypedSplice e) = fmap (first Right) $ rnUntypedSpliceExpr e
expandSplice _ (TypedSplice e) = fmap (first Right) $ rnTypedSplice e
#else
expandSplice :: Proxy# HsExpr
-> SpliceOf HsExpr GhcPs
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
expandSplice Proxy# HsExpr
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnSpliceExpr
#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
_ HsSplice GhcPs
spl) = forall a. a -> Maybe a
Just HsSplice GhcPs
spl
matchSplice Proxy# Pat
_ Pat GhcPs
_ = forall a. Maybe a
Nothing
expandSplice :: Proxy# Pat
-> SpliceOf Pat GhcPs
-> RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
expandSplice Proxy# Pat
_ =
#if MIN_VERSION_ghc(9,5,0)
fmap (first (Left . unLoc . utsplice_result . snd )) .
#endif
HsSplice GhcPs -> RnM (Either (Pat GhcPs) (Pat GhcRn), 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
_ HsSplice GhcPs
spl) = forall a. a -> Maybe a
Just HsSplice GhcPs
spl
matchSplice Proxy# HsType
_ HsType GhcPs
_ = forall a. Maybe a
Nothing
expandSplice :: Proxy# HsType
-> SpliceOf HsType GhcPs
-> RnM (Either (HsType GhcPs) (HsType GhcRn), FreeVars)
expandSplice Proxy# HsType
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars)
rnSpliceType
classifyAST :: SpliceContext -> SpliceClass
classifyAST :: SpliceContext -> SpliceClass
classifyAST = \case
SpliceContext
Expr -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Proxy# ast -> SpliceClass
OneToOneAST @HsExpr forall {k} (a :: k). Proxy# a
proxy#
SpliceContext
HsDecl -> SpliceClass
IsHsDecl
SpliceContext
Pat -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Proxy# ast -> SpliceClass
OneToOneAST @Pat forall {k} (a :: k). Proxy# a
proxy#
SpliceContext
HsType -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Proxy# ast -> SpliceClass
OneToOneAST @HsType forall {k} (a :: k). Proxy# a
proxy#
type ReportEditor = forall m. MonadIO m => MessageType -> [T.Text] -> m ()
manualCalcEdit ::
ClientCapabilities ->
ReportEditor ->
Range ->
Annotated ParsedSource ->
HscEnv ->
TcGblEnv ->
RealSrcSpan ->
ExpandStyle ->
ExpandSpliceParams ->
ExceptT 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
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
verTxtDocId :: VersionedTextDocumentIdentifier
spliceContext :: ExpandSpliceParams -> SpliceContext
spliceSpan :: ExpandSpliceParams -> RealSrcSpan
verTxtDocId :: ExpandSpliceParams -> VersionedTextDocumentIdentifier
..} = do
(Bag (MsgEnvelope DecoratedSDoc)
warns, WorkspaceEdit
resl) <-
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
(Messages DecoratedSDoc
msgs, Maybe (Either String WorkspaceEdit)
eresl) <-
forall r.
HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM r
-> IO (Messages DecoratedSDoc, Maybe r)
initTcWithGbl HscEnv
hscEnv TcGblEnv
typechkd RealSrcSpan
srcSpan forall a b. (a -> b) -> a -> b
$
case SpliceContext -> SpliceClass
classifyAST SpliceContext
spliceContext of
SpliceClass
IsHsDecl -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange (VersionedTextDocumentIdentifier
verTxtDocId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
J.uri) Range
ran) forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
clientCapabilities VersionedTextDocumentIdentifier
verTxtDocId) Annotated ParsedSource
ps forall a b. (a -> b) -> a -> b
$
forall a (m :: * -> *).
(HasDecls a, MonadFail m) =>
SrcSpan
-> (LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs]))
-> Graft m a
graftDeclsWithM (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
srcSpan forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ \case
(L SrcSpanAnnA
_spn (SpliceD XSpliceD GhcPs
_ (SpliceDecl XSpliceDecl GhcPs
_ (L SrcSpanAnnA
_ HsSplice GhcPs
spl) SpliceExplicitFlag
_))) -> do
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
eExpr <-
forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
( forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Util.try @_ @SomeException forall a b. (a -> b) -> a -> b
$
(forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
rnTopSpliceDecls HsSplice GhcPs
spl)
)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
eExpr
LHsDecl GhcPs
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
OneToOneAST Proxy# ast
astP ->
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
clientCapabilities VersionedTextDocumentIdentifier
verTxtDocId) Annotated ParsedSource
ps forall a b. (a -> b) -> a -> b
$
forall ast (m :: * -> *) a l.
(MonadFail m, Data a, Typeable l, ASTElement l ast) =>
SrcSpan
-> (LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast)))
-> Graft m a
graftWithM (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
srcSpan forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ \case
(L SrcSpanAnnA
_spn (forall l (ast :: * -> *).
HasSplice l ast =>
Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs)
matchSplice Proxy# ast
astP -> Just SpliceOf ast GhcPs
spl)) -> do
Either (ast GhcPs) (ast GhcRn)
eExpr <-
forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
( forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Util.try @_ @SomeException forall a b. (a -> b) -> a -> b
$
(forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall l (ast :: * -> *).
HasSplice l ast =>
Proxy# ast
-> SpliceOf ast GhcPs
-> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars)
expandSplice Proxy# ast
astP SpliceOf ast GhcPs
spl)
)
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Either (ast GhcPs) (ast GhcRn)
eExpr of
Left ast GhcPs
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
_spn ast GhcPs
x
Right ast GhcRn
y -> forall (ast :: * -> *) (m :: * -> *) l.
(MonadFail m, HasSplice l ast) =>
DynFlags -> ast GhcRn -> TransformT m (LocatedAn l (ast GhcPs))
unRenamedE DynFlags
dflags ast GhcRn
y
LocatedAn AnnListItem (ast GhcPs)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
let (Bag (MsgEnvelope DecoratedSDoc)
warns, Bag (MsgEnvelope DecoratedSDoc)
errs) =
#if MIN_VERSION_ghc(9,2,0)
(forall e. Messages e -> Bag (MsgEnvelope e)
Error.getWarningMessages Messages DecoratedSDoc
msgs, forall e. Messages e -> Bag (MsgEnvelope e)
Error.getErrorMessages Messages DecoratedSDoc
msgs)
#else
msgs
#endif
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Bag (MsgEnvelope DecoratedSDoc)
warns,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors Bag (MsgEnvelope DecoratedSDoc)
errs)
(forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
B.first (Text -> PluginError
PluginInternalError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)) Maybe (Either String WorkspaceEdit)
eresl
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
(forall (t :: * -> *) a. Foldable t => t a -> Bool
null Bag (MsgEnvelope DecoratedSDoc)
warns)
forall a b. (a -> b) -> a -> b
$ ReportEditor
reportEditor
MessageType
MessageType_Warning
[ Text
"Warning during expanding: "
, Text
""
, String -> Text
T.pack (Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors Bag (MsgEnvelope DecoratedSDoc)
warns)
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkspaceEdit
resl
where
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hscEnv
#if MIN_VERSION_ghc(9,4,1)
showErrors = showBag
#else
showErrors :: Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors = forall a. Show a => a -> String
show
#endif
#if MIN_VERSION_ghc(9,4,1)
showBag :: Error.Diagnostic a => Bag (Error.MsgEnvelope a) -> String
showBag = show . fmap (fmap toDiagnosticMessage)
toDiagnosticMessage :: forall a. Error.Diagnostic a => a -> Error.DiagnosticMessage
toDiagnosticMessage message =
Error.DiagnosticMessage
{ diagMessage = Error.diagnosticMessage
#if MIN_VERSION_ghc(9,5,0)
(Error.defaultDiagnosticOpts @a)
#endif
message
, diagReason = Error.diagnosticReason message
, diagHints = Error.diagnosticHints message
}
#endif
unRenamedE ::
forall ast m l.
(Fail.MonadFail m, HasSplice l ast) =>
DynFlags ->
ast GhcRn ->
TransformT m (LocatedAn l (ast GhcPs))
unRenamedE :: forall (ast :: * -> *) (m :: * -> *) l.
(MonadFail m, HasSplice l ast) =>
DynFlags -> ast GhcRn -> TransformT m (LocatedAn l (ast GhcPs))
unRenamedE DynFlags
dflags ast GhcRn
expr = do
String
uniq <- forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
#if MIN_VERSION_ghc(9,2,0)
LocatedAn l (ast GhcPs)
expr' <-
#else
(_anns, expr') <-
#endif
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall l ast. ASTElement l ast => Parser (LocatedAn l ast)
parseAST @_ @(ast GhcPs) DynFlags
dflags String
uniq forall a b. (a -> b) -> a -> b
$
DynFlags -> SDoc -> String
showSDoc DynFlags
dflags forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr ast GhcRn
expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l (ast GhcPs)
expr'
where
#if MIN_VERSION_ghc(9,4,1)
showErrors = showBag . Error.getMessages
#else
showErrors :: Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors = forall a. Show a => a -> String
show
#endif
data SearchResult r =
Continue | Stop | Here r
deriving (ReadPrec [SearchResult r]
ReadPrec (SearchResult r)
ReadS [SearchResult r]
forall r. Read r => ReadPrec [SearchResult r]
forall r. Read r => ReadPrec (SearchResult r)
forall r. Read r => Int -> ReadS (SearchResult r)
forall r. Read r => ReadS [SearchResult r]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SearchResult r]
$creadListPrec :: forall r. Read r => ReadPrec [SearchResult r]
readPrec :: ReadPrec (SearchResult r)
$creadPrec :: forall r. Read r => ReadPrec (SearchResult r)
readList :: ReadS [SearchResult r]
$creadList :: forall r. Read r => ReadS [SearchResult r]
readsPrec :: Int -> ReadS (SearchResult r)
$creadsPrec :: forall r. Read r => Int -> ReadS (SearchResult r)
Read, Int -> SearchResult r -> ShowS
forall r. Show r => Int -> SearchResult r -> ShowS
forall r. Show r => [SearchResult r] -> ShowS
forall r. Show r => SearchResult r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchResult r] -> ShowS
$cshowList :: forall r. Show r => [SearchResult r] -> ShowS
show :: SearchResult r -> String
$cshow :: forall r. Show r => SearchResult r -> String
showsPrec :: Int -> SearchResult r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> SearchResult r -> ShowS
Show, SearchResult r -> SearchResult r -> Bool
forall r. Eq r => SearchResult r -> SearchResult r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchResult r -> SearchResult r -> Bool
$c/= :: forall r. Eq r => SearchResult r -> SearchResult r -> Bool
== :: SearchResult r -> SearchResult r -> Bool
$c== :: forall r. Eq r => SearchResult r -> SearchResult r -> Bool
Eq, SearchResult r -> SearchResult r -> Bool
SearchResult r -> SearchResult r -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {r}. Ord r => Eq (SearchResult r)
forall r. Ord r => SearchResult r -> SearchResult r -> Bool
forall r. Ord r => SearchResult r -> SearchResult r -> Ordering
forall r.
Ord r =>
SearchResult r -> SearchResult r -> SearchResult r
min :: SearchResult r -> SearchResult r -> SearchResult r
$cmin :: forall r.
Ord r =>
SearchResult r -> SearchResult r -> SearchResult r
max :: SearchResult r -> SearchResult r -> SearchResult r
$cmax :: forall r.
Ord r =>
SearchResult r -> SearchResult r -> SearchResult r
>= :: SearchResult r -> SearchResult r -> Bool
$c>= :: forall r. Ord r => SearchResult r -> SearchResult r -> Bool
> :: SearchResult r -> SearchResult r -> Bool
$c> :: forall r. Ord r => SearchResult r -> SearchResult r -> Bool
<= :: SearchResult r -> SearchResult r -> Bool
$c<= :: forall r. Ord r => SearchResult r -> SearchResult r -> Bool
< :: SearchResult r -> SearchResult r -> Bool
$c< :: forall r. Ord r => SearchResult r -> SearchResult r -> Bool
compare :: SearchResult r -> SearchResult r -> Ordering
$ccompare :: forall r. Ord r => SearchResult r -> SearchResult r -> Ordering
Ord, SearchResult r -> DataType
SearchResult r -> Constr
forall {r}. Data r => Typeable (SearchResult r)
forall r. Data r => SearchResult r -> DataType
forall r. Data r => SearchResult r -> Constr
forall r.
Data r =>
(forall b. Data b => b -> b) -> SearchResult r -> SearchResult r
forall r u.
Data r =>
Int -> (forall d. Data d => d -> u) -> SearchResult r -> u
forall r u.
Data r =>
(forall d. Data d => d -> u) -> SearchResult r -> [u]
forall r r r'.
Data r =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
forall r r r'.
Data r =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
forall r (m :: * -> *).
(Data r, Monad m) =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
forall r (m :: * -> *).
(Data r, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
forall r (c :: * -> *).
Data r =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SearchResult r)
forall r (c :: * -> *).
Data r =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r)
forall r (t :: * -> *) (c :: * -> *).
(Data r, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SearchResult r))
forall r (t :: * -> * -> *) (c :: * -> *).
(Data r, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SearchResult r))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SearchResult r)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SearchResult r))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
$cgmapMo :: forall r (m :: * -> *).
(Data r, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
$cgmapMp :: forall r (m :: * -> *).
(Data r, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
$cgmapM :: forall r (m :: * -> *).
(Data r, Monad m) =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SearchResult r -> u
$cgmapQi :: forall r u.
Data r =>
Int -> (forall d. Data d => d -> u) -> SearchResult r -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SearchResult r -> [u]
$cgmapQ :: forall r u.
Data r =>
(forall d. Data d => d -> u) -> SearchResult r -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
$cgmapQr :: forall r r r'.
Data r =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
$cgmapQl :: forall r r r'.
Data r =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
gmapT :: (forall b. Data b => b -> b) -> SearchResult r -> SearchResult r
$cgmapT :: forall r.
Data r =>
(forall b. Data b => b -> b) -> SearchResult r -> SearchResult r
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SearchResult r))
$cdataCast2 :: forall r (t :: * -> * -> *) (c :: * -> *).
(Data r, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SearchResult r))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SearchResult r))
$cdataCast1 :: forall r (t :: * -> *) (c :: * -> *).
(Data r, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SearchResult r))
dataTypeOf :: SearchResult r -> DataType
$cdataTypeOf :: forall r. Data r => SearchResult r -> DataType
toConstr :: SearchResult r -> Constr
$ctoConstr :: forall r. Data r => SearchResult r -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SearchResult r)
$cgunfold :: forall r (c :: * -> *).
Data r =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SearchResult r)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r)
$cgfoldl :: forall r (c :: * -> *).
Data r =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r)
Data, Typeable)
fromSearchResult :: SearchResult a -> Maybe a
fromSearchResult :: forall a. SearchResult a -> Maybe a
fromSearchResult (Here a
r) = forall a. a -> Maybe a
Just a
r
fromSearchResult SearchResult a
_ = forall a. Maybe a
Nothing
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall config (m :: * -> *).
MonadLsp config m =>
TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedTextDoc TextDocumentIdentifier
docId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe ( forall a b. a -> a |? b
InL [])) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
NormalizedFilePath
fp <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
theUri
ParsedModule {[String]
()
ModSummary
ParsedSource
pm_parsed_source :: ParsedModule -> ParsedSource
pm_extra_src_files :: ParsedModule -> [String]
pm_annotations :: ParsedModule -> ()
pm_annotations :: ()
pm_extra_src_files :: [String]
pm_parsed_source :: ParsedSource
pm_mod_summary :: ModSummary
pm_mod_summary :: ParsedModule -> ModSummary
..} <-
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> IdeState -> Action a -> IO a
runAction String
"splice.codeAction.GitHieAst" IdeState
state forall a b. (a -> b) -> a -> b
$
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModule
GetParsedModule NormalizedFilePath
fp
let spn :: RealSrcSpan
spn = NormalizedFilePath -> Range -> RealSrcSpan
rangeToRealSrcSpan NormalizedFilePath
fp Range
ran
mouterSplice :: Maybe (RealSrcSpan, SpliceContext)
mouterSplice = forall a. GenericQ (SearchResult a) -> GenericQ (Maybe a)
something' (RealSrcSpan -> GenericQ (SearchResult (RealSrcSpan, SpliceContext))
detectSplice RealSrcSpan
spn) ParsedSource
pm_parsed_source
Maybe [Command |? CodeAction]
mcmds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (RealSrcSpan, SpliceContext)
mouterSplice forall a b. (a -> b) -> a -> b
$
\(RealSrcSpan
spliceSpan, SpliceContext
spliceContext) ->
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(ExpandStyle, (Text, CommandId))]
expandStyles forall a b. (a -> b) -> a -> b
$ \(ExpandStyle
_, (Text
title, CommandId
cmdId)) -> do
let params :: ExpandSpliceParams
params = ExpandSpliceParams {VersionedTextDocumentIdentifier
verTxtDocId :: VersionedTextDocumentIdentifier
verTxtDocId :: VersionedTextDocumentIdentifier
verTxtDocId, RealSrcSpan
SpliceContext
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
..}
act :: Command
act = PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plId CommandId
cmdId Text
title (forall a. a -> Maybe a
Just [forall a. ToJSON a => a -> Value
toJSON ExpandSpliceParams
params])
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$
Text
-> Maybe CodeActionKind
-> Maybe [Diagnostic]
-> Maybe Bool
-> Maybe (Rec (("reason" .== Text) .+ Empty))
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction Text
title (forall a. a -> Maybe a
Just CodeActionKind
CodeActionKind_RefactorRewrite) forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Command
act) forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe [Command |? CodeAction]
mcmds
where
theUri :: Uri
theUri = TextDocumentIdentifier
docId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
J.uri
detectSplice ::
RealSrcSpan ->
GenericQ (SearchResult (RealSrcSpan, SpliceContext))
detectSplice :: RealSrcSpan -> GenericQ (SearchResult (RealSrcSpan, SpliceContext))
detectSplice RealSrcSpan
spn =
let
spanIsRelevant :: SrcSpan -> Bool
spanIsRelevant SrcSpan
x = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spn forall a. Maybe a
Nothing SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
x
in
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ
forall r. SearchResult r
Continue
( \case
(L (AsSrcSpan l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc Maybe BufSpan
_)) HsExpr GhcPs
expr :: LHsExpr GhcPs)
| SrcSpan -> Bool
spanIsRelevant SrcSpan
l ->
case HsExpr GhcPs
expr of
#if MIN_VERSION_ghc(9,5,0)
HsTypedSplice{} -> Here (spLoc, Expr)
HsUntypedSplice{} -> Here (spLoc, Expr)
#else
HsSpliceE {} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Expr)
#endif
HsExpr GhcPs
_ -> forall r. SearchResult r
Continue
LocatedAn AnnListItem (HsExpr GhcPs)
_ -> forall r. SearchResult r
Stop
)
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{} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Pat)
Pat GhcPs
_ -> forall r. SearchResult r
Continue
LocatedAn AnnListItem (Pat GhcPs)
_ -> forall r. SearchResult r
Stop
forall a b 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 {} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
HsType)
HsType GhcPs
_ -> forall r. SearchResult r
Continue
LocatedAn AnnListItem (HsType GhcPs)
_ -> forall r. SearchResult r
Stop
forall a b 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 {} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
HsDecl)
HsDecl GhcPs
_ -> forall r. SearchResult r
Continue
GenLocated SrcSpanAnnA (HsDecl GhcPs)
_ -> forall r. SearchResult r
Stop
something' :: forall a. GenericQ (SearchResult a) -> GenericQ (Maybe a)
something' :: forall a. GenericQ (SearchResult a) -> GenericQ (Maybe a)
something' GenericQ (SearchResult a)
f = GenericQ (Maybe a)
go
where
go :: GenericQ (Maybe a)
go :: GenericQ (Maybe a)
go a
x =
case GenericQ (SearchResult a)
f a
x of
SearchResult a
Stop -> forall a. Maybe a
Nothing
SearchResult a
resl -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)) (forall a. SearchResult a -> Maybe a
fromSearchResult SearchResult a
resl) (forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ GenericQ (Maybe a)
go a
x)