{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ide.Plugin.Tactic.LanguageServer where
import Control.Arrow
import Control.Monad
import Control.Monad.Trans.Maybe
import Data.Aeson (Value (Object), fromJSON)
import Data.Aeson.Types (Result (Error, Success))
import Data.Coerce
import Data.Functor ((<&>))
import Data.Generics.Aliases (mkQ)
import Data.Generics.Schemes (everything)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Traversable
import Development.IDE (ShakeExtras,
getPluginConfig)
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service (runAction)
import Development.IDE.Core.Shake (IdeState (..),
useWithStale)
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error (realSrcSpanToRange)
import Development.IDE.Spans.LocalBindings (Bindings,
getDefiningBindings)
import Development.Shake (Action, RuleResult)
import Development.Shake.Classes
import qualified FastString
import Ide.Plugin.Config (PluginConfig (plcConfig))
import qualified Ide.Plugin.Config as Plugin
import Ide.Plugin.Tactic.Context
import Ide.Plugin.Tactic.FeatureSet
import Ide.Plugin.Tactic.GHC
import Ide.Plugin.Tactic.Judgements
import Ide.Plugin.Tactic.Range
import Ide.Plugin.Tactic.TestTypes (TacticCommand,
cfg_feature_set)
import Ide.Plugin.Tactic.Types
import Language.LSP.Server (MonadLsp)
import Language.LSP.Types
import OccName
import Prelude hiding (span)
import SrcLoc (containsSpan)
import TcRnTypes (tcg_binds)
tacticDesc :: T.Text -> T.Text
tacticDesc :: Text -> Text
tacticDesc Text
name = Text
"fill the hole using the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" tactic"
tcCommandName :: TacticCommand -> T.Text
tcCommandName :: TacticCommand -> Text
tcCommandName = String -> Text
T.pack (String -> Text)
-> (TacticCommand -> String) -> TacticCommand -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TacticCommand -> String
forall a. Show a => a -> String
show
runIde :: IdeState -> Action a -> IO a
runIde :: IdeState -> Action a -> IO a
runIde IdeState
state = String -> IdeState -> Action a -> IO a
forall a. String -> IdeState -> Action a -> IO a
runAction String
"tactic" IdeState
state
runStaleIde
:: forall a r
. ( r ~ RuleResult a
, Eq a , Hashable a , Binary a , Show a , Typeable a , NFData a
, Show r, Typeable r, NFData r
)
=> IdeState
-> NormalizedFilePath
-> a
-> MaybeT IO (r, PositionMapping)
runStaleIde :: IdeState
-> NormalizedFilePath -> a -> MaybeT IO (r, PositionMapping)
runStaleIde IdeState
state NormalizedFilePath
nfp a
a = IO (Maybe (r, PositionMapping)) -> MaybeT IO (r, PositionMapping)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (r, PositionMapping)) -> MaybeT IO (r, PositionMapping))
-> IO (Maybe (r, PositionMapping))
-> MaybeT IO (r, PositionMapping)
forall a b. (a -> b) -> a -> b
$ IdeState
-> Action (Maybe (r, PositionMapping))
-> IO (Maybe (r, PositionMapping))
forall a. IdeState -> Action a -> IO a
runIde IdeState
state (Action (Maybe (r, PositionMapping))
-> IO (Maybe (r, PositionMapping)))
-> Action (Maybe (r, PositionMapping))
-> IO (Maybe (r, PositionMapping))
forall a b. (a -> b) -> a -> b
$ a -> NormalizedFilePath -> Action (Maybe (r, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale a
a NormalizedFilePath
nfp
getFeatureSet :: MonadLsp Plugin.Config m => ShakeExtras -> m FeatureSet
getFeatureSet :: ShakeExtras -> m FeatureSet
getFeatureSet ShakeExtras
extras = do
PluginConfig
pcfg <- ShakeExtras -> PluginId -> m PluginConfig
forall (m :: * -> *).
MonadLsp Config m =>
ShakeExtras -> PluginId -> m PluginConfig
getPluginConfig ShakeExtras
extras PluginId
"tactics"
FeatureSet -> m FeatureSet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FeatureSet -> m FeatureSet) -> FeatureSet -> m FeatureSet
forall a b. (a -> b) -> a -> b
$ case Value -> Result Config
forall a. FromJSON a => Value -> Result a
fromJSON (Value -> Result Config) -> Value -> Result Config
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ PluginConfig -> Object
plcConfig PluginConfig
pcfg of
Success Config
cfg -> Config -> FeatureSet
cfg_feature_set Config
cfg
Error String
_ -> FeatureSet
defaultFeatures
getIdeDynflags
:: IdeState
-> NormalizedFilePath
-> MaybeT IO DynFlags
getIdeDynflags :: IdeState -> NormalizedFilePath -> MaybeT IO DynFlags
getIdeDynflags IdeState
state NormalizedFilePath
nfp = do
((ModSummary
modsum,[LImportDecl GhcPs]
_), PositionMapping
_) <- IdeState
-> NormalizedFilePath
-> GetModSummaryWithoutTimestamps
-> MaybeT IO ((ModSummary, [LImportDecl GhcPs]), PositionMapping)
forall a r.
(r ~ RuleResult a, Eq a, Hashable a, Binary a, Show a, Typeable a,
NFData a, Show r, Typeable r, NFData r) =>
IdeState
-> NormalizedFilePath -> a -> MaybeT IO (r, PositionMapping)
runStaleIde IdeState
state NormalizedFilePath
nfp GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps
DynFlags -> MaybeT IO DynFlags
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynFlags -> MaybeT IO DynFlags) -> DynFlags -> MaybeT IO DynFlags
forall a b. (a -> b) -> a -> b
$ ModSummary -> DynFlags
ms_hspp_opts ModSummary
modsum
judgementForHole
:: IdeState
-> NormalizedFilePath
-> Range
-> FeatureSet
-> MaybeT IO (Range, Judgement, Context, DynFlags)
judgementForHole :: IdeState
-> NormalizedFilePath
-> Range
-> FeatureSet
-> MaybeT IO (Range, Judgement, Context, DynFlags)
judgementForHole IdeState
state NormalizedFilePath
nfp Range
range FeatureSet
features = do
(HieAstResult
asts, PositionMapping
amapping) <- IdeState
-> NormalizedFilePath
-> GetHieAst
-> MaybeT IO (HieAstResult, PositionMapping)
forall a r.
(r ~ RuleResult a, Eq a, Hashable a, Binary a, Show a, Typeable a,
NFData a, Show r, Typeable r, NFData r) =>
IdeState
-> NormalizedFilePath -> a -> MaybeT IO (r, PositionMapping)
runStaleIde IdeState
state NormalizedFilePath
nfp GetHieAst
GetHieAst
case HieAstResult
asts of
HAR Module
_ HieASTs a
_ RefMap a
_ Map Name [RealSrcSpan]
_ (HieFromDisk HieFile
_) -> String -> MaybeT IO (Range, Judgement, Context, DynFlags)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Need a fresh hie file"
HAR Module
_ HieASTs a
hf RefMap a
_ Map Name [RealSrcSpan]
_ HieKind a
HieFresh -> do
(Bindings
binds, PositionMapping
_) <- IdeState
-> NormalizedFilePath
-> GetBindings
-> MaybeT IO (Bindings, PositionMapping)
forall a r.
(r ~ RuleResult a, Eq a, Hashable a, Binary a, Show a, Typeable a,
NFData a, Show r, Typeable r, NFData r) =>
IdeState
-> NormalizedFilePath -> a -> MaybeT IO (r, PositionMapping)
runStaleIde IdeState
state NormalizedFilePath
nfp GetBindings
GetBindings
(TcModuleResult
tcmod, PositionMapping
_) <- IdeState
-> NormalizedFilePath
-> TypeCheck
-> MaybeT IO (TcModuleResult, PositionMapping)
forall a r.
(r ~ RuleResult a, Eq a, Hashable a, Binary a, Show a, Typeable a,
NFData a, Show r, Typeable r, NFData r) =>
IdeState
-> NormalizedFilePath -> a -> MaybeT IO (r, PositionMapping)
runStaleIde IdeState
state NormalizedFilePath
nfp TypeCheck
TypeCheck
(RealSrcSpan
rss, a
g) <- Maybe (RealSrcSpan, a) -> MaybeT IO (RealSrcSpan, a)
forall (m :: * -> *) a. Monad m => Maybe a -> MaybeT m a
liftMaybe (Maybe (RealSrcSpan, a) -> MaybeT IO (RealSrcSpan, a))
-> Maybe (RealSrcSpan, a) -> MaybeT IO (RealSrcSpan, a)
forall a b. (a -> b) -> a -> b
$ PositionMapping -> Range -> HieASTs a -> Maybe (RealSrcSpan, a)
forall b.
PositionMapping -> Range -> HieASTs b -> Maybe (RealSrcSpan, b)
getSpanAndTypeAtHole PositionMapping
amapping Range
range HieASTs a
hf
Range
resulting_range <- Maybe Range -> MaybeT IO Range
forall (m :: * -> *) a. Monad m => Maybe a -> MaybeT m a
liftMaybe (Maybe Range -> MaybeT IO Range) -> Maybe Range -> MaybeT IO Range
forall a b. (a -> b) -> a -> b
$ PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
amapping (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
rss
let (Judgement
jdg, Context
ctx) = FeatureSet
-> Type
-> Bindings
-> RealSrcSpan
-> TcModuleResult
-> (Judgement, Context)
mkJudgementAndContext FeatureSet
features a
Type
g Bindings
binds RealSrcSpan
rss TcModuleResult
tcmod
DynFlags
dflags <- IdeState -> NormalizedFilePath -> MaybeT IO DynFlags
getIdeDynflags IdeState
state NormalizedFilePath
nfp
(Range, Judgement, Context, DynFlags)
-> MaybeT IO (Range, Judgement, Context, DynFlags)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range
resulting_range, Judgement
jdg, Context
ctx, DynFlags
dflags)
mkJudgementAndContext
:: FeatureSet
-> Type
-> Bindings
-> RealSrcSpan
-> TcModuleResult
-> (Judgement, Context)
mkJudgementAndContext :: FeatureSet
-> Type
-> Bindings
-> RealSrcSpan
-> TcModuleResult
-> (Judgement, Context)
mkJudgementAndContext FeatureSet
features Type
g Bindings
binds RealSrcSpan
rss TcModuleResult
tcmod = do
let tcg :: TcGblEnv
tcg = TcModuleResult -> TcGblEnv
tmrTypechecked TcModuleResult
tcmod
tcs :: LHsBinds GhcTc
tcs = TcGblEnv -> LHsBinds GhcTc
tcg_binds TcGblEnv
tcg
ctx :: Context
ctx = FeatureSet -> [(OccName, CType)] -> TcGblEnv -> Context
mkContext FeatureSet
features
(((Name, Maybe Type) -> Maybe (OccName, CType))
-> [(Name, Maybe Type)] -> [(OccName, CType)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((OccName, Maybe CType) -> Maybe (OccName, CType)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ((OccName, Maybe CType) -> Maybe (OccName, CType))
-> ((Name, Maybe Type) -> (OccName, Maybe CType))
-> (Name, Maybe Type)
-> Maybe (OccName, CType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> OccName
forall name. HasOccName name => name -> OccName
occName (Name -> OccName)
-> (Maybe Type -> Maybe CType)
-> (Name, Maybe Type)
-> (OccName, Maybe CType)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Maybe Type -> Maybe CType
coerce))
([(Name, Maybe Type)] -> [(OccName, CType)])
-> [(Name, Maybe Type)] -> [(OccName, CType)]
forall a b. (a -> b) -> a -> b
$ Bindings -> RealSrcSpan -> [(Name, Maybe Type)]
getDefiningBindings Bindings
binds RealSrcSpan
rss)
TcGblEnv
tcg
top_provs :: Map OccName Provenance
top_provs = RealSrcSpan -> LHsBinds GhcTc -> Map OccName Provenance
getRhsPosVals RealSrcSpan
rss LHsBinds GhcTc
tcs
local_hy :: Hypothesis CType
local_hy = Map OccName Provenance -> Hypothesis CType -> Hypothesis CType
forall a. Map OccName Provenance -> Hypothesis a -> Hypothesis a
spliceProvenance Map OccName Provenance
top_provs
(Hypothesis CType -> Hypothesis CType)
-> Hypothesis CType -> Hypothesis CType
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Bindings -> Hypothesis CType
hypothesisFromBindings RealSrcSpan
rss Bindings
binds
cls_hy :: Hypothesis CType
cls_hy = Context -> Hypothesis CType
contextMethodHypothesis Context
ctx
in ( Hypothesis CType -> Bool -> Type -> Judgement
mkFirstJudgement
(Hypothesis CType
local_hy Hypothesis CType -> Hypothesis CType -> Hypothesis CType
forall a. Semigroup a => a -> a -> a
<> Hypothesis CType
cls_hy)
(RealSrcSpan -> LHsBinds GhcTc -> Bool
isRhsHole RealSrcSpan
rss LHsBinds GhcTc
tcs)
Type
g
, Context
ctx
)
getSpanAndTypeAtHole
:: PositionMapping
-> Range
-> HieASTs b
-> Maybe (Span, b)
getSpanAndTypeAtHole :: PositionMapping -> Range -> HieASTs b -> Maybe (RealSrcSpan, b)
getSpanAndTypeAtHole PositionMapping
amapping Range
range HieASTs b
hf = do
Range
range' <- PositionMapping -> Range -> Maybe Range
fromCurrentRange PositionMapping
amapping Range
range
Maybe (Maybe (RealSrcSpan, b)) -> Maybe (RealSrcSpan, b)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (RealSrcSpan, b)) -> Maybe (RealSrcSpan, b))
-> Maybe (Maybe (RealSrcSpan, b)) -> Maybe (RealSrcSpan, b)
forall a b. (a -> b) -> a -> b
$ [Maybe (RealSrcSpan, b)] -> Maybe (Maybe (RealSrcSpan, b))
forall a. [a] -> Maybe a
listToMaybe ([Maybe (RealSrcSpan, b)] -> Maybe (Maybe (RealSrcSpan, b)))
-> [Maybe (RealSrcSpan, b)] -> Maybe (Maybe (RealSrcSpan, b))
forall a b. (a -> b) -> a -> b
$ Map FastString (Maybe (RealSrcSpan, b)) -> [Maybe (RealSrcSpan, b)]
forall k a. Map k a -> [a]
M.elems (Map FastString (Maybe (RealSrcSpan, b))
-> [Maybe (RealSrcSpan, b)])
-> Map FastString (Maybe (RealSrcSpan, b))
-> [Maybe (RealSrcSpan, b)]
forall a b. (a -> b) -> a -> b
$ ((FastString -> HieAST b -> Maybe (RealSrcSpan, b))
-> Map FastString (HieAST b)
-> Map FastString (Maybe (RealSrcSpan, b)))
-> Map FastString (HieAST b)
-> (FastString -> HieAST b -> Maybe (RealSrcSpan, b))
-> Map FastString (Maybe (RealSrcSpan, b))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FastString -> HieAST b -> Maybe (RealSrcSpan, b))
-> Map FastString (HieAST b)
-> Map FastString (Maybe (RealSrcSpan, b))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (HieASTs b -> Map FastString (HieAST b)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts HieASTs b
hf) ((FastString -> HieAST b -> Maybe (RealSrcSpan, b))
-> Map FastString (Maybe (RealSrcSpan, b)))
-> (FastString -> HieAST b -> Maybe (RealSrcSpan, b))
-> Map FastString (Maybe (RealSrcSpan, b))
forall a b. (a -> b) -> a -> b
$ \FastString
fs HieAST b
ast ->
case RealSrcSpan -> HieAST b -> Maybe (HieAST b)
forall a. RealSrcSpan -> HieAST a -> Maybe (HieAST a)
selectSmallestContaining (String -> Range -> RealSrcSpan
rangeToRealSrcSpan (FastString -> String
FastString.unpackFS FastString
fs) Range
range') HieAST b
ast of
Maybe (HieAST b)
Nothing -> Maybe (RealSrcSpan, b)
forall a. Maybe a
Nothing
Just HieAST b
ast' -> do
let info :: NodeInfo b
info = HieAST b -> NodeInfo b
forall a. HieAST a -> NodeInfo a
nodeInfo HieAST b
ast'
b
ty <- [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> [b] -> Maybe b
forall a b. (a -> b) -> a -> b
$ NodeInfo b -> [b]
forall a. NodeInfo a -> [a]
nodeType NodeInfo b
info
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (FastString
"HsUnboundVar",FastString
"HsExpr") (FastString, FastString) -> Set (FastString, FastString) -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` NodeInfo b -> Set (FastString, FastString)
forall a. NodeInfo a -> Set (FastString, FastString)
nodeAnnotations NodeInfo b
info
(RealSrcSpan, b) -> Maybe (RealSrcSpan, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HieAST b -> RealSrcSpan
forall a. HieAST a -> RealSrcSpan
nodeSpan HieAST b
ast', b
ty)
liftMaybe :: Monad m => Maybe a -> MaybeT m a
liftMaybe :: Maybe a -> MaybeT m a
liftMaybe Maybe a
a = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
a
spliceProvenance
:: Map OccName Provenance
-> Hypothesis a
-> Hypothesis a
spliceProvenance :: Map OccName Provenance -> Hypothesis a -> Hypothesis a
spliceProvenance Map OccName Provenance
provs Hypothesis a
x =
[HyInfo a] -> Hypothesis a
forall a. [HyInfo a] -> Hypothesis a
Hypothesis ([HyInfo a] -> Hypothesis a) -> [HyInfo a] -> Hypothesis a
forall a b. (a -> b) -> a -> b
$ ((HyInfo a -> HyInfo a) -> [HyInfo a] -> [HyInfo a])
-> [HyInfo a] -> (HyInfo a -> HyInfo a) -> [HyInfo a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HyInfo a -> HyInfo a) -> [HyInfo a] -> [HyInfo a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Hypothesis a -> [HyInfo a]
forall a. Hypothesis a -> [HyInfo a]
unHypothesis Hypothesis a
x) ((HyInfo a -> HyInfo a) -> [HyInfo a])
-> (HyInfo a -> HyInfo a) -> [HyInfo a]
forall a b. (a -> b) -> a -> b
$ \HyInfo a
hi ->
(Provenance -> Provenance) -> HyInfo a -> HyInfo a
forall a. (Provenance -> Provenance) -> HyInfo a -> HyInfo a
overProvenance ((Provenance -> Provenance)
-> (Provenance -> Provenance -> Provenance)
-> Maybe Provenance
-> Provenance
-> Provenance
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Provenance -> Provenance
forall a. a -> a
id Provenance -> Provenance -> Provenance
forall a b. a -> b -> a
const (Maybe Provenance -> Provenance -> Provenance)
-> Maybe Provenance -> Provenance -> Provenance
forall a b. (a -> b) -> a -> b
$ OccName -> Map OccName Provenance -> Maybe Provenance
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (HyInfo a -> OccName
forall a. HyInfo a -> OccName
hi_name HyInfo a
hi) Map OccName Provenance
provs) HyInfo a
hi
getRhsPosVals :: RealSrcSpan -> TypecheckedSource -> Map OccName Provenance
getRhsPosVals :: RealSrcSpan -> LHsBinds GhcTc -> Map OccName Provenance
getRhsPosVals RealSrcSpan
rss LHsBinds GhcTc
tcs
= [(OccName, Provenance)] -> Map OccName Provenance
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
([(OccName, Provenance)] -> Map OccName Provenance)
-> [(OccName, Provenance)] -> Map OccName Provenance
forall a b. (a -> b) -> a -> b
$ [[(OccName, Provenance)]] -> [(OccName, Provenance)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
([[(OccName, Provenance)]] -> [(OccName, Provenance)])
-> [[(OccName, Provenance)]] -> [(OccName, Provenance)]
forall a b. (a -> b) -> a -> b
$ Maybe [(OccName, Provenance)] -> [[(OccName, Provenance)]]
forall a. Maybe a -> [a]
maybeToList
(Maybe [(OccName, Provenance)] -> [[(OccName, Provenance)]])
-> Maybe [(OccName, Provenance)] -> [[(OccName, Provenance)]]
forall a b. (a -> b) -> a -> b
$ First [(OccName, Provenance)] -> Maybe [(OccName, Provenance)]
forall a. First a -> Maybe a
getFirst
(First [(OccName, Provenance)] -> Maybe [(OccName, Provenance)])
-> First [(OccName, Provenance)] -> Maybe [(OccName, Provenance)]
forall a b. (a -> b) -> a -> b
$ (First [(OccName, Provenance)]
-> First [(OccName, Provenance)] -> First [(OccName, Provenance)])
-> GenericQ (First [(OccName, Provenance)])
-> LHsBinds GhcTc
-> First [(OccName, Provenance)]
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything First [(OccName, Provenance)]
-> First [(OccName, Provenance)] -> First [(OccName, Provenance)]
forall a. Semigroup a => a -> a -> a
(<>) (First [(OccName, Provenance)]
-> (Match GhcTc (LHsExpr GhcTc) -> First [(OccName, Provenance)])
-> a
-> First [(OccName, Provenance)]
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ First [(OccName, Provenance)]
forall a. Monoid a => a
mempty ((Match GhcTc (LHsExpr GhcTc) -> First [(OccName, Provenance)])
-> a -> First [(OccName, Provenance)])
-> (Match GhcTc (LHsExpr GhcTc) -> First [(OccName, Provenance)])
-> a
-> First [(OccName, Provenance)]
forall a b. (a -> b) -> a -> b
$ \case
TopLevelRHS OccName
name [PatCompat GhcTc]
ps
(L (RealSrcSpan RealSrcSpan
span)
(HsVar XVar GhcTc
_ (L SrcSpan
_ IdP GhcTc
hole)))
| RealSrcSpan -> RealSrcSpan -> Bool
containsSpan RealSrcSpan
rss RealSrcSpan
span
, OccName -> Bool
isHole (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ Id -> OccName
forall name. HasOccName name => name -> OccName
occName IdP GhcTc
Id
hole
-> Maybe [(OccName, Provenance)] -> First [(OccName, Provenance)]
forall a. Maybe a -> First a
First (Maybe [(OccName, Provenance)] -> First [(OccName, Provenance)])
-> Maybe [(OccName, Provenance)] -> First [(OccName, Provenance)]
forall a b. (a -> b) -> a -> b
$ do
[OccName]
patnames <- (Located (Pat GhcTc) -> Maybe OccName)
-> [Located (Pat GhcTc)] -> Maybe [OccName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PatCompat GhcTc -> Maybe OccName
Located (Pat GhcTc) -> Maybe OccName
getPatName [PatCompat GhcTc]
[Located (Pat GhcTc)]
ps
[(OccName, Provenance)] -> Maybe [(OccName, Provenance)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(OccName, Provenance)] -> Maybe [(OccName, Provenance)])
-> [(OccName, Provenance)] -> Maybe [(OccName, Provenance)]
forall a b. (a -> b) -> a -> b
$ [OccName] -> [Provenance] -> [(OccName, Provenance)]
forall a b. [a] -> [b] -> [(a, b)]
zip [OccName]
patnames ([Provenance] -> [(OccName, Provenance)])
-> [Provenance] -> [(OccName, Provenance)]
forall a b. (a -> b) -> a -> b
$ [Int
0..] [Int] -> (Int -> Provenance) -> [Provenance]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> OccName -> Int -> Provenance
TopLevelArgPrv OccName
name
Match GhcTc (LHsExpr GhcTc)
_ -> First [(OccName, Provenance)]
forall a. Monoid a => a
mempty
) LHsBinds GhcTc
tcs
isRhsHole :: RealSrcSpan -> TypecheckedSource -> Bool
isRhsHole :: RealSrcSpan -> LHsBinds GhcTc -> Bool
isRhsHole RealSrcSpan
rss LHsBinds GhcTc
tcs = (Bool -> Bool -> Bool) -> GenericQ Bool -> LHsBinds GhcTc -> Bool
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) (Bool -> (Match GhcTc (LHsExpr GhcTc) -> Bool) -> a -> Bool
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ Bool
False ((Match GhcTc (LHsExpr GhcTc) -> Bool) -> a -> Bool)
-> (Match GhcTc (LHsExpr GhcTc) -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ \case
TopLevelRHS OccName
_ [PatCompat GhcTc]
_ (L (RealSrcSpan RealSrcSpan
span) HsExpr GhcTc
_) -> RealSrcSpan -> RealSrcSpan -> Bool
containsSpan RealSrcSpan
rss RealSrcSpan
span
Match GhcTc (LHsExpr GhcTc)
_ -> Bool
False
) LHsBinds GhcTc
tcs