{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Ide.Plugin.ExplicitImports
( descriptor
, descriptorForModules
, abbreviateImportTitle
, Log(..)
) where
import Control.DeepSeq
import Control.Lens ((&), (?~))
import Control.Monad.Error.Class (MonadError (throwError))
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Maybe
import qualified Data.Aeson as A (ToJSON (toJSON))
import Data.Aeson.Types (FromJSON)
import qualified Data.IntMap as IM (IntMap, elems,
fromList, (!?))
import Data.IORef (readIORef)
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import qualified Data.Set as S
import Data.String (fromString)
import qualified Data.Text as T
import Data.Traversable (for)
import qualified Data.Unique as U (hashUnique,
newUnique)
import Development.IDE hiding (pluginHandlers,
pluginRules)
import Development.IDE.Core.PluginUtils
import Development.IDE.Core.PositionMapping
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.GHC.Compat hiding ((<+>))
import Development.IDE.Graph.Classes
import GHC.Generics (Generic)
import Ide.Plugin.Error (PluginError (..),
getNormalizedFilePathE,
handleMaybe)
import Ide.Plugin.RangeMap (filterByRange)
import qualified Ide.Plugin.RangeMap as RM (RangeMap, fromList)
import Ide.Plugin.Resolve
import Ide.PluginUtils
import Ide.Types
import qualified Language.LSP.Protocol.Lens as L
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import Language.LSP.Server
importCommandId :: CommandId
importCommandId :: CommandId
importCommandId = CommandId
"ImportLensCommand"
data Log
= LogShake Shake.Log
| LogWAEResponseError ResponseError
| forall a. (Pretty a) => LogResolve a
instance Pretty Log where
pretty :: forall ann. Log -> Doc ann
pretty = \case
LogShake Log
logMsg -> forall a ann. Pretty a => a -> Doc ann
pretty Log
logMsg
LogWAEResponseError ResponseError
rspErr -> Doc ann
"RequestWorkspaceApplyEdit Failed with " forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow ResponseError
rspErr
LogResolve a
msg -> forall a ann. Pretty a => a -> Doc ann
pretty a
msg
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> (ModuleName -> Bool) -> PluginId -> PluginDescriptor IdeState
descriptorForModules Recorder (WithPriority Log)
recorder (forall a. Eq a => a -> a -> Bool
/= forall unit. GenModule unit -> ModuleName
moduleName Module
pRELUDE)
descriptorForModules
:: Recorder (WithPriority Log)
-> (ModuleName -> Bool)
-> PluginId
-> PluginDescriptor IdeState
descriptorForModules :: Recorder (WithPriority Log)
-> (ModuleName -> Bool) -> PluginId -> PluginDescriptor IdeState
descriptorForModules Recorder (WithPriority Log)
recorder ModuleName -> Bool
modFilter PluginId
plId =
let resolveRecorder :: Recorder (WithPriority Log)
resolveRecorder = forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio forall a. Pretty a => a -> Log
LogResolve Recorder (WithPriority Log)
recorder
codeActionHandlers :: PluginHandlers IdeState
codeActionHandlers = forall ideState a.
FromJSON a =>
Recorder (WithPriority Log)
-> PluginMethodHandler ideState 'Method_TextDocumentCodeAction
-> ResolveFunction ideState a 'Method_CodeActionResolve
-> PluginHandlers ideState
mkCodeActionHandlerWithResolve Recorder (WithPriority Log)
resolveRecorder (Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider Recorder (WithPriority Log)
recorder) (Recorder (WithPriority Log)
-> ResolveFunction IdeState IAResolveData 'Method_CodeActionResolve
codeActionResolveProvider Recorder (WithPriority Log)
recorder)
in (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
{
pluginCommands :: [PluginCommand IdeState]
pluginCommands = [forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
importCommandId Text
"Explicit import command" (Recorder (WithPriority Log)
-> CommandFunction IdeState IAResolveData
runImportCommand Recorder (WithPriority Log)
recorder)],
pluginRules :: Rules ()
pluginRules = Recorder (WithPriority Log) -> (ModuleName -> Bool) -> Rules ()
minimalImportsRule Recorder (WithPriority Log)
recorder ModuleName -> Bool
modFilter,
pluginHandlers :: PluginHandlers IdeState
pluginHandlers =
forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentCodeLens
SMethod_TextDocumentCodeLens (Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens
lensProvider Recorder (WithPriority Log)
recorder)
forall a. Semigroup a => a -> a -> a
<> forall ideState a (m :: Method 'ClientToServer 'Request).
(FromJSON a, PluginRequestMethod m,
HasData_ (MessageParams m) (Maybe Value)) =>
SClientMethod m
-> ResolveFunction ideState a m -> PluginHandlers ideState
mkResolveHandler SMethod 'Method_CodeLensResolve
SMethod_CodeLensResolve (Recorder (WithPriority Log)
-> ResolveFunction IdeState IAResolveData 'Method_CodeLensResolve
lensResolveProvider Recorder (WithPriority Log)
recorder)
forall a. Semigroup a => a -> a -> a
<> PluginHandlers IdeState
codeActionHandlers
}
runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IAResolveData
runImportCommand :: Recorder (WithPriority Log)
-> CommandFunction IdeState IAResolveData
runImportCommand Recorder (WithPriority Log)
recorder IdeState
ideState eird :: IAResolveData
eird@(ResolveOne Uri
_ Int
_) = do
WorkspaceEdit
wedit <- IdeState
-> IAResolveData
-> ExceptT PluginError (LspT Config IO) WorkspaceEdit
resolveWTextEdit IdeState
ideState IAResolveData
eird
LspId 'Method_WorkspaceApplyEdit
_ <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'ServerToClient 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (MessageResult m) -> f ())
-> f (LspId m)
sendRequest SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
wedit) Either ResponseError ApplyWorkspaceEditResult -> LspT Config IO ()
logErrors
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR Null
Null
where logErrors :: Either ResponseError ApplyWorkspaceEditResult -> LspT Config IO ()
logErrors (Left re :: ResponseError
re@(ResponseError{})) = do
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Error (ResponseError -> Log
LogWAEResponseError ResponseError
re)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
logErrors (Right ApplyWorkspaceEditResult
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
runImportCommand Recorder (WithPriority Log)
_ IdeState
_ IAResolveData
rd = do
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInvalidParams ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected argument for command handler:" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show IAResolveData
rd)
lensProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens
lensProvider :: Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens
lensProvider Recorder (WithPriority Log)
_ IdeState
state PluginId
_ CodeLensParams {$sel:_textDocument:CodeLensParams :: CodeLensParams -> TextDocumentIdentifier
_textDocument = TextDocumentIdentifier {Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri :: Uri
_uri}} = do
NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
_uri
(ImportActionsResult{[(Range, Int)]
forLens :: ImportActionsResult -> [(Range, Int)]
forLens :: [(Range, Int)]
forLens}, PositionMapping
pm) <- forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
state forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
let lens :: [CodeLens]
lens = [ Uri -> Range -> Int -> CodeLens
generateLens Uri
_uri Range
newRange Int
int
| (Range
range, Int
int) <- [(Range, Int)]
forLens
, Just Range
newRange <- [PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
pm Range
range]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL [CodeLens]
lens
where
generateLens :: Uri -> Range -> Int -> CodeLens
generateLens :: Uri -> Range -> Int -> CodeLens
generateLens Uri
uri Range
range Int
int =
CodeLens { $sel:_data_:CodeLens :: Maybe Value
_data_ = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
A.toJSON forall a b. (a -> b) -> a -> b
$ Uri -> Int -> IAResolveData
ResolveOne Uri
uri Int
int
, $sel:_range:CodeLens :: Range
_range = Range
range
, $sel:_command:CodeLens :: Maybe Command
_command = forall a. Maybe a
Nothing }
lensResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeLensResolve
lensResolveProvider :: Recorder (WithPriority Log)
-> ResolveFunction IdeState IAResolveData 'Method_CodeLensResolve
lensResolveProvider Recorder (WithPriority Log)
_ IdeState
ideState PluginId
plId MessageParams 'Method_CodeLensResolve
cl Uri
uri rd :: IAResolveData
rd@(ResolveOne Uri
_ Int
uid) = do
NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
(ImportActionsResult{IntMap ImportEdit
forResolve :: ImportActionsResult -> IntMap ImportEdit
forResolve :: IntMap ImportEdit
forResolve}, PositionMapping
_) <- forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
ImportEdit
target <- forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe PluginError
PluginStaleResolve forall a b. (a -> b) -> a -> b
$ IntMap ImportEdit
forResolve forall a. IntMap a -> Int -> Maybe a
IM.!? Int
uid
let updatedCodeLens :: CodeLens
updatedCodeLens = MessageParams 'Method_CodeLensResolve
cl forall a b. a -> (a -> b) -> b
& forall s a. HasCommand s a => Lens' s a
L.command forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ PluginId -> ImportEdit -> Command
mkCommand PluginId
plId ImportEdit
target
forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeLens
updatedCodeLens
where mkCommand :: PluginId -> ImportEdit -> Command
mkCommand :: PluginId -> ImportEdit -> Command
mkCommand PluginId
pId (ImportEdit{ResultType
ieResType :: ImportEdit -> ResultType
ieResType :: ResultType
ieResType, Text
ieText :: ImportEdit -> Text
ieText :: Text
ieText}) =
let
title :: ResultType -> Text
title ResultType
ExplicitImport = Text -> Text
abbreviateImportTitle Text
ieText
title ResultType
RefineImport = Text
"Refine imports to " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (Text -> [Text]
T.lines Text
ieText)
in PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
pId CommandId
importCommandId (ResultType -> Text
title ResultType
ieResType) (forall a. a -> Maybe a
Just [forall a. ToJSON a => a -> Value
A.toJSON IAResolveData
rd])
lensResolveProvider Recorder (WithPriority Log)
_ IdeState
_ PluginId
_ MessageParams 'Method_CodeLensResolve
_ Uri
_ IAResolveData
rd = do
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInvalidParams ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected argument for lens resolve handler: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show IAResolveData
rd)
codeActionProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider :: Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider Recorder (WithPriority Log)
_ IdeState
ideState PluginId
_pId (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ TextDocumentIdentifier {Uri
_uri :: Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri} Range
range CodeActionContext
_context) = do
NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
_uri
(ImportActionsResult{RangeMap ImportAction
forCodeActions :: ImportActionsResult -> RangeMap ImportAction
forCodeActions :: RangeMap ImportAction
forCodeActions}, PositionMapping
pm) <- forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
Range
newRange <- forall (m :: * -> *).
Monad m =>
PositionMapping -> Range -> ExceptT PluginError m Range
toCurrentRangeE PositionMapping
pm Range
range
let relevantCodeActions :: [ImportAction]
relevantCodeActions = forall a. Range -> RangeMap a -> [a]
filterByRange Range
newRange RangeMap ImportAction
forCodeActions
allExplicit :: [Command |? CodeAction]
allExplicit =
[forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ Text -> Maybe Value -> CodeAction
mkCodeAction Text
"Make all imports explicit" (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
A.toJSON forall a b. (a -> b) -> a -> b
$ Uri -> IAResolveData
ExplicitAll Uri
_uri)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ImportAction
x -> ImportAction -> ResultType
iaResType ImportAction
x forall a. Eq a => a -> a -> Bool
== ResultType
ExplicitImport) [ImportAction]
relevantCodeActions]
allRefine :: [Command |? CodeAction]
allRefine =
[forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ Text -> Maybe Value -> CodeAction
mkCodeAction Text
"Refine all imports" (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
A.toJSON forall a b. (a -> b) -> a -> b
$ Uri -> IAResolveData
RefineAll Uri
_uri)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ImportAction
x -> ImportAction -> ResultType
iaResType ImportAction
x forall a. Eq a => a -> a -> Bool
== ResultType
RefineImport) [ImportAction]
relevantCodeActions]
toCodeAction :: Uri -> ImportAction -> CodeAction
toCodeAction Uri
uri (ImportAction Range
_ Int
int ResultType
ExplicitImport) =
Text -> Maybe Value -> CodeAction
mkCodeAction Text
"Make this import explicit" (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
A.toJSON forall a b. (a -> b) -> a -> b
$ Uri -> Int -> IAResolveData
ResolveOne Uri
uri Int
int)
toCodeAction Uri
uri (ImportAction Range
_ Int
int ResultType
RefineImport) =
Text -> Maybe Value -> CodeAction
mkCodeAction Text
"Refine this import" (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
A.toJSON forall a b. (a -> b) -> a -> b
$ Uri -> Int -> IAResolveData
ResolveOne Uri
uri Int
int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL ((forall a b. b -> a |? b
InR forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> ImportAction -> CodeAction
toCodeAction Uri
_uri forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportAction]
relevantCodeActions) forall a. Semigroup a => a -> a -> a
<> [Command |? CodeAction]
allExplicit forall a. Semigroup a => a -> a -> a
<> [Command |? CodeAction]
allRefine)
where mkCodeAction :: Text -> Maybe Value -> CodeAction
mkCodeAction Text
title Maybe Value
data_ =
CodeAction
{ $sel:_title:CodeAction :: Text
_title = Text
title
, $sel:_kind:CodeAction :: Maybe CodeActionKind
_kind = forall a. a -> Maybe a
Just CodeActionKind
CodeActionKind_QuickFix
, $sel:_command:CodeAction :: Maybe Command
_command = forall a. Maybe a
Nothing
, $sel:_edit:CodeAction :: Maybe WorkspaceEdit
_edit = forall a. Maybe a
Nothing
, $sel:_diagnostics:CodeAction :: Maybe [Diagnostic]
_diagnostics = forall a. Maybe a
Nothing
, $sel:_isPreferred:CodeAction :: Maybe Bool
_isPreferred = forall a. Maybe a
Nothing
, $sel:_disabled:CodeAction :: Maybe (Rec (("reason" .== Text) .+ Empty))
_disabled = forall a. Maybe a
Nothing
, $sel:_data_:CodeAction :: Maybe Value
_data_ = Maybe Value
data_}
codeActionResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeActionResolve
codeActionResolveProvider :: Recorder (WithPriority Log)
-> ResolveFunction IdeState IAResolveData 'Method_CodeActionResolve
codeActionResolveProvider Recorder (WithPriority Log)
_ IdeState
ideState PluginId
_ MessageParams 'Method_CodeActionResolve
ca Uri
_ IAResolveData
rd = do
WorkspaceEdit
wedit <- IdeState
-> IAResolveData
-> ExceptT PluginError (LspT Config IO) WorkspaceEdit
resolveWTextEdit IdeState
ideState IAResolveData
rd
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ MessageParams 'Method_CodeActionResolve
ca forall a b. a -> (a -> b) -> b
& forall s a. HasEdit s a => Lens' s a
L.edit forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ WorkspaceEdit
wedit
resolveWTextEdit :: IdeState -> IAResolveData -> ExceptT PluginError (LspT Config IO) WorkspaceEdit
resolveWTextEdit :: IdeState
-> IAResolveData
-> ExceptT PluginError (LspT Config IO) WorkspaceEdit
resolveWTextEdit IdeState
ideState (ResolveOne Uri
uri Int
int) = do
NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
(ImportActionsResult{IntMap ImportEdit
forResolve :: IntMap ImportEdit
forResolve :: ImportActionsResult -> IntMap ImportEdit
forResolve}, PositionMapping
pm) <- forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
ImportEdit
iEdit <- forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe PluginError
PluginStaleResolve forall a b. (a -> b) -> a -> b
$ IntMap ImportEdit
forResolve forall a. IntMap a -> Int -> Maybe a
IM.!? Int
int
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit
mkWorkspaceEdit Uri
uri [ImportEdit
iEdit] PositionMapping
pm
resolveWTextEdit IdeState
ideState (ExplicitAll Uri
uri) = do
NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
(ImportActionsResult{IntMap ImportEdit
forResolve :: IntMap ImportEdit
forResolve :: ImportActionsResult -> IntMap ImportEdit
forResolve}, PositionMapping
pm) <- forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
let edits :: [ImportEdit]
edits = [ ImportEdit
ie | ie :: ImportEdit
ie@ImportEdit{ieResType :: ImportEdit -> ResultType
ieResType = ResultType
ExplicitImport} <- forall a. IntMap a -> [a]
IM.elems IntMap ImportEdit
forResolve]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit
mkWorkspaceEdit Uri
uri [ImportEdit]
edits PositionMapping
pm
resolveWTextEdit IdeState
ideState (RefineAll Uri
uri) = do
NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
(ImportActionsResult{IntMap ImportEdit
forResolve :: IntMap ImportEdit
forResolve :: ImportActionsResult -> IntMap ImportEdit
forResolve}, PositionMapping
pm) <- forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
let edits :: [ImportEdit]
edits = [ ImportEdit
re | re :: ImportEdit
re@ImportEdit{ieResType :: ImportEdit -> ResultType
ieResType = ResultType
RefineImport} <- forall a. IntMap a -> [a]
IM.elems IntMap ImportEdit
forResolve]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit
mkWorkspaceEdit Uri
uri [ImportEdit]
edits PositionMapping
pm
mkWorkspaceEdit :: Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit
mkWorkspaceEdit :: Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit
mkWorkspaceEdit Uri
uri [ImportEdit]
edits PositionMapping
pm =
WorkspaceEdit {$sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
_changes = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Uri
uri, forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ImportEdit -> Maybe TextEdit
toWEdit [ImportEdit]
edits)]
, $sel:_documentChanges:WorkspaceEdit :: Maybe
[TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_documentChanges = forall a. Maybe a
Nothing
, $sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
_changeAnnotations = forall a. Maybe a
Nothing}
where toWEdit :: ImportEdit -> Maybe TextEdit
toWEdit ImportEdit{Range
ieRange :: ImportEdit -> Range
ieRange :: Range
ieRange, Text
ieText :: Text
ieText :: ImportEdit -> Text
ieText} =
let newRange :: Maybe Range
newRange = PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
pm Range
ieRange
in (\Range
r -> Range -> Text -> TextEdit
TextEdit Range
r Text
ieText) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
newRange
data ImportActions = ImportActions
deriving (Int -> ImportActions -> ShowS
[ImportActions] -> ShowS
ImportActions -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ImportActions] -> ShowS
$cshowList :: [ImportActions] -> ShowS
show :: ImportActions -> [Char]
$cshow :: ImportActions -> [Char]
showsPrec :: Int -> ImportActions -> ShowS
$cshowsPrec :: Int -> ImportActions -> ShowS
Show, forall x. Rep ImportActions x -> ImportActions
forall x. ImportActions -> Rep ImportActions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportActions x -> ImportActions
$cfrom :: forall x. ImportActions -> Rep ImportActions x
Generic, ImportActions -> ImportActions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportActions -> ImportActions -> Bool
$c/= :: ImportActions -> ImportActions -> Bool
== :: ImportActions -> ImportActions -> Bool
$c== :: ImportActions -> ImportActions -> Bool
Eq, Eq ImportActions
ImportActions -> ImportActions -> Bool
ImportActions -> ImportActions -> Ordering
ImportActions -> ImportActions -> ImportActions
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
min :: ImportActions -> ImportActions -> ImportActions
$cmin :: ImportActions -> ImportActions -> ImportActions
max :: ImportActions -> ImportActions -> ImportActions
$cmax :: ImportActions -> ImportActions -> ImportActions
>= :: ImportActions -> ImportActions -> Bool
$c>= :: ImportActions -> ImportActions -> Bool
> :: ImportActions -> ImportActions -> Bool
$c> :: ImportActions -> ImportActions -> Bool
<= :: ImportActions -> ImportActions -> Bool
$c<= :: ImportActions -> ImportActions -> Bool
< :: ImportActions -> ImportActions -> Bool
$c< :: ImportActions -> ImportActions -> Bool
compare :: ImportActions -> ImportActions -> Ordering
$ccompare :: ImportActions -> ImportActions -> Ordering
Ord)
instance Hashable ImportActions
instance NFData ImportActions
type instance RuleResult ImportActions = ImportActionsResult
data ResultType = ExplicitImport | RefineImport
deriving ResultType -> ResultType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultType -> ResultType -> Bool
$c/= :: ResultType -> ResultType -> Bool
== :: ResultType -> ResultType -> Bool
$c== :: ResultType -> ResultType -> Bool
Eq
data ImportActionsResult = ImportActionsResult
{
ImportActionsResult -> [(Range, Int)]
forLens :: [(Range, Int)]
, ImportActionsResult -> RangeMap ImportAction
forCodeActions :: RM.RangeMap ImportAction
, ImportActionsResult -> IntMap ImportEdit
forResolve :: IM.IntMap ImportEdit }
data ImportEdit = ImportEdit { ImportEdit -> Range
ieRange :: Range, ImportEdit -> Text
ieText :: T.Text, ImportEdit -> ResultType
ieResType :: ResultType}
data ImportAction = ImportAction { ImportAction -> Range
iaRange :: Range, ImportAction -> Int
iaUniqueId :: Int, ImportAction -> ResultType
iaResType :: ResultType}
instance Show ImportActionsResult where show :: ImportActionsResult -> [Char]
show ImportActionsResult
_ = [Char]
"<ImportActionsResult>"
instance NFData ImportActionsResult where rnf :: ImportActionsResult -> ()
rnf = forall a. a -> ()
rwhnf
data IAResolveData = ResolveOne
{ IAResolveData -> Uri
uri :: Uri
, IAResolveData -> Int
importId :: Int }
| ExplicitAll
{ uri :: Uri }
| RefineAll
{ uri :: Uri }
deriving (forall x. Rep IAResolveData x -> IAResolveData
forall x. IAResolveData -> Rep IAResolveData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IAResolveData x -> IAResolveData
$cfrom :: forall x. IAResolveData -> Rep IAResolveData x
Generic, Int -> IAResolveData -> ShowS
[IAResolveData] -> ShowS
IAResolveData -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IAResolveData] -> ShowS
$cshowList :: [IAResolveData] -> ShowS
show :: IAResolveData -> [Char]
$cshow :: IAResolveData -> [Char]
showsPrec :: Int -> IAResolveData -> ShowS
$cshowsPrec :: Int -> IAResolveData -> ShowS
Show, [IAResolveData] -> Encoding
[IAResolveData] -> Value
IAResolveData -> Encoding
IAResolveData -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IAResolveData] -> Encoding
$ctoEncodingList :: [IAResolveData] -> Encoding
toJSONList :: [IAResolveData] -> Value
$ctoJSONList :: [IAResolveData] -> Value
toEncoding :: IAResolveData -> Encoding
$ctoEncoding :: IAResolveData -> Encoding
toJSON :: IAResolveData -> Value
$ctoJSON :: IAResolveData -> Value
A.ToJSON, Value -> Parser [IAResolveData]
Value -> Parser IAResolveData
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [IAResolveData]
$cparseJSONList :: Value -> Parser [IAResolveData]
parseJSON :: Value -> Parser IAResolveData
$cparseJSON :: Value -> Parser IAResolveData
FromJSON)
exportedModuleStrings :: ParsedModule -> [String]
exportedModuleStrings :: ParsedModule -> [[Char]]
exportedModuleStrings ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (LocatedP WarningTxt)
Maybe (LocatedA ModuleName)
Maybe (LocatedL [LIE GhcPs])
Maybe LHsDocString
EpAnn AnnsModule
LayoutInfo
hsmodAnn :: HsModule -> EpAnn AnnsModule
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDeprecMessage :: HsModule -> Maybe (LocatedP WarningTxt)
hsmodExports :: HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodHaddockModHeader :: HsModule -> Maybe LHsDocString
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodLayout :: HsModule -> LayoutInfo
hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (LocatedP WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (LocatedL [LIE GhcPs])
hsmodName :: Maybe (LocatedA ModuleName)
hsmodLayout :: LayoutInfo
hsmodAnn :: EpAnn AnnsModule
..}}
| Just LocatedL [LIE GhcPs]
export <- Maybe (LocatedL [LIE GhcPs])
hsmodExports,
[GenLocated SrcSpanAnnA (IE GhcPs)]
exports <- forall l e. GenLocated l e -> e
unLoc LocatedL [LIE GhcPs]
export
= forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> Text
printOutputable) [GenLocated SrcSpanAnnA (IE GhcPs)]
exports
exportedModuleStrings ParsedModule
_ = []
minimalImportsRule :: Recorder (WithPriority Log) -> (ModuleName -> Bool) -> Rules ()
minimalImportsRule :: Recorder (WithPriority Log) -> (ModuleName -> Bool) -> Rules ()
minimalImportsRule Recorder (WithPriority Log)
recorder ModuleName -> Bool
modFilter = forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics (forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) forall a b. (a -> b) -> a -> b
$ \ImportActions
ImportActions NormalizedFilePath
nfp -> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
TcModuleResult
tmr <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck NormalizedFilePath
nfp
HscEnvEq
hsc <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSessionDeps
GhcSessionDeps NormalizedFilePath
nfp
Map ModuleName (Map ModuleName [AvailInfo])
import2Map <- do
ImportMap Map ModuleName NormalizedFilePath
currIm <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetImportMap
GetImportMap NormalizedFilePath
nfp
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map ModuleName NormalizedFilePath
currIm forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
path -> do
ImportMap Map ModuleName NormalizedFilePath
importIm <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetImportMap
GetImportMap NormalizedFilePath
path
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map ModuleName NormalizedFilePath
importIm forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
imp_path -> do
HiFileResult
imp_hir <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModIface
GetModIface NormalizedFilePath
imp_path
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports forall a b. (a -> b) -> a -> b
$ HiFileResult -> ModIface
hirModIface HiFileResult
imp_hir
([GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
imports, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
mbMinImports) <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnvEq
-> TcModuleResult
-> IO (Maybe ([LImportDecl GhcRn], [LImportDecl GhcRn]))
extractMinimalImports HscEnvEq
hsc TcModuleResult
tmr
let importsMap :: Map RealSrcLoc Text
importsMap =
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
l, forall a. Outputable a => a -> Text
printOutputable ImportDecl GhcRn
i)
| L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) ImportDecl GhcRn
i <- [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
mbMinImports
]
minimalImportsResult :: [(Range, (Text, ResultType))]
minimalImportsResult =
[ (Range
range, (Text
minImport, ResultType
ExplicitImport))
| imp :: GenLocated SrcSpanAnnA (ImportDecl GhcRn)
imp@(L SrcSpanAnnA
_ ImportDecl GhcRn
impDecl) <- [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
imports
, Bool -> Bool
not (forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl GhcRn
impDecl)
, Bool -> Bool
not (ImportDecl GhcRn -> Bool
isExplicitImport ImportDecl GhcRn
impDecl)
, let L SrcSpanAnnA
_ ModuleName
moduleName = forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcRn
impDecl
, ModuleName -> Bool
modFilter ModuleName
moduleName
, RealSrcSpan RealSrcSpan
location Maybe BufSpan
_ <- [forall a. HasSrcSpan a => a -> SrcSpan
getLoc GenLocated SrcSpanAnnA (ImportDecl GhcRn)
imp]
, let range :: Range
range = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
location
, Just Text
minImport <- [forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
location) Map RealSrcLoc Text
importsMap]
]
refineImportsResult :: [(Range, (Text, ResultType))]
refineImportsResult =
[ (Range
range, (Text -> [Text] -> Text
T.intercalate Text
"\n"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Outputable a => a -> Text
printOutputable forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> LImportDecl GhcRn
constructImport GenLocated SrcSpanAnnA (ImportDecl GhcRn)
i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList
forall a b. (a -> b) -> a -> b
$ Map ModuleName [AvailInfo]
filteredInnerImports, ResultType
RefineImport))
| [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
minImports <- [[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
mbMinImports]
, i :: GenLocated SrcSpanAnnA (ImportDecl GhcRn)
i@(L SrcSpanAnnA
_ ImportDecl{ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = L SrcSpanAnnA
_ ModuleName
mn}) <- [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
minImports
, ModuleName
mn forall a. Eq a => a -> a -> Bool
/= forall unit. GenModule unit -> ModuleName
moduleName Module
pRELUDE
, Just Map ModuleName [AvailInfo]
innerImports <- [forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
mn Map ModuleName (Map ModuleName [AvailInfo])
import2Map]
, Just Map ModuleName [AvailInfo]
filteredInnerImports <- [LImportDecl GhcRn
-> Map ModuleName [AvailInfo] -> Maybe (Map ModuleName [AvailInfo])
filterByImport GenLocated SrcSpanAnnA (ImportDecl GhcRn)
i Map ModuleName [AvailInfo]
innerImports]
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map ModuleName [AvailInfo]
filteredInnerImports
, RealSrcSpan RealSrcSpan
location Maybe BufSpan
_ <- [forall a. HasSrcSpan a => a -> SrcSpan
getLoc GenLocated SrcSpanAnnA (ImportDecl GhcRn)
i]
, let range :: Range
range = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
location
]
[(Int, (Range, (Text, ResultType)))]
uniqueAndRangeAndText <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([(Range, (Text, ResultType))]
minimalImportsResult forall a. [a] -> [a] -> [a]
++ [(Range, (Text, ResultType))]
refineImportsResult) forall a b. (a -> b) -> a -> b
$ \(Range, (Text, ResultType))
rt -> do
Int
u <- Unique -> Int
U.hashUnique forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique
U.newUnique
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
u, (Range, (Text, ResultType))
rt)
let rangeAndUnique :: [ImportAction]
rangeAndUnique = [ Range -> Int -> ResultType -> ImportAction
ImportAction Range
r Int
u ResultType
rt | (Int
u, (Range
r, (Text
_, ResultType
rt))) <- [(Int, (Range, (Text, ResultType)))]
uniqueAndRangeAndText ]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportActionsResult
{ forLens :: [(Range, Int)]
forLens = (\ImportAction{Int
Range
ResultType
iaResType :: ResultType
iaUniqueId :: Int
iaRange :: Range
iaUniqueId :: ImportAction -> Int
iaRange :: ImportAction -> Range
iaResType :: ImportAction -> ResultType
..} -> (Range
iaRange, Int
iaUniqueId)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportAction]
rangeAndUnique
, forCodeActions :: RangeMap ImportAction
forCodeActions = forall a. (a -> Range) -> [a] -> RangeMap a
RM.fromList ImportAction -> Range
iaRange [ImportAction]
rangeAndUnique
, forResolve :: IntMap ImportEdit
forResolve = forall a. [(Int, a)] -> IntMap a
IM.fromList ((\(Int
u, (Range
r, (Text
te, ResultType
ty))) -> (Int
u, Range -> Text -> ResultType -> ImportEdit
ImportEdit Range
r Text
te ResultType
ty)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, (Range, (Text, ResultType)))]
uniqueAndRangeAndText) }
extractMinimalImports ::
HscEnvEq ->
TcModuleResult ->
IO (Maybe ([LImportDecl GhcRn], [LImportDecl GhcRn]))
HscEnvEq
hsc TcModuleResult {Bool
RenamedSource
ParsedModule
TcGblEnv
ModuleEnv ByteString
Splices
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferredError :: TcModuleResult -> Bool
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
tmrRuntimeModules :: ModuleEnv ByteString
tmrDeferredError :: Bool
tmrTopLevelSplices :: Splices
tmrTypechecked :: TcGblEnv
tmrRenamed :: RenamedSource
tmrParsed :: ParsedModule
..} = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
let tcEnv :: TcGblEnv
tcEnv = TcGblEnv
tmrTypechecked
(HsGroup GhcRn
_, [LImportDecl GhcRn]
imports, Maybe [(LIE GhcRn, [AvailInfo])]
_, Maybe LHsDocString
_) = RenamedSource
tmrRenamed
ParsedModule {pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
loc HsModule
_} = ParsedModule
tmrParsed
emss :: [[Char]]
emss = ParsedModule -> [[Char]]
exportedModuleStrings ParsedModule
tmrParsed
Just RealSrcSpan
srcSpan <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe RealSrcSpan
realSpan SrcSpan
loc
let notExportedImports :: [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
notExportedImports = forall a. (a -> Bool) -> [a] -> [a]
filter ([[Char]] -> LImportDecl GhcRn -> Bool
notExported [[Char]]
emss) [LImportDecl GhcRn]
imports
[GlobalRdrElt]
gblElts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (TcGblEnv -> TcRef [GlobalRdrElt]
tcg_used_gres TcGblEnv
tcEnv)
let usage :: [ImportDeclUsage]
usage = [LImportDecl GhcRn] -> [GlobalRdrElt] -> [ImportDeclUsage]
findImportUsage [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
notExportedImports [GlobalRdrElt]
gblElts
(Messages DecoratedSDoc
_, Just [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
minimalImports) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall r.
HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM r
-> IO (Messages DecoratedSDoc, Maybe r)
initTcWithGbl (HscEnvEq -> HscEnv
hscEnv HscEnvEq
hsc) TcGblEnv
tcEnv RealSrcSpan
srcSpan forall a b. (a -> b) -> a -> b
$ [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports [ImportDeclUsage]
usage
forall (m :: * -> *) a. Monad m => a -> m a
return ([LImportDecl GhcRn]
imports, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
minimalImports)
where
notExported :: [String] -> LImportDecl GhcRn -> Bool
notExported :: [[Char]] -> LImportDecl GhcRn -> Bool
notExported [] LImportDecl GhcRn
_ = Bool
True
notExported [[Char]]
exports (L SrcSpanAnnA
_ ImportDecl{ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = L SrcSpanAnnA
_ ModuleName
name}) =
Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\[Char]
e -> ([Char]
"module " forall a. [a] -> [a] -> [a]
++ ModuleName -> [Char]
moduleNameString ModuleName
name) forall a. Eq a => a -> a -> Bool
== [Char]
e) [[Char]]
exports
#if !MIN_VERSION_ghc (9,0,0)
notExported _ _ = True
#endif
isExplicitImport :: ImportDecl GhcRn -> Bool
#if MIN_VERSION_ghc (9,5,0)
isExplicitImport ImportDecl {ideclImportList = Just (Exactly, _)} = True
#else
isExplicitImport :: ImportDecl GhcRn -> Bool
isExplicitImport ImportDecl {ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding = Just (Bool
False, XRec GhcRn [LIE GhcRn]
_)} = Bool
True
#endif
isExplicitImport ImportDecl GhcRn
_ = Bool
False
maxColumns :: Int
maxColumns :: Int
maxColumns = Int
120
abbreviateImportTitle :: T.Text -> T.Text
abbreviateImportTitle :: Text -> Text
abbreviateImportTitle Text
input =
let
oneLineText :: Text
oneLineText = [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
input
(Text
prefix, Text
suffix) = Int -> Text -> (Text, Text)
T.splitAt (Int
maxColumns forall a. Num a => a -> a -> a
- Text -> Int
T.length (Int -> Text
summaryText Int
100)) Text
oneLineText
(Text
actualPrefix, Text
extraSuffix) = if Text -> Text -> Int
T.count Text
"," Text
prefix forall a. Ord a => a -> a -> Bool
> Int
0 then Text -> Text -> (Text, Text)
T.breakOnEnd Text
"," Text
prefix else (Text
prefix, Text
"")
actualSuffix :: Text
actualSuffix = Text
extraSuffix forall a. Semigroup a => a -> a -> a
<> Text
suffix
numAdditionalItems :: Int
numAdditionalItems = Text -> Text -> Int
T.count Text
"," Text
actualSuffix forall a. Num a => a -> a -> a
+ Int
1
summaryText :: Int -> T.Text
summaryText :: Int -> Text
summaryText Int
n = Text
" ... (" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show Int
n) forall a. Semigroup a => a -> a -> a
<> Text
" items)"
suffixText :: Text
suffixText = Int -> Text
summaryText Int
numAdditionalItems forall a. Semigroup a => a -> a -> a
<> if Text -> Text -> Int
T.count Text
"(" Text
prefix forall a. Ord a => a -> a -> Bool
> Int
0 then Text
")" else Text
""
title :: Text
title =
if Text -> Int
T.length Text
oneLineText forall a. Ord a => a -> a -> Bool
<= Int
maxColumns
then Text
oneLineText
else Text
actualPrefix forall a. Semigroup a => a -> a -> a
<> Text
suffixText
in Text
title
filterByImport :: LImportDecl GhcRn -> Map.Map ModuleName [AvailInfo] -> Maybe (Map.Map ModuleName [AvailInfo])
#if MIN_VERSION_ghc(9,5,0)
filterByImport (L _ ImportDecl{ideclImportList = Just (_, L _ names)})
#else
filterByImport :: LImportDecl GhcRn
-> Map ModuleName [AvailInfo] -> Maybe (Map ModuleName [AvailInfo])
filterByImport (L SrcSpanAnnA
_ ImportDecl{ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding = Just (Bool
_, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
names)})
#endif
Map ModuleName [AvailInfo]
avails =
if Set Name
importedNames forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set Name
allFilteredAvailsNames
then forall a. a -> Maybe a
Just Map ModuleName [AvailInfo]
res
else forall a. Maybe a
Nothing
where importedNames :: Set Name
importedNames = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (IE GhcRn)]
names
res :: Map ModuleName [AvailInfo]
res = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Map ModuleName [AvailInfo]
avails forall a b. (a -> b) -> a -> b
$ \[AvailInfo]
a ->
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
importedNames)
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [Name]
availNamesWithSelectors [AvailInfo]
a
allFilteredAvailsNames :: Set Name
allFilteredAvailsNames = forall a. Ord a => [a] -> Set a
S.fromList
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [Name]
availNamesWithSelectors
forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map ModuleName [AvailInfo]
res
filterByImport LImportDecl GhcRn
_ Map ModuleName [AvailInfo]
_ = forall a. Maybe a
Nothing
constructImport :: LImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> LImportDecl GhcRn
#if MIN_VERSION_ghc(9,5,0)
constructImport (L lim imd@ImportDecl {ideclName = L _ _, ideclImportList = Just (hiding, L _ names)})
#else
constructImport :: LImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> LImportDecl GhcRn
constructImport (L SrcSpanAnnA
lim imd :: ImportDecl GhcRn
imd@ImportDecl{ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = L SrcSpanAnnA
_ ModuleName
_, ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding = Just (Bool
hiding, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
names)})
#endif
(ModuleName
newModuleName, [AvailInfo]
avails) = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lim ImportDecl GhcRn
imd
{ ideclName :: XRec GhcRn ModuleName
ideclName = forall a an. a -> LocatedAn an a
noLocA ModuleName
newModuleName
#if MIN_VERSION_ghc(9,5,0)
, ideclImportList = Just (hiding, noLocA newNames)
#else
, ideclHiding :: Maybe (Bool, XRec GhcRn [LIE GhcRn])
ideclHiding = forall a. a -> Maybe a
Just (Bool
hiding, forall a an. a -> LocatedAn an a
noLocA [GenLocated SrcSpanAnnA (IE GhcRn)]
newNames)
#endif
}
where newNames :: [GenLocated SrcSpanAnnA (IE GhcRn)]
newNames = forall a. (a -> Bool) -> [a] -> [a]
filter (\GenLocated SrcSpanAnnA (IE GhcRn)
n -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GenLocated SrcSpanAnnA (IE GhcRn)
n LIE GhcRn -> AvailInfo -> Bool
`containsAvail`) [AvailInfo]
avails) [GenLocated SrcSpanAnnA (IE GhcRn)]
names
containsAvail :: LIE GhcRn -> AvailInfo -> Bool
containsAvail :: LIE GhcRn -> AvailInfo -> Bool
containsAvail LIE GhcRn
name AvailInfo
avail =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Name
an -> forall a. Outputable a => a -> Text
printOutputable Name
an forall a. Eq a => a -> a -> Bool
== (forall a. Outputable a => a -> Text
printOutputable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ LIE GhcRn
name))
forall a b. (a -> b) -> a -> b
$ AvailInfo -> [Name]
availNamesWithSelectors AvailInfo
avail
constructImport LImportDecl GhcRn
lim (ModuleName, [AvailInfo])
_ = LImportDecl GhcRn
lim