{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE ViewPatterns       #-}
module Ide.Plugin.ExplicitImports
  ( descriptor
  , descriptorForModules
  , abbreviateImportTitle
  , Log(..)
  ) where

import           Control.DeepSeq
import           Control.Lens                         ((&), (?~))
import           Control.Monad.Error.Class            (MonadError (throwError))
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class            (lift)
import           Control.Monad.Trans.Except           (ExceptT)
import           Control.Monad.Trans.Maybe
import qualified Data.Aeson                           as A (ToJSON (toJSON))
import           Data.Aeson.Types                     (FromJSON)
import qualified Data.IntMap                          as IM (IntMap, elems,
                                                             fromList, (!?))
import           Data.IORef                           (readIORef)
import qualified Data.Map.Strict                      as Map
import           Data.Maybe                           (isNothing, mapMaybe)
import qualified Data.Set                             as S
import           Data.String                          (fromString)
import qualified Data.Text                            as T
import           Data.Traversable                     (for)
import qualified Data.Unique                          as U (hashUnique,
                                                            newUnique)
import           Development.IDE                      hiding (pluginHandlers,
                                                       pluginRules)
import           Development.IDE.Core.PluginUtils
import           Development.IDE.Core.PositionMapping
import qualified Development.IDE.Core.Shake           as Shake
import           Development.IDE.GHC.Compat           hiding ((<+>))
import           Development.IDE.Graph.Classes
import           GHC.Generics                         (Generic)
import           Ide.Plugin.Error                     (PluginError (..),
                                                       getNormalizedFilePathE,
                                                       handleMaybe)
import           Ide.Plugin.RangeMap                  (filterByRange)
import qualified Ide.Plugin.RangeMap                  as RM (RangeMap, fromList)
import           Ide.Plugin.Resolve
import           Ide.PluginUtils
import           Ide.Types
import qualified Language.LSP.Protocol.Lens           as L
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types
import           Language.LSP.Server

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

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

data Log
  = LogShake Shake.Log
  | LogWAEResponseError ResponseError
  | forall a. (Pretty a) => LogResolve a


instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogShake Log
logMsg -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
logMsg
    LogWAEResponseError ResponseError
rspErr -> Doc ann
"RequestWorkspaceApplyEdit Failed with " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ResponseError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ResponseError -> Doc ann
pretty ResponseError
rspErr
    LogResolve a
msg -> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
msg

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

descriptorForModules
    :: Recorder (WithPriority Log)
    -> (ModuleName -> Bool)
      -- ^ Predicate to select modules that will be annotated
    -> PluginId
    -> PluginDescriptor IdeState
descriptorForModules :: Recorder (WithPriority Log)
-> (ModuleName -> Bool) -> PluginId -> PluginDescriptor IdeState
descriptorForModules Recorder (WithPriority Log)
recorder ModuleName -> Bool
modFilter PluginId
plId =
  let resolveRecorder :: Recorder (WithPriority Log)
resolveRecorder = (Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
forall a. Pretty a => a -> Log
LogResolve Recorder (WithPriority Log)
recorder
      codeActionHandlers :: PluginHandlers IdeState
codeActionHandlers = Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
-> ResolveFunction IdeState IAResolveData 'Method_CodeActionResolve
-> PluginHandlers IdeState
forall ideState a.
FromJSON a =>
Recorder (WithPriority Log)
-> PluginMethodHandler ideState 'Method_TextDocumentCodeAction
-> ResolveFunction ideState a 'Method_CodeActionResolve
-> PluginHandlers ideState
mkCodeActionHandlerWithResolve Recorder (WithPriority Log)
resolveRecorder (Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider Recorder (WithPriority Log)
recorder) (Recorder (WithPriority Log)
-> ResolveFunction IdeState IAResolveData 'Method_CodeActionResolve
codeActionResolveProvider Recorder (WithPriority Log)
recorder)
  in (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
"Provides a code action to make imports explicit")
    {
      -- This plugin provides a command handler
      pluginCommands = [PluginCommand importCommandId "Explicit import command" (runImportCommand recorder)],
      -- This plugin defines a new rule
      pluginRules = minimalImportsRule recorder modFilter,
      pluginHandlers =
         -- This plugin provides code lenses
           mkPluginHandler SMethod_TextDocumentCodeLens (lensProvider recorder)
        <> mkResolveHandler SMethod_CodeLensResolve (lensResolveProvider recorder)
          -- This plugin provides code actions
        <> codeActionHandlers

    }

-- | The actual command handler
runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IAResolveData
runImportCommand :: Recorder (WithPriority Log)
-> CommandFunction IdeState IAResolveData
runImportCommand Recorder (WithPriority Log)
recorder IdeState
ideState Maybe ProgressToken
_ eird :: IAResolveData
eird@(ResolveOne Uri
_ Int
_) = do
  WorkspaceEdit
wedit <- IdeState
-> IAResolveData
-> ExceptT PluginError (LspT Config IO) WorkspaceEdit
resolveWTextEdit IdeState
ideState IAResolveData
eird
  LspId 'Method_WorkspaceApplyEdit
_ <- LspM Config (LspId 'Method_WorkspaceApplyEdit)
-> ExceptT
     PluginError (LspT Config IO) (LspId 'Method_WorkspaceApplyEdit)
forall (m :: * -> *) a. Monad m => m a -> ExceptT PluginError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LspM Config (LspId 'Method_WorkspaceApplyEdit)
 -> ExceptT
      PluginError (LspT Config IO) (LspId 'Method_WorkspaceApplyEdit))
-> LspM Config (LspId 'Method_WorkspaceApplyEdit)
-> ExceptT
     PluginError (LspT Config IO) (LspId 'Method_WorkspaceApplyEdit)
forall a b. (a -> b) -> a -> b
$ SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> (Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
    -> LspT Config IO ())
-> LspM Config (LspId 'Method_WorkspaceApplyEdit)
forall (m :: Method 'ServerToClient 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (MessageResult m) -> f ())
-> f (LspId m)
sendRequest SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
wedit) Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
-> LspT Config IO ()
Either ResponseError ApplyWorkspaceEditResult -> LspT Config IO ()
logErrors
  (Value |? Null)
-> ExceptT PluginError (LspT Config IO) (Value |? Null)
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Value |? Null)
 -> ExceptT PluginError (LspT Config IO) (Value |? Null))
-> (Value |? Null)
-> ExceptT PluginError (LspT Config IO) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Null -> Value |? Null
forall a b. b -> a |? b
InR  Null
Null
  where logErrors :: Either ResponseError ApplyWorkspaceEditResult -> LspT Config IO ()
logErrors (Left re :: ResponseError
re@(ResponseError{})) = do
          Recorder (WithPriority Log) -> Priority -> Log -> LspT Config IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Error (ResponseError -> Log
LogWAEResponseError ResponseError
re)
          () -> LspT Config IO ()
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        logErrors (Right ApplyWorkspaceEditResult
_) = () -> LspT Config IO ()
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
runImportCommand Recorder (WithPriority Log)
_ IdeState
_ Maybe ProgressToken
_ IAResolveData
rd = do
  PluginError -> ExceptT PluginError (LspT Config IO) (Value |? Null)
forall a. PluginError -> ExceptT PluginError (LspT Config IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (LspT Config IO) (Value |? Null))
-> PluginError
-> ExceptT PluginError (LspT Config IO) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInvalidParams ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected argument for command handler:" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> IAResolveData -> [Char]
forall a. Show a => a -> [Char]
show IAResolveData
rd)


-- | We provide two code lenses for imports. The first lens makes imports
-- explicit. For example, for the module below:
-- > import Data.List
-- > f = intercalate " " . sortBy length
-- the provider should produce one code lens associated to the import statement:
-- > import Data.List (intercalate, sortBy)
--
-- The second one allows us to import functions directly from the original
-- module. For example, for the following import
-- > import Random.ReExporting.Module (liftIO)
-- the provider should produce one code lens associated to the import statement:
-- > Refine imports to import Control.Monad.IO.Class (liftIO)
lensProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens
lensProvider :: Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens
lensProvider Recorder (WithPriority Log)
_  IdeState
state PluginId
_ CodeLensParams {$sel:_textDocument:CodeLensParams :: CodeLensParams -> TextDocumentIdentifier
_textDocument = TextDocumentIdentifier {Uri
_uri :: Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri}} = do
    NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (LspT Config IO) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
_uri
    (ImportActionsResult{[(Range, Int)]
forLens :: [(Range, Int)]
forLens :: ImportActionsResult -> [(Range, Int)]
forLens}, PositionMapping
pm) <- [Char]
-> IdeState
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
state (ExceptT PluginError Action (ImportActionsResult, PositionMapping)
 -> ExceptT
      PluginError
      (LspT Config IO)
      (ImportActionsResult, PositionMapping))
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ ImportActions
-> NormalizedFilePath
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
    let lens :: [CodeLens]
lens = [ Uri -> Range -> Int -> CodeLens
generateLens Uri
_uri Range
newRange Int
int
                | (Range
range, Int
int) <- [(Range, Int)]
forLens
                , Just Range
newRange <- [PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
pm Range
range]]
    ([CodeLens] |? Null)
-> ExceptT PluginError (LspT Config IO) ([CodeLens] |? Null)
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([CodeLens] |? Null)
 -> ExceptT PluginError (LspT Config IO) ([CodeLens] |? Null))
-> ([CodeLens] |? Null)
-> ExceptT PluginError (LspT Config IO) ([CodeLens] |? Null)
forall a b. (a -> b) -> a -> b
$ [CodeLens] -> [CodeLens] |? Null
forall a b. a -> a |? b
InL [CodeLens]
lens
  where -- because these are non resolved lenses we only need the range and a
        -- unique id to later resolve them with. These are for both refine
        -- import lenses and for explicit import lenses.
        generateLens :: Uri  -> Range -> Int -> CodeLens
        generateLens :: Uri -> Range -> Int -> CodeLens
generateLens Uri
uri Range
range Int
int =
          CodeLens { $sel:_data_:CodeLens :: Maybe Value
_data_ = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ IAResolveData -> Value
forall a. ToJSON a => a -> Value
A.toJSON (IAResolveData -> Value) -> IAResolveData -> Value
forall a b. (a -> b) -> a -> b
$ Uri -> Int -> IAResolveData
ResolveOne Uri
uri Int
int
                   , $sel:_range:CodeLens :: Range
_range = Range
range
                   , $sel:_command:CodeLens :: Maybe Command
_command = Maybe Command
forall a. Maybe a
Nothing }

lensResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeLensResolve
lensResolveProvider :: Recorder (WithPriority Log)
-> ResolveFunction IdeState IAResolveData 'Method_CodeLensResolve
lensResolveProvider Recorder (WithPriority Log)
_ IdeState
ideState PluginId
plId MessageParams 'Method_CodeLensResolve
cl Uri
uri rd :: IAResolveData
rd@(ResolveOne Uri
_ Int
uid) = do
    NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (LspT Config IO) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
    (ImportActionsResult{IntMap ImportEdit
forResolve :: IntMap ImportEdit
forResolve :: ImportActionsResult -> IntMap ImportEdit
forResolve}, PositionMapping
_) <- [Char]
-> IdeState
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
ideState (ExceptT PluginError Action (ImportActionsResult, PositionMapping)
 -> ExceptT
      PluginError
      (LspT Config IO)
      (ImportActionsResult, PositionMapping))
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ ImportActions
-> NormalizedFilePath
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
    ImportEdit
target <- PluginError
-> Maybe ImportEdit
-> ExceptT PluginError (LspT Config IO) ImportEdit
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe PluginError
PluginStaleResolve (Maybe ImportEdit
 -> ExceptT PluginError (LspT Config IO) ImportEdit)
-> Maybe ImportEdit
-> ExceptT PluginError (LspT Config IO) ImportEdit
forall a b. (a -> b) -> a -> b
$ IntMap ImportEdit
forResolve IntMap ImportEdit -> Int -> Maybe ImportEdit
forall a. IntMap a -> Int -> Maybe a
IM.!? Int
uid
    let updatedCodeLens :: CodeLens
updatedCodeLens = MessageParams 'Method_CodeLensResolve
CodeLens
cl CodeLens -> (CodeLens -> CodeLens) -> CodeLens
forall a b. a -> (a -> b) -> b
& (Maybe Command -> Identity (Maybe Command))
-> CodeLens -> Identity CodeLens
forall s a. HasCommand s a => Lens' s a
Lens' CodeLens (Maybe Command)
L.command ((Maybe Command -> Identity (Maybe Command))
 -> CodeLens -> Identity CodeLens)
-> Command -> CodeLens -> CodeLens
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~  PluginId -> ImportEdit -> Command
mkCommand PluginId
plId ImportEdit
target
    CodeLens -> ExceptT PluginError (LspT Config IO) CodeLens
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeLens
updatedCodeLens
  where mkCommand ::  PluginId -> ImportEdit -> Command
        mkCommand :: PluginId -> ImportEdit -> Command
mkCommand PluginId
pId (ImportEdit{ResultType
ieResType :: ResultType
ieResType :: ImportEdit -> ResultType
ieResType, Text
ieText :: Text
ieText :: ImportEdit -> Text
ieText}) =
          let -- The only new thing we need to provide to resolve a lens is the
              -- title, as the unique Id is the same to resolve the lens title
              -- as it is to apply the lens through a command.
              -- The title is written differently depending on what type of lens
              -- it is.
              title :: ResultType -> Text
title ResultType
ExplicitImport = Text -> Text
abbreviateImportTitle Text
ieText
              title ResultType
RefineImport = Text
"Refine imports to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (Text -> [Text]
T.lines Text
ieText)
          in PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
pId CommandId
importCommandId (ResultType -> Text
title ResultType
ieResType) ([Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [IAResolveData -> Value
forall a. ToJSON a => a -> Value
A.toJSON IAResolveData
rd])
lensResolveProvider Recorder (WithPriority Log)
_ IdeState
_ PluginId
_ MessageParams 'Method_CodeLensResolve
_ Uri
_ IAResolveData
rd = do
   PluginError
-> ExceptT
     PluginError
     (LspT Config IO)
     (MessageResult 'Method_CodeLensResolve)
forall a. PluginError -> ExceptT PluginError (LspT Config IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT
      PluginError
      (LspT Config IO)
      (MessageResult 'Method_CodeLensResolve))
-> PluginError
-> ExceptT
     PluginError
     (LspT Config IO)
     (MessageResult 'Method_CodeLensResolve)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInvalidParams ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected argument for lens resolve handler: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> IAResolveData -> [Char]
forall a. Show a => a -> [Char]
show IAResolveData
rd)

-- |For explicit imports: If there are any implicit imports, provide both one
-- code action per import to make that specific import explicit, and one code
-- action to turn them all into explicit imports. For refine imports: If there
-- are any reexported imports, provide both one code action per import to refine
-- that specific import, and one code action to refine all imports.
codeActionProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider :: Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider Recorder (WithPriority Log)
_ IdeState
ideState PluginId
_pId (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ TextDocumentIdentifier {Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri :: Uri
_uri} Range
range CodeActionContext
_context) = do
    NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (LspT Config IO) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
_uri
    (ImportActionsResult{RangeMap ImportAction
forCodeActions :: RangeMap ImportAction
forCodeActions :: ImportActionsResult -> RangeMap ImportAction
forCodeActions}, PositionMapping
pm) <- [Char]
-> IdeState
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
ideState (ExceptT PluginError Action (ImportActionsResult, PositionMapping)
 -> ExceptT
      PluginError
      (LspT Config IO)
      (ImportActionsResult, PositionMapping))
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ ImportActions
-> NormalizedFilePath
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
    Range
newRange <- PositionMapping
-> Range -> ExceptT PluginError (LspT Config IO) Range
forall (m :: * -> *).
Monad m =>
PositionMapping -> Range -> ExceptT PluginError m Range
toCurrentRangeE PositionMapping
pm Range
range
    let relevantCodeActions :: [ImportAction]
relevantCodeActions = Range -> RangeMap ImportAction -> [ImportAction]
forall a. Range -> RangeMap a -> [a]
filterByRange Range
newRange RangeMap ImportAction
forCodeActions
        allExplicit :: [Command |? CodeAction]
allExplicit =
          [CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> CodeAction -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Value -> CodeAction
mkCodeAction Text
"Make all imports explicit" (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ IAResolveData -> Value
forall a. ToJSON a => a -> Value
A.toJSON (IAResolveData -> Value) -> IAResolveData -> Value
forall a b. (a -> b) -> a -> b
$ Uri -> IAResolveData
ExplicitAll Uri
_uri)
          -- We should only provide this code action if there are any code
          -- of this type
          | (ImportAction -> Bool) -> [ImportAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ImportAction
x -> ImportAction -> ResultType
iaResType ImportAction
x ResultType -> ResultType -> Bool
forall a. Eq a => a -> a -> Bool
== ResultType
ExplicitImport) [ImportAction]
relevantCodeActions]
        allRefine :: [Command |? CodeAction]
allRefine =
          [CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> CodeAction -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Value -> CodeAction
mkCodeAction Text
"Refine all imports" (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ IAResolveData -> Value
forall a. ToJSON a => a -> Value
A.toJSON (IAResolveData -> Value) -> IAResolveData -> Value
forall a b. (a -> b) -> a -> b
$ Uri -> IAResolveData
RefineAll Uri
_uri)
          -- We should only provide this code action if there are any code
          -- of this type
          | (ImportAction -> Bool) -> [ImportAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ImportAction
x -> ImportAction -> ResultType
iaResType ImportAction
x ResultType -> ResultType -> Bool
forall a. Eq a => a -> a -> Bool
== ResultType
RefineImport) [ImportAction]
relevantCodeActions]
        -- The only thing different in making the two types of code actions, is
        -- the title. The actual resolve data type, ResolveOne is used by both
        -- of them
        toCodeAction :: Uri -> ImportAction -> CodeAction
toCodeAction Uri
uri (ImportAction Range
_ Int
int ResultType
ExplicitImport) =
          Text -> Maybe Value -> CodeAction
mkCodeAction Text
"Make this import explicit" (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ IAResolveData -> Value
forall a. ToJSON a => a -> Value
A.toJSON (IAResolveData -> Value) -> IAResolveData -> Value
forall a b. (a -> b) -> a -> b
$ Uri -> Int -> IAResolveData
ResolveOne Uri
uri Int
int)
        toCodeAction Uri
uri (ImportAction Range
_  Int
int ResultType
RefineImport) =
          Text -> Maybe Value -> CodeAction
mkCodeAction Text
"Refine this import" (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ IAResolveData -> Value
forall a. ToJSON a => a -> Value
A.toJSON (IAResolveData -> Value) -> IAResolveData -> Value
forall a b. (a -> b) -> a -> b
$ Uri -> Int -> IAResolveData
ResolveOne Uri
uri Int
int)
    ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (LspT Config IO) ([Command |? CodeAction] |? Null)
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (LspT Config IO) ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (LspT Config IO) ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL ((CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> (ImportAction -> CodeAction)
-> ImportAction
-> Command |? CodeAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> ImportAction -> CodeAction
toCodeAction Uri
_uri (ImportAction -> Command |? CodeAction)
-> [ImportAction] -> [Command |? CodeAction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportAction]
relevantCodeActions) [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall a. Semigroup a => a -> a -> a
<> [Command |? CodeAction]
allExplicit [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall a. Semigroup a => a -> a -> a
<> [Command |? CodeAction]
allRefine)
    where mkCodeAction :: Text -> Maybe Value -> CodeAction
mkCodeAction Text
title Maybe Value
data_  =
            CodeAction
            { $sel:_title:CodeAction :: Text
_title = Text
title
            , $sel:_kind:CodeAction :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionKind_QuickFix
            , $sel:_command:CodeAction :: Maybe Command
_command = Maybe Command
forall a. Maybe a
Nothing
            , $sel:_edit:CodeAction :: Maybe WorkspaceEdit
_edit = Maybe WorkspaceEdit
forall a. Maybe a
Nothing
            , $sel:_diagnostics:CodeAction :: Maybe [Diagnostic]
_diagnostics = Maybe [Diagnostic]
forall a. Maybe a
Nothing
            , $sel:_isPreferred:CodeAction :: Maybe Bool
_isPreferred = Maybe Bool
forall a. Maybe a
Nothing
            , $sel:_disabled:CodeAction :: Maybe (Rec (("reason" .== Text) .+ Empty))
_disabled = Maybe (Rec (("reason" .== Text) .+ Empty))
Maybe (Rec ('R '["reason" ':-> Text]))
forall a. Maybe a
Nothing
            , $sel:_data_:CodeAction :: Maybe Value
_data_ = Maybe Value
data_}

codeActionResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeActionResolve
codeActionResolveProvider :: Recorder (WithPriority Log)
-> ResolveFunction IdeState IAResolveData 'Method_CodeActionResolve
codeActionResolveProvider Recorder (WithPriority Log)
_ IdeState
ideState PluginId
_ MessageParams 'Method_CodeActionResolve
ca Uri
_ IAResolveData
rd = do
    WorkspaceEdit
wedit <- IdeState
-> IAResolveData
-> ExceptT PluginError (LspT Config IO) WorkspaceEdit
resolveWTextEdit IdeState
ideState IAResolveData
rd
    CodeAction -> ExceptT PluginError (LspT Config IO) CodeAction
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodeAction -> ExceptT PluginError (LspT Config IO) CodeAction)
-> CodeAction -> ExceptT PluginError (LspT Config IO) CodeAction
forall a b. (a -> b) -> a -> b
$ MessageParams 'Method_CodeActionResolve
CodeAction
ca CodeAction -> (CodeAction -> CodeAction) -> CodeAction
forall a b. a -> (a -> b) -> b
& (Maybe WorkspaceEdit -> Identity (Maybe WorkspaceEdit))
-> CodeAction -> Identity CodeAction
forall s a. HasEdit s a => Lens' s a
Lens' CodeAction (Maybe WorkspaceEdit)
L.edit ((Maybe WorkspaceEdit -> Identity (Maybe WorkspaceEdit))
 -> CodeAction -> Identity CodeAction)
-> WorkspaceEdit -> CodeAction -> CodeAction
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ WorkspaceEdit
wedit
--------------------------------------------------------------------------------

resolveWTextEdit :: IdeState -> IAResolveData -> ExceptT PluginError (LspT Config IO) WorkspaceEdit
-- Providing the edit for the command, or the resolve for the code action is
-- completely generic, as all we need is the unique id and the text edit.
resolveWTextEdit :: IdeState
-> IAResolveData
-> ExceptT PluginError (LspT Config IO) WorkspaceEdit
resolveWTextEdit IdeState
ideState (ResolveOne Uri
uri Int
int) = do
  NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (LspT Config IO) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
  (ImportActionsResult{IntMap ImportEdit
forResolve :: ImportActionsResult -> IntMap ImportEdit
forResolve :: IntMap ImportEdit
forResolve}, PositionMapping
pm) <- [Char]
-> IdeState
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
ideState (ExceptT PluginError Action (ImportActionsResult, PositionMapping)
 -> ExceptT
      PluginError
      (LspT Config IO)
      (ImportActionsResult, PositionMapping))
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ ImportActions
-> NormalizedFilePath
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
  ImportEdit
iEdit <- PluginError
-> Maybe ImportEdit
-> ExceptT PluginError (LspT Config IO) ImportEdit
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe PluginError
PluginStaleResolve (Maybe ImportEdit
 -> ExceptT PluginError (LspT Config IO) ImportEdit)
-> Maybe ImportEdit
-> ExceptT PluginError (LspT Config IO) ImportEdit
forall a b. (a -> b) -> a -> b
$ IntMap ImportEdit
forResolve IntMap ImportEdit -> Int -> Maybe ImportEdit
forall a. IntMap a -> Int -> Maybe a
IM.!? Int
int
  WorkspaceEdit -> ExceptT PluginError (LspT Config IO) WorkspaceEdit
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit
 -> ExceptT PluginError (LspT Config IO) WorkspaceEdit)
-> WorkspaceEdit
-> ExceptT PluginError (LspT Config IO) WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit
mkWorkspaceEdit Uri
uri [ImportEdit
iEdit] PositionMapping
pm
resolveWTextEdit IdeState
ideState (ExplicitAll Uri
uri) = do
  NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (LspT Config IO) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
  (ImportActionsResult{IntMap ImportEdit
forResolve :: ImportActionsResult -> IntMap ImportEdit
forResolve :: IntMap ImportEdit
forResolve}, PositionMapping
pm) <- [Char]
-> IdeState
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
ideState (ExceptT PluginError Action (ImportActionsResult, PositionMapping)
 -> ExceptT
      PluginError
      (LspT Config IO)
      (ImportActionsResult, PositionMapping))
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ ImportActions
-> NormalizedFilePath
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
  let edits :: [ImportEdit]
edits = [ ImportEdit
ie | ie :: ImportEdit
ie@ImportEdit{ieResType :: ImportEdit -> ResultType
ieResType = ResultType
ExplicitImport} <- IntMap ImportEdit -> [ImportEdit]
forall a. IntMap a -> [a]
IM.elems IntMap ImportEdit
forResolve]
  WorkspaceEdit -> ExceptT PluginError (LspT Config IO) WorkspaceEdit
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit
 -> ExceptT PluginError (LspT Config IO) WorkspaceEdit)
-> WorkspaceEdit
-> ExceptT PluginError (LspT Config IO) WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit
mkWorkspaceEdit Uri
uri [ImportEdit]
edits PositionMapping
pm
resolveWTextEdit IdeState
ideState (RefineAll Uri
uri) = do
  NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (LspT Config IO) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
  (ImportActionsResult{IntMap ImportEdit
forResolve :: ImportActionsResult -> IntMap ImportEdit
forResolve :: IntMap ImportEdit
forResolve}, PositionMapping
pm) <- [Char]
-> IdeState
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall (m :: * -> *) e a.
MonadIO m =>
[Char] -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE [Char]
"ImportActions" IdeState
ideState (ExceptT PluginError Action (ImportActionsResult, PositionMapping)
 -> ExceptT
      PluginError
      (LspT Config IO)
      (ImportActionsResult, PositionMapping))
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
-> ExceptT
     PluginError (LspT Config IO) (ImportActionsResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ ImportActions
-> NormalizedFilePath
-> ExceptT
     PluginError Action (ImportActionsResult, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE ImportActions
ImportActions NormalizedFilePath
nfp
  let edits :: [ImportEdit]
edits = [ ImportEdit
re | re :: ImportEdit
re@ImportEdit{ieResType :: ImportEdit -> ResultType
ieResType = ResultType
RefineImport} <- IntMap ImportEdit -> [ImportEdit]
forall a. IntMap a -> [a]
IM.elems IntMap ImportEdit
forResolve]
  WorkspaceEdit -> ExceptT PluginError (LspT Config IO) WorkspaceEdit
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit
 -> ExceptT PluginError (LspT Config IO) WorkspaceEdit)
-> WorkspaceEdit
-> ExceptT PluginError (LspT Config IO) WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit
mkWorkspaceEdit Uri
uri [ImportEdit]
edits PositionMapping
pm
mkWorkspaceEdit :: Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit
mkWorkspaceEdit :: Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit
mkWorkspaceEdit Uri
uri [ImportEdit]
edits PositionMapping
pm =
      WorkspaceEdit {$sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
_changes = Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit]))
-> Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a b. (a -> b) -> a -> b
$ [(Uri, [TextEdit])] -> Map Uri [TextEdit]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Uri
uri, (ImportEdit -> Maybe TextEdit) -> [ImportEdit] -> [TextEdit]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ImportEdit -> Maybe TextEdit
toWEdit [ImportEdit]
edits)]
                    , $sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_documentChanges = Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing
                    , $sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
_changeAnnotations = Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing}
  where toWEdit :: ImportEdit -> Maybe TextEdit
toWEdit ImportEdit{Range
ieRange :: Range
ieRange :: ImportEdit -> Range
ieRange, Text
ieText :: ImportEdit -> Text
ieText :: Text
ieText} =
          let newRange :: Maybe Range
newRange = PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
pm Range
ieRange
          in (\Range
r -> Range -> Text -> TextEdit
TextEdit Range
r Text
ieText) (Range -> TextEdit) -> Maybe Range -> Maybe TextEdit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
newRange

data ImportActions = ImportActions
  deriving (Int -> ImportActions -> [Char] -> [Char]
[ImportActions] -> [Char] -> [Char]
ImportActions -> [Char]
(Int -> ImportActions -> [Char] -> [Char])
-> (ImportActions -> [Char])
-> ([ImportActions] -> [Char] -> [Char])
-> Show ImportActions
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ImportActions -> [Char] -> [Char]
showsPrec :: Int -> ImportActions -> [Char] -> [Char]
$cshow :: ImportActions -> [Char]
show :: ImportActions -> [Char]
$cshowList :: [ImportActions] -> [Char] -> [Char]
showList :: [ImportActions] -> [Char] -> [Char]
Show, (forall x. ImportActions -> Rep ImportActions x)
-> (forall x. Rep ImportActions x -> ImportActions)
-> Generic ImportActions
forall x. Rep ImportActions x -> ImportActions
forall x. ImportActions -> Rep ImportActions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImportActions -> Rep ImportActions x
from :: forall x. ImportActions -> Rep ImportActions x
$cto :: forall x. Rep ImportActions x -> ImportActions
to :: forall x. Rep ImportActions x -> ImportActions
Generic, ImportActions -> ImportActions -> Bool
(ImportActions -> ImportActions -> Bool)
-> (ImportActions -> ImportActions -> Bool) -> Eq ImportActions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImportActions -> ImportActions -> Bool
== :: ImportActions -> ImportActions -> Bool
$c/= :: ImportActions -> ImportActions -> Bool
/= :: ImportActions -> ImportActions -> Bool
Eq, Eq ImportActions
Eq ImportActions =>
(ImportActions -> ImportActions -> Ordering)
-> (ImportActions -> ImportActions -> Bool)
-> (ImportActions -> ImportActions -> Bool)
-> (ImportActions -> ImportActions -> Bool)
-> (ImportActions -> ImportActions -> Bool)
-> (ImportActions -> ImportActions -> ImportActions)
-> (ImportActions -> ImportActions -> ImportActions)
-> Ord ImportActions
ImportActions -> ImportActions -> Bool
ImportActions -> ImportActions -> Ordering
ImportActions -> ImportActions -> ImportActions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ImportActions -> ImportActions -> Ordering
compare :: ImportActions -> ImportActions -> Ordering
$c< :: ImportActions -> ImportActions -> Bool
< :: ImportActions -> ImportActions -> Bool
$c<= :: ImportActions -> ImportActions -> Bool
<= :: ImportActions -> ImportActions -> Bool
$c> :: ImportActions -> ImportActions -> Bool
> :: ImportActions -> ImportActions -> Bool
$c>= :: ImportActions -> ImportActions -> Bool
>= :: ImportActions -> ImportActions -> Bool
$cmax :: ImportActions -> ImportActions -> ImportActions
max :: ImportActions -> ImportActions -> ImportActions
$cmin :: ImportActions -> ImportActions -> ImportActions
min :: ImportActions -> ImportActions -> ImportActions
Ord)

instance Hashable ImportActions

instance NFData ImportActions

type instance RuleResult ImportActions = ImportActionsResult

data ResultType = ExplicitImport | RefineImport
  deriving ResultType -> ResultType -> Bool
(ResultType -> ResultType -> Bool)
-> (ResultType -> ResultType -> Bool) -> Eq ResultType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResultType -> ResultType -> Bool
== :: ResultType -> ResultType -> Bool
$c/= :: ResultType -> ResultType -> Bool
/= :: ResultType -> ResultType -> Bool
Eq

data ImportActionsResult = ImportActionsResult
  { -- |For providing the code lenses we need to have a range, and a unique id
    -- that is later resolved to the new text for each import. It is stored in
    -- a list, because we always need to provide all the code lens in a file.
    ImportActionsResult -> [(Range, Int)]
forLens        :: [(Range, Int)]
    -- |For the code actions we have the same data as for the code lenses, but
    -- we store it in a RangeMap, because that allows us to filter on a specific
    -- range with better performance, and code actions are almost always only
    -- requested for a specific range
  , ImportActionsResult -> RangeMap ImportAction
forCodeActions :: RM.RangeMap ImportAction
    -- |For resolve we have an intMap where for every previously provided unique id
    -- we provide a textEdit to allow our code actions or code lens to be resolved
  , ImportActionsResult -> IntMap ImportEdit
forResolve     :: IM.IntMap ImportEdit }

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

-- |The necessary data for providing code actions: the range, a unique ID for
-- later resolving the action, and the type of action for giving a proper name.
data ImportAction = ImportAction { ImportAction -> Range
iaRange :: Range, ImportAction -> Int
iaUniqueId :: Int, ImportAction -> ResultType
iaResType :: ResultType}

instance Show ImportActionsResult where show :: ImportActionsResult -> [Char]
show ImportActionsResult
_ = [Char]
"<ImportActionsResult>"

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

data IAResolveData = ResolveOne
                      { IAResolveData -> Uri
uri      :: Uri
                      , IAResolveData -> Int
importId :: Int }
                    | ExplicitAll
                      { uri :: Uri }
                    | RefineAll
                      { uri :: Uri }
                    deriving ((forall x. IAResolveData -> Rep IAResolveData x)
-> (forall x. Rep IAResolveData x -> IAResolveData)
-> Generic IAResolveData
forall x. Rep IAResolveData x -> IAResolveData
forall x. IAResolveData -> Rep IAResolveData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IAResolveData -> Rep IAResolveData x
from :: forall x. IAResolveData -> Rep IAResolveData x
$cto :: forall x. Rep IAResolveData x -> IAResolveData
to :: forall x. Rep IAResolveData x -> IAResolveData
Generic, Int -> IAResolveData -> [Char] -> [Char]
[IAResolveData] -> [Char] -> [Char]
IAResolveData -> [Char]
(Int -> IAResolveData -> [Char] -> [Char])
-> (IAResolveData -> [Char])
-> ([IAResolveData] -> [Char] -> [Char])
-> Show IAResolveData
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> IAResolveData -> [Char] -> [Char]
showsPrec :: Int -> IAResolveData -> [Char] -> [Char]
$cshow :: IAResolveData -> [Char]
show :: IAResolveData -> [Char]
$cshowList :: [IAResolveData] -> [Char] -> [Char]
showList :: [IAResolveData] -> [Char] -> [Char]
Show, [IAResolveData] -> Value
[IAResolveData] -> Encoding
IAResolveData -> Bool
IAResolveData -> Value
IAResolveData -> Encoding
(IAResolveData -> Value)
-> (IAResolveData -> Encoding)
-> ([IAResolveData] -> Value)
-> ([IAResolveData] -> Encoding)
-> (IAResolveData -> Bool)
-> ToJSON IAResolveData
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: IAResolveData -> Value
toJSON :: IAResolveData -> Value
$ctoEncoding :: IAResolveData -> Encoding
toEncoding :: IAResolveData -> Encoding
$ctoJSONList :: [IAResolveData] -> Value
toJSONList :: [IAResolveData] -> Value
$ctoEncodingList :: [IAResolveData] -> Encoding
toEncodingList :: [IAResolveData] -> Encoding
$comitField :: IAResolveData -> Bool
omitField :: IAResolveData -> Bool
A.ToJSON, Maybe IAResolveData
Value -> Parser [IAResolveData]
Value -> Parser IAResolveData
(Value -> Parser IAResolveData)
-> (Value -> Parser [IAResolveData])
-> Maybe IAResolveData
-> FromJSON IAResolveData
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser IAResolveData
parseJSON :: Value -> Parser IAResolveData
$cparseJSONList :: Value -> Parser [IAResolveData]
parseJSONList :: Value -> Parser [IAResolveData]
$comittedField :: Maybe IAResolveData
omittedField :: Maybe IAResolveData
FromJSON)

exportedModuleStrings :: ParsedModule -> [String]
exportedModuleStrings :: ParsedModule -> [[Char]]
exportedModuleStrings ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LImportDecl GhcPs]
[LHsDecl GhcPs]
Maybe (XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
XCModule GhcPs
hsmodExt :: XCModule GhcPs
hsmodName :: Maybe (XRec GhcPs ModuleName)
hsmodExports :: Maybe (XRec GhcPs [LIE GhcPs])
hsmodImports :: [LImportDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodExt :: forall p. HsModule p -> XCModule p
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
..}}
  | Just XRec GhcPs [LIE GhcPs]
export <- Maybe (XRec GhcPs [LIE GhcPs])
hsmodExports,
    [GenLocated SrcSpanAnnA (IE GhcPs)]
exports <- GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LIE GhcPs]
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
export
    = (GenLocated SrcSpanAnnA (IE GhcPs) -> [Char])
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
T.unpack (Text -> [Char])
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> Text)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> Text
forall a. Outputable a => a -> Text
printOutputable) [GenLocated SrcSpanAnnA (IE GhcPs)]
exports
exportedModuleStrings ParsedModule
_ = []

minimalImportsRule :: Recorder (WithPriority Log) -> (ModuleName -> Bool) -> Rules ()
minimalImportsRule :: Recorder (WithPriority Log) -> (ModuleName -> Bool) -> Rules ()
minimalImportsRule Recorder (WithPriority Log)
recorder ModuleName -> Bool
modFilter = Recorder (WithPriority Log)
-> (ImportActions
    -> NormalizedFilePath -> Action (Maybe ImportActionsResult))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((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) ((ImportActions
  -> NormalizedFilePath -> Action (Maybe ImportActionsResult))
 -> Rules ())
-> (ImportActions
    -> NormalizedFilePath -> Action (Maybe ImportActionsResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \ImportActions
ImportActions NormalizedFilePath
nfp -> MaybeT Action ImportActionsResult
-> Action (Maybe ImportActionsResult)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Action ImportActionsResult
 -> Action (Maybe ImportActionsResult))
-> MaybeT Action ImportActionsResult
-> Action (Maybe ImportActionsResult)
forall a b. (a -> b) -> a -> b
$ do
  -- Get the typechecking artifacts from the module
  TcModuleResult
tmr <- Action (Maybe TcModuleResult) -> MaybeT Action TcModuleResult
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe TcModuleResult) -> MaybeT Action TcModuleResult)
-> Action (Maybe TcModuleResult) -> MaybeT Action TcModuleResult
forall a b. (a -> b) -> a -> b
$ 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
  HscEnvEq
hsc <- Action (Maybe HscEnvEq) -> MaybeT Action HscEnvEq
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe HscEnvEq) -> MaybeT Action HscEnvEq)
-> Action (Maybe HscEnvEq) -> MaybeT Action HscEnvEq
forall a b. (a -> b) -> a -> b
$ GhcSessionDeps -> NormalizedFilePath -> Action (Maybe HscEnvEq)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSessionDeps
GhcSessionDeps NormalizedFilePath
nfp

  -- refine imports: 2 layer map ModuleName -> ModuleName -> [Avails] (exports)
  Map ModuleName (Map ModuleName [AvailInfo])
import2Map <- do
    -- first layer is from current(editing) module to its imports
    ImportMap Map ModuleName NormalizedFilePath
currIm <- Action (Maybe ImportMap) -> MaybeT Action ImportMap
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe ImportMap) -> MaybeT Action ImportMap)
-> Action (Maybe ImportMap) -> MaybeT Action ImportMap
forall a b. (a -> b) -> a -> b
$ GetImportMap -> NormalizedFilePath -> Action (Maybe ImportMap)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetImportMap
GetImportMap NormalizedFilePath
nfp
    Map ModuleName NormalizedFilePath
-> (NormalizedFilePath
    -> MaybeT Action (Map ModuleName [AvailInfo]))
-> MaybeT Action (Map ModuleName (Map ModuleName [AvailInfo]))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map ModuleName NormalizedFilePath
currIm ((NormalizedFilePath -> MaybeT Action (Map ModuleName [AvailInfo]))
 -> MaybeT Action (Map ModuleName (Map ModuleName [AvailInfo])))
-> (NormalizedFilePath
    -> MaybeT Action (Map ModuleName [AvailInfo]))
-> MaybeT 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 <- Action (Maybe ImportMap) -> MaybeT Action ImportMap
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe ImportMap) -> MaybeT Action ImportMap)
-> Action (Maybe ImportMap) -> MaybeT Action ImportMap
forall a b. (a -> b) -> a -> b
$ GetImportMap -> NormalizedFilePath -> Action (Maybe ImportMap)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetImportMap
GetImportMap NormalizedFilePath
path
      Map ModuleName NormalizedFilePath
-> (NormalizedFilePath -> MaybeT Action [AvailInfo])
-> MaybeT Action (Map ModuleName [AvailInfo])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map ModuleName NormalizedFilePath
importIm ((NormalizedFilePath -> MaybeT Action [AvailInfo])
 -> MaybeT Action (Map ModuleName [AvailInfo]))
-> (NormalizedFilePath -> MaybeT Action [AvailInfo])
-> MaybeT Action (Map ModuleName [AvailInfo])
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
imp_path -> do
        HiFileResult
imp_hir <- Action (Maybe HiFileResult) -> MaybeT Action HiFileResult
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe HiFileResult) -> MaybeT Action HiFileResult)
-> Action (Maybe HiFileResult) -> MaybeT Action HiFileResult
forall a b. (a -> b) -> a -> b
$ GetModIface -> NormalizedFilePath -> Action (Maybe HiFileResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModIface
GetModIface NormalizedFilePath
imp_path
        [AvailInfo] -> MaybeT Action [AvailInfo]
forall a. a -> MaybeT Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AvailInfo] -> MaybeT Action [AvailInfo])
-> [AvailInfo] -> MaybeT Action [AvailInfo]
forall a b. (a -> b) -> a -> b
$ ModIface_ 'ModIfaceFinal -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports (ModIface_ 'ModIfaceFinal -> [AvailInfo])
-> ModIface_ 'ModIfaceFinal -> [AvailInfo]
forall a b. (a -> b) -> a -> b
$ HiFileResult -> ModIface_ 'ModIfaceFinal
hirModIface HiFileResult
imp_hir

  -- Use the GHC api to extract the "minimal" imports
  [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
locationImportWithMinimal <- Action (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
-> MaybeT
     Action [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
 -> MaybeT
      Action [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
-> Action
     (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
-> MaybeT
     Action [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
forall a b. (a -> b) -> a -> b
$ IO (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
-> Action
     (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
 -> Action
      (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]))
-> IO (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
-> Action
     (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
forall a b. (a -> b) -> a -> b
$ HscEnvEq
-> TcModuleResult
-> IO (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
extractMinimalImports HscEnvEq
hsc TcModuleResult
tmr

  let minimalImportsResult :: [(Range, (Text, ResultType))]
minimalImportsResult =
        [ (Range
range, (ImportDecl GhcRn -> Text
forall a. Outputable a => a -> Text
printOutputable ImportDecl GhcRn
minImport, ResultType
ExplicitImport))
          | (RealSrcSpan
location, ImportDecl GhcRn
impDecl, ImportDecl GhcRn
minImport) <- [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
locationImportWithMinimal
          , Bool -> Bool
not (ImportDecl GhcRn -> Bool
forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl GhcRn
impDecl)
          , Bool -> Bool
not (ImportDecl GhcRn -> Bool
isExplicitImport ImportDecl GhcRn
impDecl)
          , let L SrcSpanAnnA
_ ModuleName
moduleName = ImportDecl GhcRn -> XRec GhcRn ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcRn
impDecl
          , ModuleName -> Bool
modFilter ModuleName
moduleName
          , let range :: Range
range = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
location]

      refineImportsResult :: [(Range, (Text, ResultType))]
refineImportsResult =
        [ (Range
range, (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 (ImportDecl GhcRn -> Text
forall a. Outputable a => a -> Text
printOutputable (ImportDecl GhcRn -> Text)
-> ((ModuleName, [AvailInfo]) -> ImportDecl GhcRn)
-> (ModuleName, [AvailInfo])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcRn
-> ImportDecl GhcRn
-> (ModuleName, [AvailInfo])
-> ImportDecl GhcRn
constructImport ImportDecl GhcRn
origImport ImportDecl GhcRn
minImport)
                ([(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] -> Text)
-> Map ModuleName [AvailInfo] -> Text
forall a b. (a -> b) -> a -> b
$ Map ModuleName [AvailInfo]
filteredInnerImports, ResultType
RefineImport))
        -- for every minimal imports
        | (RealSrcSpan
location, ImportDecl GhcRn
origImport, minImport :: ImportDecl GhcRn
minImport@(ImportDecl{ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = L SrcSpanAnnA
_ ModuleName
mn})) <- [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
locationImportWithMinimal
        -- (almost) no one wants to see an refine import list for Prelude
        , ModuleName
mn ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName GenModule Unit
pRELUDE
        -- 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 <- [ImportDecl GhcRn
-> Map ModuleName [AvailInfo] -> Maybe (Map ModuleName [AvailInfo])
filterByImport ImportDecl GhcRn
minImport 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 a. Map ModuleName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map ModuleName [AvailInfo]
filteredInnerImports
        -- and then convert that to a Range
        , let range :: Range
range = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
location
        ]
  [(Int, (Range, (Text, ResultType)))]
uniqueAndRangeAndText <- IO [(Int, (Range, (Text, ResultType)))]
-> MaybeT Action [(Int, (Range, (Text, ResultType)))]
forall a. IO a -> MaybeT Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Int, (Range, (Text, ResultType)))]
 -> MaybeT Action [(Int, (Range, (Text, ResultType)))])
-> IO [(Int, (Range, (Text, ResultType)))]
-> MaybeT Action [(Int, (Range, (Text, ResultType)))]
forall a b. (a -> b) -> a -> b
$ [(Range, (Text, ResultType))]
-> ((Range, (Text, ResultType))
    -> IO (Int, (Range, (Text, ResultType))))
-> IO [(Int, (Range, (Text, ResultType)))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([(Range, (Text, ResultType))]
minimalImportsResult [(Range, (Text, ResultType))]
-> [(Range, (Text, ResultType))] -> [(Range, (Text, ResultType))]
forall a. [a] -> [a] -> [a]
++ [(Range, (Text, ResultType))]
refineImportsResult) (((Range, (Text, ResultType))
  -> IO (Int, (Range, (Text, ResultType))))
 -> IO [(Int, (Range, (Text, ResultType)))])
-> ((Range, (Text, ResultType))
    -> IO (Int, (Range, (Text, ResultType))))
-> IO [(Int, (Range, (Text, ResultType)))]
forall a b. (a -> b) -> a -> b
$ \(Range, (Text, ResultType))
rt -> do
                                Int
u <- Unique -> Int
U.hashUnique (Unique -> Int) -> IO Unique -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique
U.newUnique
                                (Int, (Range, (Text, ResultType)))
-> IO (Int, (Range, (Text, ResultType)))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
u,  (Range, (Text, ResultType))
rt)
  let rangeAndUnique :: [ImportAction]
rangeAndUnique =  [ Range -> Int -> ResultType -> ImportAction
ImportAction Range
r Int
u ResultType
rt | (Int
u, (Range
r, (Text
_, ResultType
rt))) <- [(Int, (Range, (Text, ResultType)))]
uniqueAndRangeAndText ]
  ImportActionsResult -> MaybeT Action ImportActionsResult
forall a. a -> MaybeT Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportActionsResult
                      { forLens :: [(Range, Int)]
forLens = (\ImportAction{Int
Range
ResultType
iaResType :: ImportAction -> ResultType
iaRange :: ImportAction -> Range
iaUniqueId :: ImportAction -> Int
iaRange :: Range
iaUniqueId :: Int
iaResType :: ResultType
..} -> (Range
iaRange, Int
iaUniqueId)) (ImportAction -> (Range, Int)) -> [ImportAction] -> [(Range, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportAction]
rangeAndUnique
                      , forCodeActions :: RangeMap ImportAction
forCodeActions = (ImportAction -> Range) -> [ImportAction] -> RangeMap ImportAction
forall a. (a -> Range) -> [a] -> RangeMap a
RM.fromList ImportAction -> Range
iaRange [ImportAction]
rangeAndUnique
                      , forResolve :: IntMap ImportEdit
forResolve =  [(Int, ImportEdit)] -> IntMap ImportEdit
forall a. [(Int, a)] -> IntMap a
IM.fromList ((\(Int
u, (Range
r, (Text
te, ResultType
ty))) -> (Int
u, Range -> Text -> ResultType -> ImportEdit
ImportEdit Range
r Text
te ResultType
ty)) ((Int, (Range, (Text, ResultType))) -> (Int, ImportEdit))
-> [(Int, (Range, (Text, ResultType)))] -> [(Int, ImportEdit)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, (Range, (Text, ResultType)))]
uniqueAndRangeAndText) }

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

-- | Use the ghc api to extract a minimal, explicit set of imports for this module
extractMinimalImports ::
  HscEnvEq ->
  TcModuleResult ->
  IO (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
extractMinimalImports :: HscEnvEq
-> TcModuleResult
-> IO (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
extractMinimalImports HscEnvEq
hsc TcModuleResult {Bool
RenamedSource
ModuleEnv ByteString
TcGblEnv
ParsedModule
Splices
tmrParsed :: ParsedModule
tmrRenamed :: RenamedSource
tmrTypechecked :: TcGblEnv
tmrTopLevelSplices :: Splices
tmrDeferredError :: Bool
tmrRuntimeModules :: ModuleEnv ByteString
tmrDeferredError :: TcModuleResult -> Bool
tmrParsed :: TcModuleResult -> ParsedModule
tmrRenamed :: TcModuleResult -> RenamedSource
tmrRuntimeModules :: TcModuleResult -> ModuleEnv ByteString
tmrTopLevelSplices :: TcModuleResult -> Splices
tmrTypechecked :: TcModuleResult -> TcGblEnv
..} = MaybeT IO [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
-> IO (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
 -> IO (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]))
-> MaybeT IO [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
-> IO (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
forall a b. (a -> b) -> a -> b
$ do
  -- extract the original imports and the typechecking environment
  let tcEnv :: TcGblEnv
tcEnv = TcGblEnv
tmrTypechecked
      (HsGroup GhcRn
_, [LImportDecl GhcRn]
imports, Maybe [(LIE GhcRn, [AvailInfo])]
_, Maybe (LHsDoc GhcRn)
_) = RenamedSource
tmrRenamed
      ParsedModule {pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
loc HsModule GhcPs
_} = ParsedModule
tmrParsed
      emss :: [[Char]]
emss = ParsedModule -> [[Char]]
exportedModuleStrings ParsedModule
tmrParsed
  Just RealSrcSpan
srcSpan <- Maybe RealSrcSpan -> MaybeT IO (Maybe RealSrcSpan)
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RealSrcSpan -> MaybeT IO (Maybe RealSrcSpan))
-> Maybe RealSrcSpan -> MaybeT IO (Maybe 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 :: [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
notExportedImports = (GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> Bool)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
forall a. (a -> Bool) -> [a] -> [a]
filter ([[Char]] -> LImportDecl GhcRn -> Bool
notExported [[Char]]
emss) [LImportDecl GhcRn]
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
imports

  -- GHC is secretly full of mutable state
  [GlobalRdrElt]
gblElts <- IO [GlobalRdrElt] -> MaybeT IO [GlobalRdrElt]
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GlobalRdrElt] -> MaybeT IO [GlobalRdrElt])
-> IO [GlobalRdrElt] -> MaybeT IO [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ 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]
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
notExportedImports [GlobalRdrElt]
gblElts
  (Messages TcRnMessage
_, Just [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
minimalImports) <- IO
  (Messages TcRnMessage,
   Maybe [GenLocated SrcSpanAnnA (ImportDecl GhcRn)])
-> MaybeT
     IO
     (Messages TcRnMessage,
      Maybe [GenLocated SrcSpanAnnA (ImportDecl GhcRn)])
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Messages TcRnMessage,
    Maybe [GenLocated SrcSpanAnnA (ImportDecl GhcRn)])
 -> MaybeT
      IO
      (Messages TcRnMessage,
       Maybe [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]))
-> IO
     (Messages TcRnMessage,
      Maybe [GenLocated SrcSpanAnnA (ImportDecl GhcRn)])
-> MaybeT
     IO
     (Messages TcRnMessage,
      Maybe [GenLocated SrcSpanAnnA (ImportDecl GhcRn)])
forall a b. (a -> b) -> a -> b
$
    HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM [LImportDecl GhcRn]
-> IO (Messages TcRnMessage, Maybe [LImportDecl GhcRn])
forall r.
HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM r
-> IO (Messages TcRnMessage, Maybe r)
initTcWithGbl (HscEnvEq -> HscEnv
hscEnv HscEnvEq
hsc) TcGblEnv
tcEnv RealSrcSpan
srcSpan (TcM [LImportDecl GhcRn]
 -> IO (Messages TcRnMessage, Maybe [LImportDecl GhcRn]))
-> TcM [LImportDecl GhcRn]
-> IO (Messages TcRnMessage, Maybe [LImportDecl GhcRn])
forall a b. (a -> b) -> a -> b
$ [ImportDeclUsage] -> TcM [LImportDecl GhcRn]
getMinimalImports [ImportDeclUsage]
usage

  let minimalImportsMap :: Map RealSrcLoc (ImportDecl GhcRn)
minimalImportsMap =
        [(RealSrcLoc, ImportDecl GhcRn)]
-> Map RealSrcLoc (ImportDecl GhcRn)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
l, ImportDecl GhcRn
impDecl)
            | L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) ImportDecl GhcRn
impDecl <- [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
minimalImports
          ]
      results :: [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
results =
          [ (RealSrcSpan
location, ImportDecl GhcRn
imp, ImportDecl GhcRn
minImport)
          | L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> RealSrcSpan RealSrcSpan
location Maybe BufSpan
_) ImportDecl GhcRn
imp <- [LImportDecl GhcRn]
[GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
imports
          , Just ImportDecl GhcRn
minImport <- [RealSrcLoc
-> Map RealSrcLoc (ImportDecl GhcRn) -> Maybe (ImportDecl GhcRn)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
location) Map RealSrcLoc (ImportDecl GhcRn)
minimalImportsMap]]
  -- return both the original imports and the computed minimal ones
  [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
-> MaybeT IO [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
forall a. a -> MaybeT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)]
results
  where
      notExported :: [String] -> LImportDecl GhcRn -> Bool
      notExported :: [[Char]] -> LImportDecl GhcRn -> Bool
notExported []  LImportDecl GhcRn
_ = Bool
True
      notExported [[Char]]
exports (L SrcSpanAnnA
_ ImportDecl{ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = L SrcSpanAnnA
_ ModuleName
name}) =
          Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\[Char]
e -> ([Char]
"module " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ModuleName -> [Char]
moduleNameString ModuleName
name) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
e) [[Char]]
exports

isExplicitImport :: ImportDecl GhcRn -> Bool
#if MIN_VERSION_ghc(9,5,0)
isExplicitImport :: ImportDecl GhcRn -> Bool
isExplicitImport ImportDecl {ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList = Just (ImportListInterpretation
Exactly, XRec GhcRn [LIE GhcRn]
_)} = Bool
True
#else
isExplicitImport ImportDecl {ideclHiding = Just (False, _)}       = True
#endif
isExplicitImport ImportDecl GhcRn
_                                                = Bool
False

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


-- | The title of the command is ideally the minimal explicit import decl, but
-- we don't want to create a really massive code lens (and the decl can be extremely large!).
-- So we abbreviate it to fit a max column size, and indicate how many more items are in the list
-- after the abbreviation
abbreviateImportTitle :: T.Text -> T.Text
abbreviateImportTitle :: Text -> Text
abbreviateImportTitle Text
input =
  let
      -- For starters, we only want one line in the title
      oneLineText :: Text
oneLineText = [Text] -> Text
T.unwords ([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 (Int -> Text
summaryText Int
100)) Text
oneLineText
      -- We also want to truncate the last item so we get a "clean" break, rather than half way through
      -- something. The conditional here is just because 'breakOnEnd' doesn't give us quite the right thing
      -- if there are actually no commas.
      (Text
actualPrefix, Text
extraSuffix) = if HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
"," Text
prefix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then HasCallStack => Text -> Text -> (Text, Text)
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 = HasCallStack => Text -> Text -> Int
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 :: Int -> T.Text
      summaryText :: Int -> Text
summaryText Int
n = Text
" ... (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. IsString a => [Char] -> a
fromString (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" items)"
      -- so we only add a trailing paren if we've split in the export list
      suffixText :: Text
suffixText = Int -> Text
summaryText Int
numAdditionalItems Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if HasCallStack => Text -> Text -> Int
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

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


filterByImport :: ImportDecl GhcRn -> Map.Map ModuleName [AvailInfo] -> Maybe (Map.Map ModuleName [AvailInfo])
#if MIN_VERSION_ghc(9,5,0)
filterByImport :: ImportDecl GhcRn
-> Map ModuleName [AvailInfo] -> Maybe (Map ModuleName [AvailInfo])
filterByImport (ImportDecl{ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList = Just (ImportListInterpretation
_, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
names)})
#else
filterByImport (ImportDecl{ideclHiding = Just (_, L _ names)})
#endif
  Map ModuleName [AvailInfo]
avails =
      -- if there is a function defined in the current module and is used
      -- i.e. if a function is not reexported but defined in current
      -- module then this import cannot be refined
  if Set Name
importedNames 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
  where 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
$ (GenLocated SrcSpanAnnA (IE GhcRn) -> Name)
-> [GenLocated SrcSpanAnnA (IE GhcRn)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (IE GhcRn -> IdP GhcRn
IE GhcRn -> Name
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName (IE GhcRn -> Name)
-> (GenLocated SrcSpanAnnA (IE GhcRn) -> IE GhcRn)
-> GenLocated SrcSpanAnnA (IE GhcRn)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcRn) -> IE GhcRn
forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (IE 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]
getAvailNames
                      [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]
getAvailNames
          ([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
filterByImport ImportDecl GhcRn
_ Map ModuleName [AvailInfo]
_ = Maybe (Map ModuleName [AvailInfo])
forall a. Maybe a
Nothing

constructImport :: ImportDecl GhcRn -> ImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> ImportDecl GhcRn
#if MIN_VERSION_ghc(9,5,0)
constructImport :: ImportDecl GhcRn
-> ImportDecl GhcRn
-> (ModuleName, [AvailInfo])
-> ImportDecl GhcRn
constructImport ImportDecl{ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
qualified, ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList = Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
origHiding} imd :: ImportDecl GhcRn
imd@ImportDecl{ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList = Just (ImportListInterpretation
hiding, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
names)}
#else
constructImport ImportDecl{ideclQualified = qualified, ideclHiding = origHiding} imd@ImportDecl{ideclHiding = Just (hiding, L _ names)}
#endif
  (ModuleName
newModuleName, [AvailInfo]
avails) = ImportDecl GhcRn
imd
    { ideclName = noLocA newModuleName
#if MIN_VERSION_ghc(9,5,0)
    , ideclImportList = if isNothing origHiding && qualified /= NotQualified
                        then Nothing
                        else Just (hiding, noLocA newNames)
#else
    , ideclHiding = if isNothing origHiding && qualified /= NotQualified
                        then Nothing
                        else Just (hiding, noLocA newNames)
#endif
    }
    where newNames :: [GenLocated SrcSpanAnnA (IE GhcRn)]
newNames = (GenLocated SrcSpanAnnA (IE GhcRn) -> Bool)
-> [GenLocated SrcSpanAnnA (IE GhcRn)]
-> [GenLocated SrcSpanAnnA (IE GhcRn)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\GenLocated SrcSpanAnnA (IE GhcRn)
n -> (AvailInfo -> Bool) -> [AvailInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (LIE GhcRn
GenLocated SrcSpanAnnA (IE GhcRn)
n `containsAvail`) [AvailInfo]
avails) [GenLocated SrcSpanAnnA (IE GhcRn)]
names
          -- Check if a name is exposed by AvailInfo (the available information of a module)
          containsAvail :: LIE GhcRn -> AvailInfo -> Bool
          containsAvail :: LIE GhcRn -> AvailInfo -> Bool
containsAvail LIE GhcRn
name AvailInfo
avail =
            (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 -> IdP GhcRn
IE GhcRn -> Name
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName (IE GhcRn -> Name)
-> (GenLocated SrcSpanAnnA (IE GhcRn) -> IE GhcRn)
-> GenLocated SrcSpanAnnA (IE GhcRn)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcRn) -> IE GhcRn
forall l e. GenLocated l e -> e
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]
getAvailNames AvailInfo
avail

constructImport ImportDecl GhcRn
_ ImportDecl GhcRn
lim (ModuleName, [AvailInfo])
_ = ImportDecl GhcRn
lim

getAvailNames :: AvailInfo -> [Name]
getAvailNames :: AvailInfo -> [Name]
getAvailNames =
#if MIN_VERSION_ghc(9,7,0)
  availNames
#else
  AvailInfo -> [Name]
availNamesWithSelectors
#endif