{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TypeFamilies          #-}

module Ide.Plugin.RefineImports (descriptor, Log(..)) where

import           Control.Arrow                        (Arrow (second))
import           Control.DeepSeq                      (rwhnf)
import           Control.Monad                        (join)
import           Control.Monad.IO.Class               (liftIO)
import           Data.Aeson.Types
import qualified Data.HashMap.Strict                  as HashMap
import           Data.IORef                           (readIORef)
import           Data.List                            (intercalate)
import qualified Data.Map.Strict                      as Map
import           Data.Maybe                           (catMaybes, fromMaybe)
import qualified Data.Set                             as S
import qualified Data.Text                            as T
import           Data.Traversable                     (forM)
import           Development.IDE
import           Development.IDE.Core.PositionMapping
import           Development.IDE.GHC.Compat
                                                      {- (AvailInfo,
                                                       GenLocated (L), GhcRn,
                                                       HsModule (hsmodImports),
                                                       ImportDecl (ImportDecl, ideclHiding, ideclName),
                                                       LIE, LImportDecl,
                                                       Module (moduleName),
                                                       ModuleName,
                                                       ParsedModule (ParsedModule, pm_parsed_source),
                                                       SrcSpan(..),
                                                       RealSrcSpan(..),
                                                       getLoc, ieName, noLoc,
                                                       tcg_exports, unLoc) -}
import qualified Development.IDE.Core.Shake           as Shake
import           Development.IDE.Graph.Classes
import qualified Development.IDE.Types.Logger         as Logger
import           GHC.Generics                         (Generic)
import           Ide.Plugin.ExplicitImports           (extractMinimalImports,
                                                       within)
import           Ide.PluginUtils                      (mkLspCommand)
import           Ide.Types
import           Language.LSP.Server
import           Language.LSP.Types

newtype Log = LogShake Shake.Log deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Show

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogShake Log
log -> forall a ann. Pretty a => a -> Doc ann
pretty Log
log

-- | plugin declaration
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
plId = (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
  { pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState
refineImportCommand]
  , pluginRules :: Rules ()
pluginRules = Recorder (WithPriority Log) -> Rules ()
refineImportsRule Recorder (WithPriority Log)
recorder
  , pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall a. Monoid a => [a] -> a
mconcat
      [ -- This plugin provides code lenses
        forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentCodeLens
STextDocumentCodeLens PluginMethodHandler IdeState 'TextDocumentCodeLens
lensProvider
        -- This plugin provides code actions
      , forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentCodeAction
STextDocumentCodeAction PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionProvider
      ]
  }

refineImportCommandId :: CommandId
refineImportCommandId :: CommandId
refineImportCommandId = CommandId
"RefineImportLensCommand"

newtype RefineImportCommandParams = RefineImportCommandParams WorkspaceEdit
  deriving forall x.
Rep RefineImportCommandParams x -> RefineImportCommandParams
forall x.
RefineImportCommandParams -> Rep RefineImportCommandParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RefineImportCommandParams x -> RefineImportCommandParams
$cfrom :: forall x.
RefineImportCommandParams -> Rep RefineImportCommandParams x
Generic
  deriving anyclass (Value -> Parser [RefineImportCommandParams]
Value -> Parser RefineImportCommandParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RefineImportCommandParams]
$cparseJSONList :: Value -> Parser [RefineImportCommandParams]
parseJSON :: Value -> Parser RefineImportCommandParams
$cparseJSON :: Value -> Parser RefineImportCommandParams
FromJSON, [RefineImportCommandParams] -> Encoding
[RefineImportCommandParams] -> Value
RefineImportCommandParams -> Encoding
RefineImportCommandParams -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RefineImportCommandParams] -> Encoding
$ctoEncodingList :: [RefineImportCommandParams] -> Encoding
toJSONList :: [RefineImportCommandParams] -> Value
$ctoJSONList :: [RefineImportCommandParams] -> Value
toEncoding :: RefineImportCommandParams -> Encoding
$ctoEncoding :: RefineImportCommandParams -> Encoding
toJSON :: RefineImportCommandParams -> Value
$ctoJSON :: RefineImportCommandParams -> Value
ToJSON)

-- | The command descriptor
refineImportCommand :: PluginCommand IdeState
refineImportCommand :: PluginCommand IdeState
refineImportCommand =
  PluginCommand
    { commandId :: CommandId
commandId = CommandId
refineImportCommandId
    , commandDesc :: Text
commandDesc = Text
"Directly use the imports as oppose to using aggregation module"
    , commandFunc :: CommandFunction IdeState RefineImportCommandParams
commandFunc = CommandFunction IdeState RefineImportCommandParams
runRefineImportCommand
    }

-- | The actual command handler
runRefineImportCommand :: CommandFunction IdeState RefineImportCommandParams
runRefineImportCommand :: CommandFunction IdeState RefineImportCommandParams
runRefineImportCommand IdeState
_state (RefineImportCommandParams WorkspaceEdit
edit) = do
  -- This command simply triggers a workspace edit!
  LspId 'WorkspaceApplyEdit
_ <- forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
sendRequest SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Value
Null)

lensProvider :: PluginMethodHandler IdeState TextDocumentCodeLens
lensProvider :: PluginMethodHandler IdeState 'TextDocumentCodeLens
lensProvider
  IdeState
state -- ghcide state
  PluginId
pId
  CodeLensParams {$sel:_textDocument:CodeLensParams :: CodeLensParams -> TextDocumentIdentifier
_textDocument = TextDocumentIdentifier {Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri :: Uri
_uri}}
    -- VSCode uses URIs instead of file paths
    -- haskell-lsp provides conversion functions
    | Just NormalizedFilePath
nfp <- NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
_uri = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      do
        Maybe (RefineImportsResult, PositionMapping)
mbRefinedImports <-
          forall a. IdeState -> Action a -> IO a
runIde IdeState
state forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale RefineImports
RefineImports NormalizedFilePath
nfp
        case Maybe (RefineImportsResult, PositionMapping)
mbRefinedImports of
          -- Implement the provider logic:
          -- for every refined import, generate a code lens
          Just (RefineImportsResult [(LImportDecl GhcRn, Maybe Text)]
result, PositionMapping
posMapping) -> do
            [Maybe CodeLens]
commands <-
              forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                [ PluginId -> Uri -> TextEdit -> IO (Maybe CodeLens)
generateLens PluginId
pId Uri
_uri TextEdit
edit
                | (GenLocated SrcSpanAnnA (ImportDecl GhcRn)
imp, Just Text
refinedImports) <- [(LImportDecl GhcRn, Maybe Text)]
result
                , Just TextEdit
edit <- [PositionMapping -> LImportDecl GhcRn -> Text -> Maybe TextEdit
mkExplicitEdit PositionMapping
posMapping GenLocated SrcSpanAnnA (ImportDecl GhcRn)
imp Text
refinedImports]
                ]
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a. [a] -> List a
List forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe CodeLens]
commands)
          Maybe (RefineImportsResult, PositionMapping)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a. [a] -> List a
List [])
    | Bool
otherwise =
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a. [a] -> List a
List [])

-- | Provide one code action to refine all imports
codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction
codeActionProvider :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionProvider IdeState
ideState PluginId
_pId (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ TextDocumentIdentifier
docId Range
range CodeActionContext
_context)
  | TextDocumentIdentifier {Uri
_uri :: Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri} <- TextDocumentIdentifier
docId,
    Just NormalizedFilePath
nfp <- NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
_uri = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    do
      Maybe ParsedModule
pm <- forall a. IdeState -> Action a -> IO a
runIde IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModule
GetParsedModule NormalizedFilePath
nfp
      let insideImport :: Bool
insideImport = case Maybe ParsedModule
pm of
            Just ParsedModule {ParsedSource
pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source :: ParsedSource
pm_parsed_source}
              | [LImportDecl GhcPs]
locImports <- HsModule -> [LImportDecl GhcPs]
hsmodImports (forall l e. GenLocated l e -> e
unLoc ParsedSource
pm_parsed_source),
                [SrcSpan]
rangesImports <- forall a b. (a -> b) -> [a] -> [b]
map forall a. HasSrcSpan a => a -> SrcSpan
getLoc [LImportDecl GhcPs]
locImports ->
                forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Range -> SrcSpan -> Bool
within Range
range) [SrcSpan]
rangesImports
            Maybe ParsedModule
_ -> Bool
False
      if Bool -> Bool
not Bool
insideImport
        then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (forall a. [a] -> List a
List []))
        else do
          Maybe RefineImportsResult
mbRefinedImports <- forall a. IdeState -> Action a -> IO a
runIde IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use RefineImports
RefineImports NormalizedFilePath
nfp
          let edits :: [TextEdit]
edits =
                [ TextEdit
e
                | Just (RefineImportsResult [(LImportDecl GhcRn, Maybe Text)]
result) <- [Maybe RefineImportsResult
mbRefinedImports]
                , (GenLocated SrcSpanAnnA (ImportDecl GhcRn)
imp, Just Text
refinedImports) <- [(LImportDecl GhcRn, Maybe Text)]
result
                , Just TextEdit
e <- [PositionMapping -> LImportDecl GhcRn -> Text -> Maybe TextEdit
mkExplicitEdit PositionMapping
zeroMapping GenLocated SrcSpanAnnA (ImportDecl GhcRn)
imp Text
refinedImports]
                ]
              caExplicitImports :: Command |? CodeAction
caExplicitImports = forall a b. b -> a |? b
InR CodeAction {Maybe WorkspaceEdit
Maybe CodeActionKind
Text
forall a. Maybe a
$sel:_title:CodeAction :: Text
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_disabled:CodeAction :: Maybe Reason
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
$sel:_xdata:CodeAction :: Maybe Value
_xdata :: forall a. Maybe a
_disabled :: forall a. Maybe a
_isPreferred :: forall a. Maybe a
_diagnostics :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_command :: forall a. Maybe a
_kind :: Maybe CodeActionKind
_title :: Text
..}
              _title :: Text
_title = Text
"Refine all imports"
              _kind :: Maybe CodeActionKind
_kind = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> CodeActionKind
CodeActionUnknown Text
"quickfix.import.refine"
              _command :: Maybe a
_command = forall a. Maybe a
Nothing
              _edit :: Maybe WorkspaceEdit
_edit = forall a. a -> Maybe a
Just WorkspaceEdit
                {Maybe (HashMap Uri (List TextEdit))
$sel:_changes:WorkspaceEdit :: Maybe (HashMap Uri (List TextEdit))
_changes :: Maybe (HashMap Uri (List TextEdit))
_changes, forall a. Maybe a
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges :: forall a. Maybe a
_documentChanges, forall a. Maybe a
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations :: forall a. Maybe a
_changeAnnotations}
              _changes :: Maybe (HashMap Uri (List TextEdit))
_changes = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Uri
_uri forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [TextEdit]
edits
              _documentChanges :: Maybe a
_documentChanges = forall a. Maybe a
Nothing
              _diagnostics :: Maybe a
_diagnostics = forall a. Maybe a
Nothing
              _isPreferred :: Maybe a
_isPreferred = forall a. Maybe a
Nothing
              _disabled :: Maybe a
_disabled = forall a. Maybe a
Nothing
              _xdata :: Maybe a
_xdata = forall a. Maybe a
Nothing
              _changeAnnotations :: Maybe a
_changeAnnotations = forall a. Maybe a
Nothing
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [Command |? CodeAction
caExplicitImports | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TextEdit]
edits)]
  | Bool
otherwise =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List []

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

data RefineImports = RefineImports
  deriving (Int -> RefineImports -> ShowS
[RefineImports] -> ShowS
RefineImports -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RefineImports] -> ShowS
$cshowList :: [RefineImports] -> ShowS
show :: RefineImports -> String
$cshow :: RefineImports -> String
showsPrec :: Int -> RefineImports -> ShowS
$cshowsPrec :: Int -> RefineImports -> ShowS
Show, forall x. Rep RefineImports x -> RefineImports
forall x. RefineImports -> Rep RefineImports x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RefineImports x -> RefineImports
$cfrom :: forall x. RefineImports -> Rep RefineImports x
Generic, RefineImports -> RefineImports -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefineImports -> RefineImports -> Bool
$c/= :: RefineImports -> RefineImports -> Bool
== :: RefineImports -> RefineImports -> Bool
$c== :: RefineImports -> RefineImports -> Bool
Eq, Eq RefineImports
RefineImports -> RefineImports -> Bool
RefineImports -> RefineImports -> Ordering
RefineImports -> RefineImports -> RefineImports
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 :: RefineImports -> RefineImports -> RefineImports
$cmin :: RefineImports -> RefineImports -> RefineImports
max :: RefineImports -> RefineImports -> RefineImports
$cmax :: RefineImports -> RefineImports -> RefineImports
>= :: RefineImports -> RefineImports -> Bool
$c>= :: RefineImports -> RefineImports -> Bool
> :: RefineImports -> RefineImports -> Bool
$c> :: RefineImports -> RefineImports -> Bool
<= :: RefineImports -> RefineImports -> Bool
$c<= :: RefineImports -> RefineImports -> Bool
< :: RefineImports -> RefineImports -> Bool
$c< :: RefineImports -> RefineImports -> Bool
compare :: RefineImports -> RefineImports -> Ordering
$ccompare :: RefineImports -> RefineImports -> Ordering
Ord)

instance Hashable RefineImports
instance NFData RefineImports
type instance RuleResult RefineImports = RefineImportsResult

newtype RefineImportsResult = RefineImportsResult
  {RefineImportsResult -> [(LImportDecl GhcRn, Maybe Text)]
getMinimalImportsResult :: [(LImportDecl GhcRn, Maybe T.Text)]}

instance Show RefineImportsResult where show :: RefineImportsResult -> String
show RefineImportsResult
_ = String
"<refineImportsResult>"
instance NFData RefineImportsResult where rnf :: RefineImportsResult -> ()
rnf = forall a. a -> ()
rwhnf

refineImportsRule :: Recorder (WithPriority Log) -> Rules ()
refineImportsRule :: Recorder (WithPriority Log) -> Rules ()
refineImportsRule Recorder (WithPriority Log)
recorder = forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define (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
$ \RefineImports
RefineImports NormalizedFilePath
nfp -> do
  -- Get the typechecking artifacts from the module
  Maybe TcModuleResult
tmr <- 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
  Maybe HscEnvEq
hsc <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSessionDeps
GhcSessionDeps NormalizedFilePath
nfp

  -- 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 k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetImportMap
GetImportMap NormalizedFilePath
nfp
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM 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 k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetImportMap
GetImportMap NormalizedFilePath
path
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Map ModuleName NormalizedFilePath
importIm forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
imp_path -> do
        HiFileResult
imp_hir <- forall k v. IdeRule k v => k -> NormalizedFilePath -> Action 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
  -- We shouldn't blindly refine imports
  -- instead we should generate imports statements
  -- for modules/symbols actually got used
  ([GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
imports, Maybe [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
mbMinImports) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe HscEnvEq
-> Maybe TcModuleResult
-> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
extractMinimalImports Maybe HscEnvEq
hsc Maybe TcModuleResult
tmr

  let filterByImport
        :: LImportDecl GhcRn
        -> Map.Map ModuleName [AvailInfo]
        -> Maybe (Map.Map ModuleName [AvailInfo])
      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)}) Map ModuleName [AvailInfo]
avails =
        let 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
            -- 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
        in 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
      filterByImport LImportDecl GhcRn
_ Map ModuleName [AvailInfo]
_ = forall a. Maybe a
Nothing
  let constructImport
        :: LImportDecl GhcRn
        -> (ModuleName, [AvailInfo])
        -> LImportDecl GhcRn
      constructImport :: LImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> LImportDecl GhcRn
constructImport
        i :: LImportDecl GhcRn
i@(L SrcSpanAnnA
lim id :: ImportDecl GhcRn
id@ImportDecl
                  {ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = L SrcSpanAnnA
_ ModuleName
mn, ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding = Just (Bool
hiding, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
names)})
        (ModuleName
newModuleName, [AvailInfo]
avails) = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lim ImportDecl GhcRn
id
          { ideclName :: XRec GhcRn ModuleName
ideclName = forall a an. a -> LocatedAn an a
noLocA ModuleName
newModuleName
          , 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)
          }
          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
      constructImport LImportDecl GhcRn
lim (ModuleName, [AvailInfo])
_ = LImportDecl GhcRn
lim
  let res :: [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), Maybe Text)]
res =
        [ (GenLocated SrcSpanAnnA (ImportDecl GhcRn)
i, forall a. a -> Maybe a
Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
        -- for every minimal imports
        | Just [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
minImports <- [Maybe [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
        -- 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
        ]
  forall (m :: * -> *) a. Monad m => a -> m a
return ([], [(LImportDecl GhcRn, Maybe Text)] -> RefineImportsResult
RefineImportsResult [(GenLocated SrcSpanAnnA (ImportDecl GhcRn), Maybe Text)]
res forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
mbMinImports)

  where
    -- 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

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

mkExplicitEdit :: PositionMapping -> LImportDecl GhcRn -> T.Text -> Maybe TextEdit
mkExplicitEdit :: PositionMapping -> LImportDecl GhcRn -> Text -> Maybe TextEdit
mkExplicitEdit PositionMapping
posMapping (L SrcSpanAnnA
src ImportDecl GhcRn
imp) Text
explicit
  | RealSrcSpan RealSrcSpan
l Maybe BufSpan
_ <- forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src,
    L SrcSpanAnnA
_ ModuleName
mn <- forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcRn
imp,
    -- (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,
    Just Range
rng <- PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
posMapping forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
l =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Range -> Text -> TextEdit
TextEdit Range
rng Text
explicit
  | Bool
otherwise =
    forall a. Maybe a
Nothing

-- | Given an import declaration, generate a code lens unless it has an
-- explicit import list or it's qualified
generateLens :: PluginId -> Uri -> TextEdit -> IO (Maybe CodeLens)
generateLens :: PluginId -> Uri -> TextEdit -> IO (Maybe CodeLens)
generateLens PluginId
pId Uri
uri edits :: TextEdit
edits@TextEdit {Range
$sel:_range:TextEdit :: TextEdit -> Range
_range :: Range
_range, Text
$sel:_newText:TextEdit :: TextEdit -> Text
_newText :: Text
_newText} = do
  -- The title of the command is just the minimal explicit import decl
  let title :: Text
title = Text
"Refine imports to " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (Text -> [Text]
T.lines Text
_newText)
      -- the code lens has no extra data
      _xdata :: Maybe a
_xdata = forall a. Maybe a
Nothing
      -- an edit that replaces the whole declaration with the explicit one
      edit :: WorkspaceEdit
edit = Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just HashMap Uri (List TextEdit)
editsMap) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
      editsMap :: HashMap Uri (List TextEdit)
editsMap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Uri
uri, forall a. [a] -> List a
List [TextEdit
edits])]
      -- the command argument is simply the edit
      _arguments :: Maybe [Value]
_arguments = forall a. a -> Maybe a
Just [forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ WorkspaceEdit -> RefineImportCommandParams
RefineImportCommandParams WorkspaceEdit
edit]
      -- create the command
      _command :: Maybe Command
_command = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
pId CommandId
refineImportCommandId Text
title Maybe [Value]
_arguments
  -- create and return the code lens
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just CodeLens {Maybe Command
Range
forall a. Maybe a
$sel:_range:CodeLens :: Range
$sel:_command:CodeLens :: Maybe Command
$sel:_xdata:CodeLens :: Maybe Value
_command :: Maybe Command
_xdata :: forall a. Maybe a
_range :: Range
..}

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

-- | A helper to run ide actions
runIde :: IdeState -> Action a -> IO a
runIde :: forall a. IdeState -> Action a -> IO a
runIde = forall a. String -> IdeState -> Action a -> IO a
runAction String
"RefineImports"