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

-- This plugin is named explicit-imports for historical reasons. Besides
-- providing code actions and lenses to make imports explicit it also provides
-- code actions and lens to refine imports.

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

-- | The "main" function of a plugin
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder =
    -- (almost) no one wants to see an explicit import list for Prelude
    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)
      -- ^ Predicate to select modules that will be annotated
    -> 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)
    {
      -- This plugin provides a command handler
      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)],
      -- This plugin defines a new rule
      pluginRules :: Rules ()
pluginRules = Recorder (WithPriority Log) -> (ModuleName -> Bool) -> Rules ()
minimalImportsRule Recorder (WithPriority Log)
recorder ModuleName -> Bool
modFilter,
      pluginHandlers :: PluginHandlers IdeState
pluginHandlers =
         -- This plugin provides code lenses
           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)
          -- This plugin provides code actions
        forall a. Semigroup a => a -> a -> a
<> PluginHandlers IdeState
codeActionHandlers

    }

-- | The actual command handler
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)


-- | We provide two code lenses for imports. The first lens makes imports
-- explicit. For example, for the module below:
-- > import Data.List
-- > f = intercalate " " . sortBy length
-- the provider should produce one code lens associated to the import statement:
-- > import Data.List (intercalate, sortBy)
--
-- The second one allows us to import functions directly from the original
-- module. For example, for the following import
-- > import Random.ReExporting.Module (liftIO)
-- the provider should produce one code lens associated to the import statement:
-- > Refine imports to import Control.Monad.IO.Class (liftIO)
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 -- because these are non resolved lenses we only need the range and a
        -- unique id to later resolve them with. These are for both refine
        -- import lenses and for explicit import lenses.
        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 -- The only new thing we need to provide to resolve a lens is the
              -- title, as the unique Id is the same to resolve the lens title
              -- as it is to apply the lens through a command.
              -- The title is written differently depending on what type of lens
              -- it is.
              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)

-- |For explicit imports: If there are any implicit imports, provide both one
-- code action per import to make that specific import explicit, and one code
-- action to turn them all into explicit imports. For refine imports: If there
-- are any reexported imports, provide both one code action per import to refine
-- that specific import, and one code action to refine all imports.
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)
          -- We should only provide this code action if there are any code
          -- of this type
          | 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)
          -- We should only provide this code action if there are any code
          -- of this type
          | 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]
        -- The only thing different in making the two types of code actions, is
        -- the title. The actual resolve data type, ResolveOne is used by both
        -- of them
        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
-- Providing the edit for the command, or the resolve for the code action is
-- completely generic, as all we need is the unique id and the text edit.
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
  { -- |For providing the code lenses we need to have a range, and a unique id
    -- that is later resolved to the new text for each import. It is stored in
    -- a list, because we always need to provide all the code lens in a file.
    ImportActionsResult -> [(Range, Int)]
forLens        :: [(Range, Int)]
    -- |For the code actions we have the same data as for the code lenses, but
    -- we store it in a RangeMap, because that allows us to filter on a specific
    -- range with better performance, and code actions are almost always only
    -- requested for a specific range
  , ImportActionsResult -> RangeMap ImportAction
forCodeActions :: RM.RangeMap ImportAction
    -- |For resolve we have an intMap where for every previously provided unique id
    -- we provide a textEdit to allow our code actions or code lens to be resolved
  , ImportActionsResult -> IntMap ImportEdit
forResolve     :: IM.IntMap ImportEdit }

-- |For resolving code lenses and code actions we need standard text edit stuff,
-- such as range and text, and then we need the result type, because we use this
-- for code lenses which need to create a appropriate title
data ImportEdit = ImportEdit { ImportEdit -> Range
ieRange :: Range, ImportEdit -> Text
ieText :: T.Text, ImportEdit -> ResultType
ieResType :: ResultType}

-- |The necessary data for providing code actions: the range, a unique ID for
-- later resolving the action, and the type of action for giving a proper name.
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
  -- Get the typechecking artifacts from the module
  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
  -- We also need a GHC session with all the dependencies
  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

  -- refine imports: 2 layer map ModuleName -> ModuleName -> [Avails] (exports)
  Map ModuleName (Map ModuleName [AvailInfo])
import2Map <- do
    -- first layer is from current(editing) module to its imports
    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
      -- second layer is from the imports of first layer to their imports
      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

  -- Use the GHC api to extract the "minimal" imports
  ([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))
        -- for every minimal imports
        | [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
        -- (almost) no one wants to see an refine import list for Prelude
        , ModuleName
mn forall a. Eq a => a -> a -> Bool
/= forall unit. GenModule unit -> ModuleName
moduleName Module
pRELUDE
        -- we check for the inner imports
        , 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]
        -- and only get those symbols used
        , Just Map ModuleName [AvailInfo]
filteredInnerImports <- [LImportDecl GhcRn
-> Map ModuleName [AvailInfo] -> Maybe (Map ModuleName [AvailInfo])
filterByImport GenLocated SrcSpanAnnA (ImportDecl GhcRn)
i Map ModuleName [AvailInfo]
innerImports]
        -- if no symbols from this modules then don't need to generate new import
        , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map ModuleName [AvailInfo]
filteredInnerImports
        -- get the location
        , RealSrcSpan RealSrcSpan
location Maybe BufSpan
_ <- [forall a. HasSrcSpan a => a -> SrcSpan
getLoc GenLocated SrcSpanAnnA (ImportDecl GhcRn)
i]
        -- and then convert that to a Range
        , 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) }

--------------------------------------------------------------------------------

-- | Use the ghc api to extract a minimal, explicit set of imports for this module
extractMinimalImports ::
  HscEnvEq ->
  TcModuleResult ->
  IO (Maybe ([LImportDecl GhcRn], [LImportDecl GhcRn]))
extractMinimalImports :: HscEnvEq
-> TcModuleResult
-> IO (Maybe ([LImportDecl GhcRn], [LImportDecl GhcRn]))
extractMinimalImports 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
  -- extract the original imports and the typechecking environment
  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
  -- Don't make suggestions for modules which are also exported, the user probably doesn't want this!
  -- See https://github.com/haskell/haskell-language-server/issues/2079
  let notExportedImports :: [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
notExportedImports = forall a. (a -> Bool) -> [a] -> [a]
filter ([[Char]] -> LImportDecl GhcRn -> Bool
notExported [[Char]]
emss) [LImportDecl GhcRn]
imports

  -- GHC is secretly full of mutable state
  [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)

  -- call findImportUsage does exactly what we need
  -- GHC is full of treats like this
  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

  -- return both the original imports and the computed minimal ones
  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

-- This number is somewhat arbitrarily chosen. Ideally the protocol would tell us these things,
-- but at the moment I don't believe we know it.
-- 80 columns is traditional, but Haskellers tend to use longer lines (citation needed) and it's
-- probably not too bad if the lens is a *bit* longer than normal lines.
maxColumns :: Int
maxColumns :: Int
maxColumns = Int
120


-- | The title of the command is ideally the minimal explicit import decl, but
-- we don't want to create a really massive code lens (and the decl can be extremely large!).
-- So we abbreviate it to fit a max column size, and indicate how many more items are in the list
-- after the abbreviation
abbreviateImportTitle :: T.Text -> T.Text
abbreviateImportTitle :: Text -> Text
abbreviateImportTitle Text
input =
  let
      -- For starters, we only want one line in the title
      oneLineText :: Text
oneLineText = [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
input
      -- Now, split at the max columns, leaving space for the summary text we're going to add
      -- (conservatively assuming we won't need to print a number larger than 100)
      (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
      -- We also want to truncate the last item so we get a "clean" break, rather than half way through
      -- something. The conditional here is just because 'breakOnEnd' doesn't give us quite the right thing
      -- if there are actually no commas.
      (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

      -- The number of additional items is the number of commas+1
      numAdditionalItems :: Int
numAdditionalItems = Text -> Text -> Int
T.count Text
"," Text
actualSuffix forall a. Num a => a -> a -> a
+ Int
1
      -- We want to make text like this: import Foo (AImport, BImport, ... (30 items))
      -- We also want it to look sensible if we end up splitting in the module name itself,
      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)"
      -- so we only add a trailing paren if we've split in the export list
      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 the original text fits, just use it
          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 there is a function defined in the current module and is used
      -- i.e. if a function is not reexported but defined in current
      -- module then this import cannot be refined
  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
          -- Check if a name is exposed by AvailInfo (the available information of a module)
          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