{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Ide.Plugin.Splice
( descriptor,
)
where
import Control.Applicative (Alternative ((<|>)))
import Control.Arrow
import Control.Exception
import qualified Control.Foldl as L
import Control.Lens (Identity (..), ix, view, (%~),
(<&>), (^.))
import Control.Monad
import Control.Monad.Extra (eitherM)
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Data.Aeson
import Data.Foldable (Foldable (foldl'))
import Data.Function
import Data.Generics
import qualified Data.Kind as Kinds
import Data.List (sortOn)
import Data.Maybe (fromMaybe, listToMaybe,
mapMaybe)
import qualified Data.Text as T
import Development.IDE
import Development.IDE.GHC.Compat as Compat hiding (getLoc)
import Development.IDE.GHC.Compat.ExactPrint
import qualified Development.IDE.GHC.Compat.Util as Util
import Development.IDE.GHC.ExactPrint
#if MIN_VERSION_ghc(9,4,1)
import GHC.Data.Bag (Bag)
#endif
import GHC.Exts
#if MIN_VERSION_ghc(9,2,0)
import GHC.Parser.Annotation (SrcSpanAnn'(..))
import qualified GHC.Types.Error as Error
#endif
import Ide.Plugin.Splice.Types
import Ide.Types
import Language.Haskell.GHC.ExactPrint (uniqueSrcSpanT)
import Language.LSP.Server
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import qualified Language.LSP.Types.Lens as J
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId =
(forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
{ pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState]
commands
, pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentCodeAction
STextDocumentCodeAction PluginMethodHandler IdeState 'TextDocumentCodeAction
codeAction
}
commands :: [PluginCommand IdeState]
commands :: [PluginCommand IdeState]
commands =
[ forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
expandInplaceId Text
inplaceCmdName forall a b. (a -> b) -> a -> b
$ ExpandStyle -> CommandFunction IdeState ExpandSpliceParams
expandTHSplice ExpandStyle
Inplace
]
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
Uri
SpliceContext
spliceContext :: ExpandSpliceParams -> SpliceContext
spliceSpan :: ExpandSpliceParams -> RealSrcSpan
uri :: ExpandSpliceParams -> Uri
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
uri :: Uri
..} = do
ClientCapabilities
clientCapabilities <- forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
LspT Config IO () -> IO ()
rio <- forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
let reportEditor :: ReportEditor
reportEditor :: ReportEditor
reportEditor MessageType
msgTy [Text]
msgs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ LspT Config IO () -> IO ()
rio forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
sendNotification SMethod 'WindowShowMessage
SWindowShowMessage (MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
msgTy ([Text] -> Text
T.unlines [Text]
msgs))
expandManually :: NormalizedFilePath -> ExceptT String IO WorkspaceEdit
expandManually NormalizedFilePath
fp = do
Maybe (TcModuleResult, PositionMapping)
mresl <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.TypeCheck (stale)" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale TypeCheck
TypeCheck NormalizedFilePath
fp
(TcModuleResult {Bool
RenamedSource
ParsedModule
TcGblEnv
ModuleEnv ByteString
Splices
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferredError :: TcModuleResult -> Bool
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
tmrRuntimeModules :: ModuleEnv ByteString
tmrDeferredError :: Bool
tmrTopLevelSplices :: Splices
tmrTypechecked :: TcGblEnv
tmrRenamed :: RenamedSource
tmrParsed :: ParsedModule
..}, PositionMapping
_) <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"Splice expansion: Type-checking information not found in cache.\nYou can once delete or replace the macro with placeholder, convince the type checker and then revert to original (erroneous) macro and expand splice again."
)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TcModuleResult, PositionMapping)
mresl
ReportEditor
reportEditor
MessageType
MtWarning
[ Text
"Expansion in type-checking phase failed;"
, Text
"trying to expand manually, but note that it is less rigorous."
]
ParsedModule
pm <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.GetParsedModule" IdeState
ideState forall a b. (a -> b) -> a -> b
$
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetParsedModule
GetParsedModule NormalizedFilePath
fp
(Annotated ParsedSource
ps, HscEnv
hscEnv, DynFlags
_dflags) <- IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
pm
ClientCapabilities
-> ReportEditor
-> Range
-> Annotated ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT String IO WorkspaceEdit
manualCalcEdit
ClientCapabilities
clientCapabilities
ReportEditor
reportEditor
Range
range
Annotated ParsedSource
ps
HscEnv
hscEnv
TcGblEnv
tmrTypechecked
RealSrcSpan
spliceSpan
ExpandStyle
_eStyle
ExpandSpliceParams
params
withTypeChecked :: NormalizedFilePath
-> TcModuleResult -> ExceptT String IO WorkspaceEdit
withTypeChecked NormalizedFilePath
fp TcModuleResult {Bool
RenamedSource
ParsedModule
TcGblEnv
ModuleEnv ByteString
Splices
tmrRuntimeModules :: ModuleEnv ByteString
tmrDeferredError :: Bool
tmrTopLevelSplices :: Splices
tmrTypechecked :: TcGblEnv
tmrRenamed :: RenamedSource
tmrParsed :: ParsedModule
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferredError :: TcModuleResult -> Bool
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
..} = do
(Annotated ParsedSource
ps, HscEnv
_hscEnv, DynFlags
dflags) <- IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
tmrParsed
let Splices {[(LHsExpr GhcTc, [LHsDecl GhcPs])]
[(LHsExpr GhcTc, Serialized)]
[(LHsExpr GhcTc, LHsType GhcPs)]
[(LHsExpr GhcTc, LPat GhcPs)]
[(LHsExpr GhcTc, LHsExpr GhcPs)]
exprSplices :: Splices -> [(LHsExpr GhcTc, LHsExpr GhcPs)]
patSplices :: Splices -> [(LHsExpr GhcTc, LPat GhcPs)]
typeSplices :: Splices -> [(LHsExpr GhcTc, LHsType GhcPs)]
declSplices :: Splices -> [(LHsExpr GhcTc, [LHsDecl GhcPs])]
awSplices :: Splices -> [(LHsExpr GhcTc, Serialized)]
awSplices :: [(LHsExpr GhcTc, Serialized)]
declSplices :: [(LHsExpr GhcTc, [LHsDecl GhcPs])]
typeSplices :: [(LHsExpr GhcTc, LHsType GhcPs)]
patSplices :: [(LHsExpr GhcTc, LPat GhcPs)]
exprSplices :: [(LHsExpr GhcTc, LHsExpr GhcPs)]
..} = Splices
tmrTopLevelSplices
let exprSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))
exprSuperSpans =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LHsExpr GhcPs)]
exprSplices
_patSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs))
_patSuperSpans =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LPat GhcPs)]
patSplices
typeSuperSpans :: Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs))
typeSuperSpans =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LHsType GhcPs)]
typeSplices
declSuperSpans :: Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
declSuperSpans =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, [LHsDecl GhcPs])]
declSplices
graftSpliceWith ::
forall ast.
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs)) ->
Maybe (Either String WorkspaceEdit)
graftSpliceWith :: forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
expandeds =
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
expandeds forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SrcSpan
_, LocatedAn AnnListItem (ast GhcPs)
expanded) ->
DynFlags
-> ClientCapabilities
-> Uri
-> Graft (Either String) ParsedSource
-> Annotated ParsedSource
-> Either String WorkspaceEdit
transform
DynFlags
dflags
ClientCapabilities
clientCapabilities
Uri
uri
(forall l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spliceSpan forall a. Maybe a
Nothing) LocatedAn AnnListItem (ast GhcPs)
expanded)
Annotated ParsedSource
ps
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"No splice information found") (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall a b. (a -> b) -> a -> b
$
case SpliceContext
spliceContext of
SpliceContext
Expr -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (HsExpr GhcPs))
exprSuperSpans
SpliceContext
Pat ->
forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (Pat GhcPs))
_patSuperSpans
SpliceContext
HsType -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Maybe (SrcSpan, LocatedAn AnnListItem (ast GhcPs))
-> Maybe (Either String WorkspaceEdit)
graftSpliceWith Maybe (SrcSpan, LocatedAn AnnListItem (HsType GhcPs))
typeSuperSpans
SpliceContext
HsDecl ->
Maybe (SrcSpan, [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
declSuperSpans forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SrcSpan
_, [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
expanded) ->
DynFlags
-> ClientCapabilities
-> Uri
-> Graft (Either String) ParsedSource
-> Annotated ParsedSource
-> Either String WorkspaceEdit
transform
DynFlags
dflags
ClientCapabilities
clientCapabilities
Uri
uri
(forall a.
HasDecls a =>
SrcSpan -> [LHsDecl GhcPs] -> Graft (Either String) a
graftDecls (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spliceSpan forall a. Maybe a
Nothing) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
expanded)
Annotated ParsedSource
ps
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange Uri
uri Range
range
Maybe (Either ResponseError WorkspaceEdit)
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
NormalizedFilePath
fp <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
Either String WorkspaceEdit
eedits <-
( forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath
-> TcModuleResult -> ExceptT String IO WorkspaceEdit
withTypeChecked NormalizedFilePath
fp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT
(forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.TypeCheck" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck NormalizedFilePath
fp)
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> ExceptT String IO WorkspaceEdit
expandManually NormalizedFilePath
fp)
case Either String WorkspaceEdit
eedits of
Left String
err -> do
ReportEditor
reportEditor
MessageType
MtError
[Text
"Error during expanding splice: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
responseError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err)
Right WorkspaceEdit
edits ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right WorkspaceEdit
edits)
case Maybe (Either ResponseError WorkspaceEdit)
res of
Maybe (Either ResponseError WorkspaceEdit)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Value
Null
Just (Left ResponseError
err) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ResponseError
err
Just (Right WorkspaceEdit
edit) -> do
LspId 'WorkspaceApplyEdit
_ <- forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
sendRequest SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Value
Null
where
range :: Range
range = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
spliceSpan
srcSpan :: SrcSpan
srcSpan = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spliceSpan forall a. Maybe a
Nothing
setupHscEnv
:: IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv :: IdeState
-> NormalizedFilePath
-> ParsedModule
-> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags)
setupHscEnv IdeState
ideState NormalizedFilePath
fp ParsedModule
pm = do
HscEnvEq
hscEnvEq <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.ghcSessionDeps" IdeState
ideState forall a b. (a -> b) -> a -> b
$
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSessionDeps
GhcSessionDeps NormalizedFilePath
fp
let ps :: Annotated ParsedSource
ps = ParsedModule -> Annotated ParsedSource
annotateParsedSource ParsedModule
pm
hscEnv0 :: HscEnv
hscEnv0 = HscEnvEq -> HscEnv
hscEnvWithImportPaths HscEnvEq
hscEnvEq
modSum :: ModSummary
modSum = ParsedModule -> ModSummary
pm_mod_summary ParsedModule
pm
HscEnv
hscEnv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike HscEnv
hscEnv0 forall a b. (a -> b) -> a -> b
$ ModSummary -> DynFlags
ms_hspp_opts ModSummary
modSum
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotated ParsedSource
ps, HscEnv
hscEnv, HscEnv -> DynFlags
hsc_dflags HscEnv
hscEnv)
setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike HscEnv
env DynFlags
dflags = do
let dflags3 :: DynFlags
dflags3 = DynFlags -> DynFlags
setInterpreterLinkerOptions DynFlags
dflags
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags3
dflags3a :: DynFlags
dflags3a = Ways -> DynFlags -> DynFlags
setWays Ways
hostFullWays DynFlags
dflags3
dflags3b :: DynFlags
dflags3b =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflags3a forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
wayGeneralFlags Platform
platform) Ways
hostFullWays
dflags3c :: DynFlags
dflags3c =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
dflags3b forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
wayUnsetGeneralFlags Platform
platform) Ways
hostFullWays
dflags4 :: DynFlags
dflags4 =
DynFlags
dflags3c
DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_ImplicitImportQualified
DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_IgnoreOptimChanges
DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_IgnoreHpcChanges
DynFlags -> GeneralFlag -> DynFlags
`gopt_unset` GeneralFlag
Opt_DiagnosticsShowCaret
HscEnv -> IO HscEnv
initializePlugins (DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags4 HscEnv
env)
adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange Uri
uri Range
ran (WorkspaceEdit Maybe WorkspaceEditMap
mhult Maybe (List DocumentChange)
mlt Maybe ChangeAnnotationMap
x) =
Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> WorkspaceEditMap
adjustWS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe WorkspaceEditMap
mhult) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocumentChange -> DocumentChange
adjustDoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (List DocumentChange)
mlt) Maybe ChangeAnnotationMap
x
where
adjustTextEdits :: Traversable f => f TextEdit -> f TextEdit
adjustTextEdits :: forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits f TextEdit
eds =
let minStart :: Range
minStart =
case forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (forall a b r. (a -> b) -> Fold b r -> Fold a r
L.premap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasRange s a => Lens' s a
J.range) forall a. Ord a => Fold a (Maybe a)
L.minimum) f TextEdit
eds of
Maybe Range
Nothing -> forall a. HasCallStack => String -> a
error String
"impossible"
Just Range
v -> Range
v
in Range -> TextEdit -> TextEdit
adjustLine Range
minStart forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f TextEdit
eds
adjustATextEdits :: Traversable f => f (TextEdit |? AnnotatedTextEdit) -> f (TextEdit |? AnnotatedTextEdit)
adjustATextEdits :: forall (f :: * -> *).
Traversable f =>
f (TextEdit |? AnnotatedTextEdit)
-> f (TextEdit |? AnnotatedTextEdit)
adjustATextEdits = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \case
InL TextEdit
t -> forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits (forall a. a -> Identity a
Identity TextEdit
t)
InR AnnotatedTextEdit{Range
$sel:_range:AnnotatedTextEdit :: AnnotatedTextEdit -> Range
_range :: Range
_range, Text
$sel:_newText:AnnotatedTextEdit :: AnnotatedTextEdit -> Text
_newText :: Text
_newText, ChangeAnnotationIdentifier
$sel:_annotationId:AnnotatedTextEdit :: AnnotatedTextEdit -> ChangeAnnotationIdentifier
_annotationId :: ChangeAnnotationIdentifier
_annotationId} ->
let oldTE :: TextEdit
oldTE = TextEdit{Range
$sel:_range:TextEdit :: Range
_range :: Range
_range,Text
$sel:_newText:TextEdit :: Text
_newText :: Text
_newText}
in let TextEdit{Range
_range :: Range
$sel:_range:TextEdit :: TextEdit -> Range
_range,Text
_newText :: Text
$sel:_newText:TextEdit :: TextEdit -> Text
_newText} = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits (forall a. a -> Identity a
Identity TextEdit
oldTE)
in forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ AnnotatedTextEdit{Range
_range :: Range
$sel:_range:AnnotatedTextEdit :: Range
_range,Text
_newText :: Text
$sel:_newText:AnnotatedTextEdit :: Text
_newText,ChangeAnnotationIdentifier
$sel:_annotationId:AnnotatedTextEdit :: ChangeAnnotationIdentifier
_annotationId :: ChangeAnnotationIdentifier
_annotationId}
adjustWS :: WorkspaceEditMap -> WorkspaceEditMap
adjustWS = forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Uri
uri forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits
adjustDoc :: DocumentChange -> DocumentChange
adjustDoc :: DocumentChange -> DocumentChange
adjustDoc (InR CreateFile |? (RenameFile |? DeleteFile)
es) = forall a b. b -> a |? b
InR CreateFile |? (RenameFile |? DeleteFile)
es
adjustDoc (InL TextDocumentEdit
es)
| TextDocumentEdit
es forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri forall a. Eq a => a -> a -> Bool
== Uri
uri =
forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ TextDocumentEdit
es forall a b. a -> (a -> b) -> b
& forall s a. HasEdits s a => Lens' s a
J.edits forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *).
Traversable f =>
f (TextEdit |? AnnotatedTextEdit)
-> f (TextEdit |? AnnotatedTextEdit)
adjustATextEdits
| Bool
otherwise = forall a b. a -> a |? b
InL TextDocumentEdit
es
adjustLine :: Range -> TextEdit -> TextEdit
adjustLine :: Range -> TextEdit -> TextEdit
adjustLine Range
bad =
forall s a. HasRange s a => Lens' s a
J.range forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Range
r ->
if Range
r forall a. Eq a => a -> a -> Bool
== Range
bad then Range
ran else Range
bad
{-# COMPLETE AsSrcSpan #-}
#if MIN_VERSION_ghc(9,2,0)
pattern AsSrcSpan :: SrcSpan -> SrcSpanAnn' a
pattern $mAsSrcSpan :: forall {r} {a}.
SrcSpanAnn' a -> (SrcSpan -> r) -> ((# #) -> r) -> r
AsSrcSpan locA <- SrcSpanAnn {locA}
#else
pattern AsSrcSpan :: SrcSpan -> SrcSpan
pattern AsSrcSpan loc <- loc
#endif
findSubSpansDesc :: SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc :: forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan =
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SubSpan
SubSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
( \(L (AsSrcSpan SrcSpan
spn) HsExpr GhcTc
_, a
e) -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SrcSpan
spn SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
srcSpan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpan
spn, a
e)
)
data SpliceClass where
OneToOneAST :: HasSplice AnnListItem ast => Proxy# ast -> SpliceClass
IsHsDecl :: SpliceClass
class (Outputable (ast GhcRn), ASTElement l (ast GhcPs)) => HasSplice l ast where
type SpliceOf ast :: Kinds.Type -> Kinds.Type
type SpliceOf ast = HsSplice
matchSplice :: Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs)
expandSplice :: Proxy# ast -> SpliceOf ast GhcPs -> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars)
instance HasSplice AnnListItem HsExpr where
matchSplice :: Proxy# HsExpr -> HsExpr GhcPs -> Maybe (SpliceOf HsExpr GhcPs)
matchSplice Proxy# HsExpr
_ (HsSpliceE XSpliceE GhcPs
_ HsSplice GhcPs
spl) = forall a. a -> Maybe a
Just HsSplice GhcPs
spl
matchSplice Proxy# HsExpr
_ HsExpr GhcPs
_ = forall a. Maybe a
Nothing
expandSplice :: Proxy# HsExpr
-> SpliceOf HsExpr GhcPs
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
expandSplice Proxy# HsExpr
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnSpliceExpr
instance HasSplice AnnListItem Pat where
matchSplice :: Proxy# Pat -> Pat GhcPs -> Maybe (SpliceOf Pat GhcPs)
matchSplice Proxy# Pat
_ (SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
spl) = forall a. a -> Maybe a
Just HsSplice GhcPs
spl
matchSplice Proxy# Pat
_ Pat GhcPs
_ = forall a. Maybe a
Nothing
expandSplice :: Proxy# Pat
-> SpliceOf Pat GhcPs
-> RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
expandSplice Proxy# Pat
_ = HsSplice GhcPs -> RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
rnSplicePat
instance HasSplice AnnListItem HsType where
matchSplice :: Proxy# HsType -> HsType GhcPs -> Maybe (SpliceOf HsType GhcPs)
matchSplice Proxy# HsType
_ (HsSpliceTy XSpliceTy GhcPs
_ HsSplice GhcPs
spl) = forall a. a -> Maybe a
Just HsSplice GhcPs
spl
matchSplice Proxy# HsType
_ HsType GhcPs
_ = forall a. Maybe a
Nothing
expandSplice :: Proxy# HsType
-> SpliceOf HsType GhcPs
-> RnM (Either (HsType GhcPs) (HsType GhcRn), FreeVars)
expandSplice Proxy# HsType
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars)
rnSpliceType
classifyAST :: SpliceContext -> SpliceClass
classifyAST :: SpliceContext -> SpliceClass
classifyAST = \case
SpliceContext
Expr -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Proxy# ast -> SpliceClass
OneToOneAST @HsExpr forall {k} (a :: k). Proxy# a
proxy#
SpliceContext
HsDecl -> SpliceClass
IsHsDecl
SpliceContext
Pat -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Proxy# ast -> SpliceClass
OneToOneAST @Pat forall {k} (a :: k). Proxy# a
proxy#
SpliceContext
HsType -> forall (ast :: * -> *).
HasSplice AnnListItem ast =>
Proxy# ast -> SpliceClass
OneToOneAST @HsType forall {k} (a :: k). Proxy# a
proxy#
type ReportEditor = forall m. MonadIO m => MessageType -> [T.Text] -> m ()
manualCalcEdit ::
ClientCapabilities ->
ReportEditor ->
Range ->
Annotated ParsedSource ->
HscEnv ->
TcGblEnv ->
RealSrcSpan ->
ExpandStyle ->
ExpandSpliceParams ->
ExceptT String IO WorkspaceEdit
manualCalcEdit :: ClientCapabilities
-> ReportEditor
-> Range
-> Annotated ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT String IO WorkspaceEdit
manualCalcEdit ClientCapabilities
clientCapabilities ReportEditor
reportEditor Range
ran Annotated ParsedSource
ps HscEnv
hscEnv TcGblEnv
typechkd RealSrcSpan
srcSpan ExpandStyle
_eStyle ExpandSpliceParams {RealSrcSpan
Uri
SpliceContext
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
uri :: Uri
spliceContext :: ExpandSpliceParams -> SpliceContext
spliceSpan :: ExpandSpliceParams -> RealSrcSpan
uri :: ExpandSpliceParams -> Uri
..} = do
(Bag (MsgEnvelope DecoratedSDoc)
warns, WorkspaceEdit
resl) <-
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
(Messages DecoratedSDoc
msgs, Maybe (Either String WorkspaceEdit)
eresl) <-
forall r.
HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM r
-> IO (Messages DecoratedSDoc, Maybe r)
initTcWithGbl HscEnv
hscEnv TcGblEnv
typechkd RealSrcSpan
srcSpan forall a b. (a -> b) -> a -> b
$
case SpliceContext -> SpliceClass
classifyAST SpliceContext
spliceContext of
SpliceClass
IsHsDecl -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange Uri
uri Range
ran) forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> Uri
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
clientCapabilities Uri
uri) Annotated ParsedSource
ps forall a b. (a -> b) -> a -> b
$
forall a (m :: * -> *).
(HasDecls a, MonadFail m) =>
SrcSpan
-> (LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs]))
-> Graft m a
graftDeclsWithM (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
srcSpan forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ \case
(L SrcSpanAnnA
_spn (SpliceD XSpliceD GhcPs
_ (SpliceDecl XSpliceDecl GhcPs
_ (L SrcSpanAnnA
_ HsSplice GhcPs
spl) SpliceExplicitFlag
_))) -> do
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
eExpr <-
forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
( forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Util.try @_ @SomeException forall a b. (a -> b) -> a -> b
$
(forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
rnTopSpliceDecls HsSplice GhcPs
spl)
)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
eExpr
LHsDecl GhcPs
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
OneToOneAST Proxy# ast
astP ->
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> Uri
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
clientCapabilities Uri
uri) Annotated ParsedSource
ps forall a b. (a -> b) -> a -> b
$
forall ast (m :: * -> *) a l.
(MonadFail m, Data a, Typeable l, ASTElement l ast) =>
SrcSpan
-> (LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast)))
-> Graft m a
graftWithM (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
srcSpan forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ \case
(L SrcSpanAnnA
_spn (forall l (ast :: * -> *).
HasSplice l ast =>
Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs)
matchSplice Proxy# ast
astP -> Just SpliceOf ast GhcPs
spl)) -> do
Either (ast GhcPs) (ast GhcRn)
eExpr <-
forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
( forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Util.try @_ @SomeException forall a b. (a -> b) -> a -> b
$
(forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall l (ast :: * -> *).
HasSplice l ast =>
Proxy# ast
-> SpliceOf ast GhcPs
-> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars)
expandSplice Proxy# ast
astP SpliceOf ast GhcPs
spl)
)
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Either (ast GhcPs) (ast GhcRn)
eExpr of
Left ast GhcPs
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
_spn ast GhcPs
x
Right ast GhcRn
y -> forall (ast :: * -> *) (m :: * -> *) l.
(MonadFail m, HasSplice l ast) =>
DynFlags -> ast GhcRn -> TransformT m (LocatedAn l (ast GhcPs))
unRenamedE DynFlags
dflags ast GhcRn
y
LocatedAn AnnListItem (ast GhcPs)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
let (Bag (MsgEnvelope DecoratedSDoc)
warns, Bag (MsgEnvelope DecoratedSDoc)
errs) =
#if MIN_VERSION_ghc(9,2,0)
(forall e. Messages e -> Bag (MsgEnvelope e)
Error.getWarningMessages Messages DecoratedSDoc
msgs, forall e. Messages e -> Bag (MsgEnvelope e)
Error.getErrorMessages Messages DecoratedSDoc
msgs)
#else
msgs
#endif
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Bag (MsgEnvelope DecoratedSDoc)
warns,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors Bag (MsgEnvelope DecoratedSDoc)
errs) Maybe (Either String WorkspaceEdit)
eresl
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
(forall (t :: * -> *) a. Foldable t => t a -> Bool
null Bag (MsgEnvelope DecoratedSDoc)
warns)
forall a b. (a -> b) -> a -> b
$ ReportEditor
reportEditor
MessageType
MtWarning
[ Text
"Warning during expanding: "
, Text
""
, String -> Text
T.pack (Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors Bag (MsgEnvelope DecoratedSDoc)
warns)
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkspaceEdit
resl
where
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hscEnv
#if MIN_VERSION_ghc(9,4,1)
showErrors = showBag
#else
showErrors :: Bag (MsgEnvelope DecoratedSDoc) -> String
showErrors = forall a. Show a => a -> String
show
#endif
#if MIN_VERSION_ghc(9,4,1)
showBag :: Error.Diagnostic a => Bag (Error.MsgEnvelope a) -> String
showBag = show . fmap (fmap toDiagnosticMessage)
toDiagnosticMessage :: Error.Diagnostic a => a -> Error.DiagnosticMessage
toDiagnosticMessage message =
Error.DiagnosticMessage
{ diagMessage = Error.diagnosticMessage message
, diagReason = Error.diagnosticReason message
, diagHints = Error.diagnosticHints message
}
#endif
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 TextDocumentCodeAction
codeAction :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeAction IdeState
state PluginId
plId (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ TextDocumentIdentifier
docId Range
ran CodeActionContext
_) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List []) forall a b. b -> Either a b
Right) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
NormalizedFilePath
fp <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
theUri
ParsedModule {[String]
()
ModSummary
ParsedSource
pm_parsed_source :: ParsedModule -> ParsedSource
pm_extra_src_files :: ParsedModule -> [String]
pm_annotations :: ParsedModule -> ()
pm_annotations :: ()
pm_extra_src_files :: [String]
pm_parsed_source :: ParsedSource
pm_mod_summary :: ModSummary
pm_mod_summary :: ParsedModule -> ModSummary
..} <-
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> IdeState -> Action a -> IO a
runAction String
"splice.codeAction.GitHieAst" IdeState
state forall a b. (a -> b) -> a -> b
$
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModule
GetParsedModule NormalizedFilePath
fp
let spn :: RealSrcSpan
spn = NormalizedFilePath -> Range -> RealSrcSpan
rangeToRealSrcSpan NormalizedFilePath
fp Range
ran
mouterSplice :: Maybe (RealSrcSpan, SpliceContext)
mouterSplice = forall a. GenericQ (SearchResult a) -> GenericQ (Maybe a)
something' (RealSrcSpan -> GenericQ (SearchResult (RealSrcSpan, SpliceContext))
detectSplice RealSrcSpan
spn) ParsedSource
pm_parsed_source
Maybe [Command |? CodeAction]
mcmds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (RealSrcSpan, SpliceContext)
mouterSplice forall a b. (a -> b) -> a -> b
$
\(RealSrcSpan
spliceSpan, SpliceContext
spliceContext) ->
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(ExpandStyle, (Text, CommandId))]
expandStyles forall a b. (a -> b) -> a -> b
$ \(ExpandStyle
_, (Text
title, CommandId
cmdId)) -> do
let params :: ExpandSpliceParams
params = ExpandSpliceParams {uri :: Uri
uri = Uri
theUri, RealSrcSpan
SpliceContext
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
..}
act :: Command
act = PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plId CommandId
cmdId Text
title (forall a. a -> Maybe a
Just [forall a. ToJSON a => a -> Value
toJSON ExpandSpliceParams
params])
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$
Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction Text
title (forall a. a -> Maybe a
Just CodeActionKind
CodeActionRefactorRewrite) forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Command
act) forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. [a] -> List a
List Maybe [Command |? CodeAction]
mcmds
where
theUri :: Uri
theUri = TextDocumentIdentifier
docId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
J.uri
detectSplice ::
RealSrcSpan ->
GenericQ (SearchResult (RealSrcSpan, SpliceContext))
detectSplice :: RealSrcSpan -> GenericQ (SearchResult (RealSrcSpan, SpliceContext))
detectSplice RealSrcSpan
spn =
let
spanIsRelevant :: SrcSpan -> Bool
spanIsRelevant SrcSpan
x = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spn forall a. Maybe a
Nothing SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
x
in
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ
forall r. SearchResult r
Continue
( \case
(L (AsSrcSpan l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc Maybe BufSpan
_)) HsExpr GhcPs
expr :: LHsExpr GhcPs)
| SrcSpan -> Bool
spanIsRelevant SrcSpan
l ->
case HsExpr GhcPs
expr of
HsSpliceE {} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Expr)
HsExpr GhcPs
_ -> forall r. SearchResult r
Continue
LocatedAn AnnListItem (HsExpr GhcPs)
_ -> forall r. SearchResult r
Stop
)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` \case
#if __GLASGOW_HASKELL__ == 808
(dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc _) pat :: Located (Pat GhcPs))
#else
(L (AsSrcSpan l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc Maybe BufSpan
_)) Pat GhcPs
pat :: LPat GhcPs)
#endif
| SrcSpan -> Bool
spanIsRelevant SrcSpan
l ->
case Pat GhcPs
pat of
SplicePat{} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Pat)
Pat GhcPs
_ -> forall r. SearchResult r
Continue
LocatedAn AnnListItem (Pat GhcPs)
_ -> forall r. SearchResult r
Stop
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` \case
(L (AsSrcSpan l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc Maybe BufSpan
_)) HsType GhcPs
ty :: LHsType GhcPs)
| SrcSpan -> Bool
spanIsRelevant SrcSpan
l ->
case HsType GhcPs
ty of
HsSpliceTy {} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
HsType)
HsType GhcPs
_ -> forall r. SearchResult r
Continue
LocatedAn AnnListItem (HsType GhcPs)
_ -> forall r. SearchResult r
Stop
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` \case
(L (AsSrcSpan l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc Maybe BufSpan
_)) HsDecl GhcPs
decl :: LHsDecl GhcPs)
| SrcSpan -> Bool
spanIsRelevant SrcSpan
l ->
case HsDecl GhcPs
decl of
SpliceD {} -> forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
HsDecl)
HsDecl GhcPs
_ -> forall r. SearchResult r
Continue
GenLocated SrcSpanAnnA (HsDecl GhcPs)
_ -> forall r. SearchResult r
Stop
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)