{-# LANGUAGE GADTs           #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns    #-}

module Ide.Plugin.Class.CodeAction where

import           Control.Applicative                  (liftA2)
import           Control.Lens                         hiding (List, use)
import           Control.Monad.Extra
import           Control.Monad.IO.Class               (liftIO)
import           Control.Monad.Trans.Class            (lift)
import           Control.Monad.Trans.Except           (ExceptT, throwE)
import           Control.Monad.Trans.Maybe
import           Data.Aeson
import           Data.Either.Extra                    (rights)
import           Data.List
import qualified Data.Map.Strict                      as Map
import           Data.Maybe                           (isNothing, listToMaybe,
                                                       mapMaybe)
import qualified Data.Set                             as Set
import qualified Data.Text                            as T
import           Development.IDE
import           Development.IDE.Core.PositionMapping (fromCurrentRange)
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Compat.Util
import           Development.IDE.Spans.AtPoint        (pointCommand)
import           GHC.LanguageExtensions.Type
import           Ide.Plugin.Class.ExactPrint
import           Ide.Plugin.Class.Types
import           Ide.Plugin.Class.Utils
import qualified Ide.Plugin.Config
import           Ide.PluginUtils
import           Ide.Types
import           Language.LSP.Server
import           Language.LSP.Types
import qualified Language.LSP.Types.Lens              as J

addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsParams
addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsParams
addMethodPlaceholders PluginId
_ IdeState
state param :: AddMinimalMethodsParams
param@AddMinimalMethodsParams{Bool
List (Text, Text)
Uri
Range
withSig :: AddMinimalMethodsParams -> Bool
methodGroup :: AddMinimalMethodsParams -> List (Text, Text)
range :: AddMinimalMethodsParams -> Range
uri :: AddMinimalMethodsParams -> Uri
withSig :: Bool
methodGroup :: List (Text, Text)
range :: Range
uri :: Uri
..} = do
    ClientCapabilities
caps <- forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
    forall (m :: * -> *) a.
Monad m =>
ExceptT String m a -> m (Either ResponseError a)
pluginResponse forall a b. (a -> b) -> a -> b
$ do
        NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT String m NormalizedFilePath
getNormalizedFilePath Uri
uri
        ParsedModule
pm <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Unable to GetParsedModule"
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin.addMethodPlaceholders.GetParsedModule" IdeState
state
            forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModule
GetParsedModule NormalizedFilePath
nfp
        (HscEnv -> DynFlags
hsc_dflags forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnvEq -> HscEnv
hscEnv -> DynFlags
df) <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Unable to GhcSessionDeps"
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin.addMethodPlaceholders.GhcSessionDeps" IdeState
state
            forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSessionDeps
GhcSessionDeps NormalizedFilePath
nfp
        (Text
old, Text
new) <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Unable to makeEditText"
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
ParsedModule
-> DynFlags -> AddMinimalMethodsParams -> MaybeT m (Text, Text)
makeEditText ParsedModule
pm DynFlags
df AddMinimalMethodsParams
param
        [TextEdit]
pragmaInsertion <- forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Extension -> ExceptT String m [TextEdit]
insertPragmaIfNotPresent IdeState
state NormalizedFilePath
nfp Extension
InstanceSigs
        let edit :: WorkspaceEdit
edit =
                if Bool
withSig
                then WorkspaceEdit -> [TextEdit] -> WorkspaceEdit
mergeEdit (ClientCapabilities -> Text -> Text -> WorkspaceEdit
workspaceEdit ClientCapabilities
caps Text
old Text
new) [TextEdit]
pragmaInsertion
                else ClientCapabilities -> Text -> Text -> WorkspaceEdit
workspaceEdit ClientCapabilities
caps Text
old Text
new

        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
sendRequest SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

        forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
    where
        toTextDocumentEdit :: TextEdit -> TextDocumentEdit
toTextDocumentEdit TextEdit
edit =
            VersionedTextDocumentIdentifier
-> List (TextEdit |? AnnotatedTextEdit) -> TextDocumentEdit
TextDocumentEdit (Uri -> TextDocumentVersion -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri (forall a. a -> Maybe a
Just Int32
0)) (forall a. [a] -> List a
List [forall a b. a -> a |? b
InL TextEdit
edit])

        mergeEdit :: WorkspaceEdit -> [TextEdit] -> WorkspaceEdit
        mergeEdit :: WorkspaceEdit -> [TextEdit] -> WorkspaceEdit
mergeEdit WorkspaceEdit{Maybe WorkspaceEditMap
Maybe ChangeAnnotationMap
Maybe (List DocumentChange)
$sel:_changes:WorkspaceEdit :: WorkspaceEdit -> Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: WorkspaceEdit -> Maybe (List DocumentChange)
$sel:_changeAnnotations:WorkspaceEdit :: WorkspaceEdit -> Maybe ChangeAnnotationMap
_changeAnnotations :: Maybe ChangeAnnotationMap
_documentChanges :: Maybe (List DocumentChange)
_changes :: Maybe WorkspaceEditMap
..} [TextEdit]
edits = WorkspaceEdit
            { $sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges =
                (\(List [DocumentChange]
x) -> forall a. [a] -> List a
List forall a b. (a -> b) -> a -> b
$ [DocumentChange]
x forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> a |? b
InL forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEdit -> TextDocumentEdit
toTextDocumentEdit) [TextEdit]
edits)
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (List DocumentChange)
_documentChanges
            , Maybe WorkspaceEditMap
Maybe ChangeAnnotationMap
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations :: Maybe ChangeAnnotationMap
_changes :: Maybe WorkspaceEditMap
..
            }

        workspaceEdit :: ClientCapabilities -> Text -> Text -> WorkspaceEdit
workspaceEdit ClientCapabilities
caps Text
old Text
new
            = ClientCapabilities
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
caps (Uri
uri, Text
old) Text
new WithDeletions
IncludeDeletions

-- |
-- This implementation is ad-hoc in a sense that the diagnostic detection mechanism is
-- sensitive to the format of diagnostic messages from GHC.
codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState TextDocumentCodeAction
codeAction :: Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
codeAction Recorder (WithPriority Log)
recorder IdeState
state PluginId
plId (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ TextDocumentIdentifier
docId Range
_ CodeActionContext
context) = forall (m :: * -> *) a.
Monad m =>
ExceptT String m a -> m (Either ResponseError a)
pluginResponse forall a b. (a -> b) -> a -> b
$ do
    NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT String m NormalizedFilePath
getNormalizedFilePath Uri
uri
    [Command |? CodeAction]
actions <- forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NormalizedFilePath
-> Diagnostic
-> ExceptT String (LspT Config IO) [Command |? CodeAction]
mkActions NormalizedFilePath
nfp) [Diagnostic]
methodDiags
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [Command |? CodeAction]
actions
    where
        uri :: Uri
uri = TextDocumentIdentifier
docId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
J.uri
        List [Diagnostic]
diags = CodeActionContext
context forall s a. s -> Getting a s a -> a
^. forall s a. HasDiagnostics s a => Lens' s a
J.diagnostics

        ghcDiags :: [Diagnostic]
ghcDiags = forall a. (a -> Bool) -> [a] -> [a]
filter (\Diagnostic
d -> Diagnostic
d forall s a. s -> Getting a s a -> a
^. forall s a. HasSource s a => Lens' s a
J.source forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"typecheck") [Diagnostic]
diags
        methodDiags :: [Diagnostic]
methodDiags = forall a. (a -> Bool) -> [a] -> [a]
filter (\Diagnostic
d -> Text -> Bool
isClassMethodWarning (Diagnostic
d forall s a. s -> Getting a s a -> a
^. forall s a. HasMessage s a => Lens' s a
J.message)) [Diagnostic]
ghcDiags

        mkActions
            :: NormalizedFilePath
            -> Diagnostic
            -> ExceptT String (LspT Ide.Plugin.Config.Config IO) [Command |? CodeAction]
        mkActions :: NormalizedFilePath
-> Diagnostic
-> ExceptT String (LspT Config IO) [Command |? CodeAction]
mkActions NormalizedFilePath
docPath Diagnostic
diag = do
            (HAR {hieAst :: ()
hieAst = HieASTs a
ast}, PositionMapping
pmap) <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Unable to GetHieAst"
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin.findClassIdentifier.GetHieAst" IdeState
state
                forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetHieAst
GetHieAst NormalizedFilePath
docPath
            Position
instancePosition <- forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"No range" forall a b. (a -> b) -> a -> b
$
                              PositionMapping -> Range -> Maybe Range
fromCurrentRange PositionMapping
pmap Range
range forall s a. s -> Getting (First a) s a -> Maybe a
^? forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStart s a => Lens' s a
J.start
                              forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. HasCharacter s a => Lens' s a
J.character forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ UInt
1)
            Identifier
ident <- forall {m :: * -> *} {e} {a}.
(Monad m, IsString e) =>
HieASTs a -> Position -> ExceptT e m Identifier
findClassIdentifier HieASTs a
ast Position
instancePosition
            Class
cls <- NormalizedFilePath
-> Identifier -> ExceptT String (LspT Config IO) Class
findClassFromIdentifier NormalizedFilePath
docPath Identifier
ident
            InstanceBindTypeSigsResult [InstanceBindTypeSig]
sigs <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Unable to GetInstanceBindTypeSigs"
                forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin.codeAction.GetInstanceBindTypeSigs" IdeState
state
                forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetInstanceBindTypeSigs
GetInstanceBindTypeSigs NormalizedFilePath
docPath
            [Text]
implemented <- forall a.
HieASTs a -> Position -> ExceptT String (LspT Config IO) [Text]
findImplementedMethods HieASTs a
ast Position
instancePosition
            forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Info (Class -> [Text] -> Log
LogImplementedMethods Class
cls [Text]
implemented)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure
                forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [(Text, Text)] -> [Command |? CodeAction]
mkAction
                forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
bind, Text
_) -> Text
bind forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
implemented))
                forall a b. (a -> b) -> a -> b
$ Range
-> [InstanceBindTypeSig] -> BooleanFormula Name -> [[(Text, Text)]]
minDefToMethodGroups Range
range [InstanceBindTypeSig]
sigs
                forall a b. (a -> b) -> a -> b
$ Class -> BooleanFormula Name
classMinimalDef Class
cls
            where
                range :: Range
range = Diagnostic
diag forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
J.range

                mkAction :: [(T.Text, T.Text)] -> [Command |? CodeAction]
                mkAction :: [(Text, Text)] -> [Command |? CodeAction]
mkAction [(Text, Text)]
methodGroup
                    = [ forall {a}. Text -> Command -> a |? CodeAction
mkCodeAction Text
title
                            forall a b. (a -> b) -> a -> b
$ PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plId CommandId
codeActionCommandId Text
title
                                (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Bool -> [Value]
mkCmdParams [(Text, Text)]
methodGroup Bool
False)
                      , forall {a}. Text -> Command -> a |? CodeAction
mkCodeAction Text
titleWithSig
                            forall a b. (a -> b) -> a -> b
$ PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plId CommandId
codeActionCommandId Text
titleWithSig
                                (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Bool -> [Value]
mkCmdParams [(Text, Text)]
methodGroup Bool
True)
                      ]
                    where
                        title :: Text
title = forall {a}. (IsString a, Monoid a) => [a] -> a
mkTitle forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
methodGroup
                        titleWithSig :: Text
titleWithSig = forall {a}. (IsString a, Monoid a) => [a] -> a
mkTitleWithSig forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
methodGroup

                mkTitle :: [a] -> a
mkTitle [a]
methodGroup
                    = a
"Add placeholders for "
                        forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse a
", " (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
m -> a
"'" forall a. Semigroup a => a -> a -> a
<> a
m forall a. Semigroup a => a -> a -> a
<> a
"'") [a]
methodGroup))

                mkTitleWithSig :: [a] -> a
mkTitleWithSig [a]
methodGroup = forall {a}. (IsString a, Monoid a) => [a] -> a
mkTitle [a]
methodGroup forall a. Semigroup a => a -> a -> a
<> a
" with signature(s)"

                mkCmdParams :: [(Text, Text)] -> Bool -> [Value]
mkCmdParams [(Text, Text)]
methodGroup Bool
withSig =
                    [forall a. ToJSON a => a -> Value
toJSON (Uri
-> Range -> List (Text, Text) -> Bool -> AddMinimalMethodsParams
AddMinimalMethodsParams Uri
uri Range
range (forall a. [a] -> List a
List [(Text, Text)]
methodGroup) Bool
withSig)]

                mkCodeAction :: Text -> Command -> a |? CodeAction
mkCodeAction Text
title Command
cmd
                    = forall a b. b -> a |? b
InR
                    forall a b. (a -> b) -> a -> b
$ Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction
                        Text
title
                        (forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix)
                        (forall a. a -> Maybe a
Just (forall a. [a] -> List a
List []))
                        forall a. Maybe a
Nothing
                        forall a. Maybe a
Nothing
                        forall a. Maybe a
Nothing
                        (forall a. a -> Maybe a
Just Command
cmd)
                        forall a. Maybe a
Nothing

        findClassIdentifier :: HieASTs a -> Position -> ExceptT e m Identifier
findClassIdentifier HieASTs a
hf Position
instancePosition =
            forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe e
"No Identifier found"
                forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe
                forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. [a] -> Maybe a
listToMaybe
                forall a b. (a -> b) -> a -> b
$ forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
hf Position
instancePosition
                    ( (forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter forall a. IdentifierDetails a -> Bool
isClassNodeIdentifier forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HieAST a -> Map Identifier (IdentifierDetails a)
getNodeIds)
                        forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. HieAST a -> [HieAST a]
nodeChildren
                    )

        findImplementedMethods
            :: HieASTs a
            -> Position
            -> ExceptT String (LspT Ide.Plugin.Config.Config IO) [T.Text]
        findImplementedMethods :: forall a.
HieASTs a -> Position -> ExceptT String (LspT Config IO) [Text]
findImplementedMethods HieASTs a
asts Position
instancePosition = do
            forall (f :: * -> *) a. Applicative f => a -> f a
pure
                forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                forall a b. (a -> b) -> a -> b
$ forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
asts Position
instancePosition
                forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NamedThing a => a -> String
getOccString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> [b]
rights forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HieAST a -> [Identifier]
findInstanceValBindIdentifiers

        -- | Recurses through the given AST to find identifiers which are
        -- 'InstanceValBind's.
        findInstanceValBindIdentifiers :: HieAST a -> [Identifier]
        findInstanceValBindIdentifiers :: forall a. HieAST a -> [Identifier]
findInstanceValBindIdentifiers HieAST a
ast =
            let valBindIds :: [Identifier]
valBindIds = forall k a. Map k a -> [k]
Map.keys
                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isInstanceValBind forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IdentifierDetails a -> Set ContextInfo
identInfo)
                            forall a b. (a -> b) -> a -> b
$ forall a. HieAST a -> Map Identifier (IdentifierDetails a)
getNodeIds HieAST a
ast
            in [Identifier]
valBindIds forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. HieAST a -> [Identifier]
findInstanceValBindIdentifiers (forall a. HieAST a -> [HieAST a]
nodeChildren HieAST a
ast)

        findClassFromIdentifier :: NormalizedFilePath
-> Identifier -> ExceptT String (LspT Config IO) Class
findClassFromIdentifier NormalizedFilePath
docPath (Right Name
name) = do
            (HscEnvEq -> HscEnv
hscEnv -> HscEnv
hscenv, PositionMapping
_) <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Unable to GhcSessionDeps"
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin.findClassFromIdentifier.GhcSessionDeps" IdeState
state
                forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSessionDeps
GhcSessionDeps NormalizedFilePath
docPath
            (TcModuleResult -> TcGblEnv
tmrTypechecked -> TcGblEnv
thisMod, PositionMapping
_) <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Unable to TypeCheck"
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin.findClassFromIdentifier.TypeCheck" IdeState
state
                forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale TypeCheck
TypeCheck NormalizedFilePath
docPath
            forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"TcEnv"
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r.
HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM r
-> IO (Messages DecoratedSDoc, Maybe r)
initTcWithGbl HscEnv
hscenv TcGblEnv
thisMod RealSrcSpan
ghostSpan forall a b. (a -> b) -> a -> b
$ do
                    TcTyThing
tcthing <- Name -> TcM TcTyThing
tcLookup Name
name
                    case TcTyThing
tcthing of
                        AGlobal (AConLike (RealDataCon DataCon
con))
                            | Just Class
cls <- TyCon -> Maybe Class
tyConClass_maybe (DataCon -> TyCon
dataConOrigTyCon DataCon
con) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Class
cls
                        TcTyThing
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Ide.Plugin.Class.findClassFromIdentifier"
        findClassFromIdentifier NormalizedFilePath
_ (Left ModuleName
_) = forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"Ide.Plugin.Class.findClassIdentifier"

isClassNodeIdentifier :: IdentifierDetails a -> Bool
isClassNodeIdentifier :: forall a. IdentifierDetails a -> Bool
isClassNodeIdentifier IdentifierDetails a
ident = (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IdentifierDetails a -> Maybe a
identType) IdentifierDetails a
ident Bool -> Bool -> Bool
&& ContextInfo
Use forall a. Ord a => a -> Set a -> Bool
`Set.member` forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
ident

isClassMethodWarning :: T.Text -> Bool
isClassMethodWarning :: Text -> Bool
isClassMethodWarning = Text -> Text -> Bool
T.isPrefixOf Text
"• No explicit implementation for"

isInstanceValBind :: ContextInfo -> Bool
isInstanceValBind :: ContextInfo -> Bool
isInstanceValBind (ValBind BindType
InstanceBind Scope
_ Maybe RealSrcSpan
_) = Bool
True
isInstanceValBind ContextInfo
_                          = Bool
False

-- Return (name text, signature text)
minDefToMethodGroups :: Range -> [InstanceBindTypeSig] -> BooleanFormula Name -> [[(T.Text, T.Text)]]
minDefToMethodGroups :: Range
-> [InstanceBindTypeSig] -> BooleanFormula Name -> [[(Text, Text)]]
minDefToMethodGroups Range
range [InstanceBindTypeSig]
sigs = BooleanFormula Name -> [[(Text, Text)]]
go
    where
        go :: BooleanFormula Name -> [[(Text, Text)]]
go (Var Name
mn)   = [[ (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name. HasOccName name => name -> OccName
occName forall a b. (a -> b) -> a -> b
$ Name
mn, InstanceBindTypeSig -> Text
bindRendered InstanceBindTypeSig
sig)
                        | InstanceBindTypeSig
sig <- [InstanceBindTypeSig]
sigs
                        , Range -> SrcSpan -> Bool
inRange Range
range (forall a. NamedThing a => a -> SrcSpan
getSrcSpan forall a b. (a -> b) -> a -> b
$ InstanceBindTypeSig -> Name
bindName InstanceBindTypeSig
sig)
                        , forall a. Outputable a => a -> Text
printOutputable Name
mn forall a. Eq a => a -> a -> Bool
== Int -> Text -> Text
T.drop (Text -> Int
T.length forall s. IsString s => s
bindingPrefix) (forall a. Outputable a => a -> Text
printOutputable (InstanceBindTypeSig -> Name
bindName InstanceBindTypeSig
sig))
                        ]]
        go (Or [LBooleanFormula Name]
ms)    = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BooleanFormula Name -> [[(Text, Text)]]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [LBooleanFormula Name]
ms
        go (And [LBooleanFormula Name]
ms)   = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)) [[]] (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BooleanFormula Name -> [[(Text, Text)]]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [LBooleanFormula Name]
ms)
        go (Parens LBooleanFormula Name
m) = BooleanFormula Name -> [[(Text, Text)]]
go (forall l e. GenLocated l e -> e
unLoc LBooleanFormula Name
m)