{-# 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
toTextDocunemtEdit :: TextEdit -> TextDocumentEdit
toTextDocunemtEdit 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
toTextDocunemtEdit) [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
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
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
"Error in 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
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)