{-# 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
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
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 :: Log -> Doc ann
pretty = \case
    LogShake Log
log -> Log -> Doc ann
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 = (PluginId -> PluginDescriptor IdeState
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 = [PluginHandlers IdeState] -> PluginHandlers IdeState
forall a. Monoid a => [a] -> a
mconcat
      [ -- This plugin provides code lenses
        SClientMethod 'TextDocumentCodeLens
-> PluginMethodHandler IdeState 'TextDocumentCodeLens
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentCodeLens
STextDocumentCodeLens PluginMethodHandler IdeState 'TextDocumentCodeLens
lensProvider
        -- This plugin provides code actions
      , SClientMethod 'TextDocumentCodeAction
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentCodeAction
STextDocumentCodeAction PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionProvider
      ]
  }

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

newtype RefineImportCommandParams = RefineImportCommandParams WorkspaceEdit
  deriving (forall x.
 RefineImportCommandParams -> Rep RefineImportCommandParams x)
-> (forall x.
    Rep RefineImportCommandParams x -> RefineImportCommandParams)
-> Generic RefineImportCommandParams
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
(Value -> Parser RefineImportCommandParams)
-> (Value -> Parser [RefineImportCommandParams])
-> FromJSON 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
(RefineImportCommandParams -> Value)
-> (RefineImportCommandParams -> Encoding)
-> ([RefineImportCommandParams] -> Value)
-> ([RefineImportCommandParams] -> Encoding)
-> ToJSON RefineImportCommandParams
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 :: forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
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
_ <- SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> (Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
    -> LspT Config IO ())
-> LspT Config IO (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 SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> () -> LspT Config IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  Either ResponseError Value
-> LspM Config (Either ResponseError Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Either ResponseError Value
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 {_textDocument = TextDocumentIdentifier {_uri}}
    -- VSCode uses URIs instead of file paths
    -- haskell-lsp provides conversion functions
    | Just NormalizedFilePath
nfp <- NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath (NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri -> Maybe NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
_uri = IO (Either ResponseError (List CodeLens))
-> LspT Config IO (Either ResponseError (List CodeLens))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ResponseError (List CodeLens))
 -> LspT Config IO (Either ResponseError (List CodeLens)))
-> IO (Either ResponseError (List CodeLens))
-> LspT Config IO (Either ResponseError (List CodeLens))
forall a b. (a -> b) -> a -> b
$
      do
        Maybe (RefineImportsResult, PositionMapping)
mbRefinedImports <-
          IdeState
-> Action (Maybe (RefineImportsResult, PositionMapping))
-> IO (Maybe (RefineImportsResult, PositionMapping))
forall a. IdeState -> Action a -> IO a
runIde IdeState
state (Action (Maybe (RefineImportsResult, PositionMapping))
 -> IO (Maybe (RefineImportsResult, PositionMapping)))
-> Action (Maybe (RefineImportsResult, PositionMapping))
-> IO (Maybe (RefineImportsResult, PositionMapping))
forall a b. (a -> b) -> a -> b
$ RefineImports
-> NormalizedFilePath
-> Action (Maybe (RefineImportsResult, PositionMapping))
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 <-
              [IO (Maybe CodeLens)] -> IO [Maybe CodeLens]
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
                | (LImportDecl GhcRn
imp, Just Text
refinedImports) <- [(LImportDecl GhcRn, Maybe Text)]
result
                , Just TextEdit
edit <- [PositionMapping -> LImportDecl GhcRn -> Text -> Maybe TextEdit
mkExplicitEdit PositionMapping
posMapping LImportDecl GhcRn
imp Text
refinedImports]
                ]
            Either ResponseError (List CodeLens)
-> IO (Either ResponseError (List CodeLens))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List CodeLens)
 -> IO (Either ResponseError (List CodeLens)))
-> Either ResponseError (List CodeLens)
-> IO (Either ResponseError (List CodeLens))
forall a b. (a -> b) -> a -> b
$ List CodeLens -> Either ResponseError (List CodeLens)
forall a b. b -> Either a b
Right ([CodeLens] -> List CodeLens
forall a. [a] -> List a
List ([CodeLens] -> List CodeLens) -> [CodeLens] -> List CodeLens
forall a b. (a -> b) -> a -> b
$ [Maybe CodeLens] -> [CodeLens]
forall a. [Maybe a] -> [a]
catMaybes [Maybe CodeLens]
commands)
          Maybe (RefineImportsResult, PositionMapping)
_ -> Either ResponseError (List CodeLens)
-> IO (Either ResponseError (List CodeLens))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List CodeLens)
 -> IO (Either ResponseError (List CodeLens)))
-> Either ResponseError (List CodeLens)
-> IO (Either ResponseError (List CodeLens))
forall a b. (a -> b) -> a -> b
$ List CodeLens -> Either ResponseError (List CodeLens)
forall a b. b -> Either a b
Right ([CodeLens] -> List CodeLens
forall a. [a] -> List a
List [])
    | Bool
otherwise =
      Either ResponseError (List CodeLens)
-> LspT Config IO (Either ResponseError (List CodeLens))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List CodeLens)
 -> LspT Config IO (Either ResponseError (List CodeLens)))
-> Either ResponseError (List CodeLens)
-> LspT Config IO (Either ResponseError (List CodeLens))
forall a b. (a -> b) -> a -> b
$ List CodeLens -> Either ResponseError (List CodeLens)
forall a b. b -> Either a b
Right ([CodeLens] -> List CodeLens
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 _ _ docId range _context)
  | TextDocumentIdentifier {Uri
_uri :: Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri} <- TextDocumentIdentifier
docId,
    Just NormalizedFilePath
nfp <- NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath (NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri -> Maybe NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
_uri = IO (Either ResponseError (List (Command |? CodeAction)))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ResponseError (List (Command |? CodeAction)))
 -> LspT
      Config IO (Either ResponseError (List (Command |? CodeAction))))
-> IO (Either ResponseError (List (Command |? CodeAction)))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$
    do
      Maybe ParsedModule
pm <- IdeState -> Action (Maybe ParsedModule) -> IO (Maybe ParsedModule)
forall a. IdeState -> Action a -> IO a
runIde IdeState
ideState (Action (Maybe ParsedModule) -> IO (Maybe ParsedModule))
-> Action (Maybe ParsedModule) -> IO (Maybe ParsedModule)
forall a b. (a -> b) -> a -> b
$ GetParsedModule
-> NormalizedFilePath -> Action (Maybe ParsedModule)
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 GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports (ParsedSource -> SrcSpanLess ParsedSource
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ParsedSource
pm_parsed_source),
                [SrcSpan]
rangesImports <- (LImportDecl GhcPs -> SrcSpan) -> [LImportDecl GhcPs] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc [LImportDecl GhcPs]
locImports ->
                (SrcSpan -> Bool) -> [SrcSpan] -> Bool
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 Either ResponseError (List (Command |? CodeAction))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall (m :: * -> *) a. Monad m => a -> m a
return (List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. b -> Either a b
Right ([Command |? CodeAction] -> List (Command |? CodeAction)
forall a. [a] -> List a
List []))
        else do
          Maybe RefineImportsResult
mbRefinedImports <- IdeState
-> Action (Maybe RefineImportsResult)
-> IO (Maybe RefineImportsResult)
forall a. IdeState -> Action a -> IO a
runIde IdeState
ideState (Action (Maybe RefineImportsResult)
 -> IO (Maybe RefineImportsResult))
-> Action (Maybe RefineImportsResult)
-> IO (Maybe RefineImportsResult)
forall a b. (a -> b) -> a -> b
$ RefineImports
-> NormalizedFilePath -> Action (Maybe RefineImportsResult)
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]
                , (LImportDecl GhcRn
imp, Just Text
refinedImports) <- [(LImportDecl GhcRn, Maybe Text)]
result
                , Just TextEdit
e <- [PositionMapping -> LImportDecl GhcRn -> Text -> Maybe TextEdit
mkExplicitEdit PositionMapping
zeroMapping LImportDecl GhcRn
imp Text
refinedImports]
                ]
              caExplicitImports :: Command |? CodeAction
caExplicitImports = CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction {Maybe Bool
Maybe Value
Maybe WorkspaceEdit
Maybe (List Diagnostic)
Maybe Reason
Maybe CodeActionKind
Maybe Command
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 = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just (CodeActionKind -> Maybe CodeActionKind)
-> CodeActionKind -> Maybe CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text -> CodeActionKind
CodeActionUnknown Text
"quickfix.import.refine"
              _command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
              _edit :: Maybe WorkspaceEdit
_edit = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit
                {Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
_changes :: Maybe WorkspaceEditMap
_changes, Maybe (List DocumentChange)
forall a. Maybe a
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges :: forall a. Maybe a
_documentChanges, Maybe ChangeAnnotationMap
forall a. Maybe a
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations :: forall a. Maybe a
_changeAnnotations}
              _changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Uri
_uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
edits
              _documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
              _diagnostics :: Maybe a
_diagnostics = Maybe a
forall a. Maybe a
Nothing
              _isPreferred :: Maybe a
_isPreferred = Maybe a
forall a. Maybe a
Nothing
              _disabled :: Maybe a
_disabled = Maybe a
forall a. Maybe a
Nothing
              _xdata :: Maybe a
_xdata = Maybe a
forall a. Maybe a
Nothing
              _changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing
          Either ResponseError (List (Command |? CodeAction))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List (Command |? CodeAction))
 -> IO (Either ResponseError (List (Command |? CodeAction))))
-> Either ResponseError (List (Command |? CodeAction))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. b -> Either a b
Right (List (Command |? CodeAction)
 -> Either ResponseError (List (Command |? CodeAction)))
-> List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> List (Command |? CodeAction)
forall a. [a] -> List a
List [Command |? CodeAction
caExplicitImports | Bool -> Bool
not ([TextEdit] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TextEdit]
edits)]
  | Bool
otherwise =
    Either ResponseError (List (Command |? CodeAction))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List (Command |? CodeAction))
 -> LspT
      Config IO (Either ResponseError (List (Command |? CodeAction))))
-> Either ResponseError (List (Command |? CodeAction))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. b -> Either a b
Right (List (Command |? CodeAction)
 -> Either ResponseError (List (Command |? CodeAction)))
-> List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> List (Command |? CodeAction)
forall a. [a] -> List a
List []

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

data RefineImports = RefineImports
  deriving (Int -> RefineImports -> ShowS
[RefineImports] -> ShowS
RefineImports -> String
(Int -> RefineImports -> ShowS)
-> (RefineImports -> String)
-> ([RefineImports] -> ShowS)
-> Show RefineImports
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. RefineImports -> Rep RefineImports x)
-> (forall x. Rep RefineImports x -> RefineImports)
-> Generic RefineImports
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
(RefineImports -> RefineImports -> Bool)
-> (RefineImports -> RefineImports -> Bool) -> Eq RefineImports
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
Eq RefineImports
-> (RefineImports -> RefineImports -> Ordering)
-> (RefineImports -> RefineImports -> Bool)
-> (RefineImports -> RefineImports -> Bool)
-> (RefineImports -> RefineImports -> Bool)
-> (RefineImports -> RefineImports -> Bool)
-> (RefineImports -> RefineImports -> RefineImports)
-> (RefineImports -> RefineImports -> RefineImports)
-> Ord 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
$cp1Ord :: Eq RefineImports
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 = RefineImportsResult -> ()
forall a. a -> ()
rwhnf

refineImportsRule :: Recorder (WithPriority Log) -> Rules ()
refineImportsRule :: Recorder (WithPriority Log) -> Rules ()
refineImportsRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> (RefineImports
    -> NormalizedFilePath -> Action (IdeResult RefineImportsResult))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((RefineImports
  -> NormalizedFilePath -> Action (IdeResult RefineImportsResult))
 -> Rules ())
-> (RefineImports
    -> NormalizedFilePath -> Action (IdeResult RefineImportsResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \RefineImports
RefineImports NormalizedFilePath
nfp -> do
  -- Get the typechecking artifacts from the module
  Maybe TcModuleResult
tmr <- TypeCheck -> NormalizedFilePath -> Action (Maybe TcModuleResult)
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 <- GhcSessionDeps -> NormalizedFilePath -> Action (Maybe HscEnvEq)
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 <- GetImportMap -> NormalizedFilePath -> Action ImportMap
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetImportMap
GetImportMap NormalizedFilePath
nfp
    Map ModuleName NormalizedFilePath
-> (NormalizedFilePath -> Action (Map ModuleName [AvailInfo]))
-> Action (Map ModuleName (Map ModuleName [AvailInfo]))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Map ModuleName NormalizedFilePath
currIm ((NormalizedFilePath -> Action (Map ModuleName [AvailInfo]))
 -> Action (Map ModuleName (Map ModuleName [AvailInfo])))
-> (NormalizedFilePath -> Action (Map ModuleName [AvailInfo]))
-> Action (Map ModuleName (Map ModuleName [AvailInfo]))
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 <- GetImportMap -> NormalizedFilePath -> Action ImportMap
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetImportMap
GetImportMap NormalizedFilePath
path
      Map ModuleName NormalizedFilePath
-> (NormalizedFilePath -> Action [AvailInfo])
-> Action (Map ModuleName [AvailInfo])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Map ModuleName NormalizedFilePath
importIm ((NormalizedFilePath -> Action [AvailInfo])
 -> Action (Map ModuleName [AvailInfo]))
-> (NormalizedFilePath -> Action [AvailInfo])
-> Action (Map ModuleName [AvailInfo])
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
imp_path -> do
        TcModuleResult
imp_tmr <- TypeCheck -> NormalizedFilePath -> Action TcModuleResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ TypeCheck
TypeCheck NormalizedFilePath
imp_path
        [AvailInfo] -> Action [AvailInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return ([AvailInfo] -> Action [AvailInfo])
-> [AvailInfo] -> Action [AvailInfo]
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> [AvailInfo]
tcg_exports (TcGblEnv -> [AvailInfo]) -> TcGblEnv -> [AvailInfo]
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> TcGblEnv
tmrTypechecked TcModuleResult
imp_tmr

  -- 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
  ([LImportDecl GhcRn]
imports, Maybe [LImportDecl GhcRn]
mbMinImports) <- IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
-> Action ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
 -> Action ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn]))
-> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
-> Action ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
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 SrcSpan
_ ImportDecl{ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding = Just (Bool
_, L SrcSpan
_ [LIE GhcRn]
names)}) Map ModuleName [AvailInfo]
avails =
        let importedNames :: Set Name
importedNames = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList ([Name] -> Set Name) -> [Name] -> Set Name
forall a b. (a -> b) -> a -> b
$ (LIE GhcRn -> Name) -> [LIE GhcRn] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (IE GhcRn -> Name
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName (IE GhcRn -> Name) -> (LIE GhcRn -> IE GhcRn) -> LIE GhcRn -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcRn -> IE GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LIE GhcRn]
names
            res :: Map ModuleName [AvailInfo]
res = (([AvailInfo] -> Bool)
 -> Map ModuleName [AvailInfo] -> Map ModuleName [AvailInfo])
-> Map ModuleName [AvailInfo]
-> ([AvailInfo] -> Bool)
-> Map ModuleName [AvailInfo]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([AvailInfo] -> Bool)
-> Map ModuleName [AvailInfo] -> Map ModuleName [AvailInfo]
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Map ModuleName [AvailInfo]
avails (([AvailInfo] -> Bool) -> Map ModuleName [AvailInfo])
-> ([AvailInfo] -> Bool) -> Map ModuleName [AvailInfo]
forall a b. (a -> b) -> a -> b
$ \[AvailInfo]
a ->
                    (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
importedNames)
                      ([Name] -> Bool) -> [Name] -> Bool
forall a b. (a -> b) -> a -> b
$ (AvailInfo -> [Name]) -> [AvailInfo] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [Name]
availNamesWithSelectors [AvailInfo]
a
            allFilteredAvailsNames :: Set Name
allFilteredAvailsNames = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList
              ([Name] -> Set Name) -> [Name] -> Set Name
forall a b. (a -> b) -> a -> b
$ (AvailInfo -> [Name]) -> [AvailInfo] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [Name]
availNamesWithSelectors
              ([AvailInfo] -> [Name]) -> [AvailInfo] -> [Name]
forall a b. (a -> b) -> a -> b
$ [[AvailInfo]] -> [AvailInfo]
forall a. Monoid a => [a] -> a
mconcat
              ([[AvailInfo]] -> [AvailInfo]) -> [[AvailInfo]] -> [AvailInfo]
forall a b. (a -> b) -> a -> b
$ Map ModuleName [AvailInfo] -> [[AvailInfo]]
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 Set Name -> Set Name -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set Name
allFilteredAvailsNames
              then Map ModuleName [AvailInfo] -> Maybe (Map ModuleName [AvailInfo])
forall a. a -> Maybe a
Just Map ModuleName [AvailInfo]
res
              else Maybe (Map ModuleName [AvailInfo])
forall a. Maybe a
Nothing
      filterByImport LImportDecl GhcRn
_ Map ModuleName [AvailInfo]
_ = Maybe (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 SrcSpan
lim id :: ImportDecl GhcRn
id@ImportDecl
                  {ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclName = L SrcSpan
_ ModuleName
mn, ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding = Just (Bool
hiding, L SrcSpan
_ [LIE GhcRn]
names)})
        (ModuleName
newModuleName, [AvailInfo]
avails) = SrcSpan -> ImportDecl GhcRn -> LImportDecl GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
lim ImportDecl GhcRn
id
          { ideclName :: Located ModuleName
ideclName = ModuleName -> Located ModuleName
forall a an. a -> LocatedAn an a
noLocA ModuleName
newModuleName
          , ideclHiding :: Maybe (Bool, Located [LIE GhcRn])
ideclHiding = (Bool, Located [LIE GhcRn]) -> Maybe (Bool, Located [LIE GhcRn])
forall a. a -> Maybe a
Just (Bool
hiding, [LIE GhcRn] -> Located [LIE GhcRn]
forall a an. a -> LocatedAn an a
noLocA [LIE GhcRn]
newNames)
          }
          where newNames :: [LIE GhcRn]
newNames = (LIE GhcRn -> Bool) -> [LIE GhcRn] -> [LIE GhcRn]
forall a. (a -> Bool) -> [a] -> [a]
filter (\LIE GhcRn
n -> (AvailInfo -> Bool) -> [AvailInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (LIE GhcRn
n LIE GhcRn -> AvailInfo -> Bool
`containsAvail`) [AvailInfo]
avails) [LIE GhcRn]
names
      constructImport LImportDecl GhcRn
lim (ModuleName, [AvailInfo])
_ = LImportDecl GhcRn
lim
  let res :: [(LImportDecl GhcRn, Maybe Text)]
res =
        [ (LImportDecl GhcRn
i, Text -> Maybe Text
forall a. a -> Maybe a
Just
                (Text -> Maybe Text)
-> (Map ModuleName [AvailInfo] -> Text)
-> Map ModuleName [AvailInfo]
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n"
                ([Text] -> Text)
-> (Map ModuleName [AvailInfo] -> [Text])
-> Map ModuleName [AvailInfo]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ModuleName, [AvailInfo]) -> Text)
-> [(ModuleName, [AvailInfo])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (LImportDecl GhcRn -> Text
forall a. Outputable a => a -> Text
printOutputable (LImportDecl GhcRn -> Text)
-> ((ModuleName, [AvailInfo]) -> LImportDecl GhcRn)
-> (ModuleName, [AvailInfo])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> LImportDecl GhcRn
constructImport LImportDecl GhcRn
i)
                ([(ModuleName, [AvailInfo])] -> [Text])
-> (Map ModuleName [AvailInfo] -> [(ModuleName, [AvailInfo])])
-> Map ModuleName [AvailInfo]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ModuleName [AvailInfo] -> [(ModuleName, [AvailInfo])]
forall k a. Map k a -> [(k, a)]
Map.toList
                (Map ModuleName [AvailInfo] -> Maybe Text)
-> Map ModuleName [AvailInfo] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Map ModuleName [AvailInfo]
filteredInnerImports)
        -- for every minimal imports
        | Just [LImportDecl GhcRn]
minImports <- [Maybe [LImportDecl GhcRn]
mbMinImports]
        , i :: LImportDecl GhcRn
i@(L SrcSpan
_ ImportDecl{ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclName = L SrcSpan
_ ModuleName
mn}) <- [LImportDecl GhcRn]
minImports
        -- we check for the inner imports
        , Just Map ModuleName [AvailInfo]
innerImports <- [ModuleName
-> Map ModuleName (Map ModuleName [AvailInfo])
-> Maybe (Map ModuleName [AvailInfo])
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 LImportDecl GhcRn
i Map ModuleName [AvailInfo]
innerImports]
        -- if no symbols from this modules then don't need to generate new import
        , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map ModuleName [AvailInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map ModuleName [AvailInfo]
filteredInnerImports
        ]
  IdeResult RefineImportsResult
-> Action (IdeResult RefineImportsResult)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [(LImportDecl GhcRn, Maybe Text)] -> RefineImportsResult
RefineImportsResult [(LImportDecl GhcRn, Maybe Text)]
res RefineImportsResult
-> Maybe [LImportDecl GhcRn] -> Maybe RefineImportsResult
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe [LImportDecl 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 =
      (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Name
an -> Name -> Text
forall a. Outputable a => a -> Text
printOutputable Name
an Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Name -> Text
forall a. Outputable a => a -> Text
printOutputable (Name -> Text) -> (LIE GhcRn -> Name) -> LIE GhcRn -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IE GhcRn -> Name
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName (IE GhcRn -> Name) -> (LIE GhcRn -> IE GhcRn) -> LIE GhcRn -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcRn -> IE GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LIE GhcRn -> Text) -> LIE GhcRn -> Text
forall a b. (a -> b) -> a -> b
$ LIE GhcRn
name))
        ([Name] -> Bool) -> [Name] -> Bool
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 SrcSpan
src ImportDecl GhcRn
imp) Text
explicit
  | RealSrcSpan RealSrcSpan
l Maybe ()
_ <- SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
src,
    L SrcSpan
_ ModuleName
mn <- ImportDecl GhcRn -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcRn
imp,
    -- (almost) no one wants to see an refine import list for Prelude
    ModuleName
mn ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= Module -> ModuleName
moduleName Module
pRELUDE,
    Just Range
rng <- PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
posMapping (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
l =
    TextEdit -> Maybe TextEdit
forall a. a -> Maybe a
Just (TextEdit -> Maybe TextEdit) -> TextEdit -> Maybe TextEdit
forall a b. (a -> b) -> a -> b
$ Range -> Text -> TextEdit
TextEdit Range
rng Text
explicit
  | Bool
otherwise =
    Maybe TextEdit
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 " Text -> Text -> Text
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 = Maybe a
forall a. Maybe a
Nothing
      -- an edit that replaces the whole declaration with the explicit one
      edit :: WorkspaceEdit
edit = Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just WorkspaceEditMap
editsMap) Maybe (List DocumentChange)
forall a. Maybe a
Nothing Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
      editsMap :: WorkspaceEditMap
editsMap = [(Uri, List TextEdit)] -> WorkspaceEditMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Uri
uri, [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
edits])]
      -- the command argument is simply the edit
      _arguments :: Maybe [Value]
_arguments = [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [RefineImportCommandParams -> Value
forall a. ToJSON a => a -> Value
toJSON (RefineImportCommandParams -> Value)
-> RefineImportCommandParams -> Value
forall a b. (a -> b) -> a -> b
$ WorkspaceEdit -> RefineImportCommandParams
RefineImportCommandParams WorkspaceEdit
edit]
      -- create the command
      _command :: Maybe Command
_command = Command -> Maybe Command
forall a. a -> Maybe a
Just (Command -> Maybe Command) -> Command -> Maybe Command
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
  Maybe CodeLens -> IO (Maybe CodeLens)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CodeLens -> IO (Maybe CodeLens))
-> Maybe CodeLens -> IO (Maybe CodeLens)
forall a b. (a -> b) -> a -> b
$ CodeLens -> Maybe CodeLens
forall a. a -> Maybe a
Just CodeLens :: Range -> Maybe Command -> Maybe Value -> CodeLens
CodeLens {Maybe Value
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 :: IdeState -> Action a -> IO a
runIde = String -> IdeState -> Action a -> IO a
forall a. String -> IdeState -> Action a -> IO a
runAction String
"RefineImports"