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

module Ide.Plugin.Splice
    ( descriptor,
    )
where

import Control.Applicative (Alternative ((<|>)))
import Control.Arrow
import qualified Control.Foldl as L
import Control.Lens (ix, view, (%~), (<&>), (^.))
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Data.Aeson
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 hiding (getLoc)
import Exception
import GHC.Exts
import GhcMonad
import GhcPlugins hiding (Var, getLoc, (<>))
import Ide.Plugin.Splice.Types
import Ide.PluginUtils (mkLspCommand, responseError)
import Development.IDE.GHC.ExactPrint
import Ide.Types
import Language.Haskell.GHC.ExactPrint (TransformT, setPrecedingLines, uniqueSrcSpanT)
import Language.Haskell.LSP.Core
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Types.Lens as J
import Retrie.ExactPrint (Annotated)
import RnSplice
import TcRnMonad
import Data.Foldable (Foldable(foldl'))

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId =
    (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
        { pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState]
commands
        , pluginCodeActionProvider :: Maybe (CodeActionProvider IdeState)
pluginCodeActionProvider = CodeActionProvider IdeState -> Maybe (CodeActionProvider IdeState)
forall a. a -> Maybe a
Just CodeActionProvider IdeState
codeAction
        }

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

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

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

instance Ord SubSpan where
    <= :: SubSpan -> SubSpan -> Bool
(<=) = (SrcSpan -> SrcSpan -> Bool) -> SubSpan -> SubSpan -> Bool
coerce SrcSpan -> SrcSpan -> Bool
isSubspanOf

expandTHSplice ::
    -- | Inplace?
    ExpandStyle ->
    CommandFunction IdeState ExpandSpliceParams
expandTHSplice :: ExpandStyle -> CommandFunction IdeState ExpandSpliceParams
expandTHSplice ExpandStyle
_eStyle LspFuncs Config
lsp IdeState
ideState params :: ExpandSpliceParams
params@ExpandSpliceParams {RealSrcSpan
Uri
SpliceContext
spliceContext :: ExpandSpliceParams -> SpliceContext
spliceSpan :: ExpandSpliceParams -> RealSrcSpan
uri :: ExpandSpliceParams -> Uri
spliceContext :: SpliceContext
spliceSpan :: RealSrcSpan
uri :: Uri
..} =
    (Maybe
   (Either ResponseError Value,
    Maybe (ServerMethod, ApplyWorkspaceEditParams))
 -> (Either ResponseError Value,
     Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> IO
     (Maybe
        (Either ResponseError Value,
         Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> Maybe
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> (Either ResponseError Value,
    Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall a. a -> Maybe a -> a
fromMaybe (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall a a. (Either a Value, Maybe a)
defaultResult) (IO
   (Maybe
      (Either ResponseError Value,
       Maybe (ServerMethod, ApplyWorkspaceEditParams)))
 -> IO
      (Either ResponseError Value,
       Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> IO
     (Maybe
        (Either ResponseError Value,
         Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall a b. (a -> b) -> a -> b
$
        MaybeT
  IO
  (Either ResponseError Value,
   Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Maybe
        (Either ResponseError Value,
         Maybe (ServerMethod, ApplyWorkspaceEditParams)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   IO
   (Either ResponseError Value,
    Maybe (ServerMethod, ApplyWorkspaceEditParams))
 -> IO
      (Maybe
         (Either ResponseError Value,
          Maybe (ServerMethod, ApplyWorkspaceEditParams))))
-> MaybeT
     IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Maybe
        (Either ResponseError Value,
         Maybe (ServerMethod, ApplyWorkspaceEditParams)))
forall a b. (a -> b) -> a -> b
$ do

            NormalizedFilePath
fp <- IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath)
-> IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath))
-> Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath)
forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath (NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri -> Maybe NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
            Either String WorkspaceEdit
eedits <-
                ( IO (Either String WorkspaceEdit)
-> MaybeT IO (Either String WorkspaceEdit)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Either String WorkspaceEdit)
 -> MaybeT IO (Either String WorkspaceEdit))
-> (TcModuleResult -> IO (Either String WorkspaceEdit))
-> TcModuleResult
-> MaybeT IO (Either String WorkspaceEdit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String IO WorkspaceEdit -> IO (Either String WorkspaceEdit)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO WorkspaceEdit
 -> IO (Either String WorkspaceEdit))
-> (TcModuleResult -> ExceptT String IO WorkspaceEdit)
-> TcModuleResult
-> IO (Either String WorkspaceEdit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath
-> TcModuleResult -> ExceptT String IO WorkspaceEdit
withTypeChecked NormalizedFilePath
fp
                        (TcModuleResult -> MaybeT IO (Either String WorkspaceEdit))
-> MaybeT IO TcModuleResult
-> MaybeT IO (Either String WorkspaceEdit)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe TcModuleResult) -> MaybeT IO TcModuleResult
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT
                            (String
-> IdeState
-> Action (Maybe TcModuleResult)
-> IO (Maybe TcModuleResult)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.TypeCheck" IdeState
ideState (Action (Maybe TcModuleResult) -> IO (Maybe TcModuleResult))
-> Action (Maybe TcModuleResult) -> IO (Maybe TcModuleResult)
forall a b. (a -> b) -> a -> b
$ TypeCheck -> NormalizedFilePath -> Action (Maybe TcModuleResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck NormalizedFilePath
fp)
                    )
                    MaybeT IO (Either String WorkspaceEdit)
-> MaybeT IO (Either String WorkspaceEdit)
-> MaybeT IO (Either String WorkspaceEdit)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO (Either String WorkspaceEdit)
-> MaybeT IO (Either String WorkspaceEdit)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT String IO WorkspaceEdit -> IO (Either String WorkspaceEdit)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO WorkspaceEdit
 -> IO (Either String WorkspaceEdit))
-> ExceptT String IO WorkspaceEdit
-> IO (Either String WorkspaceEdit)
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
                    LspFuncs Config -> MessageType -> [Text] -> MaybeT IO ()
forall (m :: * -> *) a.
MonadIO m =>
LspFuncs a -> MessageType -> [Text] -> m ()
reportEditor
                        LspFuncs Config
lsp
                        MessageType
MtError
                        [Text
"Error during expanding splice: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err]
                    (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> MaybeT
     IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResponseError -> Either ResponseError Value
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError Value)
-> ResponseError -> Either ResponseError Value
forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
responseError (Text -> ResponseError) -> Text -> ResponseError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err, Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. Maybe a
Nothing)
                Right WorkspaceEdit
edits ->
                    (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> MaybeT
     IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                        ( Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
Null
                        , (ServerMethod, ApplyWorkspaceEditParams)
-> Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. a -> Maybe a
Just (ServerMethod
WorkspaceApplyEdit, WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
edits)
                        )
    where
        range :: Range
range = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
spliceSpan
        srcSpan :: SrcSpan
srcSpan = RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spliceSpan
        defaultResult :: (Either a Value, Maybe a)
defaultResult = (Value -> Either a Value
forall a b. b -> Either a b
Right Value
Null, Maybe a
forall a. Maybe a
Nothing)
        expandManually :: NormalizedFilePath -> ExceptT String IO WorkspaceEdit
expandManually NormalizedFilePath
fp = do
            Maybe (TcModuleResult, PositionMapping)
mresl <-
                IO (Maybe (TcModuleResult, PositionMapping))
-> ExceptT String IO (Maybe (TcModuleResult, PositionMapping))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (TcModuleResult, PositionMapping))
 -> ExceptT String IO (Maybe (TcModuleResult, PositionMapping)))
-> IO (Maybe (TcModuleResult, PositionMapping))
-> ExceptT String IO (Maybe (TcModuleResult, PositionMapping))
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action (Maybe (TcModuleResult, PositionMapping))
-> IO (Maybe (TcModuleResult, PositionMapping))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.TypeCheck (stale)" IdeState
ideState (Action (Maybe (TcModuleResult, PositionMapping))
 -> IO (Maybe (TcModuleResult, PositionMapping)))
-> Action (Maybe (TcModuleResult, PositionMapping))
-> IO (Maybe (TcModuleResult, PositionMapping))
forall a b. (a -> b) -> a -> b
$ TypeCheck
-> NormalizedFilePath
-> Action (Maybe (TcModuleResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale TypeCheck
TypeCheck NormalizedFilePath
fp
            (TcModuleResult {Bool
RenamedSource
ParsedModule
TcGblEnv
Splices
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferedError :: TcModuleResult -> Bool
tmrDeferedError :: Bool
tmrTopLevelSplices :: Splices
tmrTypechecked :: TcGblEnv
tmrRenamed :: RenamedSource
tmrParsed :: ParsedModule
..}, PositionMapping
_) <-
                ExceptT String IO (TcModuleResult, PositionMapping)
-> ((TcModuleResult, PositionMapping)
    -> ExceptT String IO (TcModuleResult, PositionMapping))
-> Maybe (TcModuleResult, PositionMapping)
-> ExceptT String IO (TcModuleResult, PositionMapping)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (String -> ExceptT String IO (TcModuleResult, PositionMapping)
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 (errornous) macro and expand splice again."
                )
                (TcModuleResult, PositionMapping)
-> ExceptT String IO (TcModuleResult, PositionMapping)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TcModuleResult, PositionMapping)
mresl
            LspFuncs Config -> MessageType -> [Text] -> ExceptT String IO ()
forall (m :: * -> *) a.
MonadIO m =>
LspFuncs a -> MessageType -> [Text] -> m ()
reportEditor
                LspFuncs Config
lsp
                MessageType
MtWarning
                [ Text
"Expansion in type-chcking phase failed;"
                , Text
"trying to expand manually, but note taht it is less rigorous."
                ]
            ParsedModule
pm <-
                IO ParsedModule -> ExceptT String IO ParsedModule
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ParsedModule -> ExceptT String IO ParsedModule)
-> IO ParsedModule -> ExceptT String IO ParsedModule
forall a b. (a -> b) -> a -> b
$
                    String -> IdeState -> Action ParsedModule -> IO ParsedModule
forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.GetParsedModule" IdeState
ideState (Action ParsedModule -> IO ParsedModule)
-> Action ParsedModule -> IO ParsedModule
forall a b. (a -> b) -> a -> b
$
                        GetParsedModule -> NormalizedFilePath -> Action ParsedModule
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

            LspFuncs Config
-> Range
-> Annotated ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT String IO WorkspaceEdit
forall a.
LspFuncs a
-> Range
-> Annotated ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT String IO WorkspaceEdit
manualCalcEdit
                LspFuncs Config
lsp
                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
Splices
tmrDeferedError :: Bool
tmrTopLevelSplices :: Splices
tmrTypechecked :: TcGblEnv
tmrRenamed :: RenamedSource
tmrParsed :: ParsedModule
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferedError :: TcModuleResult -> Bool
..} = 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, LPat GhcPs)]
[(LHsExpr GhcTc, LHsType 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, LHsExpr GhcPs)
exprSuperSpans =
                    [(SrcSpan, LHsExpr GhcPs)] -> Maybe (SrcSpan, LHsExpr GhcPs)
forall a. [a] -> Maybe a
listToMaybe ([(SrcSpan, LHsExpr GhcPs)] -> Maybe (SrcSpan, LHsExpr GhcPs))
-> [(SrcSpan, LHsExpr GhcPs)] -> Maybe (SrcSpan, LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> [(LHsExpr GhcTc, LHsExpr GhcPs)] -> [(SrcSpan, LHsExpr GhcPs)]
forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LHsExpr GhcPs)]
exprSplices
                _patSuperSpans :: Maybe (SrcSpan, Located (Pat GhcPs))
_patSuperSpans =
#if __GLASGOW_HASKELL__ == 808
                    fmap (second dL) $
#endif
                    [(SrcSpan, Located (Pat GhcPs))]
-> Maybe (SrcSpan, Located (Pat GhcPs))
forall a. [a] -> Maybe a
listToMaybe ([(SrcSpan, Located (Pat GhcPs))]
 -> Maybe (SrcSpan, Located (Pat GhcPs)))
-> [(SrcSpan, Located (Pat GhcPs))]
-> Maybe (SrcSpan, Located (Pat GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> [(LHsExpr GhcTc, Located (Pat GhcPs))]
-> [(SrcSpan, Located (Pat GhcPs))]
forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LPat GhcPs)]
[(LHsExpr GhcTc, Located (Pat GhcPs))]
patSplices
                typeSuperSpans :: Maybe (SrcSpan, LHsType GhcPs)
typeSuperSpans =
                    [(SrcSpan, LHsType GhcPs)] -> Maybe (SrcSpan, LHsType GhcPs)
forall a. [a] -> Maybe a
listToMaybe ([(SrcSpan, LHsType GhcPs)] -> Maybe (SrcSpan, LHsType GhcPs))
-> [(SrcSpan, LHsType GhcPs)] -> Maybe (SrcSpan, LHsType GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> [(LHsExpr GhcTc, LHsType GhcPs)] -> [(SrcSpan, LHsType GhcPs)]
forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, LHsType GhcPs)]
typeSplices
                declSuperSpans :: Maybe (SrcSpan, [LHsDecl GhcPs])
declSuperSpans =
                    [(SrcSpan, [LHsDecl GhcPs])] -> Maybe (SrcSpan, [LHsDecl GhcPs])
forall a. [a] -> Maybe a
listToMaybe ([(SrcSpan, [LHsDecl GhcPs])] -> Maybe (SrcSpan, [LHsDecl GhcPs]))
-> [(SrcSpan, [LHsDecl GhcPs])] -> Maybe (SrcSpan, [LHsDecl GhcPs])
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> [(LHsExpr GhcTc, [LHsDecl GhcPs])]
-> [(SrcSpan, [LHsDecl GhcPs])]
forall a. SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
findSubSpansDesc SrcSpan
srcSpan [(LHsExpr GhcTc, [LHsDecl GhcPs])]
declSplices

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

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

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

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 <-
        IO HscEnvEq -> ExceptT String IO HscEnvEq
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnvEq -> ExceptT String IO HscEnvEq)
-> IO HscEnvEq -> ExceptT String IO HscEnvEq
forall a b. (a -> b) -> a -> b
$
            String -> IdeState -> Action HscEnvEq -> IO HscEnvEq
forall a. String -> IdeState -> Action a -> IO a
runAction String
"expandTHSplice.fallback.ghcSessionDeps" IdeState
ideState (Action HscEnvEq -> IO HscEnvEq) -> Action HscEnvEq -> IO HscEnvEq
forall a b. (a -> b) -> a -> b
$
                GhcSessionDeps -> NormalizedFilePath -> Action HscEnvEq
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
    DynFlags
df' <- IO DynFlags -> ExceptT String IO DynFlags
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DynFlags -> ExceptT String IO DynFlags)
-> IO DynFlags -> ExceptT String IO DynFlags
forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags -> IO DynFlags
setupDynFlagsForGHCiLike HscEnv
hscEnv0 (DynFlags -> IO DynFlags) -> DynFlags -> IO DynFlags
forall a b. (a -> b) -> a -> b
$ ModSummary -> DynFlags
ms_hspp_opts ModSummary
modSum
    let hscEnv :: HscEnv
hscEnv = HscEnv
hscEnv0 { hsc_dflags :: DynFlags
hsc_dflags = DynFlags
df' }
    (Annotated ParsedSource, HscEnv, DynFlags)
-> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotated ParsedSource
ps, HscEnv
hscEnv, DynFlags
df')

setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags
setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags
setupDynFlagsForGHCiLike HscEnv
env DynFlags
dflags = do
    let dflags3 :: DynFlags
dflags3 =
            DynFlags
dflags
                { hscTarget :: HscTarget
hscTarget = HscTarget
HscInterpreted
                , ghcMode :: GhcMode
ghcMode = GhcMode
CompManager
                , ghcLink :: GhcLink
ghcLink = GhcLink
LinkInMemory
                }
        platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags3
        dflags3a :: DynFlags
dflags3a = DynFlags -> DynFlags
updateWays (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags
dflags3 {ways :: [Way]
ways = [Way]
interpWays}
        dflags3b :: DynFlags
dflags3b =
            (DynFlags -> GeneralFlag -> DynFlags)
-> DynFlags -> [GeneralFlag] -> DynFlags
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflags3a ([GeneralFlag] -> DynFlags) -> [GeneralFlag] -> DynFlags
forall a b. (a -> b) -> a -> b
$
                (Way -> [GeneralFlag]) -> [Way] -> [GeneralFlag]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
wayGeneralFlags Platform
platform) [Way]
interpWays
        dflags3c :: DynFlags
dflags3c =
            (DynFlags -> GeneralFlag -> DynFlags)
-> DynFlags -> [GeneralFlag] -> DynFlags
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
dflags3b ([GeneralFlag] -> DynFlags) -> [GeneralFlag] -> DynFlags
forall a b. (a -> b) -> a -> b
$
                (Way -> [GeneralFlag]) -> [Way] -> [GeneralFlag]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
wayUnsetGeneralFlags Platform
platform) [Way]
interpWays
        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 -> DynFlags -> IO DynFlags
initializePlugins HscEnv
env DynFlags
dflags4

adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange Uri
uri Range
ran (WorkspaceEdit Maybe WorkspaceEditMap
mhult Maybe (List TextDocumentEdit)
mlt) =
    Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> WorkspaceEditMap
adjustWS (WorkspaceEditMap -> WorkspaceEditMap)
-> Maybe WorkspaceEditMap -> Maybe WorkspaceEditMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe WorkspaceEditMap
mhult) ((TextDocumentEdit -> TextDocumentEdit)
-> List TextDocumentEdit -> List TextDocumentEdit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextDocumentEdit -> TextDocumentEdit
adjustDoc (List TextDocumentEdit -> List TextDocumentEdit)
-> Maybe (List TextDocumentEdit) -> Maybe (List TextDocumentEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (List TextDocumentEdit)
mlt)
    where
        adjustTextEdits :: Traversable f => f TextEdit -> f TextEdit
        adjustTextEdits :: f TextEdit -> f TextEdit
adjustTextEdits f TextEdit
eds =
            let Just Range
minStart =
                    Fold TextEdit (Maybe Range) -> f TextEdit -> Maybe Range
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold
                        ((TextEdit -> Range)
-> Fold Range (Maybe Range) -> Fold TextEdit (Maybe Range)
forall a b r. (a -> b) -> Fold b r -> Fold a r
L.premap (Getting Range TextEdit Range -> TextEdit -> Range
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Range TextEdit Range
forall s a. HasRange s a => Lens' s a
J.range) Fold Range (Maybe Range)
forall a. Ord a => Fold a (Maybe a)
L.minimum)
                        f TextEdit
eds
             in Range -> TextEdit -> TextEdit
adjustLine Range
minStart (TextEdit -> TextEdit) -> f TextEdit -> f TextEdit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f TextEdit
eds
        adjustWS :: WorkspaceEditMap -> WorkspaceEditMap
adjustWS = Index WorkspaceEditMap
-> Traversal' WorkspaceEditMap (IxValue WorkspaceEditMap)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Uri
Index WorkspaceEditMap
uri ((List TextEdit -> Identity (List TextEdit))
 -> WorkspaceEditMap -> Identity WorkspaceEditMap)
-> (List TextEdit -> List TextEdit)
-> WorkspaceEditMap
-> WorkspaceEditMap
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ List TextEdit -> List TextEdit
forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits
        adjustDoc :: TextDocumentEdit -> TextDocumentEdit
adjustDoc TextDocumentEdit
es
            | TextDocumentEdit
es TextDocumentEdit -> Getting Uri TextDocumentEdit Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (VersionedTextDocumentIdentifier
 -> Const Uri VersionedTextDocumentIdentifier)
-> TextDocumentEdit -> Const Uri TextDocumentEdit
forall s a. HasTextDocument s a => Lens' s a
J.textDocument ((VersionedTextDocumentIdentifier
  -> Const Uri VersionedTextDocumentIdentifier)
 -> TextDocumentEdit -> Const Uri TextDocumentEdit)
-> ((Uri -> Const Uri Uri)
    -> VersionedTextDocumentIdentifier
    -> Const Uri VersionedTextDocumentIdentifier)
-> Getting Uri TextDocumentEdit Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> VersionedTextDocumentIdentifier
-> Const Uri VersionedTextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
J.uri Uri -> Uri -> Bool
forall a. Eq a => a -> a -> Bool
== Uri
uri =
                TextDocumentEdit
es TextDocumentEdit
-> (TextDocumentEdit -> TextDocumentEdit) -> TextDocumentEdit
forall a b. a -> (a -> b) -> b
& (List TextEdit -> Identity (List TextEdit))
-> TextDocumentEdit -> Identity TextDocumentEdit
forall s a. HasEdits s a => Lens' s a
J.edits ((List TextEdit -> Identity (List TextEdit))
 -> TextDocumentEdit -> Identity TextDocumentEdit)
-> (List TextEdit -> List TextEdit)
-> TextDocumentEdit
-> TextDocumentEdit
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ List TextEdit -> List TextEdit
forall (f :: * -> *). Traversable f => f TextEdit -> f TextEdit
adjustTextEdits
            | Bool
otherwise = TextDocumentEdit
es

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

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

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

class (Outputable (ast GhcRn), ASTElement (ast GhcPs)) => HasSplice 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 HsExpr where
    matchSplice :: Proxy# HsExpr -> HsExpr GhcPs -> Maybe (SpliceOf HsExpr GhcPs)
matchSplice Proxy# HsExpr
_ (HsSpliceE XSpliceE GhcPs
_ HsSplice GhcPs
spl) = HsSplice GhcPs -> Maybe (HsSplice GhcPs)
forall a. a -> Maybe a
Just HsSplice GhcPs
spl
    matchSplice Proxy# HsExpr
_ HsExpr GhcPs
_ = Maybe (SpliceOf HsExpr GhcPs)
forall a. Maybe a
Nothing
    expandSplice :: Proxy# HsExpr
-> SpliceOf HsExpr GhcPs
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
expandSplice Proxy# HsExpr
_ = ((HsExpr GhcRn, FreeVars)
 -> (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars))
-> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HsExpr GhcRn -> Either (HsExpr GhcPs) (HsExpr GhcRn))
-> (HsExpr GhcRn, FreeVars)
-> (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first HsExpr GhcRn -> Either (HsExpr GhcPs) (HsExpr GhcRn)
forall a b. b -> Either a b
Right) (IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
 -> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars))
-> (HsSplice GhcPs
    -> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars))
-> HsSplice GhcPs
-> RnM (Either (HsExpr GhcPs) (HsExpr GhcRn), FreeVars)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSplice GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcRn, FreeVars)
rnSpliceExpr

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


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

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

reportEditor :: MonadIO m => LspFuncs a -> MessageType -> [T.Text] -> m ()
reportEditor :: LspFuncs a -> MessageType -> [Text] -> m ()
reportEditor LspFuncs a
lsp MessageType
msgTy [Text]
msgs =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
        LspFuncs a -> SendFunc
forall c. LspFuncs c -> SendFunc
sendFunc LspFuncs a
lsp SendFunc -> SendFunc
forall a b. (a -> b) -> a -> b
$
            ShowMessageNotification -> FromServerMessage
NotShowMessage (ShowMessageNotification -> FromServerMessage)
-> ShowMessageNotification -> FromServerMessage
forall a b. (a -> b) -> a -> b
$
                Text
-> ServerMethod -> ShowMessageParams -> ShowMessageNotification
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ServerMethod
WindowShowMessage (ShowMessageParams -> ShowMessageNotification)
-> ShowMessageParams -> ShowMessageNotification
forall a b. (a -> b) -> a -> b
$
                    MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
msgTy (Text -> ShowMessageParams) -> Text -> ShowMessageParams
forall a b. (a -> b) -> a -> b
$
                        [Text] -> Text
T.unlines [Text]
msgs

manualCalcEdit ::
    LspFuncs a ->
    Range ->
    Annotated ParsedSource ->
    HscEnv ->
    TcGblEnv ->
    RealSrcSpan ->
    ExpandStyle ->
    ExpandSpliceParams ->
    ExceptT String IO WorkspaceEdit
manualCalcEdit :: LspFuncs a
-> Range
-> Annotated ParsedSource
-> HscEnv
-> TcGblEnv
-> RealSrcSpan
-> ExpandStyle
-> ExpandSpliceParams
-> ExceptT String IO WorkspaceEdit
manualCalcEdit LspFuncs a
lsp 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
    (WarningMessages
warns, WorkspaceEdit
resl) <-
        IO (Either String (WarningMessages, WorkspaceEdit))
-> ExceptT String IO (WarningMessages, WorkspaceEdit)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String (WarningMessages, WorkspaceEdit))
 -> ExceptT String IO (WarningMessages, WorkspaceEdit))
-> IO (Either String (WarningMessages, WorkspaceEdit))
-> ExceptT String IO (WarningMessages, WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$ do
            ((WarningMessages
warns, WarningMessages
errs), Maybe (Either String WorkspaceEdit)
eresl) <-
                HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM (Either String WorkspaceEdit)
-> IO (Messages, Maybe (Either String WorkspaceEdit))
forall r.
HscEnv
-> TcGblEnv -> RealSrcSpan -> TcM r -> IO (Messages, Maybe r)
initTcWithGbl HscEnv
hscEnv TcGblEnv
typechkd RealSrcSpan
srcSpan (TcM (Either String WorkspaceEdit)
 -> IO (Messages, Maybe (Either String WorkspaceEdit)))
-> TcM (Either String WorkspaceEdit)
-> IO (Messages, Maybe (Either String WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$
                    case SpliceContext -> SpliceClass
classifyAST SpliceContext
spliceContext of
                        SpliceClass
IsHsDecl -> (Either String WorkspaceEdit -> Either String WorkspaceEdit)
-> TcM (Either String WorkspaceEdit)
-> TcM (Either String WorkspaceEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WorkspaceEdit -> WorkspaceEdit)
-> Either String WorkspaceEdit -> Either String WorkspaceEdit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WorkspaceEdit -> WorkspaceEdit)
 -> Either String WorkspaceEdit -> Either String WorkspaceEdit)
-> (WorkspaceEdit -> WorkspaceEdit)
-> Either String WorkspaceEdit
-> Either String WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange Uri
uri Range
ran) (TcM (Either String WorkspaceEdit)
 -> TcM (Either String WorkspaceEdit))
-> TcM (Either String WorkspaceEdit)
-> TcM (Either String WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$
                            (Graft (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
 -> Annotated ParsedSource -> TcM (Either String WorkspaceEdit))
-> Annotated ParsedSource
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> TcM (Either String WorkspaceEdit)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DynFlags
-> ClientCapabilities
-> Uri
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> Annotated ParsedSource
-> TcM (Either String WorkspaceEdit)
forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> Uri
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags (LspFuncs a -> ClientCapabilities
forall c. LspFuncs c -> ClientCapabilities
clientCapabilities LspFuncs a
lsp) Uri
uri) Annotated ParsedSource
ps (Graft (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
 -> TcM (Either String WorkspaceEdit))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> TcM (Either String WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$
                                SrcSpan
-> (LHsDecl GhcPs
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Maybe [LHsDecl GhcPs]))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
forall a (m :: * -> *).
(HasDecls a, MonadFail m) =>
SrcSpan
-> (LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs]))
-> Graft m a
graftDeclsWithM (RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
srcSpan) ((LHsDecl GhcPs
  -> TransformT
       (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
       (Maybe [LHsDecl GhcPs]))
 -> Graft
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource)
-> (LHsDecl GhcPs
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Maybe [LHsDecl GhcPs]))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
forall a b. (a -> b) -> a -> b
$ \case
                                    (L SrcSpan
_spn (SpliceD XSpliceD GhcPs
_ (SpliceDecl XSpliceDecl GhcPs
_ (L SrcSpan
_ HsSplice GhcPs
spl) SpliceExplicitFlag
_))) -> do
                                        [LHsDecl GhcPs]
eExpr <-
                                            (SomeException
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) [LHsDecl GhcPs])
-> ([LHsDecl GhcPs]
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) [LHsDecl GhcPs])
-> Either SomeException [LHsDecl GhcPs]
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) [LHsDecl GhcPs]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) [LHsDecl GhcPs]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) [LHsDecl GhcPs])
-> (SomeException -> String)
-> SomeException
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) [LHsDecl GhcPs]
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) [LHsDecl GhcPs]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                                                (Either SomeException [LHsDecl GhcPs]
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) [LHsDecl GhcPs])
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException [LHsDecl GhcPs])
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) [LHsDecl GhcPs]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptStringT
  (IOEnv (Env TcGblEnv TcLclEnv))
  (Either SomeException [LHsDecl GhcPs])
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException [LHsDecl GhcPs])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
                                                    ( IOEnv
  (Env TcGblEnv TcLclEnv) (Either SomeException [LHsDecl GhcPs])
-> ExceptStringT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Either SomeException [LHsDecl GhcPs])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv
   (Env TcGblEnv TcLclEnv) (Either SomeException [LHsDecl GhcPs])
 -> ExceptStringT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (Either SomeException [LHsDecl GhcPs]))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Either SomeException [LHsDecl GhcPs])
-> ExceptStringT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Either SomeException [LHsDecl GhcPs])
forall a b. (a -> b) -> a -> b
$
                                                        forall a.
(ExceptionMonad (IOEnv (Env TcGblEnv TcLclEnv)),
 Exception SomeException) =>
IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) (Either SomeException a)
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> m (Either e a)
gtry @_ @SomeException (IOEnv (Env TcGblEnv TcLclEnv) [LHsDecl GhcPs]
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (Either SomeException [LHsDecl GhcPs]))
-> IOEnv (Env TcGblEnv TcLclEnv) [LHsDecl GhcPs]
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Either SomeException [LHsDecl GhcPs])
forall a b. (a -> b) -> a -> b
$
                                                            (([LHsDecl GhcPs], FreeVars) -> [LHsDecl GhcPs]
forall a b. (a, b) -> a
fst (([LHsDecl GhcPs], FreeVars) -> [LHsDecl GhcPs])
-> IOEnv (Env TcGblEnv TcLclEnv) ([LHsDecl GhcPs], FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) [LHsDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsSplice GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) ([LHsDecl GhcPs], FreeVars)
rnTopSpliceDecls HsSplice GhcPs
spl)
                                                    )
                                        Maybe [LHsDecl GhcPs]
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Maybe [LHsDecl GhcPs])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [LHsDecl GhcPs]
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Maybe [LHsDecl GhcPs]))
-> Maybe [LHsDecl GhcPs]
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Maybe [LHsDecl GhcPs])
forall a b. (a -> b) -> a -> b
$ [LHsDecl GhcPs] -> Maybe [LHsDecl GhcPs]
forall a. a -> Maybe a
Just [LHsDecl GhcPs]
eExpr
                                    LHsDecl GhcPs
_ -> Maybe [LHsDecl GhcPs]
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Maybe [LHsDecl GhcPs])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [LHsDecl GhcPs]
forall a. Maybe a
Nothing
                        OneToOneAST Proxy# ast
astP ->
                            (Graft (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
 -> Annotated ParsedSource -> TcM (Either String WorkspaceEdit))
-> Annotated ParsedSource
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> TcM (Either String WorkspaceEdit)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DynFlags
-> ClientCapabilities
-> Uri
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> Annotated ParsedSource
-> TcM (Either String WorkspaceEdit)
forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> Uri
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags (LspFuncs a -> ClientCapabilities
forall c. LspFuncs c -> ClientCapabilities
clientCapabilities LspFuncs a
lsp) Uri
uri) Annotated ParsedSource
ps (Graft (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
 -> TcM (Either String WorkspaceEdit))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
-> TcM (Either String WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$
                                SrcSpan
-> (Located (ast GhcPs)
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Maybe (Located (ast GhcPs))))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
forall ast (m :: * -> *) a.
(MonadFail m, Data a, ASTElement ast) =>
SrcSpan
-> (Located ast -> TransformT m (Maybe (Located ast))) -> Graft m a
graftWithM (RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
srcSpan) ((Located (ast GhcPs)
  -> TransformT
       (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
       (Maybe (Located (ast GhcPs))))
 -> Graft
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource)
-> (Located (ast GhcPs)
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Maybe (Located (ast GhcPs))))
-> Graft
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv))) ParsedSource
forall a b. (a -> b) -> a -> b
$ \case
                                    (L SrcSpan
_spn (Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs)
forall (ast :: * -> *).
HasSplice ast =>
Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs)
matchSplice Proxy# ast
astP -> Just SpliceOf ast GhcPs
spl)) -> do
                                        Either (ast GhcPs) (ast GhcRn)
eExpr <-
                                            (SomeException
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Either (ast GhcPs) (ast GhcRn)))
-> (Either (ast GhcPs) (ast GhcRn)
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Either (ast GhcPs) (ast GhcRn)))
-> Either SomeException (Either (ast GhcPs) (ast GhcRn))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either (ast GhcPs) (ast GhcRn))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either (ast GhcPs) (ast GhcRn))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Either (ast GhcPs) (ast GhcRn)))
-> (SomeException -> String)
-> SomeException
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either (ast GhcPs) (ast GhcRn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) Either (ast GhcPs) (ast GhcRn)
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either (ast GhcPs) (ast GhcRn))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                                                (Either SomeException (Either (ast GhcPs) (ast GhcRn))
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Either (ast GhcPs) (ast GhcRn)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either (ast GhcPs) (ast GhcRn))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptStringT
  (IOEnv (Env TcGblEnv TcLclEnv))
  (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
                                                    ( IOEnv
  (Env TcGblEnv TcLclEnv)
  (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> ExceptStringT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv
   (Env TcGblEnv TcLclEnv)
   (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
 -> ExceptStringT
      (IOEnv (Env TcGblEnv TcLclEnv))
      (Either SomeException (Either (ast GhcPs) (ast GhcRn))))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
-> ExceptStringT
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
forall a b. (a -> b) -> a -> b
$
                                                        forall a.
(ExceptionMonad (IOEnv (Env TcGblEnv TcLclEnv)),
 Exception SomeException) =>
IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) (Either SomeException a)
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> m (Either e a)
gtry @_ @SomeException (IOEnv (Env TcGblEnv TcLclEnv) (Either (ast GhcPs) (ast GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (Either SomeException (Either (ast GhcPs) (ast GhcRn))))
-> IOEnv (Env TcGblEnv TcLclEnv) (Either (ast GhcPs) (ast GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Either SomeException (Either (ast GhcPs) (ast GhcRn)))
forall a b. (a -> b) -> a -> b
$
                                                            ((Either (ast GhcPs) (ast GhcRn), FreeVars)
-> Either (ast GhcPs) (ast GhcRn)
forall a b. (a, b) -> a
fst ((Either (ast GhcPs) (ast GhcRn), FreeVars)
 -> Either (ast GhcPs) (ast GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Either (ast GhcPs) (ast GhcRn), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Either (ast GhcPs) (ast GhcRn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy# ast
-> SpliceOf ast GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Either (ast GhcPs) (ast GhcRn), FreeVars)
forall (ast :: * -> *).
HasSplice ast =>
Proxy# ast
-> SpliceOf ast GhcPs
-> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars)
expandSplice Proxy# ast
astP SpliceOf ast GhcPs
spl)
                                                    )
                                        Located (ast GhcPs) -> Maybe (Located (ast GhcPs))
forall a. a -> Maybe a
Just (Located (ast GhcPs) -> Maybe (Located (ast GhcPs)))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Located (ast GhcPs))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Maybe (Located (ast GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ast GhcPs
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Located (ast GhcPs)))
-> (ast GhcRn
    -> TransformT
         (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
         (Located (ast GhcPs)))
-> Either (ast GhcPs) (ast GhcRn)
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Located (ast GhcPs))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Located (ast GhcPs)
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Located (ast GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Located (ast GhcPs)
 -> TransformT
      (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
      (Located (ast GhcPs)))
-> (ast GhcPs -> Located (ast GhcPs))
-> ast GhcPs
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Located (ast GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> ast GhcPs -> Located (ast GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
_spn) (DynFlags
-> ast GhcRn
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Located (ast GhcPs))
forall (ast :: * -> *) (m :: * -> *).
(MonadFail m, HasSplice ast) =>
DynFlags -> ast GhcRn -> TransformT m (Located (ast GhcPs))
unRenamedE DynFlags
dflags) Either (ast GhcPs) (ast GhcRn)
eExpr
                                    Located (ast GhcPs)
_ -> Maybe (Located (ast GhcPs))
-> TransformT
     (ExceptStringT (IOEnv (Env TcGblEnv TcLclEnv)))
     (Maybe (Located (ast GhcPs)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Located (ast GhcPs))
forall a. Maybe a
Nothing
            Either String (WarningMessages, WorkspaceEdit)
-> IO (Either String (WarningMessages, WorkspaceEdit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (WarningMessages, WorkspaceEdit)
 -> IO (Either String (WarningMessages, WorkspaceEdit)))
-> Either String (WarningMessages, WorkspaceEdit)
-> IO (Either String (WarningMessages, WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$ (WarningMessages
warns,) (WorkspaceEdit -> (WarningMessages, WorkspaceEdit))
-> Either String WorkspaceEdit
-> Either String (WarningMessages, WorkspaceEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String WorkspaceEdit
-> Maybe (Either String WorkspaceEdit)
-> Either String WorkspaceEdit
forall a. a -> Maybe a -> a
fromMaybe (String -> Either String WorkspaceEdit
forall a b. a -> Either a b
Left (String -> Either String WorkspaceEdit)
-> String -> Either String WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ WarningMessages -> String
forall a. Show a => a -> String
show WarningMessages
errs) Maybe (Either String WorkspaceEdit)
eresl

    Bool -> ExceptT String IO () -> ExceptT String IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
        (WarningMessages -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null WarningMessages
warns)
        (ExceptT String IO () -> ExceptT String IO ())
-> ExceptT String IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ LspFuncs a -> MessageType -> [Text] -> ExceptT String IO ()
forall (m :: * -> *) a.
MonadIO m =>
LspFuncs a -> MessageType -> [Text] -> m ()
reportEditor
            LspFuncs a
lsp
            MessageType
MtWarning
            [ Text
"Warning during expanding: "
            , Text
""
            , String -> Text
T.pack (WarningMessages -> String
forall a. Show a => a -> String
show WarningMessages
warns)
            ]
    WorkspaceEdit -> ExceptT String IO WorkspaceEdit
forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkspaceEdit
resl
    where
        dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hscEnv

-- | FIXME:  Is thereAny "clever" way to do this exploiting TTG?
unRenamedE ::
    forall ast m.
    (Fail.MonadFail m, HasSplice ast) =>
    DynFlags ->
    ast GhcRn ->
    TransformT m (Located (ast GhcPs))
unRenamedE :: DynFlags -> ast GhcRn -> TransformT m (Located (ast GhcPs))
unRenamedE DynFlags
dflags ast GhcRn
expr = do
    String
uniq <- SrcSpan -> String
forall a. Show a => a -> String
show (SrcSpan -> String) -> TransformT m SrcSpan -> TransformT m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransformT m SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
    (Anns
anns, Located (ast GhcPs)
expr') <-
        (WarningMessages -> TransformT m (Anns, Located (ast GhcPs)))
-> ((Anns, Located (ast GhcPs))
    -> TransformT m (Anns, Located (ast GhcPs)))
-> Either WarningMessages (Anns, Located (ast GhcPs))
-> TransformT m (Anns, Located (ast GhcPs))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> TransformT m (Anns, Located (ast GhcPs))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> TransformT m (Anns, Located (ast GhcPs)))
-> (WarningMessages -> String)
-> WarningMessages
-> TransformT m (Anns, Located (ast GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WarningMessages -> String
forall a. Show a => a -> String
show) (Anns, Located (ast GhcPs))
-> TransformT m (Anns, Located (ast GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either WarningMessages (Anns, Located (ast GhcPs))
 -> TransformT m (Anns, Located (ast GhcPs)))
-> Either WarningMessages (Anns, Located (ast GhcPs))
-> TransformT m (Anns, Located (ast GhcPs))
forall a b. (a -> b) -> a -> b
$
            Parser (Located (ast GhcPs))
forall ast. ASTElement ast => Parser (Located ast)
parseAST @(ast GhcPs) DynFlags
dflags String
uniq (String -> Either WarningMessages (Anns, Located (ast GhcPs)))
-> String -> Either WarningMessages (Anns, Located (ast GhcPs))
forall a b. (a -> b) -> a -> b
$
                DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ ast GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr ast GhcRn
expr
    let _anns' :: Anns
_anns' = Located (ast GhcPs) -> Int -> Int -> Anns -> Anns
forall a. Data a => Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines Located (ast GhcPs)
expr' Int
0 Int
1 Anns
anns
    Located (ast GhcPs) -> TransformT m (Located (ast GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located (ast GhcPs)
expr'

data SearchResult r =
    Continue | Stop | Here r
    deriving (ReadPrec [SearchResult r]
ReadPrec (SearchResult r)
Int -> ReadS (SearchResult r)
ReadS [SearchResult r]
(Int -> ReadS (SearchResult r))
-> ReadS [SearchResult r]
-> ReadPrec (SearchResult r)
-> ReadPrec [SearchResult r]
-> Read (SearchResult r)
forall r. Read r => ReadPrec [SearchResult r]
forall r. Read r => ReadPrec (SearchResult r)
forall r. Read r => Int -> ReadS (SearchResult r)
forall r. Read r => ReadS [SearchResult r]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
[SearchResult r] -> ShowS
SearchResult r -> String
(Int -> SearchResult r -> ShowS)
-> (SearchResult r -> String)
-> ([SearchResult r] -> ShowS)
-> Show (SearchResult r)
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
(SearchResult r -> SearchResult r -> Bool)
-> (SearchResult r -> SearchResult r -> Bool)
-> Eq (SearchResult r)
forall r. Eq r => SearchResult r -> SearchResult r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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, Eq (SearchResult r)
Eq (SearchResult r)
-> (SearchResult r -> SearchResult r -> Ordering)
-> (SearchResult r -> SearchResult r -> Bool)
-> (SearchResult r -> SearchResult r -> Bool)
-> (SearchResult r -> SearchResult r -> Bool)
-> (SearchResult r -> SearchResult r -> Bool)
-> (SearchResult r -> SearchResult r -> SearchResult r)
-> (SearchResult r -> SearchResult r -> SearchResult r)
-> Ord (SearchResult r)
SearchResult r -> SearchResult r -> Bool
SearchResult r -> SearchResult r -> Ordering
SearchResult r -> SearchResult r -> SearchResult r
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall r. Ord r => Eq (SearchResult r)
forall r. Ord r => SearchResult r -> SearchResult r -> Bool
forall r. Ord r => SearchResult r -> SearchResult r -> Ordering
forall r.
Ord r =>
SearchResult r -> SearchResult r -> SearchResult r
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
$cp1Ord :: forall r. Ord r => Eq (SearchResult r)
Ord, Typeable (SearchResult r)
DataType
Constr
Typeable (SearchResult r)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (SearchResult r))
-> (SearchResult r -> Constr)
-> (SearchResult r -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (SearchResult r)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (SearchResult r)))
-> ((forall b. Data b => b -> b)
    -> SearchResult r -> SearchResult r)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SearchResult r -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SearchResult r -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SearchResult r -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SearchResult r -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SearchResult r -> m (SearchResult r))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SearchResult r -> m (SearchResult r))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SearchResult r -> m (SearchResult r))
-> Data (SearchResult r)
SearchResult r -> DataType
SearchResult r -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (SearchResult r))
(forall b. Data b => b -> b) -> SearchResult r -> SearchResult r
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SearchResult r)
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 u.
Int -> (forall d. Data d => d -> u) -> SearchResult r -> u
forall u. (forall d. Data d => d -> u) -> SearchResult r -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchResult r -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchResult r -> m (SearchResult r)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SearchResult r)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SearchResult r -> c (SearchResult r)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SearchResult r))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SearchResult r))
$cHere :: Constr
$cStop :: Constr
$cContinue :: Constr
$tSearchResult :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> SearchResult r -> [u]
$cgmapQ :: forall r u.
Data r =>
(forall d. Data d => d -> u) -> SearchResult r -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall r. Data r => Typeable (SearchResult r)
Data, Typeable)

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

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

            List CAResult -> MaybeT IO (List CAResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List CAResult -> MaybeT IO (List CAResult))
-> List CAResult -> MaybeT IO (List CAResult)
forall a b. (a -> b) -> a -> b
$ List CAResult
-> ([CAResult] -> List CAResult)
-> Maybe [CAResult]
-> List CAResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe List CAResult
forall a. Monoid a => a
mempty [CAResult] -> List CAResult
forall a. [a] -> List a
List Maybe [CAResult]
mcmds
    where
        theUri :: Uri
theUri = TextDocumentIdentifier
docId TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
J.uri
        detectSplice ::
            RealSrcSpan ->
            GenericQ (SearchResult (RealSrcSpan, SpliceContext))
        detectSplice :: RealSrcSpan -> GenericQ (SearchResult (RealSrcSpan, SpliceContext))
detectSplice RealSrcSpan
spn =
            SearchResult (RealSrcSpan, SpliceContext)
-> (LHsExpr GhcPs -> SearchResult (RealSrcSpan, SpliceContext))
-> a
-> SearchResult (RealSrcSpan, SpliceContext)
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ
                SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Continue
                ( \case
                    (L l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc) HsExpr GhcPs
expr :: LHsExpr GhcPs)
                        | RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spn SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
l ->
                            case HsExpr GhcPs
expr of
                                HsSpliceE {} -> (RealSrcSpan, SpliceContext)
-> SearchResult (RealSrcSpan, SpliceContext)
forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Expr)
                                HsExpr GhcPs
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Continue
                    LHsExpr GhcPs
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Stop
                )
                (a -> SearchResult (RealSrcSpan, SpliceContext))
-> (Located (Pat GhcPs)
    -> SearchResult (RealSrcSpan, SpliceContext))
-> a
-> SearchResult (RealSrcSpan, SpliceContext)
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 l@(RealSrcSpan spLoc) pat :: LPat GhcPs)
#endif
                        | RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spn SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
l ->
                            case Pat GhcPs
pat of
                                SplicePat{} -> (RealSrcSpan, SpliceContext)
-> SearchResult (RealSrcSpan, SpliceContext)
forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
Pat)
                                Pat GhcPs
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Continue
                    Located (Pat GhcPs)
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Stop
                (a -> SearchResult (RealSrcSpan, SpliceContext))
-> (LHsType GhcPs -> SearchResult (RealSrcSpan, SpliceContext))
-> a
-> SearchResult (RealSrcSpan, SpliceContext)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` \case
                    (L l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc) HsType GhcPs
ty :: LHsType GhcPs)
                        | RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spn SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
l ->
                            case HsType GhcPs
ty of
                                HsSpliceTy {} -> (RealSrcSpan, SpliceContext)
-> SearchResult (RealSrcSpan, SpliceContext)
forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
HsType)
                                HsType GhcPs
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Continue
                    LHsType GhcPs
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Stop
                (a -> SearchResult (RealSrcSpan, SpliceContext))
-> (LHsDecl GhcPs -> SearchResult (RealSrcSpan, SpliceContext))
-> a
-> SearchResult (RealSrcSpan, SpliceContext)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` \case
                    (L l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
spLoc) HsDecl GhcPs
decl :: LHsDecl GhcPs)
                        | RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
spn SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
l ->
                            case HsDecl GhcPs
decl of
                                SpliceD {} -> (RealSrcSpan, SpliceContext)
-> SearchResult (RealSrcSpan, SpliceContext)
forall r. r -> SearchResult r
Here (RealSrcSpan
spLoc, SpliceContext
HsDecl)
                                HsDecl GhcPs
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Continue
                    LHsDecl GhcPs
_ -> SearchResult (RealSrcSpan, SpliceContext)
forall r. SearchResult r
Stop

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

posToRealSrcLoc :: Position -> FastString -> RealSrcLoc
posToRealSrcLoc :: Position -> FastString -> RealSrcLoc
posToRealSrcLoc Position
pos FastString
fs = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
fs (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    where
        line :: Int
line = Position -> Int
_line Position
pos
        col :: Int
col = Position -> Int
_character Position
pos

rangeToRealSrcSpan :: Range -> FastString -> RealSrcSpan
rangeToRealSrcSpan :: Range -> FastString -> RealSrcSpan
rangeToRealSrcSpan Range
ran FastString
fs =
    RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan
        (Position -> FastString -> RealSrcLoc
posToRealSrcLoc (Range -> Position
_start Range
ran) FastString
fs)
        (Position -> FastString -> RealSrcLoc
posToRealSrcLoc (Range -> Position
_end Range
ran) FastString
fs)