{-# 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"


------------------------------------------------------------------------------
-- | The name of the command for the LS.
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


------------------------------------------------------------------------------
-- | Get the current feature set from the plugin config.
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
  -- Ok to use the stale 'ModIface', since all we need is its 'DynFlags'
  -- which don't change very often.
  ((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


------------------------------------------------------------------------------
-- | Find the last typechecked module, and find the most specific span, as well
-- as the judgement at the given range.
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


------------------------------------------------------------------------------
-- | Compute top-level position vals of a function
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)  -- body with no guards and a single defn
            (HsVar XVar GhcTc
_ (L SrcSpan
_ IdP GhcTc
hole)))
        | RealSrcSpan -> RealSrcSpan -> Bool
containsSpan RealSrcSpan
rss RealSrcSpan
span  -- which contains our 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  -- and the span is a 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


------------------------------------------------------------------------------
-- | Is this hole immediately to the right of an equals sign?
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