{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms   #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE ViewPatterns      #-}

module Ide.Plugin.QualifyImportedNames (descriptor) where

import           Control.Monad                     (foldM)
import           Control.Monad.IO.Class            (MonadIO (liftIO))
import           Control.Monad.Trans.State.Strict  (State)
import qualified Control.Monad.Trans.State.Strict  as State
import           Data.DList                        (DList)
import qualified Data.DList                        as DList
import           Data.Foldable                     (Foldable (foldl'), find)
import qualified Data.HashMap.Strict               as HashMap
import           Data.List                         (sortOn)
import qualified Data.List                         as List
import qualified Data.Map.Strict                   as Map
import           Data.Maybe                        (mapMaybe)
import           Data.Text                         (Text)
import qualified Data.Text                         as Text
import           Development.IDE.Core.RuleTypes    (GetFileContents (GetFileContents),
                                                    GetHieAst (GetHieAst),
                                                    HieAstResult (HAR, refMap),
                                                    TcModuleResult (TcModuleResult, tmrParsed, tmrTypechecked),
                                                    TypeCheck (TypeCheck))
import           Development.IDE.Core.Service      (runAction)
import           Development.IDE.Core.Shake        (IdeState, use)
import           Development.IDE.GHC.Compat        (ContextInfo (Use),
                                                    GenLocated (..), GhcPs,
                                                    GlobalRdrElt, GlobalRdrEnv,
                                                    HsModule (hsmodImports),
                                                    Identifier,
                                                    IdentifierDetails (IdentifierDetails, identInfo),
                                                    ImpDeclSpec (ImpDeclSpec, is_as, is_dloc, is_qual),
                                                    ImportSpec (ImpSpec),
                                                    LImportDecl, ModuleName,
                                                    Name, NameEnv, OccName,
                                                    ParsedModule, RefMap, Span,
                                                    SrcSpan,
                                                    TcGblEnv (tcg_rdr_env),
                                                    emptyUFM, globalRdrEnvElts,
                                                    gre_imp, gre_name, locA,
                                                    lookupNameEnv,
                                                    moduleNameString,
                                                    nameOccName, occNameString,
                                                    pattern GRE,
                                                    pattern ParsedModule,
                                                    plusUFM_C, pm_parsed_source,
                                                    srcSpanEndCol,
                                                    srcSpanEndLine,
                                                    srcSpanStartCol,
                                                    srcSpanStartLine, unitUFM)
import           Development.IDE.GHC.Error         (isInsideSrcSpan)
import           Development.IDE.Types.Diagnostics (List (List))
import           Development.IDE.Types.Location    (NormalizedFilePath,
                                                    Position (Position),
                                                    Range (Range), Uri,
                                                    toNormalizedUri)
import           Ide.Types                         (PluginDescriptor (pluginHandlers),
                                                    PluginId,
                                                    PluginMethodHandler,
                                                    defaultPluginDescriptor,
                                                    mkPluginHandler)
import           Language.LSP.Types                (CodeAction (CodeAction, _command, _diagnostics, _disabled, _edit, _isPreferred, _kind, _title, _xdata),
                                                    CodeActionKind (CodeActionQuickFix),
                                                    CodeActionParams (CodeActionParams),
                                                    Method (TextDocumentCodeAction),
                                                    SMethod (STextDocumentCodeAction),
                                                    TextDocumentIdentifier (TextDocumentIdentifier),
                                                    TextEdit (TextEdit),
                                                    WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges),
                                                    type (|?) (InR),
                                                    uriToNormalizedFilePath)

thenCmp :: Ordering -> Ordering -> Ordering
{-# INLINE thenCmp #-}
thenCmp :: Ordering -> Ordering -> Ordering
thenCmp Ordering
EQ       Ordering
ordering = Ordering
ordering
thenCmp Ordering
ordering Ordering
_        = Ordering
ordering

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
pluginId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
pluginId) {
  pluginHandlers :: PluginHandlers IdeState
pluginHandlers = [PluginHandlers IdeState] -> PluginHandlers IdeState
forall a. Monoid a => [a] -> a
mconcat
    [ SClientMethod 'TextDocumentCodeAction
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentCodeAction
STextDocumentCodeAction PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionProvider
    ]
}

isRangeWithinSrcSpan :: Range -> SrcSpan -> Bool
isRangeWithinSrcSpan :: Range -> SrcSpan -> Bool
isRangeWithinSrcSpan (Range Position
start Position
end) SrcSpan
srcSpan =
  Position -> SrcSpan -> Bool
isInsideSrcSpan Position
start SrcSpan
srcSpan Bool -> Bool -> Bool
&& Position -> SrcSpan -> Bool
isInsideSrcSpan Position
end SrcSpan
srcSpan

findLImportDeclAt :: Range -> ParsedModule -> Maybe (LImportDecl GhcPs)
findLImportDeclAt :: Range -> ParsedModule -> Maybe (LImportDecl GhcPs)
findLImportDeclAt Range
range ParsedModule
parsedModule
  | ParsedModule {ParsedSource
pm_parsed_source :: ParsedSource
pm_parsed_source :: ParsedModule -> ParsedSource
..} <- ParsedModule
parsedModule
  , L SrcSpan
_ HsModule GhcPs
hsModule <- ParsedSource
pm_parsed_source
  , [LImportDecl GhcPs]
locatedImportDecls <- HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports HsModule GhcPs
hsModule =
      (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> SrcSpan
srcSpan) ImportDecl GhcPs
_) -> Range -> SrcSpan -> Bool
isRangeWithinSrcSpan Range
range SrcSpan
srcSpan) [LImportDecl GhcPs]
locatedImportDecls

makeCodeActions :: Uri -> [TextEdit] -> [a |? CodeAction]
makeCodeActions :: Uri -> [TextEdit] -> [a |? CodeAction]
makeCodeActions Uri
uri [TextEdit]
textEdits = [CodeAction -> a |? 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
_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
$sel:_xdata:CodeAction :: Maybe Value
$sel:_title:CodeAction :: Text
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_disabled:CodeAction :: Maybe Reason
$sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
$sel:_command:CodeAction :: Maybe Command
..} | Bool -> Bool
not ([TextEdit] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TextEdit]
textEdits)]
  where _title :: Text
_title = Text
"Qualify imported names"
        _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
Maybe ChangeAnnotationMap
Maybe (List DocumentChange)
forall a. Maybe a
_changeAnnotations :: forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
..}
        _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]
textEdits
        _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

getTypeCheckedModule :: IdeState -> NormalizedFilePath -> IO (Maybe TcModuleResult)
getTypeCheckedModule :: IdeState -> NormalizedFilePath -> IO (Maybe TcModuleResult)
getTypeCheckedModule IdeState
ideState NormalizedFilePath
normalizedFilePath =
  String
-> IdeState
-> Action (Maybe TcModuleResult)
-> IO (Maybe TcModuleResult)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"QualifyImportedNames.TypeCheck" IdeState
ideState (TypeCheck -> NormalizedFilePath -> Action (Maybe TcModuleResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck NormalizedFilePath
normalizedFilePath)

getHieAst :: IdeState -> NormalizedFilePath -> IO (Maybe HieAstResult)
getHieAst :: IdeState -> NormalizedFilePath -> IO (Maybe HieAstResult)
getHieAst IdeState
ideState NormalizedFilePath
normalizedFilePath =
  String
-> IdeState
-> Action (Maybe HieAstResult)
-> IO (Maybe HieAstResult)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"QualifyImportedNames.GetHieAst" IdeState
ideState (GetHieAst -> NormalizedFilePath -> Action (Maybe HieAstResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetHieAst
GetHieAst NormalizedFilePath
normalizedFilePath)

getSourceText :: IdeState -> NormalizedFilePath -> IO (Maybe Text)
getSourceText :: IdeState -> NormalizedFilePath -> IO (Maybe Text)
getSourceText IdeState
ideState NormalizedFilePath
normalizedFilePath = do
  Maybe (FileVersion, Maybe Text)
fileContents <- String
-> IdeState
-> Action (Maybe (FileVersion, Maybe Text))
-> IO (Maybe (FileVersion, Maybe Text))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"QualifyImportedNames.GetFileContents" IdeState
ideState (GetFileContents
-> NormalizedFilePath -> Action (Maybe (FileVersion, Maybe Text))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetFileContents
GetFileContents NormalizedFilePath
normalizedFilePath)
  if | Just (FileVersion
_, Maybe Text
sourceText) <- Maybe (FileVersion, Maybe Text)
fileContents -> Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
sourceText
     | Bool
otherwise                            -> Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

data ImportedBy = ImportedBy {
  ImportedBy -> ModuleName
importedByAlias   :: !ModuleName,
  ImportedBy -> SrcSpan
importedBySrcSpan :: !SrcSpan
}

isRangeWithinImportedBy :: Range -> ImportedBy -> Bool
isRangeWithinImportedBy :: Range -> ImportedBy -> Bool
isRangeWithinImportedBy Range
range (ImportedBy ModuleName
_ SrcSpan
srcSpan) = Range -> SrcSpan -> Bool
isRangeWithinSrcSpan Range
range SrcSpan
srcSpan

globalRdrEnvToNameToImportedByMap :: GlobalRdrEnv -> NameEnv [ImportedBy]
globalRdrEnvToNameToImportedByMap :: GlobalRdrEnv -> NameEnv [ImportedBy]
globalRdrEnvToNameToImportedByMap =
  (DList ImportedBy -> [ImportedBy])
-> UniqFM (DList ImportedBy) -> NameEnv [ImportedBy]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList ImportedBy -> [ImportedBy]
forall a. DList a -> [a]
DList.toList (UniqFM (DList ImportedBy) -> NameEnv [ImportedBy])
-> (GlobalRdrEnv -> UniqFM (DList ImportedBy))
-> GlobalRdrEnv
-> NameEnv [ImportedBy]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqFM (DList ImportedBy)
 -> UniqFM (DList ImportedBy) -> UniqFM (DList ImportedBy))
-> UniqFM (DList ImportedBy)
-> [UniqFM (DList ImportedBy)]
-> UniqFM (DList ImportedBy)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((DList ImportedBy -> DList ImportedBy -> DList ImportedBy)
-> UniqFM (DList ImportedBy)
-> UniqFM (DList ImportedBy)
-> UniqFM (DList ImportedBy)
forall elt.
(elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt
plusUFM_C DList ImportedBy -> DList ImportedBy -> DList ImportedBy
forall a. Semigroup a => a -> a -> a
(<>)) UniqFM (DList ImportedBy)
forall elt. UniqFM elt
emptyUFM ([UniqFM (DList ImportedBy)] -> UniqFM (DList ImportedBy))
-> (GlobalRdrEnv -> [UniqFM (DList ImportedBy)])
-> GlobalRdrEnv
-> UniqFM (DList ImportedBy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalRdrElt -> UniqFM (DList ImportedBy))
-> [GlobalRdrElt] -> [UniqFM (DList ImportedBy)]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> UniqFM (DList ImportedBy)
globalRdrEltToNameToImportedByMap ([GlobalRdrElt] -> [UniqFM (DList ImportedBy)])
-> (GlobalRdrEnv -> [GlobalRdrElt])
-> GlobalRdrEnv
-> [UniqFM (DList ImportedBy)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts
  where
    globalRdrEltToNameToImportedByMap :: GlobalRdrElt -> NameEnv (DList ImportedBy)
    globalRdrEltToNameToImportedByMap :: GlobalRdrElt -> UniqFM (DList ImportedBy)
globalRdrEltToNameToImportedByMap GRE {[ImportSpec]
Name
gre_imp :: [ImportSpec]
gre_name :: Name
gre_name :: GlobalRdrElt -> Name
gre_imp :: GlobalRdrElt -> [ImportSpec]
..} =
      Name -> DList ImportedBy -> UniqFM (DList ImportedBy)
forall key elt. Uniquable key => key -> elt -> UniqFM elt
unitUFM Name
gre_name (DList ImportedBy -> UniqFM (DList ImportedBy))
-> DList ImportedBy -> UniqFM (DList ImportedBy)
forall a b. (a -> b) -> a -> b
$ [ImportedBy] -> DList ImportedBy
forall a. [a] -> DList a
DList.fromList ([ImportedBy] -> DList ImportedBy)
-> [ImportedBy] -> DList ImportedBy
forall a b. (a -> b) -> a -> b
$ (ImportSpec -> Maybe ImportedBy) -> [ImportSpec] -> [ImportedBy]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ImportSpec -> Maybe ImportedBy
importSpecToImportedBy [ImportSpec]
gre_imp

    importSpecToImportedBy :: ImportSpec -> Maybe ImportedBy
    importSpecToImportedBy :: ImportSpec -> Maybe ImportedBy
importSpecToImportedBy (ImpSpec ImpDeclSpec {Bool
SrcSpan
ModuleName
is_dloc :: SrcSpan
is_qual :: Bool
is_as :: ModuleName
is_qual :: ImpDeclSpec -> Bool
is_dloc :: ImpDeclSpec -> SrcSpan
is_as :: ImpDeclSpec -> ModuleName
..} ImpItemSpec
_)
      | Bool
is_qual = Maybe ImportedBy
forall a. Maybe a
Nothing
      | Bool
otherwise = ImportedBy -> Maybe ImportedBy
forall a. a -> Maybe a
Just (ModuleName -> SrcSpan -> ImportedBy
ImportedBy ModuleName
is_as SrcSpan
is_dloc)

data IdentifierSpan = IdentifierSpan {
  IdentifierSpan -> Int
identifierSpanLine     :: !Int,
  IdentifierSpan -> Int
identifierSpanStartCol :: !Int,
  IdentifierSpan -> Int
identifierSpanEndCol   :: !Int
} deriving (Int -> IdentifierSpan -> ShowS
[IdentifierSpan] -> ShowS
IdentifierSpan -> String
(Int -> IdentifierSpan -> ShowS)
-> (IdentifierSpan -> String)
-> ([IdentifierSpan] -> ShowS)
-> Show IdentifierSpan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentifierSpan] -> ShowS
$cshowList :: [IdentifierSpan] -> ShowS
show :: IdentifierSpan -> String
$cshow :: IdentifierSpan -> String
showsPrec :: Int -> IdentifierSpan -> ShowS
$cshowsPrec :: Int -> IdentifierSpan -> ShowS
Show, IdentifierSpan -> IdentifierSpan -> Bool
(IdentifierSpan -> IdentifierSpan -> Bool)
-> (IdentifierSpan -> IdentifierSpan -> Bool) -> Eq IdentifierSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdentifierSpan -> IdentifierSpan -> Bool
$c/= :: IdentifierSpan -> IdentifierSpan -> Bool
== :: IdentifierSpan -> IdentifierSpan -> Bool
$c== :: IdentifierSpan -> IdentifierSpan -> Bool
Eq)

instance Ord IdentifierSpan where
  compare :: IdentifierSpan -> IdentifierSpan -> Ordering
compare (IdentifierSpan Int
line1 Int
startCol1 Int
endCol1) (IdentifierSpan Int
line2 Int
startCol2 Int
endCol2) =
    (Int
line1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
line2) Ordering -> Ordering -> Ordering
`thenCmp` (Int
startCol1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
startCol2) Ordering -> Ordering -> Ordering
`thenCmp` (Int
endCol1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
endCol2)

realSrcSpanToIdentifierSpan :: Span -> Maybe IdentifierSpan
realSrcSpanToIdentifierSpan :: Span -> Maybe IdentifierSpan
realSrcSpanToIdentifierSpan Span
realSrcSpan
  | let startLine :: Int
startLine = Span -> Int
srcSpanStartLine Span
realSrcSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  , let endLine :: Int
endLine = Span -> Int
srcSpanEndLine Span
realSrcSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  , Int
startLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
endLine
  , let startCol :: Int
startCol = Span -> Int
srcSpanStartCol Span
realSrcSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  , let endCol :: Int
endCol = Span -> Int
srcSpanEndCol Span
realSrcSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 =
      IdentifierSpan -> Maybe IdentifierSpan
forall a. a -> Maybe a
Just (IdentifierSpan -> Maybe IdentifierSpan)
-> IdentifierSpan -> Maybe IdentifierSpan
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> IdentifierSpan
IdentifierSpan Int
startLine Int
startCol Int
endCol
  | Bool
otherwise = Maybe IdentifierSpan
forall a. Maybe a
Nothing

identifierSpanToRange :: IdentifierSpan -> Range
identifierSpanToRange :: IdentifierSpan -> Range
identifierSpanToRange (IdentifierSpan Int
line Int
startCol Int
endCol) =
  Position -> Position -> Range
Range (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
line) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startCol)) (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
line) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endCol))

data UsedIdentifier = UsedIdentifier {
  UsedIdentifier -> Name
usedIdentifierName :: !Name,
  UsedIdentifier -> IdentifierSpan
usedIdentifierSpan :: !IdentifierSpan
}

refMapToUsedIdentifiers :: RefMap a -> [UsedIdentifier]
refMapToUsedIdentifiers :: RefMap a -> [UsedIdentifier]
refMapToUsedIdentifiers = DList UsedIdentifier -> [UsedIdentifier]
forall a. DList a -> [a]
DList.toList (DList UsedIdentifier -> [UsedIdentifier])
-> (RefMap a -> DList UsedIdentifier)
-> RefMap a
-> [UsedIdentifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DList UsedIdentifier
 -> Identifier
 -> [(Span, IdentifierDetails a)]
 -> DList UsedIdentifier)
-> DList UsedIdentifier -> RefMap a -> DList UsedIdentifier
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' DList UsedIdentifier
-> Identifier
-> [(Span, IdentifierDetails a)]
-> DList UsedIdentifier
forall a.
DList UsedIdentifier
-> Identifier
-> [(Span, IdentifierDetails a)]
-> DList UsedIdentifier
folder DList UsedIdentifier
forall a. DList a
DList.empty
  where
    folder :: DList UsedIdentifier
-> Identifier
-> [(Span, IdentifierDetails a)]
-> DList UsedIdentifier
folder DList UsedIdentifier
acc Identifier
identifier [(Span, IdentifierDetails a)]
spanIdentifierDetailsPairs =
      [UsedIdentifier] -> DList UsedIdentifier
forall a. [a] -> DList a
DList.fromList (((Span, IdentifierDetails a) -> Maybe UsedIdentifier)
-> [(Span, IdentifierDetails a)] -> [UsedIdentifier]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Span -> IdentifierDetails a -> Maybe UsedIdentifier)
-> (Span, IdentifierDetails a) -> Maybe UsedIdentifier
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Identifier -> Span -> IdentifierDetails a -> Maybe UsedIdentifier
forall a.
Identifier -> Span -> IdentifierDetails a -> Maybe UsedIdentifier
getUsedIdentifier Identifier
identifier)) [(Span, IdentifierDetails a)]
spanIdentifierDetailsPairs) DList UsedIdentifier
-> DList UsedIdentifier -> DList UsedIdentifier
forall a. Semigroup a => a -> a -> a
<> DList UsedIdentifier
acc

    getUsedIdentifier :: Identifier -> Span -> IdentifierDetails a -> Maybe UsedIdentifier
    getUsedIdentifier :: Identifier -> Span -> IdentifierDetails a -> Maybe UsedIdentifier
getUsedIdentifier Identifier
identifier Span
span IdentifierDetails {Set ContextInfo
identInfo :: Set ContextInfo
identInfo :: forall a. IdentifierDetails a -> Set ContextInfo
..}
      | Just IdentifierSpan
identifierSpan <- Span -> Maybe IdentifierSpan
realSrcSpanToIdentifierSpan Span
span
      , Right Name
name <- Identifier
identifier
      , ContextInfo
Use ContextInfo -> Set ContextInfo -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set ContextInfo
identInfo = UsedIdentifier -> Maybe UsedIdentifier
forall a. a -> Maybe a
Just (UsedIdentifier -> Maybe UsedIdentifier)
-> UsedIdentifier -> Maybe UsedIdentifier
forall a b. (a -> b) -> a -> b
$ Name -> IdentifierSpan -> UsedIdentifier
UsedIdentifier Name
name IdentifierSpan
identifierSpan
      | Bool
otherwise = Maybe UsedIdentifier
forall a. Maybe a
Nothing

occNameToText :: OccName -> Text
occNameToText :: OccName -> Text
occNameToText = String -> Text
Text.pack (String -> Text) -> (OccName -> String) -> OccName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString

updateColOffset :: Int -> Int -> Int -> Int
updateColOffset :: Int -> Int -> Int -> Int
updateColOffset Int
row Int
lineOffset Int
colOffset
  | Int
row Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lineOffset = Int
colOffset
  | Bool
otherwise = Int
0

usedIdentifiersToTextEdits :: Range -> NameEnv [ImportedBy] -> Text -> [UsedIdentifier] -> [TextEdit]
usedIdentifiersToTextEdits :: Range
-> NameEnv [ImportedBy] -> Text -> [UsedIdentifier] -> [TextEdit]
usedIdentifiersToTextEdits Range
range NameEnv [ImportedBy]
nameToImportedByMap Text
sourceText [UsedIdentifier]
usedIdentifiers
  | let sortedUsedIdentifiers :: [UsedIdentifier]
sortedUsedIdentifiers = (UsedIdentifier -> IdentifierSpan)
-> [UsedIdentifier] -> [UsedIdentifier]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn UsedIdentifier -> IdentifierSpan
usedIdentifierSpan [UsedIdentifier]
usedIdentifiers =
      State ([Text], Int, Int) [TextEdit]
-> ([Text], Int, Int) -> [TextEdit]
forall s a. State s a -> s -> a
State.evalState ([UsedIdentifier] -> State ([Text], Int, Int) [TextEdit]
makeStateComputation [UsedIdentifier]
sortedUsedIdentifiers) (Text -> [Text]
Text.lines Text
sourceText, Int
0, Int
0)
  where
    folder :: [TextEdit] -> UsedIdentifier -> State ([Text], Int, Int) [TextEdit]
    folder :: [TextEdit] -> UsedIdentifier -> State ([Text], Int, Int) [TextEdit]
folder [TextEdit]
prevTextEdits (UsedIdentifier Name
identifierName IdentifierSpan
identifierSpan)
      | Just [ImportedBy]
importedBys <- NameEnv [ImportedBy] -> Name -> Maybe [ImportedBy]
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv [ImportedBy]
nameToImportedByMap Name
identifierName
      , Just (ImportedBy ModuleName
alias SrcSpan
_) <- (ImportedBy -> Bool) -> [ImportedBy] -> Maybe ImportedBy
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Range -> ImportedBy -> Bool
isRangeWithinImportedBy Range
range) [ImportedBy]
importedBys
      , let IdentifierSpan Int
row Int
startCol Int
endCol = IdentifierSpan
identifierSpan
      , let identifierRange :: Range
identifierRange = IdentifierSpan -> Range
identifierSpanToRange IdentifierSpan
identifierSpan
      , let aliasText :: Text
aliasText = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
alias
      , let identifierText :: Text
identifierText = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
identifierName
      , let qualifiedIdentifierText :: Text
qualifiedIdentifierText = Text
aliasText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identifierText = do
          ([Text]
sourceTextLines, Int
lineOffset, Int -> Int -> Int -> Int
updateColOffset Int
row Int
lineOffset -> Int
colOffset) <- StateT ([Text], Int, Int) Identity ([Text], Int, Int)
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
          let lines :: [Text]
lines = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
List.drop (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lineOffset) [Text]
sourceTextLines
          let (Text
replacementText, [Text]
remainingLines) =
                if | Text
line : [Text]
remainingLines <- [Text]
lines
                   , let lineStartingAtIdentifier :: Text
lineStartingAtIdentifier = Int -> Text -> Text
Text.drop (Int
startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
colOffset) Text
line
                   , Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
Text.uncons Text
lineStartingAtIdentifier
                   , let isParenthesized :: Bool
isParenthesized = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
                   , let isBackticked :: Bool
isBackticked = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'
                   , let replacementText :: Text
replacementText =
                           if | Bool
isParenthesized -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qualifiedIdentifierText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
                              | Bool
isBackticked -> Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qualifiedIdentifierText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
                              | Bool
otherwise -> Text
qualifiedIdentifierText ->
                       (Text
replacementText, Text
lineStartingAtIdentifier Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
remainingLines)
                   | Bool
otherwise -> (Text
qualifiedIdentifierText, [Text]
lines)
          let textEdit :: TextEdit
textEdit = Range -> Text -> TextEdit
TextEdit Range
identifierRange Text
replacementText
          ([Text], Int, Int) -> StateT ([Text], Int, Int) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put ([Text]
remainingLines, Int
row, Int
startCol)
          [TextEdit] -> State ([Text], Int, Int) [TextEdit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TextEdit] -> State ([Text], Int, Int) [TextEdit])
-> [TextEdit] -> State ([Text], Int, Int) [TextEdit]
forall a b. (a -> b) -> a -> b
$ TextEdit
textEdit TextEdit -> [TextEdit] -> [TextEdit]
forall a. a -> [a] -> [a]
: [TextEdit]
prevTextEdits
      | Bool
otherwise = [TextEdit] -> State ([Text], Int, Int) [TextEdit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TextEdit]
prevTextEdits

    makeStateComputation :: [UsedIdentifier] -> State ([Text], Int, Int) [TextEdit]
    makeStateComputation :: [UsedIdentifier] -> State ([Text], Int, Int) [TextEdit]
makeStateComputation [UsedIdentifier]
usedIdentifiers = ([TextEdit]
 -> UsedIdentifier -> State ([Text], Int, Int) [TextEdit])
-> [TextEdit]
-> [UsedIdentifier]
-> State ([Text], Int, Int) [TextEdit]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [TextEdit] -> UsedIdentifier -> State ([Text], Int, Int) [TextEdit]
folder [] [UsedIdentifier]
usedIdentifiers

-- The overall idea:
-- 1. GlobalRdrEnv from typechecking phase contains info on what imported a
--    name.
-- 2. refMap from GetHieAst contains location of names and how they are used.
-- 3. For each used name in refMap check whether the name comes from an import
--    at the origin of the code action.
codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction
codeActionProvider :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionProvider IdeState
ideState PluginId
pluginId (CodeActionParams _ _ documentId range context)
  | TextDocumentIdentifier Uri
uri <- TextDocumentIdentifier
documentId
  , Just NormalizedFilePath
normalizedFilePath <- NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath (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 TcModuleResult
tcModuleResult <- IdeState -> NormalizedFilePath -> IO (Maybe TcModuleResult)
getTypeCheckedModule IdeState
ideState NormalizedFilePath
normalizedFilePath
      if | Just TcModuleResult { ParsedModule
tmrParsed :: ParsedModule
tmrParsed :: TcModuleResult -> ParsedModule
tmrParsed, TcGblEnv
tmrTypechecked :: TcGblEnv
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTypechecked } <- Maybe TcModuleResult
tcModuleResult
         , Just LImportDecl GhcPs
_ <- Range -> ParsedModule -> Maybe (LImportDecl GhcPs)
findLImportDeclAt Range
range ParsedModule
tmrParsed -> do
             Maybe HieAstResult
hieAstResult <- IdeState -> NormalizedFilePath -> IO (Maybe HieAstResult)
getHieAst IdeState
ideState NormalizedFilePath
normalizedFilePath
             Maybe Text
sourceText <- IdeState -> NormalizedFilePath -> IO (Maybe Text)
getSourceText IdeState
ideState NormalizedFilePath
normalizedFilePath
             if | Just HAR {RefMap a
refMap :: RefMap a
refMap :: ()
..} <- Maybe HieAstResult
hieAstResult
                , Just Text
sourceText <- Maybe Text
sourceText
                , let globalRdrEnv :: GlobalRdrEnv
globalRdrEnv = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
tmrTypechecked
                , let nameToImportedByMap :: NameEnv [ImportedBy]
nameToImportedByMap = GlobalRdrEnv -> NameEnv [ImportedBy]
globalRdrEnvToNameToImportedByMap GlobalRdrEnv
globalRdrEnv
                , let usedIdentifiers :: [UsedIdentifier]
usedIdentifiers = RefMap a -> [UsedIdentifier]
forall a. RefMap a -> [UsedIdentifier]
refMapToUsedIdentifiers RefMap a
refMap
                , let textEdits :: [TextEdit]
textEdits = Range
-> NameEnv [ImportedBy] -> Text -> [UsedIdentifier] -> [TextEdit]
usedIdentifiersToTextEdits Range
range NameEnv [ImportedBy]
nameToImportedByMap Text
sourceText [UsedIdentifier]
usedIdentifiers ->
                    Either ResponseError (List (Command |? CodeAction))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 (Uri -> [TextEdit] -> [Command |? CodeAction]
forall a. Uri -> [TextEdit] -> [a |? CodeAction]
makeCodeActions Uri
uri [TextEdit]
textEdits)
                | Bool
otherwise -> Either ResponseError (List (Command |? CodeAction))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 []
         | Bool
otherwise -> Either ResponseError (List (Command |? CodeAction))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 []
  | Bool
otherwise = Either ResponseError (List (Command |? CodeAction))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 []