{-# LANGUAGE CPP             #-}
{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies    #-}
{-# LANGUAGE ViewPatterns    #-}

module Ide.Plugin.Class.Types where

import           Control.DeepSeq                  (rwhnf)
import           Control.Monad.Extra              (mapMaybeM, whenMaybe)
import           Control.Monad.IO.Class           (liftIO)
import           Control.Monad.Trans.Maybe        (MaybeT (MaybeT, runMaybeT))
import           Data.Aeson
import qualified Data.IntMap                      as IntMap
import           Data.List.Extra                  (firstJust)
import           Data.Maybe                       (catMaybes, mapMaybe,
                                                   maybeToList)
import qualified Data.Text                        as T
import           Data.Unique                      (hashUnique, newUnique)
import           Development.IDE
import           Development.IDE.Core.PluginUtils (useMT)
import qualified Development.IDE.Core.Shake       as Shake
import           Development.IDE.GHC.Compat       hiding (newUnique, (<+>))
import           Development.IDE.GHC.Compat.Util  (bagToList)
import           Development.IDE.Graph.Classes
import           GHC.Generics
import           Ide.Plugin.Class.Utils
import           Ide.Types
import           Language.LSP.Protocol.Types      (TextEdit,
                                                   VersionedTextDocumentIdentifier)

typeLensCommandId :: CommandId
typeLensCommandId :: CommandId
typeLensCommandId = CommandId
"classplugin.typelens"

codeActionCommandId :: CommandId
codeActionCommandId :: CommandId
codeActionCommandId = CommandId
"classplugin.codeaction"

-- | Default indent size for inserting
defaultIndent :: Int
defaultIndent :: Int
defaultIndent = Int
2

data AddMinimalMethodsParams = AddMinimalMethodsParams
    { AddMinimalMethodsParams -> VersionedTextDocumentIdentifier
verTxtDocId :: VersionedTextDocumentIdentifier
    , AddMinimalMethodsParams -> Range
range       :: Range
    , AddMinimalMethodsParams -> [(Text, Text)]
methodGroup :: [(T.Text, T.Text)]
    -- ^ (name text, signature text)
    , AddMinimalMethodsParams -> Bool
withSig     :: Bool
    }
    deriving (Int -> AddMinimalMethodsParams -> ShowS
[AddMinimalMethodsParams] -> ShowS
AddMinimalMethodsParams -> String
(Int -> AddMinimalMethodsParams -> ShowS)
-> (AddMinimalMethodsParams -> String)
-> ([AddMinimalMethodsParams] -> ShowS)
-> Show AddMinimalMethodsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddMinimalMethodsParams -> ShowS
showsPrec :: Int -> AddMinimalMethodsParams -> ShowS
$cshow :: AddMinimalMethodsParams -> String
show :: AddMinimalMethodsParams -> String
$cshowList :: [AddMinimalMethodsParams] -> ShowS
showList :: [AddMinimalMethodsParams] -> ShowS
Show, AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool
(AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool)
-> (AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool)
-> Eq AddMinimalMethodsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool
== :: AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool
$c/= :: AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool
/= :: AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool
Eq, (forall x.
 AddMinimalMethodsParams -> Rep AddMinimalMethodsParams x)
-> (forall x.
    Rep AddMinimalMethodsParams x -> AddMinimalMethodsParams)
-> Generic AddMinimalMethodsParams
forall x. Rep AddMinimalMethodsParams x -> AddMinimalMethodsParams
forall x. AddMinimalMethodsParams -> Rep AddMinimalMethodsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddMinimalMethodsParams -> Rep AddMinimalMethodsParams x
from :: forall x. AddMinimalMethodsParams -> Rep AddMinimalMethodsParams x
$cto :: forall x. Rep AddMinimalMethodsParams x -> AddMinimalMethodsParams
to :: forall x. Rep AddMinimalMethodsParams x -> AddMinimalMethodsParams
Generic, [AddMinimalMethodsParams] -> Value
[AddMinimalMethodsParams] -> Encoding
AddMinimalMethodsParams -> Bool
AddMinimalMethodsParams -> Value
AddMinimalMethodsParams -> Encoding
(AddMinimalMethodsParams -> Value)
-> (AddMinimalMethodsParams -> Encoding)
-> ([AddMinimalMethodsParams] -> Value)
-> ([AddMinimalMethodsParams] -> Encoding)
-> (AddMinimalMethodsParams -> Bool)
-> ToJSON AddMinimalMethodsParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: AddMinimalMethodsParams -> Value
toJSON :: AddMinimalMethodsParams -> Value
$ctoEncoding :: AddMinimalMethodsParams -> Encoding
toEncoding :: AddMinimalMethodsParams -> Encoding
$ctoJSONList :: [AddMinimalMethodsParams] -> Value
toJSONList :: [AddMinimalMethodsParams] -> Value
$ctoEncodingList :: [AddMinimalMethodsParams] -> Encoding
toEncodingList :: [AddMinimalMethodsParams] -> Encoding
$comitField :: AddMinimalMethodsParams -> Bool
omitField :: AddMinimalMethodsParams -> Bool
ToJSON, Maybe AddMinimalMethodsParams
Value -> Parser [AddMinimalMethodsParams]
Value -> Parser AddMinimalMethodsParams
(Value -> Parser AddMinimalMethodsParams)
-> (Value -> Parser [AddMinimalMethodsParams])
-> Maybe AddMinimalMethodsParams
-> FromJSON AddMinimalMethodsParams
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser AddMinimalMethodsParams
parseJSON :: Value -> Parser AddMinimalMethodsParams
$cparseJSONList :: Value -> Parser [AddMinimalMethodsParams]
parseJSONList :: Value -> Parser [AddMinimalMethodsParams]
$comittedField :: Maybe AddMinimalMethodsParams
omittedField :: Maybe AddMinimalMethodsParams
FromJSON)

-- |The InstanceBindTypeSigs Rule collects the instance bindings type
-- signatures (both name and type). It is used by both the code actions and the
-- code lenses
data GetInstanceBindTypeSigs = GetInstanceBindTypeSigs
    deriving ((forall x.
 GetInstanceBindTypeSigs -> Rep GetInstanceBindTypeSigs x)
-> (forall x.
    Rep GetInstanceBindTypeSigs x -> GetInstanceBindTypeSigs)
-> Generic GetInstanceBindTypeSigs
forall x. Rep GetInstanceBindTypeSigs x -> GetInstanceBindTypeSigs
forall x. GetInstanceBindTypeSigs -> Rep GetInstanceBindTypeSigs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetInstanceBindTypeSigs -> Rep GetInstanceBindTypeSigs x
from :: forall x. GetInstanceBindTypeSigs -> Rep GetInstanceBindTypeSigs x
$cto :: forall x. Rep GetInstanceBindTypeSigs x -> GetInstanceBindTypeSigs
to :: forall x. Rep GetInstanceBindTypeSigs x -> GetInstanceBindTypeSigs
Generic, Int -> GetInstanceBindTypeSigs -> ShowS
[GetInstanceBindTypeSigs] -> ShowS
GetInstanceBindTypeSigs -> String
(Int -> GetInstanceBindTypeSigs -> ShowS)
-> (GetInstanceBindTypeSigs -> String)
-> ([GetInstanceBindTypeSigs] -> ShowS)
-> Show GetInstanceBindTypeSigs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetInstanceBindTypeSigs -> ShowS
showsPrec :: Int -> GetInstanceBindTypeSigs -> ShowS
$cshow :: GetInstanceBindTypeSigs -> String
show :: GetInstanceBindTypeSigs -> String
$cshowList :: [GetInstanceBindTypeSigs] -> ShowS
showList :: [GetInstanceBindTypeSigs] -> ShowS
Show, GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
(GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool)
-> (GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool)
-> Eq GetInstanceBindTypeSigs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
== :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
$c/= :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
/= :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
Eq, Eq GetInstanceBindTypeSigs
Eq GetInstanceBindTypeSigs =>
(GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Ordering)
-> (GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool)
-> (GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool)
-> (GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool)
-> (GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool)
-> (GetInstanceBindTypeSigs
    -> GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs)
-> (GetInstanceBindTypeSigs
    -> GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs)
-> Ord GetInstanceBindTypeSigs
GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Ordering
GetInstanceBindTypeSigs
-> GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs
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
$ccompare :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Ordering
compare :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Ordering
$c< :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
< :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
$c<= :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
<= :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
$c> :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
> :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
$c>= :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
>= :: GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs -> Bool
$cmax :: GetInstanceBindTypeSigs
-> GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs
max :: GetInstanceBindTypeSigs
-> GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs
$cmin :: GetInstanceBindTypeSigs
-> GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs
min :: GetInstanceBindTypeSigs
-> GetInstanceBindTypeSigs -> GetInstanceBindTypeSigs
Ord, Eq GetInstanceBindTypeSigs
Eq GetInstanceBindTypeSigs =>
(Int -> GetInstanceBindTypeSigs -> Int)
-> (GetInstanceBindTypeSigs -> Int)
-> Hashable GetInstanceBindTypeSigs
Int -> GetInstanceBindTypeSigs -> Int
GetInstanceBindTypeSigs -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> GetInstanceBindTypeSigs -> Int
hashWithSalt :: Int -> GetInstanceBindTypeSigs -> Int
$chash :: GetInstanceBindTypeSigs -> Int
hash :: GetInstanceBindTypeSigs -> Int
Hashable, GetInstanceBindTypeSigs -> ()
(GetInstanceBindTypeSigs -> ()) -> NFData GetInstanceBindTypeSigs
forall a. (a -> ()) -> NFData a
$crnf :: GetInstanceBindTypeSigs -> ()
rnf :: GetInstanceBindTypeSigs -> ()
NFData)

data InstanceBindTypeSig = InstanceBindTypeSig
    { InstanceBindTypeSig -> Name
bindName :: Name
    , InstanceBindTypeSig -> Type
bindType :: Type
    }

newtype InstanceBindTypeSigsResult =
    InstanceBindTypeSigsResult [InstanceBindTypeSig]

instance Show InstanceBindTypeSigsResult where
    show :: InstanceBindTypeSigsResult -> String
show InstanceBindTypeSigsResult
_ = String
"<InstanceBindTypeSigs>"

instance NFData InstanceBindTypeSigsResult where
    rnf :: InstanceBindTypeSigsResult -> ()
rnf = InstanceBindTypeSigsResult -> ()
forall a. a -> ()
rwhnf

type instance RuleResult GetInstanceBindTypeSigs = InstanceBindTypeSigsResult

-- |The necessary data to execute our code lens
data InstanceBindLensCommand = InstanceBindLensCommand
    { -- |The URI needed to run actions in the command
      InstanceBindLensCommand -> Uri
commandUri  :: Uri
      -- |The specific TextEdit we want to apply. This does not include the
      -- pragma edit which is computed in the command
    , InstanceBindLensCommand -> TextEdit
commandEdit :: TextEdit }
    deriving ((forall x.
 InstanceBindLensCommand -> Rep InstanceBindLensCommand x)
-> (forall x.
    Rep InstanceBindLensCommand x -> InstanceBindLensCommand)
-> Generic InstanceBindLensCommand
forall x. Rep InstanceBindLensCommand x -> InstanceBindLensCommand
forall x. InstanceBindLensCommand -> Rep InstanceBindLensCommand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InstanceBindLensCommand -> Rep InstanceBindLensCommand x
from :: forall x. InstanceBindLensCommand -> Rep InstanceBindLensCommand x
$cto :: forall x. Rep InstanceBindLensCommand x -> InstanceBindLensCommand
to :: forall x. Rep InstanceBindLensCommand x -> InstanceBindLensCommand
Generic, Maybe InstanceBindLensCommand
Value -> Parser [InstanceBindLensCommand]
Value -> Parser InstanceBindLensCommand
(Value -> Parser InstanceBindLensCommand)
-> (Value -> Parser [InstanceBindLensCommand])
-> Maybe InstanceBindLensCommand
-> FromJSON InstanceBindLensCommand
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InstanceBindLensCommand
parseJSON :: Value -> Parser InstanceBindLensCommand
$cparseJSONList :: Value -> Parser [InstanceBindLensCommand]
parseJSONList :: Value -> Parser [InstanceBindLensCommand]
$comittedField :: Maybe InstanceBindLensCommand
omittedField :: Maybe InstanceBindLensCommand
FromJSON, [InstanceBindLensCommand] -> Value
[InstanceBindLensCommand] -> Encoding
InstanceBindLensCommand -> Bool
InstanceBindLensCommand -> Value
InstanceBindLensCommand -> Encoding
(InstanceBindLensCommand -> Value)
-> (InstanceBindLensCommand -> Encoding)
-> ([InstanceBindLensCommand] -> Value)
-> ([InstanceBindLensCommand] -> Encoding)
-> (InstanceBindLensCommand -> Bool)
-> ToJSON InstanceBindLensCommand
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InstanceBindLensCommand -> Value
toJSON :: InstanceBindLensCommand -> Value
$ctoEncoding :: InstanceBindLensCommand -> Encoding
toEncoding :: InstanceBindLensCommand -> Encoding
$ctoJSONList :: [InstanceBindLensCommand] -> Value
toJSONList :: [InstanceBindLensCommand] -> Value
$ctoEncodingList :: [InstanceBindLensCommand] -> Encoding
toEncodingList :: [InstanceBindLensCommand] -> Encoding
$comitField :: InstanceBindLensCommand -> Bool
omitField :: InstanceBindLensCommand -> Bool
ToJSON)

-- | The InstanceBindLens rule is specifically for code lenses. It  relies on
-- the InstanceBindTypeSigs rule, filters out irrelevant matches and signatures
-- that can't be matched to a source span. It provides all the signatures linked
-- to a unique ID to aid in resolving. It also provides a list of enabled
-- extensions.
data GetInstanceBindLens = GetInstanceBindLens
    deriving ((forall x. GetInstanceBindLens -> Rep GetInstanceBindLens x)
-> (forall x. Rep GetInstanceBindLens x -> GetInstanceBindLens)
-> Generic GetInstanceBindLens
forall x. Rep GetInstanceBindLens x -> GetInstanceBindLens
forall x. GetInstanceBindLens -> Rep GetInstanceBindLens x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetInstanceBindLens -> Rep GetInstanceBindLens x
from :: forall x. GetInstanceBindLens -> Rep GetInstanceBindLens x
$cto :: forall x. Rep GetInstanceBindLens x -> GetInstanceBindLens
to :: forall x. Rep GetInstanceBindLens x -> GetInstanceBindLens
Generic, Int -> GetInstanceBindLens -> ShowS
[GetInstanceBindLens] -> ShowS
GetInstanceBindLens -> String
(Int -> GetInstanceBindLens -> ShowS)
-> (GetInstanceBindLens -> String)
-> ([GetInstanceBindLens] -> ShowS)
-> Show GetInstanceBindLens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetInstanceBindLens -> ShowS
showsPrec :: Int -> GetInstanceBindLens -> ShowS
$cshow :: GetInstanceBindLens -> String
show :: GetInstanceBindLens -> String
$cshowList :: [GetInstanceBindLens] -> ShowS
showList :: [GetInstanceBindLens] -> ShowS
Show, GetInstanceBindLens -> GetInstanceBindLens -> Bool
(GetInstanceBindLens -> GetInstanceBindLens -> Bool)
-> (GetInstanceBindLens -> GetInstanceBindLens -> Bool)
-> Eq GetInstanceBindLens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
== :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
$c/= :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
/= :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
Eq, Eq GetInstanceBindLens
Eq GetInstanceBindLens =>
(GetInstanceBindLens -> GetInstanceBindLens -> Ordering)
-> (GetInstanceBindLens -> GetInstanceBindLens -> Bool)
-> (GetInstanceBindLens -> GetInstanceBindLens -> Bool)
-> (GetInstanceBindLens -> GetInstanceBindLens -> Bool)
-> (GetInstanceBindLens -> GetInstanceBindLens -> Bool)
-> (GetInstanceBindLens
    -> GetInstanceBindLens -> GetInstanceBindLens)
-> (GetInstanceBindLens
    -> GetInstanceBindLens -> GetInstanceBindLens)
-> Ord GetInstanceBindLens
GetInstanceBindLens -> GetInstanceBindLens -> Bool
GetInstanceBindLens -> GetInstanceBindLens -> Ordering
GetInstanceBindLens -> GetInstanceBindLens -> GetInstanceBindLens
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
$ccompare :: GetInstanceBindLens -> GetInstanceBindLens -> Ordering
compare :: GetInstanceBindLens -> GetInstanceBindLens -> Ordering
$c< :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
< :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
$c<= :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
<= :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
$c> :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
> :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
$c>= :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
>= :: GetInstanceBindLens -> GetInstanceBindLens -> Bool
$cmax :: GetInstanceBindLens -> GetInstanceBindLens -> GetInstanceBindLens
max :: GetInstanceBindLens -> GetInstanceBindLens -> GetInstanceBindLens
$cmin :: GetInstanceBindLens -> GetInstanceBindLens -> GetInstanceBindLens
min :: GetInstanceBindLens -> GetInstanceBindLens -> GetInstanceBindLens
Ord, Eq GetInstanceBindLens
Eq GetInstanceBindLens =>
(Int -> GetInstanceBindLens -> Int)
-> (GetInstanceBindLens -> Int) -> Hashable GetInstanceBindLens
Int -> GetInstanceBindLens -> Int
GetInstanceBindLens -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> GetInstanceBindLens -> Int
hashWithSalt :: Int -> GetInstanceBindLens -> Int
$chash :: GetInstanceBindLens -> Int
hash :: GetInstanceBindLens -> Int
Hashable, GetInstanceBindLens -> ()
(GetInstanceBindLens -> ()) -> NFData GetInstanceBindLens
forall a. (a -> ()) -> NFData a
$crnf :: GetInstanceBindLens -> ()
rnf :: GetInstanceBindLens -> ()
NFData)

data InstanceBindLens = InstanceBindLens
    { -- |What we need to provide the code lens. The range linked with
      -- a unique ID that will allow us to resolve the rest of the data later
      InstanceBindLens -> [(Range, Int)]
lensRange             :: [(Range, Int)]
      -- |Provides the necessary data to allow us to display the
      -- title of the lens and compute a TextEdit for it.
    , InstanceBindLens -> IntMap (Range, Name, Type)
lensDetails           :: IntMap.IntMap (Range, Name, Type)
    -- |Provides currently enabled extensions, allowing us to conditionally
    -- insert needed extensions.
    , InstanceBindLens -> [Extension]
lensEnabledExtensions :: [Extension]
    }

newtype InstanceBindLensResult =
    InstanceBindLensResult InstanceBindLens

instance Show InstanceBindLensResult where
    show :: InstanceBindLensResult -> String
show InstanceBindLensResult
_ = String
"<InstanceBindLens>"

instance NFData InstanceBindLensResult where
    rnf :: InstanceBindLensResult -> ()
rnf = InstanceBindLensResult -> ()
forall a. a -> ()
rwhnf

type instance RuleResult GetInstanceBindLens = InstanceBindLensResult

data Log
  = LogImplementedMethods Class [T.Text]
  | LogShake Shake.Log

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogImplementedMethods Class
cls [Text]
methods ->
      String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String
"Detected implemented methods for class" :: String)
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ShowS
forall a. Show a => a -> String
show (Class -> String
forall a. NamedThing a => a -> String
getOccString Class
cls) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":") -- 'show' is used here to add quotes around the class name
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Text] -> Doc ann
forall ann. [Text] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Text]
methods
    LogShake Log
log -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
log

data BindInfo = BindInfo
    { BindInfo -> SrcSpan
bindSpan     :: SrcSpan
      -- ^ SrcSpan of the whole binding
    , BindInfo -> SrcSpan
bindNameSpan :: SrcSpan
      -- ^ SrcSpan of the binding name
    }

getInstanceBindLensRule :: Recorder (WithPriority Log) -> Rules ()
getInstanceBindLensRule :: Recorder (WithPriority Log) -> Rules ()
getInstanceBindLensRule Recorder (WithPriority Log)
recorder = do
    Recorder (WithPriority Log)
-> (GetInstanceBindLens
    -> NormalizedFilePath -> Action (Maybe InstanceBindLensResult))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetInstanceBindLens
  -> NormalizedFilePath -> Action (Maybe InstanceBindLensResult))
 -> Rules ())
-> (GetInstanceBindLens
    -> NormalizedFilePath -> Action (Maybe InstanceBindLensResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetInstanceBindLens
GetInstanceBindLens NormalizedFilePath
nfp -> MaybeT Action InstanceBindLensResult
-> Action (Maybe InstanceBindLensResult)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Action InstanceBindLensResult
 -> Action (Maybe InstanceBindLensResult))
-> MaybeT Action InstanceBindLensResult
-> Action (Maybe InstanceBindLensResult)
forall a b. (a -> b) -> a -> b
$ do
        tmr :: TcModuleResult
tmr@(TcModuleResult -> RenamedSource
tmrRenamed ->  (HsGroup GhcRn -> [TyClGroup GhcRn]
forall p. HsGroup p -> [TyClGroup p]
hs_tyclds -> [TyClGroup GhcRn]
tycls, [LImportDecl GhcRn]
_, Maybe [(LIE GhcRn, Avails)]
_, Maybe (LHsDoc GhcRn)
_)) <- TypeCheck -> NormalizedFilePath -> MaybeT Action TcModuleResult
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT Action v
useMT TypeCheck
TypeCheck NormalizedFilePath
nfp
        (InstanceBindTypeSigsResult [InstanceBindTypeSig]
allBinds) <- GetInstanceBindTypeSigs
-> NormalizedFilePath -> MaybeT Action InstanceBindTypeSigsResult
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT Action v
useMT GetInstanceBindTypeSigs
GetInstanceBindTypeSigs NormalizedFilePath
nfp

        let -- declared instance methods without signatures
            bindInfos :: [BindInfo]
bindInfos = [ BindInfo
bind
                        | [GenLocated SrcSpanAnnA (InstDecl GhcRn)]
instds <- (TyClGroup GhcRn -> [GenLocated SrcSpanAnnA (InstDecl GhcRn)])
-> [TyClGroup GhcRn] -> [[GenLocated SrcSpanAnnA (InstDecl GhcRn)]]
forall a b. (a -> b) -> [a] -> [b]
map TyClGroup GhcRn -> [LInstDecl GhcRn]
TyClGroup GhcRn -> [GenLocated SrcSpanAnnA (InstDecl GhcRn)]
forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds [TyClGroup GhcRn]
tycls -- class instance decls
                        , GenLocated SrcSpanAnnA (InstDecl GhcRn)
instd <- [GenLocated SrcSpanAnnA (InstDecl GhcRn)]
instds
                        , ClsInstDecl GhcRn
inst <- Maybe (ClsInstDecl GhcRn) -> [ClsInstDecl GhcRn]
forall a. Maybe a -> [a]
maybeToList (Maybe (ClsInstDecl GhcRn) -> [ClsInstDecl GhcRn])
-> Maybe (ClsInstDecl GhcRn) -> [ClsInstDecl GhcRn]
forall a b. (a -> b) -> a -> b
$ InstDecl GhcRn -> Maybe (ClsInstDecl GhcRn)
forall {pass}. InstDecl pass -> Maybe (ClsInstDecl pass)
getClsInstD (GenLocated SrcSpanAnnA (InstDecl GhcRn) -> InstDecl GhcRn
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (InstDecl GhcRn)
instd)
                        , BindInfo
bind <- ClsInstDecl GhcRn -> [BindInfo]
getBindSpanWithoutSig ClsInstDecl GhcRn
inst
                        ]
            targetSigs :: [Maybe (InstanceBindTypeSig, SrcSpan)]
targetSigs = [BindInfo]
-> [InstanceBindTypeSig] -> [Maybe (InstanceBindTypeSig, SrcSpan)]
matchBind [BindInfo]
bindInfos [InstanceBindTypeSig]
allBinds
        [(Range, Int, Name, Type)]
rangeIntNameType <- IO [(Range, Int, Name, Type)]
-> MaybeT Action [(Range, Int, Name, Type)]
forall a. IO a -> MaybeT Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Range, Int, Name, Type)]
 -> MaybeT Action [(Range, Int, Name, Type)])
-> IO [(Range, Int, Name, Type)]
-> MaybeT Action [(Range, Int, Name, Type)]
forall a b. (a -> b) -> a -> b
$ (Maybe (InstanceBindTypeSig, SrcSpan)
 -> IO (Maybe (Range, Int, Name, Type)))
-> [Maybe (InstanceBindTypeSig, SrcSpan)]
-> IO [(Range, Int, Name, Type)]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM Maybe (InstanceBindTypeSig, SrcSpan)
-> IO (Maybe (Range, Int, Name, Type))
getRangeWithSig [Maybe (InstanceBindTypeSig, SrcSpan)]
targetSigs
        let lensRange :: [(Range, Int)]
lensRange = (\(Range
range, Int
int, Name
_, Type
_) -> (Range
range, Int
int)) ((Range, Int, Name, Type) -> (Range, Int))
-> [(Range, Int, Name, Type)] -> [(Range, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Range, Int, Name, Type)]
rangeIntNameType
            lensDetails :: IntMap (Range, Name, Type)
lensDetails = [(Int, (Range, Name, Type))] -> IntMap (Range, Name, Type)
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, (Range, Name, Type))] -> IntMap (Range, Name, Type))
-> [(Int, (Range, Name, Type))] -> IntMap (Range, Name, Type)
forall a b. (a -> b) -> a -> b
$ (\(Range
range, Int
int, Name
name, Type
typ) -> (Int
int, (Range
range, Name
name, Type
typ))) ((Range, Int, Name, Type) -> (Int, (Range, Name, Type)))
-> [(Range, Int, Name, Type)] -> [(Int, (Range, Name, Type))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Range, Int, Name, Type)]
rangeIntNameType
            lensEnabledExtensions :: [Extension]
lensEnabledExtensions = ParsedModule -> [Extension]
getExtensions (ParsedModule -> [Extension]) -> ParsedModule -> [Extension]
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> ParsedModule
tmrParsed TcModuleResult
tmr
        InstanceBindLensResult -> MaybeT Action InstanceBindLensResult
forall a. a -> MaybeT Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstanceBindLensResult -> MaybeT Action InstanceBindLensResult)
-> InstanceBindLensResult -> MaybeT Action InstanceBindLensResult
forall a b. (a -> b) -> a -> b
$ InstanceBindLens -> InstanceBindLensResult
InstanceBindLensResult (InstanceBindLens -> InstanceBindLensResult)
-> InstanceBindLens -> InstanceBindLensResult
forall a b. (a -> b) -> a -> b
$ InstanceBindLens{[(Range, Int)]
[Extension]
IntMap (Range, Name, Type)
lensRange :: [(Range, Int)]
lensDetails :: IntMap (Range, Name, Type)
lensEnabledExtensions :: [Extension]
lensRange :: [(Range, Int)]
lensDetails :: IntMap (Range, Name, Type)
lensEnabledExtensions :: [Extension]
..}
    where
        -- Match Binds with their signatures
        -- We try to give every `InstanceBindTypeSig` a `SrcSpan`,
        -- hence we can display signatures for `InstanceBindTypeSig` with span later.
        matchBind :: [BindInfo] -> [InstanceBindTypeSig] -> [Maybe (InstanceBindTypeSig, SrcSpan)]
        matchBind :: [BindInfo]
-> [InstanceBindTypeSig] -> [Maybe (InstanceBindTypeSig, SrcSpan)]
matchBind [BindInfo]
existedBinds [InstanceBindTypeSig]
allBindWithSigs =
            [(BindInfo -> Maybe (InstanceBindTypeSig, SrcSpan))
-> [BindInfo] -> Maybe (InstanceBindTypeSig, SrcSpan)
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust (InstanceBindTypeSig
-> BindInfo -> Maybe (InstanceBindTypeSig, SrcSpan)
go InstanceBindTypeSig
bindSig) [BindInfo]
existedBinds | InstanceBindTypeSig
bindSig <- [InstanceBindTypeSig]
allBindWithSigs]
            where
                go :: InstanceBindTypeSig -> BindInfo -> Maybe (InstanceBindTypeSig,  SrcSpan)
                go :: InstanceBindTypeSig
-> BindInfo -> Maybe (InstanceBindTypeSig, SrcSpan)
go InstanceBindTypeSig
bindSig BindInfo
bind = do
                    Range
range <- (SrcSpan -> Maybe Range
srcSpanToRange (SrcSpan -> Maybe Range)
-> (BindInfo -> SrcSpan) -> BindInfo -> Maybe Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BindInfo -> SrcSpan
bindNameSpan) BindInfo
bind
                    if Range -> SrcSpan -> Bool
inRange Range
range (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan (Name -> SrcSpan) -> Name -> SrcSpan
forall a b. (a -> b) -> a -> b
$ InstanceBindTypeSig -> Name
bindName InstanceBindTypeSig
bindSig)
                    then (InstanceBindTypeSig, SrcSpan)
-> Maybe (InstanceBindTypeSig, SrcSpan)
forall a. a -> Maybe a
Just (InstanceBindTypeSig
bindSig, BindInfo -> SrcSpan
bindSpan BindInfo
bind)
                    else Maybe (InstanceBindTypeSig, SrcSpan)
forall a. Maybe a
Nothing

        getClsInstD :: InstDecl pass -> Maybe (ClsInstDecl pass)
getClsInstD (ClsInstD XClsInstD pass
_ ClsInstDecl pass
d) = ClsInstDecl pass -> Maybe (ClsInstDecl pass)
forall a. a -> Maybe a
Just ClsInstDecl pass
d
        getClsInstD InstDecl pass
_              = Maybe (ClsInstDecl pass)
forall a. Maybe a
Nothing

        getSigName :: Sig pass -> Maybe [IdP pass]
getSigName (ClassOpSig XClassOpSig pass
_ Bool
_ [XRec pass (IdP pass)]
sigNames LHsSigType pass
_) = [IdP pass] -> Maybe [IdP pass]
forall a. a -> Maybe a
Just ([IdP pass] -> Maybe [IdP pass]) -> [IdP pass] -> Maybe [IdP pass]
forall a b. (a -> b) -> a -> b
$ (GenLocated l (IdP pass) -> IdP pass)
-> [GenLocated l (IdP pass)] -> [IdP pass]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated l (IdP pass) -> IdP pass
forall l e. GenLocated l e -> e
unLoc [XRec pass (IdP pass)]
[GenLocated l (IdP pass)]
sigNames
        getSigName Sig pass
_                           = Maybe [IdP pass]
forall a. Maybe a
Nothing

        getBindSpanWithoutSig :: ClsInstDecl GhcRn -> [BindInfo]
        getBindSpanWithoutSig :: ClsInstDecl GhcRn -> [BindInfo]
getBindSpanWithoutSig ClsInstDecl{[LSig GhcRn]
[LDataFamInstDecl GhcRn]
[LTyFamInstDecl GhcRn]
Maybe (XRec GhcRn OverlapMode)
XCClsInstDecl GhcRn
LHsSigType GhcRn
LHsBinds GhcRn
cid_ext :: XCClsInstDecl GhcRn
cid_poly_ty :: LHsSigType GhcRn
cid_binds :: LHsBinds GhcRn
cid_sigs :: [LSig GhcRn]
cid_tyfam_insts :: [LTyFamInstDecl GhcRn]
cid_datafam_insts :: [LDataFamInstDecl GhcRn]
cid_overlap_mode :: Maybe (XRec GhcRn OverlapMode)
cid_ext :: forall pass. ClsInstDecl pass -> XCClsInstDecl pass
cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_overlap_mode :: forall pass. ClsInstDecl pass -> Maybe (XRec pass OverlapMode)
..} =
            let bindNames :: [GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn))]
bindNames = (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
 -> Maybe
      (GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn))))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
-> [GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
-> Maybe (GenLocated SrcSpanAnnA (XRec GhcRn (IdP GhcRn)))
GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
-> Maybe
     (GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn)))
forall {p} {l} {idL}.
(XMG p (XRec p (HsExpr p)) ~ Origin) =>
GenLocated l (HsBindLR idL p)
-> Maybe (GenLocated l (XRec idL (IdP idL)))
go (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
forall a. Bag a -> [a]
bagToList LHsBinds GhcRn
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
cid_binds)
                go :: GenLocated l (HsBindLR idL p)
-> Maybe (GenLocated l (XRec idL (IdP idL)))
go (L l
l HsBindLR idL p
bind) = case HsBindLR idL p
bind of
                    FunBind{XFunBind idL p
XRec idL (IdP idL)
MatchGroup p (XRec p (HsExpr p))
fun_ext :: XFunBind idL p
fun_id :: XRec idL (IdP idL)
fun_matches :: MatchGroup p (XRec p (HsExpr p))
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
..}
                        -- `Generated` tagged for Template Haskell,
                        -- here we filter out nonsense generated bindings
                        -- that are nonsense for displaying code lenses.
                        --
                        -- See https://github.com/haskell/haskell-language-server/issues/3319
                        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Origin -> Bool
isGenerated (MatchGroup p (XRec p (HsExpr p)) -> XMG p (XRec p (HsExpr p))
forall {p} {body}. MatchGroup p body -> XMG p body
groupOrigin MatchGroup p (XRec p (HsExpr p))
fun_matches)
                            -> GenLocated l (XRec idL (IdP idL))
-> Maybe (GenLocated l (XRec idL (IdP idL)))
forall a. a -> Maybe a
Just (GenLocated l (XRec idL (IdP idL))
 -> Maybe (GenLocated l (XRec idL (IdP idL))))
-> GenLocated l (XRec idL (IdP idL))
-> Maybe (GenLocated l (XRec idL (IdP idL)))
forall a b. (a -> b) -> a -> b
$ l -> XRec idL (IdP idL) -> GenLocated l (XRec idL (IdP idL))
forall l e. l -> e -> GenLocated l e
L l
l XRec idL (IdP idL)
fun_id
                    HsBindLR idL p
_       -> Maybe (GenLocated l (XRec idL (IdP idL)))
forall a. Maybe a
Nothing
                -- Existed signatures' name
                sigNames :: [IdP GhcRn]
sigNames = [[IdP GhcRn]] -> [IdP GhcRn]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IdP GhcRn]] -> [IdP GhcRn]) -> [[IdP GhcRn]] -> [IdP GhcRn]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Sig GhcRn) -> Maybe [IdP GhcRn])
-> [GenLocated SrcSpanAnnA (Sig GhcRn)] -> [[IdP GhcRn]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(L SrcSpanAnnA
_ Sig GhcRn
r) -> Sig GhcRn -> Maybe [IdP GhcRn]
forall {pass} {l}.
(XRec pass (IdP pass) ~ GenLocated l (IdP pass)) =>
Sig pass -> Maybe [IdP pass]
getSigName Sig GhcRn
r) [LSig GhcRn]
[GenLocated SrcSpanAnnA (Sig GhcRn)]
cid_sigs
                toBindInfo :: GenLocated (SrcSpanAnn' a) (GenLocated (SrcSpanAnn' a) e)
-> BindInfo
toBindInfo (L SrcSpanAnn' a
l (L SrcSpanAnn' a
l' e
_)) = SrcSpan -> SrcSpan -> BindInfo
BindInfo
                    (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
l) -- bindSpan
                    (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
l') -- bindNameSpan
            in GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn))
-> BindInfo
forall {a} {a} {e}.
GenLocated (SrcSpanAnn' a) (GenLocated (SrcSpanAnn' a) e)
-> BindInfo
toBindInfo (GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn))
 -> BindInfo)
-> [GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn))]
-> [BindInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn))
 -> Bool)
-> [GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn))]
-> [GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(L SrcSpanAnnA
_ GenLocated SrcSpanAnnN (IdP GhcRn)
name) -> GenLocated SrcSpanAnnN (IdP GhcRn) -> IdP GhcRn
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN (IdP GhcRn)
name IdP GhcRn -> [IdP GhcRn] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [IdP GhcRn]
sigNames) [GenLocated SrcSpanAnnA (GenLocated SrcSpanAnnN (IdP GhcRn))]
bindNames

        -- Get bind definition range with its rendered signature text
        getRangeWithSig :: Maybe (InstanceBindTypeSig, SrcSpan) -> IO (Maybe (Range, Int, Name, Type))
        getRangeWithSig :: Maybe (InstanceBindTypeSig, SrcSpan)
-> IO (Maybe (Range, Int, Name, Type))
getRangeWithSig (Just (InstanceBindTypeSig
bind, SrcSpan
span)) = MaybeT IO (Range, Int, Name, Type)
-> IO (Maybe (Range, Int, Name, Type))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Range, Int, Name, Type)
 -> IO (Maybe (Range, Int, Name, Type)))
-> MaybeT IO (Range, Int, Name, Type)
-> IO (Maybe (Range, Int, Name, Type))
forall a b. (a -> b) -> a -> b
$ do
            Range
range <- IO (Maybe Range) -> MaybeT IO Range
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Range) -> MaybeT IO Range)
-> (Maybe Range -> IO (Maybe Range))
-> Maybe Range
-> MaybeT IO Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Range -> IO (Maybe Range)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Range -> MaybeT IO Range) -> Maybe Range -> MaybeT IO Range
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
span
            Int
uniqueID <- IO Int -> MaybeT IO Int
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> MaybeT IO Int) -> IO Int -> MaybeT IO Int
forall a b. (a -> b) -> a -> b
$ Unique -> Int
hashUnique (Unique -> Int) -> IO Unique -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique
newUnique
            (Range, Int, Name, Type) -> MaybeT IO (Range, Int, Name, Type)
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range
range, Int
uniqueID, InstanceBindTypeSig -> Name
bindName InstanceBindTypeSig
bind, InstanceBindTypeSig -> Type
bindType InstanceBindTypeSig
bind)
        getRangeWithSig Maybe (InstanceBindTypeSig, SrcSpan)
Nothing = Maybe (Range, Int, Name, Type)
-> IO (Maybe (Range, Int, Name, Type))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Range, Int, Name, Type)
forall a. Maybe a
Nothing


getInstanceBindTypeSigsRule :: Recorder (WithPriority Log) -> Rules ()
getInstanceBindTypeSigsRule :: Recorder (WithPriority Log) -> Rules ()
getInstanceBindTypeSigsRule Recorder (WithPriority Log)
recorder = do
    Recorder (WithPriority Log)
-> (GetInstanceBindTypeSigs
    -> NormalizedFilePath -> Action (Maybe InstanceBindTypeSigsResult))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetInstanceBindTypeSigs
  -> NormalizedFilePath -> Action (Maybe InstanceBindTypeSigsResult))
 -> Rules ())
-> (GetInstanceBindTypeSigs
    -> NormalizedFilePath -> Action (Maybe InstanceBindTypeSigsResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetInstanceBindTypeSigs
GetInstanceBindTypeSigs NormalizedFilePath
nfp -> MaybeT Action InstanceBindTypeSigsResult
-> Action (Maybe InstanceBindTypeSigsResult)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Action InstanceBindTypeSigsResult
 -> Action (Maybe InstanceBindTypeSigsResult))
-> MaybeT Action InstanceBindTypeSigsResult
-> Action (Maybe InstanceBindTypeSigsResult)
forall a b. (a -> b) -> a -> b
$ do
        (TcModuleResult -> TcGblEnv
tmrTypechecked -> TcGblEnv
gblEnv ) <- TypeCheck -> NormalizedFilePath -> MaybeT Action TcModuleResult
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT Action v
useMT TypeCheck
TypeCheck NormalizedFilePath
nfp
        (HscEnvEq -> HscEnv
hscEnv -> HscEnv
hsc) <- GhcSession -> NormalizedFilePath -> MaybeT Action HscEnvEq
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT Action v
useMT GhcSession
GhcSession NormalizedFilePath
nfp
        let binds :: [IdP GhcTc]
binds = Bag (XRec GhcTc (HsBindLR GhcTc GhcTc)) -> [IdP GhcTc]
forall p idR.
CollectPass p =>
Bag (XRec p (HsBindLR p idR)) -> [IdP p]
collectHsBindsBinders (Bag (XRec GhcTc (HsBindLR GhcTc GhcTc)) -> [IdP GhcTc])
-> Bag (XRec GhcTc (HsBindLR GhcTc GhcTc)) -> [IdP GhcTc]
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> Bag (XRec GhcTc (HsBindLR GhcTc GhcTc))
tcg_binds TcGblEnv
gblEnv
        (Messages TcRnMessage
_, [InstanceBindTypeSig]
-> ([Maybe InstanceBindTypeSig] -> [InstanceBindTypeSig])
-> Maybe [Maybe InstanceBindTypeSig]
-> [InstanceBindTypeSig]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Maybe InstanceBindTypeSig] -> [InstanceBindTypeSig]
forall a. [Maybe a] -> [a]
catMaybes -> [InstanceBindTypeSig]
instanceBinds) <- IO (Messages TcRnMessage, Maybe [Maybe InstanceBindTypeSig])
-> MaybeT
     Action (Messages TcRnMessage, Maybe [Maybe InstanceBindTypeSig])
forall a. IO a -> MaybeT Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Messages TcRnMessage, Maybe [Maybe InstanceBindTypeSig])
 -> MaybeT
      Action (Messages TcRnMessage, Maybe [Maybe InstanceBindTypeSig]))
-> IO (Messages TcRnMessage, Maybe [Maybe InstanceBindTypeSig])
-> MaybeT
     Action (Messages TcRnMessage, Maybe [Maybe InstanceBindTypeSig])
forall a b. (a -> b) -> a -> b
$
            HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM [Maybe InstanceBindTypeSig]
-> IO (Messages TcRnMessage, Maybe [Maybe InstanceBindTypeSig])
forall r.
HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM r
-> IO (Messages TcRnMessage, Maybe r)
initTcWithGbl HscEnv
hsc TcGblEnv
gblEnv RealSrcSpan
ghostSpan
#if MIN_VERSION_ghc(9,7,0)
              $ liftZonkM
#endif
              (TcM [Maybe InstanceBindTypeSig]
 -> IO (Messages TcRnMessage, Maybe [Maybe InstanceBindTypeSig]))
-> TcM [Maybe InstanceBindTypeSig]
-> IO (Messages TcRnMessage, Maybe [Maybe InstanceBindTypeSig])
forall a b. (a -> b) -> a -> b
$ (Id -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe InstanceBindTypeSig))
-> [Id] -> TcM [Maybe InstanceBindTypeSig]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe InstanceBindTypeSig)
bindToSig [IdP GhcTc]
[Id]
binds
        InstanceBindTypeSigsResult
-> MaybeT Action InstanceBindTypeSigsResult
forall a. a -> MaybeT Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstanceBindTypeSigsResult
 -> MaybeT Action InstanceBindTypeSigsResult)
-> InstanceBindTypeSigsResult
-> MaybeT Action InstanceBindTypeSigsResult
forall a b. (a -> b) -> a -> b
$ [InstanceBindTypeSig] -> InstanceBindTypeSigsResult
InstanceBindTypeSigsResult [InstanceBindTypeSig]
instanceBinds
    where
        bindToSig :: Id -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe InstanceBindTypeSig)
bindToSig Id
id = do
            let name :: Name
name = Id -> Name
idName Id
id
            Bool
-> IOEnv (Env TcGblEnv TcLclEnv) InstanceBindTypeSig
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe InstanceBindTypeSig)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
whenMaybe (Name -> Bool
isBindingName Name
name) (IOEnv (Env TcGblEnv TcLclEnv) InstanceBindTypeSig
 -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe InstanceBindTypeSig))
-> IOEnv (Env TcGblEnv TcLclEnv) InstanceBindTypeSig
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe InstanceBindTypeSig)
forall a b. (a -> b) -> a -> b
$ do
                TidyEnv
env <- TcM TidyEnv
tcInitTidyEnv
                let (TidyEnv
_, Type
ty) = TidyEnv -> Type -> (TidyEnv, Type)
tidyOpenType TidyEnv
env (Id -> Type
idType Id
id)
                InstanceBindTypeSig
-> IOEnv (Env TcGblEnv TcLclEnv) InstanceBindTypeSig
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstanceBindTypeSig
 -> IOEnv (Env TcGblEnv TcLclEnv) InstanceBindTypeSig)
-> InstanceBindTypeSig
-> IOEnv (Env TcGblEnv TcLclEnv) InstanceBindTypeSig
forall a b. (a -> b) -> a -> b
$ Name -> Type -> InstanceBindTypeSig
InstanceBindTypeSig Name
name Type
ty