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

#include "ghc-api-version.h"

module Ide.Plugin.ExplicitImports (descriptor) where

import Control.DeepSeq
import Control.Monad.IO.Class
import Data.Aeson (ToJSON (toJSON), Value (Null))
import Data.Aeson.Types (FromJSON)
import qualified Data.HashMap.Strict as HashMap
import Data.IORef (readIORef)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe)
import qualified Data.Text as T
import Development.IDE
import Development.IDE.Core.PositionMapping
import Development.IDE.GHC.Compat
import Development.Shake.Classes
import GHC.Generics (Generic)
import Ide.PluginUtils ( mkLspCommand )
import Ide.Types
import Language.LSP.Types
import Language.LSP.Server
import PrelNames (pRELUDE)
import RnNames
  ( findImportUsage,
    getMinimalImports,
  )
import TcRnMonad (initTcWithGbl)
import TcRnTypes (TcGblEnv (tcg_used_gres))

importCommandId :: CommandId
importCommandId :: CommandId
importCommandId = CommandId
"ImportLensCommand"

-- | The "main" function of a plugin
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId =
  (PluginId -> PluginDescriptor Any
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
    { 
      -- This plugin provides a command handler
      pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState
importLensCommand],
      -- This plugin defines a new rule
      pluginRules :: Rules ()
pluginRules = Rules ()
minimalImportsRule,
      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
        ]
    }

-- | The command descriptor
importLensCommand :: PluginCommand IdeState
importLensCommand :: PluginCommand IdeState
importLensCommand =
  CommandId
-> Text
-> CommandFunction IdeState ImportCommandParams
-> PluginCommand IdeState
forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
importCommandId Text
"Explicit import command" CommandFunction IdeState ImportCommandParams
runImportCommand

-- | The type of the parameters accepted by our command
data ImportCommandParams = ImportCommandParams WorkspaceEdit
  deriving ((forall x. ImportCommandParams -> Rep ImportCommandParams x)
-> (forall x. Rep ImportCommandParams x -> ImportCommandParams)
-> Generic ImportCommandParams
forall x. Rep ImportCommandParams x -> ImportCommandParams
forall x. ImportCommandParams -> Rep ImportCommandParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportCommandParams x -> ImportCommandParams
$cfrom :: forall x. ImportCommandParams -> Rep ImportCommandParams x
Generic)
  deriving anyclass (Value -> Parser [ImportCommandParams]
Value -> Parser ImportCommandParams
(Value -> Parser ImportCommandParams)
-> (Value -> Parser [ImportCommandParams])
-> FromJSON ImportCommandParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ImportCommandParams]
$cparseJSONList :: Value -> Parser [ImportCommandParams]
parseJSON :: Value -> Parser ImportCommandParams
$cparseJSON :: Value -> Parser ImportCommandParams
FromJSON, [ImportCommandParams] -> Encoding
[ImportCommandParams] -> Value
ImportCommandParams -> Encoding
ImportCommandParams -> Value
(ImportCommandParams -> Value)
-> (ImportCommandParams -> Encoding)
-> ([ImportCommandParams] -> Value)
-> ([ImportCommandParams] -> Encoding)
-> ToJSON ImportCommandParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ImportCommandParams] -> Encoding
$ctoEncodingList :: [ImportCommandParams] -> Encoding
toJSONList :: [ImportCommandParams] -> Value
$ctoJSONList :: [ImportCommandParams] -> Value
toEncoding :: ImportCommandParams -> Encoding
$ctoEncoding :: ImportCommandParams -> Encoding
toJSON :: ImportCommandParams -> Value
$ctoJSON :: ImportCommandParams -> Value
ToJSON)

-- | The actual command handler
runImportCommand :: CommandFunction IdeState ImportCommandParams
runImportCommand :: CommandFunction IdeState ImportCommandParams
runImportCommand IdeState
_state (ImportCommandParams 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)

-- | For every implicit import statement, return a code lens of the corresponding explicit import
-- 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)
lensProvider :: PluginMethodHandler IdeState TextDocumentCodeLens
lensProvider :: PluginMethodHandler IdeState 'TextDocumentCodeLens
lensProvider
  IdeState
state -- ghcide state, used to retrieve typechecking artifacts
  PluginId
pId -- plugin Id
  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 (MinimalImportsResult, PositionMapping)
mbMinImports <- String
-> IdeState
-> Action (Maybe (MinimalImportsResult, PositionMapping))
-> IO (Maybe (MinimalImportsResult, PositionMapping))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"" IdeState
state (Action (Maybe (MinimalImportsResult, PositionMapping))
 -> IO (Maybe (MinimalImportsResult, PositionMapping)))
-> Action (Maybe (MinimalImportsResult, PositionMapping))
-> IO (Maybe (MinimalImportsResult, PositionMapping))
forall a b. (a -> b) -> a -> b
$ MinimalImports
-> NormalizedFilePath
-> Action (Maybe (MinimalImportsResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale MinimalImports
MinimalImports NormalizedFilePath
nfp
        case Maybe (MinimalImportsResult, PositionMapping)
mbMinImports of
          -- Implement the provider logic:
          -- for every import, if it's lacking a explicit list, generate a code lens
          Just (MinimalImportsResult [(LImportDecl GhcRn, Maybe Text)]
minImports, 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
minImport) <- [(LImportDecl GhcRn, Maybe Text)]
minImports,
                    Just TextEdit
edit <- [PositionMapping -> LImportDecl GhcRn -> Text -> Maybe TextEdit
forall pass.
PositionMapping -> LImportDecl pass -> Text -> Maybe TextEdit
mkExplicitEdit PositionMapping
posMapping LImportDecl GhcRn
imp Text
minImport]
                ]
            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 (MinimalImportsResult, 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 [])

-- | If there are any implicit imports, provide one code action to turn them all
--   into explicit 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 MinimalImportsResult
minImports <- String
-> IdeState
-> Action (Maybe MinimalImportsResult)
-> IO (Maybe MinimalImportsResult)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"MinimalImports" IdeState
ideState (Action (Maybe MinimalImportsResult)
 -> IO (Maybe MinimalImportsResult))
-> Action (Maybe MinimalImportsResult)
-> IO (Maybe MinimalImportsResult)
forall a b. (a -> b) -> a -> b
$ MinimalImports
-> NormalizedFilePath -> Action (Maybe MinimalImportsResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use MinimalImports
MinimalImports NormalizedFilePath
nfp
          let edits :: [TextEdit]
edits =
                [ TextEdit
e
                  | (LImportDecl GhcRn
imp, Just Text
explicit) <-
                      [(LImportDecl GhcRn, Maybe Text)]
-> (MinimalImportsResult -> [(LImportDecl GhcRn, Maybe Text)])
-> Maybe MinimalImportsResult
-> [(LImportDecl GhcRn, Maybe Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MinimalImportsResult -> [(LImportDecl GhcRn, Maybe Text)]
getMinimalImportsResult Maybe MinimalImportsResult
minImports,
                    Just TextEdit
e <- [PositionMapping -> LImportDecl GhcRn -> Text -> Maybe TextEdit
forall pass.
PositionMapping -> LImportDecl pass -> Text -> Maybe TextEdit
mkExplicitEdit PositionMapping
zeroMapping LImportDecl GhcRn
imp Text
explicit]
                ]
              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
-> CodeAction
CodeAction {Maybe Bool
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
_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
"Make all imports explicit"
              _kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
              _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) -> 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}
              _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
          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 MinimalImports = MinimalImports
  deriving (Int -> MinimalImports -> ShowS
[MinimalImports] -> ShowS
MinimalImports -> String
(Int -> MinimalImports -> ShowS)
-> (MinimalImports -> String)
-> ([MinimalImports] -> ShowS)
-> Show MinimalImports
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MinimalImports] -> ShowS
$cshowList :: [MinimalImports] -> ShowS
show :: MinimalImports -> String
$cshow :: MinimalImports -> String
showsPrec :: Int -> MinimalImports -> ShowS
$cshowsPrec :: Int -> MinimalImports -> ShowS
Show, (forall x. MinimalImports -> Rep MinimalImports x)
-> (forall x. Rep MinimalImports x -> MinimalImports)
-> Generic MinimalImports
forall x. Rep MinimalImports x -> MinimalImports
forall x. MinimalImports -> Rep MinimalImports x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MinimalImports x -> MinimalImports
$cfrom :: forall x. MinimalImports -> Rep MinimalImports x
Generic, MinimalImports -> MinimalImports -> Bool
(MinimalImports -> MinimalImports -> Bool)
-> (MinimalImports -> MinimalImports -> Bool) -> Eq MinimalImports
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MinimalImports -> MinimalImports -> Bool
$c/= :: MinimalImports -> MinimalImports -> Bool
== :: MinimalImports -> MinimalImports -> Bool
$c== :: MinimalImports -> MinimalImports -> Bool
Eq, Eq MinimalImports
Eq MinimalImports
-> (MinimalImports -> MinimalImports -> Ordering)
-> (MinimalImports -> MinimalImports -> Bool)
-> (MinimalImports -> MinimalImports -> Bool)
-> (MinimalImports -> MinimalImports -> Bool)
-> (MinimalImports -> MinimalImports -> Bool)
-> (MinimalImports -> MinimalImports -> MinimalImports)
-> (MinimalImports -> MinimalImports -> MinimalImports)
-> Ord MinimalImports
MinimalImports -> MinimalImports -> Bool
MinimalImports -> MinimalImports -> Ordering
MinimalImports -> MinimalImports -> MinimalImports
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 :: MinimalImports -> MinimalImports -> MinimalImports
$cmin :: MinimalImports -> MinimalImports -> MinimalImports
max :: MinimalImports -> MinimalImports -> MinimalImports
$cmax :: MinimalImports -> MinimalImports -> MinimalImports
>= :: MinimalImports -> MinimalImports -> Bool
$c>= :: MinimalImports -> MinimalImports -> Bool
> :: MinimalImports -> MinimalImports -> Bool
$c> :: MinimalImports -> MinimalImports -> Bool
<= :: MinimalImports -> MinimalImports -> Bool
$c<= :: MinimalImports -> MinimalImports -> Bool
< :: MinimalImports -> MinimalImports -> Bool
$c< :: MinimalImports -> MinimalImports -> Bool
compare :: MinimalImports -> MinimalImports -> Ordering
$ccompare :: MinimalImports -> MinimalImports -> Ordering
$cp1Ord :: Eq MinimalImports
Ord)

instance Hashable MinimalImports

instance NFData MinimalImports

instance Binary MinimalImports

type instance RuleResult MinimalImports = MinimalImportsResult

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

instance Show MinimalImportsResult where show :: MinimalImportsResult -> String
show MinimalImportsResult
_ = String
"<minimalImportsResult>"

instance NFData MinimalImportsResult where rnf :: MinimalImportsResult -> ()
rnf = MinimalImportsResult -> ()
forall a. a -> ()
rwhnf

minimalImportsRule :: Rules ()
minimalImportsRule :: Rules ()
minimalImportsRule = (MinimalImports
 -> NormalizedFilePath -> Action (IdeResult MinimalImportsResult))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((MinimalImports
  -> NormalizedFilePath -> Action (IdeResult MinimalImportsResult))
 -> Rules ())
-> (MinimalImports
    -> NormalizedFilePath -> Action (IdeResult MinimalImportsResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \MinimalImports
MinimalImports 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
  -- Use the GHC api to extract the "minimal" imports
  ([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 importsMap :: Map SrcLoc Text
importsMap =
        [(SrcLoc, Text)] -> Map SrcLoc Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l, String -> Text
T.pack (ImportDecl GhcRn -> String
forall a. Outputable a => a -> String
prettyPrint ImportDecl GhcRn
i))
            | L SrcSpan
l ImportDecl GhcRn
i <- [LImportDecl GhcRn]
-> Maybe [LImportDecl GhcRn] -> [LImportDecl GhcRn]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [LImportDecl GhcRn]
mbMinImports
          ]
      res :: [(LImportDecl GhcRn, Maybe Text)]
res =
        [ (LImportDecl GhcRn
i, SrcLoc -> Map SrcLoc Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (SrcSpan -> SrcLoc
srcSpanStart (LImportDecl GhcRn -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LImportDecl GhcRn
i)) Map SrcLoc Text
importsMap)
          | LImportDecl GhcRn
i <- [LImportDecl GhcRn]
imports
        ]
  IdeResult MinimalImportsResult
-> Action (IdeResult MinimalImportsResult)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [(LImportDecl GhcRn, Maybe Text)] -> MinimalImportsResult
MinimalImportsResult [(LImportDecl GhcRn, Maybe Text)]
res MinimalImportsResult
-> Maybe [LImportDecl GhcRn] -> Maybe MinimalImportsResult
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe [LImportDecl GhcRn]
mbMinImports)

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

-- | Use the ghc api to extract a minimal, explicit set of imports for this module
extractMinimalImports ::
  Maybe HscEnvEq ->
  Maybe TcModuleResult ->
  IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
extractMinimalImports :: Maybe HscEnvEq
-> Maybe TcModuleResult
-> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
extractMinimalImports (Just HscEnvEq
hsc) (Just TcModuleResult {Bool
RenamedSource
ParsedModule
TcGblEnv
Splices
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferedError :: TcModuleResult -> Bool
tmrDeferedError :: Bool
tmrTopLevelSplices :: Splices
tmrTypechecked :: TcGblEnv
tmrRenamed :: RenamedSource
tmrParsed :: ParsedModule
..}) = do
  -- extract the original imports and the typechecking environment
  let tcEnv :: TcGblEnv
tcEnv = TcGblEnv
tmrTypechecked
      (HsGroup GhcRn
_, [LImportDecl GhcRn]
imports, Maybe [(LIE GhcRn, Avails)]
_, Maybe LHsDocString
_) = RenamedSource
tmrRenamed
      ParsedModule {pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
loc HsModule GhcPs
_} = ParsedModule
tmrParsed
      span :: RealSrcSpan
span = RealSrcSpan -> Maybe RealSrcSpan -> RealSrcSpan
forall a. a -> Maybe a -> a
fromMaybe (String -> RealSrcSpan
forall a. HasCallStack => String -> a
error String
"expected real") (Maybe RealSrcSpan -> RealSrcSpan)
-> Maybe RealSrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe RealSrcSpan
realSpan SrcSpan
loc

  -- GHC is secretly full of mutable state
  [GlobalRdrElt]
gblElts <- IORef [GlobalRdrElt] -> IO [GlobalRdrElt]
forall a. IORef a -> IO a
readIORef (TcGblEnv -> IORef [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 [LImportDecl GhcRn]
imports [GlobalRdrElt]
gblElts
  (Messages
_, Maybe [LImportDecl GhcRn]
minimalImports) <- HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM [LImportDecl GhcRn]
-> IO (Messages, Maybe [LImportDecl GhcRn])
forall r.
HscEnv
-> TcGblEnv -> RealSrcSpan -> TcM r -> IO (Messages, Maybe r)
initTcWithGbl (HscEnvEq -> HscEnv
hscEnv HscEnvEq
hsc) TcGblEnv
tcEnv RealSrcSpan
span (TcM [LImportDecl GhcRn]
 -> IO (Messages, Maybe [LImportDecl GhcRn]))
-> TcM [LImportDecl GhcRn]
-> IO (Messages, Maybe [LImportDecl GhcRn])
forall a b. (a -> b) -> a -> b
$ [ImportDeclUsage] -> TcM [LImportDecl GhcRn]
getMinimalImports [ImportDeclUsage]
usage

  -- return both the original imports and the computed minimal ones
  ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
-> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
forall (m :: * -> *) a. Monad m => a -> m a
return ([LImportDecl GhcRn]
imports, Maybe [LImportDecl GhcRn]
minimalImports)
extractMinimalImports Maybe HscEnvEq
_ Maybe TcModuleResult
_ = ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
-> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe [LImportDecl GhcRn]
forall a. Maybe a
Nothing)

mkExplicitEdit :: PositionMapping -> LImportDecl pass -> T.Text -> Maybe TextEdit
mkExplicitEdit :: PositionMapping -> LImportDecl pass -> Text -> Maybe TextEdit
mkExplicitEdit PositionMapping
posMapping (L SrcSpan
src ImportDecl pass
imp) Text
explicit
  -- Explicit import list case
  | ImportDecl {ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding = Just (Bool
False, Located [LIE pass]
_)} <- ImportDecl pass
imp =
    Maybe TextEdit
forall a. Maybe a
Nothing
  | Bool -> Bool
not (ImportDecl pass -> Bool
forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl pass
imp),
    RealSrcSpan RealSrcSpan
l <- SrcSpan
src,
    L SrcSpan
_ ModuleName
mn <- ImportDecl pass -> GenLocated SrcSpan ModuleName
forall pass. ImportDecl pass -> GenLocated SrcSpan ModuleName
ideclName ImportDecl pass
imp,
    -- (almost) no one wants to see an explicit 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 importEdit :: TextEdit
importEdit@TextEdit {Range
$sel:_range:TextEdit :: TextEdit -> Range
_range :: Range
_range} = do
  -- The title of the command is just the minimal explicit import decl
  let title :: Text
title = TextEdit -> Text
_newText TextEdit
importEdit
      -- 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) -> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just WorkspaceEditMap
editsMap) Maybe (List DocumentChange)
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
importEdit])]
      -- the command argument is simply the edit
      _arguments :: Maybe [Value]
_arguments = [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [ImportCommandParams -> Value
forall a. ToJSON a => a -> Value
toJSON (ImportCommandParams -> Value) -> ImportCommandParams -> Value
forall a b. (a -> b) -> a -> b
$ WorkspaceEdit -> ImportCommandParams
ImportCommandParams 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
importCommandId 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 IdeState
state = String -> IdeState -> Action a -> IO a
forall a. String -> IdeState -> Action a -> IO a
runAction String
"importLens" IdeState
state

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

within :: Range -> SrcSpan -> Bool
within :: Range -> SrcSpan -> Bool
within (Range Position
start Position
end) SrcSpan
span =
  Position -> SrcSpan -> Bool
isInsideSrcSpan Position
start SrcSpan
span Bool -> Bool -> Bool
|| Position -> SrcSpan -> Bool
isInsideSrcSpan Position
end SrcSpan
span