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

module Ide.Plugin.ExplicitImports
  ( descriptor
  , descriptorForModules
  , extractMinimalImports
  , within
  , abbreviateImportTitle
  , Log(..)
  ) 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,
                                                       isJust)
import qualified Data.Text                            as T
import           Data.String                          (fromString)
import           Development.IDE                      hiding (pluginHandlers,
                                                       pluginRules)
import           Development.IDE.Core.PositionMapping
import qualified Development.IDE.Core.Shake           as Shake
import           Development.IDE.GHC.Compat
import           Development.IDE.Graph.Classes
import           Development.IDE.Types.Logger         as Logger (Pretty (pretty))
import           GHC.Generics                         (Generic)
import           Ide.PluginUtils                      (mkLspCommand)
import           Ide.Types
import           Language.LSP.Server
import           Language.LSP.Types

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

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

-- | The "main" function of a plugin
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder =
    -- (almost) no one wants to see an explicit import list for Prelude
    Recorder (WithPriority Log)
-> (ModuleName -> Bool) -> PluginId -> PluginDescriptor IdeState
descriptorForModules Recorder (WithPriority Log)
recorder (ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= Module -> ModuleName
moduleName Module
pRELUDE)

descriptorForModules
    :: Recorder (WithPriority Log)
    -> (ModuleName -> Bool)
      -- ^ Predicate to select modules that will be annotated
    -> PluginId
    -> PluginDescriptor IdeState
descriptorForModules :: Recorder (WithPriority Log)
-> (ModuleName -> Bool) -> PluginId -> PluginDescriptor IdeState
descriptorForModules Recorder (WithPriority Log)
recorder ModuleName -> Bool
pred PluginId
plId =
  (PluginId -> PluginDescriptor IdeState
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 = Recorder (WithPriority Log) -> Rules ()
minimalImportsRule 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
 -> PluginHandlers IdeState)
-> PluginMethodHandler IdeState 'TextDocumentCodeLens
-> PluginHandlers IdeState
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool)
-> PluginMethodHandler IdeState 'TextDocumentCodeLens
lensProvider ModuleName -> Bool
pred
          -- 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
 -> PluginHandlers IdeState)
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
-> PluginHandlers IdeState
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool)
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionProvider ModuleName -> Bool
pred
        ]
    }

-- | 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
newtype 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 :: (ModuleName -> Bool) -> PluginMethodHandler IdeState TextDocumentCodeLens
lensProvider :: (ModuleName -> Bool)
-> PluginMethodHandler IdeState 'TextDocumentCodeLens
lensProvider
  ModuleName -> Bool
pred
  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 <- [(ModuleName -> Bool)
-> PositionMapping -> LImportDecl GhcRn -> Text -> Maybe TextEdit
mkExplicitEdit ModuleName -> Bool
pred 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 :: (ModuleName -> Bool) -> PluginMethodHandler IdeState TextDocumentCodeAction
codeActionProvider :: (ModuleName -> Bool)
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionProvider ModuleName -> Bool
pred 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 <- [(ModuleName -> Bool)
-> PositionMapping -> LImportDecl GhcRn -> Text -> Maybe TextEdit
mkExplicitEdit ModuleName -> Bool
pred 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
-> 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
"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)
-> 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 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

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

exportedModuleStrings :: ParsedModule -> [String]
exportedModuleStrings :: ParsedModule -> [String]
exportedModuleStrings ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (Located [LIE GhcPs])
Maybe LHsDocString
Maybe (Located WarningTxt)
Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodName :: Maybe (Located ModuleName)
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
..}}
  | Just Located [LIE GhcPs]
export <- Maybe (Located [LIE GhcPs])
hsmodExports,
    SrcSpanLess (Located [LIE GhcPs])
exports <- Located [LIE GhcPs] -> SrcSpanLess (Located [LIE GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LIE GhcPs]
export
    = (LIE GhcPs -> String) -> [LIE GhcPs] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack (Text -> String) -> (LIE GhcPs -> Text) -> LIE GhcPs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> Text
forall a. Outputable a => a -> Text
printOutputable) [LIE GhcPs]
SrcSpanLess (Located [LIE GhcPs])
exports
exportedModuleStrings ParsedModule
_ = []

minimalImportsRule :: Recorder (WithPriority Log) -> Rules ()
minimalImportsRule :: Recorder (WithPriority Log) -> Rules ()
minimalImportsRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> (MinimalImports
    -> NormalizedFilePath -> Action (IdeResult MinimalImportsResult))
-> 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) ((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 RealSrcLoc Text
importsMap =
        [(RealSrcLoc, Text)] -> Map RealSrcLoc Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
l, ImportDecl GhcRn -> Text
forall a. Outputable a => a -> Text
printOutputable ImportDecl GhcRn
i)
            | L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> RealSrcSpan RealSrcSpan
l Maybe ()
_) 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, RealSrcLoc -> Map RealSrcLoc Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
l) Map RealSrcLoc Text
importsMap)
          | LImportDecl GhcRn
i <- [LImportDecl GhcRn]
imports
          , RealSrcSpan RealSrcSpan
l Maybe ()
_ <- [LImportDecl GhcRn -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LImportDecl GhcRn
i]
        ]
  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
ModuleEnv UTCTime
Splices
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrDeferedError :: TcModuleResult -> Bool
tmrRuntimeModules :: TcModuleResult -> ModuleEnv UTCTime
tmrRuntimeModules :: ModuleEnv UTCTime
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
      emss :: [String]
emss = ParsedModule -> [String]
exportedModuleStrings 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
  -- Don't make suggestions for modules which are also exported, the user probably doesn't want this!
  -- See https://github.com/haskell/haskell-language-server/issues/2079
  let notExportedImports :: [LImportDecl GhcRn]
notExportedImports = (LImportDecl GhcRn -> Bool)
-> [LImportDecl GhcRn] -> [LImportDecl GhcRn]
forall a. (a -> Bool) -> [a] -> [a]
filter ([String] -> LImportDecl GhcRn -> Bool
notExported [String]
emss) [LImportDecl GhcRn]
imports

  -- 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]
notExportedImports [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)
  where
      notExported :: [String] -> LImportDecl GhcRn -> Bool
      notExported :: [String] -> LImportDecl GhcRn -> Bool
notExported []  LImportDecl GhcRn
_ = Bool
True
      notExported [String]
exports (L SrcSpan
_ ImportDecl{ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclName = L SrcSpan
_ ModuleName
name}) =
          Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
e -> (String
"module " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleName -> String
moduleNameString ModuleName
name) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
e) [String]
exports
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 :: (ModuleName -> Bool) -> PositionMapping -> LImportDecl GhcRn -> T.Text -> Maybe TextEdit
mkExplicitEdit :: (ModuleName -> Bool)
-> PositionMapping -> LImportDecl GhcRn -> Text -> Maybe TextEdit
mkExplicitEdit ModuleName -> Bool
pred PositionMapping
posMapping (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> SrcSpan
src) ImportDecl GhcRn
imp) Text
explicit
  -- Explicit import list case
  | ImportDecl {ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding = Just (Bool
False, Located [LIE GhcRn]
_)} <- ImportDecl GhcRn
imp =
    Maybe TextEdit
forall a. Maybe a
Nothing
  | Bool -> Bool
not (ImportDecl GhcRn -> Bool
forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl GhcRn
imp),
    RealSrcSpan RealSrcSpan
l Maybe ()
_ <- SrcSpan
src,
    L SrcSpan
_ ModuleName
mn <- ImportDecl GhcRn -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcRn
imp,
    ModuleName -> Bool
pred ModuleName
mn,
    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

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

-- | 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, Text
$sel:_newText:TextEdit :: TextEdit -> Text
_newText :: Text
_newText} = do
  let
      title :: Text
title = Text -> Text
abbreviateImportTitle 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
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
..}

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

      -- The number of additional items is the number of commas+1
      numAdditionalItems :: Int
numAdditionalItems = Text -> Text -> Int
T.count Text
"," Text
actualSuffix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      -- We want to make text like this: import Foo (AImport, BImport, ... (30 items))
      -- We also want it to look sensible if we end up splitting in the module name itself,
      summaryText :: a -> a
summaryText a
n = a
" ... (" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> String -> a
forall a. IsString a => String -> a
fromString (a -> String
forall a. Show a => a -> String
show a
n) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" items)"
      -- so we only add a trailing paren if we've split in the export list
      suffixText :: Text
suffixText = Int -> Text
forall a a. (Semigroup a, IsString a, Show a) => a -> a
summaryText Int
numAdditionalItems Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text -> Text -> Int
T.count Text
"(" Text
prefix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Text
")" else Text
""
      title :: Text
title =
          -- If the original text fits, just use it
          if Text -> Int
T.length Text
oneLineText Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxColumns
          then Text
oneLineText
          else Text
actualPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffixText
  in Text
title

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

-- | 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
"importLens"

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