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

module Ide.Plugin.QualifyImportedNames (descriptor) where

import           Control.Lens                     ((^.))
import           Control.Monad                    (foldM)
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           Data.List                        (sortOn)
import qualified Data.List                        as List
import qualified Data.Map.Strict                  as Map
import           Data.Maybe                       (fromMaybe, isJust, mapMaybe)
import           Data.Text                        (Text)
import qualified Data.Text                        as Text
import           Development.IDE                  (spanContainsRange)
import           Development.IDE.Core.PluginUtils
import           Development.IDE.Core.RuleTypes   (GetFileContents (GetFileContents),
                                                   GetHieAst (GetHieAst),
                                                   HieAstResult (HAR, refMap),
                                                   TcModuleResult (TcModuleResult, tmrParsed, tmrTypechecked),
                                                   TypeCheck (TypeCheck))
import           Development.IDE.Core.Shake       (IdeState)
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, 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.Types.Location   (Position (Position),
                                                   Range (Range), Uri)
import           Ide.Plugin.Error                 (PluginError (PluginRuleFailed),
                                                   getNormalizedFilePathE,
                                                   handleMaybe)
import           Ide.Types                        (PluginDescriptor (pluginHandlers),
                                                   PluginId,
                                                   PluginMethodHandler,
                                                   defaultPluginDescriptor,
                                                   mkPluginHandler)
import qualified Language.LSP.Protocol.Lens       as L
import           Language.LSP.Protocol.Message    (Method (Method_TextDocumentCodeAction),
                                                   SMethod (SMethod_TextDocumentCodeAction))
import           Language.LSP.Protocol.Types      (CodeAction (CodeAction, _command, _data_, _diagnostics, _disabled, _edit, _isPreferred, _kind, _title),
                                                   CodeActionKind (CodeActionKind_QuickFix),
                                                   CodeActionParams (CodeActionParams),
                                                   TextEdit (TextEdit),
                                                   WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges),
                                                   type (|?) (InL, InR))

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 -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
pluginId Text
"Provides a code action to qualify imported names") {
  pluginHandlers = mconcat
    [ mkPluginHandler SMethod_TextDocumentCodeAction codeActionProvider
    ]
}

findLImportDeclAt :: Range -> ParsedModule -> Maybe (LImportDecl GhcPs)
findLImportDeclAt :: Range -> ParsedModule -> Maybe (LImportDecl GhcPs)
findLImportDeclAt Range
range ParsedModule
parsedModule
  | ParsedModule {ParsedSource
pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source :: ParsedSource
..} <- ParsedModule
parsedModule
  , L SrcSpan
_ HsModule GhcPs
hsModule <- ParsedSource
pm_parsed_source
  , [LImportDecl GhcPs]
locatedImportDecls <- HsModule GhcPs -> [LImportDecl GhcPs]
forall p. HsModule p -> [LImportDecl p]
hsmodImports HsModule GhcPs
hsModule =
      (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)
 -> Bool)
-> [GenLocated
      (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)]
-> Maybe
     (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ (L (SrcSpanAnn' (EpAnn AnnListItem) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
srcSpan) ImportDecl GhcPs
_) -> Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SrcSpan
srcSpan SrcSpan -> Range -> Maybe Bool
`spanContainsRange` Range
range) [LImportDecl GhcPs]
[GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)]
locatedImportDecls

makeCodeActions :: Uri -> [TextEdit] -> [a |? CodeAction]
makeCodeActions :: forall a. Uri -> [TextEdit] -> [a |? CodeAction]
makeCodeActions Uri
uri [TextEdit]
textEdits = [CodeAction -> a |? CodeAction
forall a b. b -> a |? b
InR CodeAction {Maybe Bool
Maybe [Diagnostic]
Maybe Value
Maybe WorkspaceEdit
Maybe (Rec (("reason" .== Text) .+ Empty))
Maybe (Rec ('R '["reason" ':-> Text]))
Maybe Command
Maybe CodeActionKind
Text
forall {a}. Maybe a
$sel:_command:CodeAction :: Maybe Command
$sel:_data_:CodeAction :: Maybe Value
$sel:_diagnostics:CodeAction :: Maybe [Diagnostic]
$sel:_disabled:CodeAction :: Maybe (Rec (("reason" .== Text) .+ Empty))
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_title:CodeAction :: Text
_title :: Text
_kind :: Maybe CodeActionKind
_command :: forall {a}. Maybe a
_edit :: Maybe WorkspaceEdit
_diagnostics :: forall {a}. Maybe a
_isPreferred :: forall {a}. Maybe a
_disabled :: forall {a}. Maybe a
_data_ :: forall {a}. Maybe a
..} | Bool -> Bool
not ([TextEdit] -> Bool
forall a. [a] -> 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
CodeActionKind_QuickFix
        _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
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
Maybe (Map Uri [TextEdit])
Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall {a}. Maybe a
$sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
$sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
$sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_changes :: Maybe (Map Uri [TextEdit])
_documentChanges :: forall {a}. Maybe a
_changeAnnotations :: forall {a}. Maybe a
..}
        _changes :: 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. k -> a -> Map k a
Map.singleton Uri
uri [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
        _data_ :: Maybe a
_data_ = Maybe a
forall {a}. Maybe a
Nothing
        _changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
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{SrcSpan
importedBySrcSpan :: ImportedBy -> SrcSpan
importedBySrcSpan :: SrcSpan
importedBySrcSpan} = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Range -> Maybe Bool
spanContainsRange SrcSpan
importedBySrcSpan Range
range

globalRdrEnvToNameToImportedByMap :: GlobalRdrEnv -> NameEnv [ImportedBy]
globalRdrEnvToNameToImportedByMap :: GlobalRdrEnv -> NameEnv [ImportedBy]
globalRdrEnvToNameToImportedByMap =
  (DList ImportedBy -> [ImportedBy])
-> UniqFM Name (DList ImportedBy) -> NameEnv [ImportedBy]
forall a b. (a -> b) -> UniqFM Name a -> UniqFM Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList ImportedBy -> [ImportedBy]
forall a. DList a -> [a]
DList.toList (UniqFM Name (DList ImportedBy) -> NameEnv [ImportedBy])
-> (GlobalRdrEnv -> UniqFM Name (DList ImportedBy))
-> GlobalRdrEnv
-> NameEnv [ImportedBy]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqFM Name (DList ImportedBy)
 -> UniqFM Name (DList ImportedBy)
 -> UniqFM Name (DList ImportedBy))
-> UniqFM Name (DList ImportedBy)
-> [UniqFM Name (DList ImportedBy)]
-> UniqFM Name (DList ImportedBy)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((DList ImportedBy -> DList ImportedBy -> DList ImportedBy)
-> UniqFM Name (DList ImportedBy)
-> UniqFM Name (DList ImportedBy)
-> UniqFM Name (DList ImportedBy)
forall elt key.
(elt -> elt -> elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C DList ImportedBy -> DList ImportedBy -> DList ImportedBy
forall a. Semigroup a => a -> a -> a
(<>)) UniqFM Name (DList ImportedBy)
forall key elt. UniqFM key elt
emptyUFM ([UniqFM Name (DList ImportedBy)]
 -> UniqFM Name (DList ImportedBy))
-> (GlobalRdrEnv -> [UniqFM Name (DList ImportedBy)])
-> GlobalRdrEnv
-> UniqFM Name (DList ImportedBy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalRdrElt -> UniqFM Name (DList ImportedBy))
-> [GlobalRdrElt] -> [UniqFM Name (DList ImportedBy)]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> UniqFM Name (DList ImportedBy)
globalRdrEltToNameToImportedByMap ([GlobalRdrElt] -> [UniqFM Name (DList ImportedBy)])
-> (GlobalRdrEnv -> [GlobalRdrElt])
-> GlobalRdrEnv
-> [UniqFM Name (DList ImportedBy)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts
  where
    globalRdrEltToNameToImportedByMap :: GlobalRdrElt -> NameEnv (DList ImportedBy)
    globalRdrEltToNameToImportedByMap :: GlobalRdrElt -> UniqFM Name (DList ImportedBy)
globalRdrEltToNameToImportedByMap GRE {[ImportSpec]
Name
gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_name :: GlobalRdrElt -> Name
gre_name :: Name
gre_imp :: [ImportSpec]
..} =
      Name -> DList ImportedBy -> UniqFM Name (DList ImportedBy)
forall key elt. Uniquable key => key -> elt -> UniqFM key elt
unitUFM Name
gre_name (DList ImportedBy -> UniqFM Name (DList ImportedBy))
-> DList ImportedBy -> UniqFM Name (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
ModuleName
SrcSpan
is_as :: ImpDeclSpec -> ModuleName
is_dloc :: ImpDeclSpec -> SrcSpan
is_qual :: ImpDeclSpec -> Bool
is_as :: ModuleName
is_qual :: Bool
is_dloc :: SrcSpan
..} 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
$cshowsPrec :: Int -> IdentifierSpan -> ShowS
showsPrec :: Int -> IdentifierSpan -> ShowS
$cshow :: IdentifierSpan -> String
show :: IdentifierSpan -> String
$cshowList :: [IdentifierSpan] -> ShowS
showList :: [IdentifierSpan] -> ShowS
Show, IdentifierSpan -> IdentifierSpan -> Bool
(IdentifierSpan -> IdentifierSpan -> Bool)
-> (IdentifierSpan -> IdentifierSpan -> Bool) -> Eq IdentifierSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdentifierSpan -> IdentifierSpan -> Bool
== :: IdentifierSpan -> IdentifierSpan -> Bool
$c/= :: IdentifierSpan -> IdentifierSpan -> Bool
/= :: 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 :: forall a. 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 :: forall a.
Identifier -> Span -> IdentifierDetails a -> Maybe UsedIdentifier
getUsedIdentifier Identifier
identifier Span
span IdentifierDetails {Set ContextInfo
identInfo :: forall a. IdentifierDetails a -> Set ContextInfo
identInfo :: Set ContextInfo
..}
      | Just IdentifierSpan
identifierSpan <- Span -> Maybe IdentifierSpan
realSrcSpanToIdentifierSpan Span
span
      , Right Name
name <- Identifier
identifier
      , ContextInfo
Use ContextInfo -> Set ContextInfo -> Bool
forall a. Eq a => a -> Set a -> 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

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
usedIdentifierName :: UsedIdentifier -> Name
usedIdentifierName :: Name
usedIdentifierName, IdentifierSpan
usedIdentifierSpan :: UsedIdentifier -> IdentifierSpan
usedIdentifierSpan :: IdentifierSpan
usedIdentifierSpan}
      | Just [ImportedBy]
importedBys <- NameEnv [ImportedBy] -> Name -> Maybe [ImportedBy]
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv [ImportedBy]
nameToImportedByMap Name
usedIdentifierName
      , Just ImportedBy{ModuleName
importedByAlias :: ImportedBy -> ModuleName
importedByAlias :: ModuleName
importedByAlias} <- (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
_ = IdentifierSpan
usedIdentifierSpan
      , let identifierRange :: Range
identifierRange = IdentifierSpan -> Range
identifierSpanToRange IdentifierSpan
usedIdentifierSpan
      , let aliasText :: Text
aliasText = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
importedByAlias
      , 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
usedIdentifierName
      , 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 a. a -> StateT ([Text], Int, Int) Identity a
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 a. a -> StateT ([Text], Int, Int) Identity a
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 Method_TextDocumentCodeAction
codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider IdeState
ideState PluginId
_pluginId (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ TextDocumentIdentifier
documentId Range
range CodeActionContext
_) = do
  NormalizedFilePath
normalizedFilePath <- Uri -> ExceptT PluginError (LspM Config) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE (TextDocumentIdentifier
documentId TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri)
  TcModuleResult { ParsedModule
tmrParsed :: TcModuleResult -> ParsedModule
tmrParsed :: ParsedModule
tmrParsed, TcGblEnv
tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTypechecked :: TcGblEnv
tmrTypechecked } <- String
-> IdeState
-> ExceptT PluginError Action TcModuleResult
-> ExceptT PluginError (LspM Config) TcModuleResult
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"QualifyImportedNames.TypeCheck" IdeState
ideState (ExceptT PluginError Action TcModuleResult
 -> ExceptT PluginError (LspM Config) TcModuleResult)
-> ExceptT PluginError Action TcModuleResult
-> ExceptT PluginError (LspM Config) TcModuleResult
forall a b. (a -> b) -> a -> b
$ TypeCheck
-> NormalizedFilePath -> ExceptT PluginError Action TcModuleResult
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE TypeCheck
TypeCheck NormalizedFilePath
normalizedFilePath
  if Maybe
  (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs))
-> Bool
forall a. Maybe a -> Bool
isJust (Range -> ParsedModule -> Maybe (LImportDecl GhcPs)
findLImportDeclAt Range
range ParsedModule
tmrParsed)
    then do
          HAR {RefMap a
refMap :: ()
refMap :: RefMap a
..} <- String
-> IdeState
-> ExceptT PluginError Action HieAstResult
-> ExceptT PluginError (LspM Config) HieAstResult
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"QualifyImportedNames.GetHieAst" IdeState
ideState (GetHieAst
-> NormalizedFilePath -> ExceptT PluginError Action HieAstResult
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetHieAst
GetHieAst NormalizedFilePath
normalizedFilePath)
          (FileVersion
_, Maybe Text
sourceTextM) <-  String
-> IdeState
-> ExceptT PluginError Action (FileVersion, Maybe Text)
-> ExceptT PluginError (LspM Config) (FileVersion, Maybe Text)
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"QualifyImportedNames.GetFileContents" IdeState
ideState (GetFileContents
-> NormalizedFilePath
-> ExceptT PluginError Action (FileVersion, Maybe Text)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetFileContents
GetFileContents NormalizedFilePath
normalizedFilePath)
          Text
sourceText <- PluginError -> Maybe Text -> ExceptT PluginError (LspM Config) Text
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe (Text -> PluginError
PluginRuleFailed Text
"GetFileContents") Maybe Text
sourceTextM
          let globalRdrEnv :: GlobalRdrEnv
globalRdrEnv = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
tmrTypechecked
              nameToImportedByMap :: NameEnv [ImportedBy]
nameToImportedByMap = GlobalRdrEnv -> NameEnv [ImportedBy]
globalRdrEnvToNameToImportedByMap GlobalRdrEnv
globalRdrEnv
              usedIdentifiers :: [UsedIdentifier]
usedIdentifiers = RefMap a -> [UsedIdentifier]
forall a. RefMap a -> [UsedIdentifier]
refMapToUsedIdentifiers RefMap a
refMap
              textEdits :: [TextEdit]
textEdits = Range
-> NameEnv [ImportedBy] -> Text -> [UsedIdentifier] -> [TextEdit]
usedIdentifiersToTextEdits Range
range NameEnv [ImportedBy]
nameToImportedByMap Text
sourceText [UsedIdentifier]
usedIdentifiers
          ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (LspM Config) ([Command |? CodeAction] |? Null)
forall a. a -> ExceptT PluginError (LspM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure  (([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (LspM Config) ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (LspM Config) ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL (Uri -> [TextEdit] -> [Command |? CodeAction]
forall a. Uri -> [TextEdit] -> [a |? CodeAction]
makeCodeActions (TextDocumentIdentifier
documentId TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri) [TextEdit]
textEdits)
    else ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (LspM Config) ([Command |? CodeAction] |? Null)
forall a. a -> ExceptT PluginError (LspM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure  (([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (LspM Config) ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (LspM Config) ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL []