-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE GADTs #-}

module Development.IDE.Plugin.CodeAction
    (
    mkExactprintPluginDescriptor,
    iePluginDescriptor,
    typeSigsPluginDescriptor,
    bindingsPluginDescriptor,
    fillHolePluginDescriptor,
    extendImportPluginDescriptor,
    -- * For testing
    matchRegExMultipleImports
    ) where

import           Control.Applicative                               ((<|>))
import           Control.Arrow                                     (second,
                                                                    (&&&),
                                                                    (>>>))
import           Control.Concurrent.STM.Stats                      (atomically)
import           Control.Monad.Extra
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Maybe
import           Data.Aeson
import           Data.Char
import qualified Data.DList                                        as DL
import           Data.Function
import           Data.Functor
import qualified Data.HashMap.Strict                               as Map
import qualified Data.HashSet                                      as Set
import           Data.List.Extra
import           Data.List.NonEmpty                                (NonEmpty ((:|)))
import qualified Data.List.NonEmpty                                as NE
import qualified Data.Map.Strict                                   as M
import           Data.Maybe
import           Data.Ord                                          (comparing)
import qualified Data.Set                                          as S
import qualified Data.Text                                         as T
import qualified Data.Text.Encoding                                as T
import qualified Data.Text.Utf16.Rope                              as Rope
import           Development.IDE.Core.Rules
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Service
import           Development.IDE.Core.Shake                        hiding (Log)
import           Development.IDE.GHC.Compat                        hiding
                                                                   (ImplicitPrelude)
import           Development.IDE.GHC.Compat.ExactPrint
import           Development.IDE.GHC.Compat.Util
import           Development.IDE.GHC.Error
import           Development.IDE.GHC.ExactPrint
import qualified Development.IDE.GHC.ExactPrint                    as E
import           Development.IDE.GHC.Util                          (printOutputable,
                                                                    printRdrName)
import           Development.IDE.Plugin.CodeAction.Args
import           Development.IDE.Plugin.CodeAction.ExactPrint
import           Development.IDE.Plugin.CodeAction.PositionIndexed
import           Development.IDE.Plugin.CodeAction.Util
import           Development.IDE.Plugin.Completions.Types
import qualified Development.IDE.Plugin.Plugins.AddArgument
import           Development.IDE.Plugin.Plugins.Diagnostic
import           Development.IDE.Plugin.Plugins.FillHole           (suggestFillHole)
import           Development.IDE.Plugin.Plugins.FillTypeWildcard   (suggestFillTypeWildcard)
import           Development.IDE.Plugin.Plugins.ImportUtils
import           Development.IDE.Plugin.TypeLenses                 (suggestSignature)
import           Development.IDE.Types.Exports
import           Development.IDE.Types.Location
import           Development.IDE.Types.Logger                      hiding
                                                                   (group)
import           Development.IDE.Types.Options
import           GHC.Exts                                          (fromList)
import qualified GHC.LanguageExtensions                            as Lang
#if MIN_VERSION_ghc(9,4,0)
import           GHC.Parser.Annotation                             (TokenLocation (..))
#endif
import           Ide.PluginUtils                                   (subRange)
import           Ide.Types
import qualified Language.LSP.Server                               as LSP
import           Language.LSP.Types                                (ApplyWorkspaceEditParams (..),
                                                                    CodeAction (..),
                                                                    CodeActionContext (CodeActionContext, _diagnostics),
                                                                    CodeActionKind (CodeActionQuickFix),
                                                                    CodeActionParams (CodeActionParams),
                                                                    Command,
                                                                    Diagnostic (..),
                                                                    List (..),
                                                                    MessageType (..),
                                                                    ResponseError,
                                                                    SMethod (..),
                                                                    ShowMessageParams (..),
                                                                    TextDocumentIdentifier (TextDocumentIdentifier),
                                                                    TextEdit (TextEdit, _range),
                                                                    UInt,
                                                                    WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges),
                                                                    type (|?) (InR),
                                                                    uriToFilePath)
import           Language.LSP.VFS                                  (VirtualFile,
                                                                    _file_text)
import qualified Text.Fuzzy.Parallel                               as TFP
import           Text.Regex.TDFA                                   ((=~), (=~~))
#if MIN_VERSION_ghc(9,2,0)
import           GHC                                               (AddEpAnn (AddEpAnn),
                                                                    Anchor (anchor_op),
                                                                    AnchorOperation (..),
                                                                    AnnsModule (am_main),
                                                                    DeltaPos (..),
                                                                    EpAnn (..),
                                                                    EpaLocation (..),
                                                                    hsmodAnn,
                                                                    LEpaComment)
#else
import           Language.Haskell.GHC.ExactPrint.Types             (Annotation (annsDP),
                                                                    DeltaPos,
                                                                    KeywordId (G),
                                                                    deltaRow,
                                                                    mkAnnKey)
#endif

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

-- | Generate code actions.
codeAction
    :: IdeState
    -> PluginId
    -> CodeActionParams
    -> LSP.LspM c (Either ResponseError (List (Command |? CodeAction)))
codeAction :: forall c.
IdeState
-> PluginId
-> CodeActionParams
-> LspM c (Either ResponseError (List (Command |? CodeAction)))
codeAction IdeState
state PluginId
_ (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ (TextDocumentIdentifier Uri
uri) Range
_range CodeActionContext{$sel:_diagnostics:CodeActionContext :: CodeActionContext -> List Diagnostic
_diagnostics=List [Diagnostic]
xs}) = do
  Maybe VirtualFile
contents <- forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
LSP.getVirtualFile forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    let text :: Maybe Text
text = Rope -> Text
Rope.toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VirtualFile -> Rope
_file_text :: VirtualFile -> Rope.Rope) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe VirtualFile
contents
        mbFile :: Maybe NormalizedFilePath
mbFile = String -> NormalizedFilePath
toNormalizedFilePath' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> Maybe String
uriToFilePath Uri
uri
    [Diagnostic]
diag <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(NormalizedFilePath
_, ShowDiagnostic
_, Diagnostic
d) -> Diagnostic
d) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(NormalizedFilePath
p, ShowDiagnostic
_, Diagnostic
_) -> Maybe NormalizedFilePath
mbFile forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just NormalizedFilePath
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdeState -> STM [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
getDiagnostics IdeState
state
    (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe ParsedModule
parsedModule) <- forall a. String -> IdeState -> Action a -> IO a
runAction String
"GhcideCodeActions.getParsedModule" IdeState
state forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Action (Maybe ParsedModule)
getParsedModule forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Maybe NormalizedFilePath
mbFile
    let
      actions :: [Command |? CodeAction]
actions = Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> [Diagnostic]
-> Uri
-> [Command |? CodeAction]
caRemoveRedundantImports Maybe ParsedModule
parsedModule Maybe Text
text [Diagnostic]
diag [Diagnostic]
xs Uri
uri
               forall a. Semigroup a => a -> a -> a
<> Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> [Diagnostic]
-> Uri
-> [Command |? CodeAction]
caRemoveInvalidExports Maybe ParsedModule
parsedModule Maybe Text
text [Diagnostic]
diag [Diagnostic]
xs Uri
uri
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [Command |? CodeAction]
actions

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

iePluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
iePluginDescriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
iePluginDescriptor Recorder (WithPriority Log)
recorder PluginId
plId =
  let old :: PluginDescriptor IdeState
old =
        [GhcideCodeAction] -> PluginId -> PluginDescriptor IdeState
mkGhcideCAsPlugin [
            forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Maybe Text -> ParsedModule -> Diagnostic -> Maybe (Text, TextEdit)
suggestExportUnusedTopBinding
          , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Diagnostic -> [(Text, TextEdit)]
suggestModuleTypo
          , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Diagnostic -> [(Text, TextEdit)]
suggestFixConstructorImport
          , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap ExportsMap
-> ParsedSource -> Diagnostic -> [(Text, CodeActionKind, Rewrite)]
suggestExtendImport
          , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap DynFlags
-> Maybe Text
-> Annotated ParsedSource
-> Text
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])]
suggestImportDisambiguation
          , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap ExportsMap
-> Annotated ParsedSource
-> Text
-> Diagnostic
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
suggestNewOrExtendImportForClassMethod
          , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Annotated ParsedSource
-> Text
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])]
suggestHideShadow
          , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap DynFlags
-> ExportsMap
-> Annotated ParsedSource
-> Text
-> Diagnostic
-> [(Text, CodeActionKind, TextEdit)]
suggestNewImport
          ]
          PluginId
plId
   in forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder forall a b. (a -> b) -> a -> b
$ PluginDescriptor IdeState
old {pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall ideState.
PluginDescriptor ideState -> PluginHandlers ideState
pluginHandlers PluginDescriptor IdeState
old forall a. Semigroup a => a -> a -> a
<> forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentCodeAction
STextDocumentCodeAction forall c.
IdeState
-> PluginId
-> CodeActionParams
-> LspM c (Either ResponseError (List (Command |? CodeAction)))
codeAction }

typeSigsPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
typeSigsPluginDescriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
typeSigsPluginDescriptor Recorder (WithPriority Log)
recorder PluginId
plId = forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder forall a b. (a -> b) -> a -> b
$
  [GhcideCodeAction] -> PluginId -> PluginDescriptor IdeState
mkGhcideCAsPlugin [
      forall a. ToCodeAction a => a -> GhcideCodeAction
wrap forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe HscEnv
-> Maybe GlobalBindingTypeSigsResult
-> Maybe TcModuleResult
-> Maybe Bindings
-> Diagnostic
-> [(Text, [TextEdit])]
suggestSignature Bool
True
    , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Diagnostic -> [(Text, TextEdit)]
suggestFillTypeWildcard
    , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyConstraints
    , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap DynFlags -> ParsedSource -> Diagnostic -> [(Text, Rewrite)]
removeRedundantConstraints
    , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap DynFlags -> ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestConstraint
    ]
    PluginId
plId

bindingsPluginDescriptor :: Recorder (WithPriority E.Log) ->  PluginId -> PluginDescriptor IdeState
bindingsPluginDescriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
bindingsPluginDescriptor Recorder (WithPriority Log)
recorder PluginId
plId = forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder forall a b. (a -> b) -> a -> b
$
  [GhcideCodeAction] -> PluginId -> PluginDescriptor IdeState
mkGhcideCAsPlugin [
      forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestReplaceIdentifier
    , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestImplicitParameter
    , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap IdeOptions
-> ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestNewDefinition
    , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap ParsedModule
-> Diagnostic -> Either ResponseError [(Text, [TextEdit])]
Development.IDE.Plugin.Plugins.AddArgument.plugin
    , forall a. ToCodeAction a => a -> GhcideCodeAction
wrap ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDeleteUnusedBinding
    ]
    PluginId
plId

fillHolePluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
fillHolePluginDescriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
fillHolePluginDescriptor Recorder (WithPriority Log)
recorder PluginId
plId = forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder (GhcideCodeAction -> PluginId -> PluginDescriptor IdeState
mkGhcideCAPlugin (forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Diagnostic -> [(Text, TextEdit)]
suggestFillHole) PluginId
plId)

extendImportPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
extendImportPluginDescriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
extendImportPluginDescriptor Recorder (WithPriority Log)
recorder PluginId
plId = forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder forall a b. (a -> b) -> a -> b
$ (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
  { pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState
extendImportCommand] }


-- | Add the ability for a plugin to call GetAnnotatedParsedSource
mkExactprintPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor :: forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder PluginDescriptor a
desc = PluginDescriptor a
desc { pluginRules :: Rules ()
pluginRules = forall ideState. PluginDescriptor ideState -> Rules ()
pluginRules PluginDescriptor a
desc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Recorder (WithPriority Log) -> Rules ()
getAnnotatedParsedSourceRule Recorder (WithPriority Log)
recorder }

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


extendImportCommand :: PluginCommand IdeState
extendImportCommand :: PluginCommand IdeState
extendImportCommand =
  forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand (Text -> CommandId
CommandId Text
extendImportCommandId) Text
"additional edits for a completion" CommandFunction IdeState ExtendImport
extendImportHandler

extendImportHandler :: CommandFunction IdeState ExtendImport
extendImportHandler :: CommandFunction IdeState ExtendImport
extendImportHandler IdeState
ideState edit :: ExtendImport
edit@ExtendImport {Maybe Text
Text
Uri
doc :: ExtendImport -> Uri
newThing :: ExtendImport -> Text
thingParent :: ExtendImport -> Maybe Text
importName :: ExtendImport -> Text
importQual :: ExtendImport -> Maybe Text
importQual :: Maybe Text
importName :: Text
thingParent :: Maybe Text
newThing :: Text
doc :: Uri
..} = do
  Maybe (NormalizedFilePath, WorkspaceEdit)
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ IdeState
-> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
extendImportHandler' IdeState
ideState ExtendImport
edit
  forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (NormalizedFilePath, WorkspaceEdit)
res forall a b. (a -> b) -> a -> b
$ \(NormalizedFilePath
nfp, wedit :: WorkspaceEdit
wedit@WorkspaceEdit {Maybe WorkspaceEditMap
_changes :: Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: WorkspaceEdit -> Maybe WorkspaceEditMap
_changes}) -> do
    let (Uri
_, List (forall a. [a] -> a
head -> TextEdit {Range
_range :: Range
$sel:_range:TextEdit :: TextEdit -> Range
_range})) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe WorkspaceEditMap
_changes forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
Map.toList
        srcSpan :: SrcSpan
srcSpan = NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
nfp Range
_range
    forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification SMethod 'WindowShowMessage
SWindowShowMessage forall a b. (a -> b) -> a -> b
$
      MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
MtInfo forall a b. (a -> b) -> a -> b
$
        Text
"Import "
          forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
"‘" forall a. Semigroup a => a -> a -> a
<> Text
newThing) (\Text
x -> Text
"‘" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
" (" forall a. Semigroup a => a -> a -> a
<> Text
newThing forall a. Semigroup a => a -> a -> a
<> Text
")") Maybe Text
thingParent
          forall a. Semigroup a => a -> a -> a
<> Text
"’ from "
          forall a. Semigroup a => a -> a -> a
<> Text
importName
          forall a. Semigroup a => a -> a -> a
<> Text
" (at "
          forall a. Semigroup a => a -> a -> a
<> forall a. Outputable a => a -> Text
printOutputable SrcSpan
srcSpan
          forall a. Semigroup a => a -> a -> a
<> Text
")"
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
wedit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Value
Null

extendImportHandler' :: IdeState -> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
extendImportHandler' :: IdeState
-> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
extendImportHandler' IdeState
ideState ExtendImport {Maybe Text
Text
Uri
importQual :: Maybe Text
importName :: Text
thingParent :: Maybe Text
newThing :: Text
doc :: Uri
doc :: ExtendImport -> Uri
newThing :: ExtendImport -> Text
thingParent :: ExtendImport -> Maybe Text
importName :: ExtendImport -> Text
importQual :: ExtendImport -> Maybe Text
..}
  | Just String
fp <- Uri -> Maybe String
uriToFilePath Uri
doc,
    NormalizedFilePath
nfp <- String -> NormalizedFilePath
toNormalizedFilePath' String
fp =
    do
      (ModSummaryResult {[LImportDecl GhcPs]
Fingerprint
HscEnv
ModSummary
msrModSummary :: ModSummaryResult -> ModSummary
msrImports :: ModSummaryResult -> [LImportDecl GhcPs]
msrFingerprint :: ModSummaryResult -> Fingerprint
msrHscEnv :: ModSummaryResult -> HscEnv
msrHscEnv :: HscEnv
msrFingerprint :: Fingerprint
msrImports :: [LImportDecl GhcPs]
msrModSummary :: ModSummary
..}, Annotated ParsedSource
ps, Maybe Text
contents) <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
        forall a. String -> IdeState -> Action a -> IO a
runAction String
"extend import" IdeState
ideState forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
            -- We want accurate edits, so do not use stale data here
            ModSummaryResult
msr <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
nfp
            Annotated ParsedSource
ps <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetAnnotatedParsedSource
GetAnnotatedParsedSource NormalizedFilePath
nfp
            (FileVersion
_, Maybe Text
contents) <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetFileContents
GetFileContents NormalizedFilePath
nfp
            forall (m :: * -> *) a. Monad m => a -> m a
return (ModSummaryResult
msr, Annotated ParsedSource
ps, Maybe Text
contents)
      let df :: DynFlags
df = ModSummary -> DynFlags
ms_hspp_opts ModSummary
msrModSummary
          wantedModule :: ModuleName
wantedModule = String -> ModuleName
mkModuleName (Text -> String
T.unpack Text
importName)
          wantedQual :: Maybe ModuleName
wantedQual = String -> ModuleName
mkModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
importQual
          existingImport :: Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
existingImport = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall l.
ModuleName
-> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool
isWantedModule ModuleName
wantedModule Maybe ModuleName
wantedQual) [LImportDecl GhcPs]
msrImports
      case Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
existingImport of
        Just GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp -> do
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NormalizedFilePath
nfp,) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => Either e a -> MaybeT m a
liftEither forall a b. (a -> b) -> a -> b
$
              DynFlags -> Uri -> Rewrite -> Either String WorkspaceEdit
rewriteToWEdit DynFlags
df Uri
doc
#if !MIN_VERSION_ghc(9,2,0)
                (annsA ps)
#endif
                forall a b. (a -> b) -> a -> b
$
                  Maybe String -> String -> LImportDecl GhcPs -> Rewrite
extendImport (Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
thingParent) (Text -> String
T.unpack Text
newThing) (forall ast. ExactPrint ast => ast -> ast
makeDeltaAst GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp)

        Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
Nothing -> do
            let qns :: Maybe (Text, QualifiedImportStyle)
qns = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
importQual forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> Maybe a
Just (DynFlags -> QualifiedImportStyle
qualifiedImportStyle DynFlags
df)
                n :: NewImport
n = Text
-> Maybe Text
-> Maybe (Text, QualifiedImportStyle)
-> Bool
-> NewImport
newImport Text
importName Maybe Text
sym Maybe (Text, QualifiedImportStyle)
qns Bool
False
                sym :: Maybe Text
sym = if forall a. Maybe a -> Bool
isNothing Maybe Text
importQual then forall a. a -> Maybe a
Just Text
it else forall a. Maybe a
Nothing
                it :: Text
it = case Maybe Text
thingParent of
                  Maybe Text
Nothing -> Text
newThing
                  Just Text
p  -> Text
p forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
newThing forall a. Semigroup a => a -> a -> a
<> Text
")"
            TextEdit
t <- forall (m :: * -> *) a. Monad m => Maybe a -> MaybeT m a
liftMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewImport
-> Annotated ParsedSource -> Text -> Maybe (Text, TextEdit)
newImportToEdit NewImport
n Annotated ParsedSource
ps (forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
contents)
            forall (m :: * -> *) a. Monad m => a -> m a
return (NormalizedFilePath
nfp, WorkspaceEdit {$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
_changes=forall a. a -> Maybe a
Just (forall l. IsList l => [Item l] -> l
GHC.Exts.fromList [(Uri
doc,forall a. [a] -> List a
List [TextEdit
t])]), $sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges=forall a. Maybe a
Nothing, $sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations=forall a. Maybe a
Nothing})
  | Bool
otherwise =
    forall (m :: * -> *) a. MonadPlus m => m a
mzero

isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool
isWantedModule :: forall l.
ModuleName
-> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool
isWantedModule ModuleName
wantedModule Maybe ModuleName
Nothing (L l
_ it :: ImportDecl GhcPs
it@ImportDecl{ XRec GhcPs ModuleName
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName :: XRec GhcPs ModuleName
ideclName
#if MIN_VERSION_ghc(9,5,0)
                                                      , ideclImportList = Just (Exactly, _)
#else
                                                      , ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding = Just (Bool
False, XRec GhcPs [LIE GhcPs]
_)
#endif
                                                      }) =
    Bool -> Bool
not (forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl GhcPs
it) Bool -> Bool -> Bool
&& forall l e. GenLocated l e -> e
unLoc XRec GhcPs ModuleName
ideclName forall a. Eq a => a -> a -> Bool
== ModuleName
wantedModule
isWantedModule ModuleName
wantedModule (Just ModuleName
qual) (L l
_ ImportDecl{ Maybe (XRec GhcPs ModuleName)
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclAs, XRec GhcPs ModuleName
ideclName :: XRec GhcPs ModuleName
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName
#if MIN_VERSION_ghc(9,5,0)
                                                       , ideclImportList = Just (Exactly, _)
#else
                                                       , ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding = Just (Bool
False, XRec GhcPs [LIE GhcPs]
_)
#endif
                                                       }) =
    forall l e. GenLocated l e -> e
unLoc XRec GhcPs ModuleName
ideclName forall a. Eq a => a -> a -> Bool
== ModuleName
wantedModule Bool -> Bool -> Bool
&& (ModuleName
wantedModule forall a. Eq a => a -> a -> Bool
== ModuleName
qual Bool -> Bool -> Bool
|| (forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LocatedAn a e -> Located e
reLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (XRec GhcPs ModuleName)
ideclAs) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ModuleName
qual)
isWantedModule ModuleName
_ Maybe ModuleName
_ GenLocated l (ImportDecl GhcPs)
_ = Bool
False


liftMaybe :: Monad m => Maybe a -> MaybeT m a
liftMaybe :: forall (m :: * -> *) a. Monad m => Maybe a -> MaybeT m a
liftMaybe Maybe a
a = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
a

liftEither :: Monad m => Either e a -> MaybeT m a
liftEither :: forall (m :: * -> *) e a. Monad m => Either e a -> MaybeT m a
liftEither (Left e
_)  = forall (m :: * -> *) a. MonadPlus m => m a
mzero
liftEither (Right a
x) = forall (m :: * -> *) a. Monad m => a -> m a
return a
x

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

findSigOfDecl :: p ~ GhcPass p0 => (IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDecl :: forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
(IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDecl IdP p -> Bool
pred [LHsDecl p]
decls =
  forall a. [a] -> Maybe a
listToMaybe
    [ Sig p
sig
      | L SrcSpanAnnA
_ (SigD XSigD p
_ sig :: Sig p
sig@(TypeSig XTypeSig p
_ [LIdP p]
idsSig LHsSigWcType p
_)) <- [LHsDecl p]
decls,
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (IdP p -> Bool
pred forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [LIdP p]
idsSig
    ]

findSigOfDeclRanged :: forall p p0 . p ~ GhcPass p0 => Range -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDeclRanged :: forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDeclRanged Range
range [LHsDecl p]
decls = do
  GenLocated SrcSpanAnnA (HsDecl p)
dec <- forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) [LHsDecl p]
decls
  case GenLocated SrcSpanAnnA (HsDecl p)
dec of
     L SrcSpanAnnA
_ (SigD XSigD p
_ sig :: Sig p
sig@TypeSig {})     -> forall a. a -> Maybe a
Just Sig p
sig
     L SrcSpanAnnA
_ (ValD XValD p
_ (HsBind p
bind :: HsBind p)) -> forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsBind p -> Maybe (Sig p)
findSigOfBind Range
range HsBind p
bind
     GenLocated SrcSpanAnnA (HsDecl p)
_                               -> forall a. Maybe a
Nothing

findSigOfBind :: forall p p0. p ~ GhcPass p0 => Range -> HsBind p -> Maybe (Sig p)
findSigOfBind :: forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsBind p -> Maybe (Sig p)
findSigOfBind Range
range HsBind p
bind =
    case HsBind p
bind of
      FunBind {} -> [LMatch p (LHsExpr p)] -> Maybe (Sig p)
findSigOfLMatch (forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts (forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches HsBind p
bind))
      HsBind p
_          -> forall a. Maybe a
Nothing
  where
    findSigOfLMatch :: [LMatch p (LHsExpr p)] -> Maybe (Sig p)
    findSigOfLMatch :: [LMatch p (LHsExpr p)] -> Maybe (Sig p)
findSigOfLMatch [LMatch p (LHsExpr p)]
ls = do
      GenLocated
  SrcSpanAnnA
  (Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))
match <- forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) [LMatch p (LHsExpr p)]
ls
      let grhs :: GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
grhs = forall p body. Match p body -> GRHSs p body
m_grhss forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc GenLocated
  SrcSpanAnnA
  (Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))
match
#if !MIN_VERSION_ghc(9,2,0)
          span = getLoc $ reLoc $ grhssLocalBinds grhs
      if _start range `isInsideSrcSpan` span
        then findSigOfBinds range (unLoc (grhssLocalBinds grhs)) -- where clause
        else do
          grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs)
          case unLoc grhs of
            GRHS _ _ bd -> findSigOfExpr (unLoc bd)
            _           -> Nothing
#else
      forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
        [forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsLocalBinds p -> Maybe (Sig p)
findSigOfBinds Range
range (forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
grhs) -- where clause
        , do
#if MIN_VERSION_ghc(9,3,0)
          grhs <- findDeclContainingLoc (_start range) (grhssGRHSs grhs)
#else
          GenLocated
  (SrcSpanAnn' (EpAnn Any))
  (GRHS (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr p)))
grhs <- forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) (forall a b. (a -> b) -> [a] -> [b]
map forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
grhs)
#endif
          case forall l e. GenLocated l e -> e
unLoc GenLocated
  (SrcSpanAnn' (EpAnn Any))
  (GRHS (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr p)))
grhs of
            GRHS XCGRHS (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr p))
_ [GuardLStmt (GhcPass p0)]
_ GenLocated SrcSpanAnnA (HsExpr p)
bd -> HsExpr p -> Maybe (Sig p)
findSigOfExpr (forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr p)
bd)
        ]
#endif

    findSigOfExpr :: HsExpr p -> Maybe (Sig p)
    findSigOfExpr :: HsExpr p -> Maybe (Sig p)
findSigOfExpr = HsExpr p -> Maybe (Sig p)
go
      where
#if MIN_VERSION_ghc(9,3,0)
        go (HsLet _ _ binds _ _) = findSigOfBinds range binds
#else
        go :: HsExpr p -> Maybe (Sig p)
go (HsLet XLet p
_ HsLocalBinds p
binds LHsExpr p
_) = forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsLocalBinds p -> Maybe (Sig p)
findSigOfBinds Range
range HsLocalBinds p
binds
#endif
        go (HsDo XDo p
_ HsStmtContext (HsDoRn p)
_ XRec p [ExprLStmt p]
stmts) = do
          StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
stmtlr <- forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) (forall l e. GenLocated l e -> e
unLoc XRec p [ExprLStmt p]
stmts)
          case StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
stmtlr of
            LetStmt XLetStmt p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
_ HsLocalBinds p
lhsLocalBindsLR -> forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsLocalBinds p -> Maybe (Sig p)
findSigOfBinds Range
range HsLocalBinds p
lhsLocalBindsLR
            StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
_                         -> forall a. Maybe a
Nothing
        go HsExpr p
_ = forall a. Maybe a
Nothing

findSigOfBinds :: p ~ GhcPass p0 => Range -> HsLocalBinds p -> Maybe (Sig p)
findSigOfBinds :: forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsLocalBinds p -> Maybe (Sig p)
findSigOfBinds Range
range = HsLocalBindsLR p p -> Maybe (Sig p)
go
  where
    go :: HsLocalBindsLR p p -> Maybe (Sig p)
go (HsValBinds XHsValBinds p p
_ (ValBinds XValBinds p p
_ LHsBindsLR p p
binds [LSig p]
lsigs)) =
        case forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) [LSig p]
lsigs of
          Just Sig p
sig' -> forall a. a -> Maybe a
Just Sig p
sig'
          Maybe (Sig p)
Nothing -> do
            GenLocated SrcSpanAnnA (HsBind p)
lHsBindLR <- forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) (forall a. Bag a -> [a]
bagToList LHsBindsLR p p
binds)
            forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsBind p -> Maybe (Sig p)
findSigOfBind Range
range (forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsBind p)
lHsBindLR)
    go HsLocalBindsLR p p
_ = forall a. Maybe a
Nothing

findInstanceHead :: (Outputable (HsType p), p ~ GhcPass p0) => DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p)
findInstanceHead :: forall p (p0 :: Pass).
(Outputable (HsType p), p ~ GhcPass p0) =>
DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p)
findInstanceHead DynFlags
df String
instanceHead [LHsDecl p]
decls =
  forall a. [a] -> Maybe a
listToMaybe
#if !MIN_VERSION_ghc(9,2,0)
    [ hsib_body
      | L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = HsIB {hsib_body}})) <- decls,
        showSDoc df (ppr hsib_body) == instanceHead
    ]
#else
    [ LHsType (GhcPass p0)
hsib_body
      | L SrcSpanAnnA
_ (InstD XInstD (GhcPass p0)
_ (ClsInstD XClsInstD (GhcPass p0)
_ ClsInstDecl {cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = (forall l e. GenLocated l e -> e
unLoc -> HsSig {sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType (GhcPass p0)
hsib_body})})) <- [LHsDecl p]
decls,
        DynFlags -> SDoc -> String
showSDoc DynFlags
df (forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass p0)
hsib_body) forall a. Eq a => a -> a -> Bool
== String
instanceHead
    ]
#endif

#if MIN_VERSION_ghc(9,2,0)
findDeclContainingLoc :: Foldable t => Position -> t (GenLocated (SrcSpanAnn' a) e) -> Maybe (GenLocated (SrcSpanAnn' a) e)
#else
findDeclContainingLoc :: Foldable t => Position -> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e)
#endif
findDeclContainingLoc :: forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc Position
loc = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L SrcSpanAnn' a
l e
_) -> Position
loc Position -> SrcSpan -> Bool
`isInsideSrcSpan` forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
l)

-- Single:
-- This binding for ‘mod’ shadows the existing binding
--   imported from ‘Prelude’ at haskell-language-server/ghcide/src/Development/IDE/Plugin/CodeAction.hs:10:8-40
--   (and originally defined in ‘GHC.Real’)typecheck(-Wname-shadowing)
-- Multi:
--This binding for ‘pack’ shadows the existing bindings
--  imported from ‘Data.ByteString’ at B.hs:6:1-22
--  imported from ‘Data.ByteString.Lazy’ at B.hs:8:1-27
--  imported from ‘Data.Text’ at B.hs:7:1-16
suggestHideShadow :: Annotated ParsedSource -> T.Text -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])]
suggestHideShadow :: Annotated ParsedSource
-> Text
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])]
suggestHideShadow Annotated ParsedSource
ps Text
fileContents Maybe TcModuleResult
mTcM Maybe HieAstResult
mHar Diagnostic {Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message :: Text
_message, Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range :: Range
_range}
  | Just [Text
identifier, Text
modName, Text
s] <-
      Text -> Text -> Maybe [Text]
matchRegexUnifySpaces
        Text
_message
        Text
"This binding for ‘([^`]+)’ shadows the existing binding imported from ‘([^`]+)’ at ([^ ]*)" =
    Text -> Text -> Text -> [(Text, [Either TextEdit Rewrite])]
suggests Text
identifier Text
modName Text
s
  | Just [Text
identifier] <-
      Text -> Text -> Maybe [Text]
matchRegexUnifySpaces
        Text
_message
        Text
"This binding for ‘([^`]+)’ shadows the existing bindings",
    Just [[Text]]
matched <- Text -> Text -> Maybe [[Text]]
allMatchRegexUnifySpaces Text
_message Text
"imported from ‘([^’]+)’ at ([^ ]*)",
    [(Text, Text)]
mods <- [(Text
modName, Text
s) | [Text
_, Text
modName, Text
s] <- [[Text]]
matched],
    [(Text, [Either TextEdit Rewrite])]
result <- forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
mods forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Text -> Text -> Text -> [(Text, [Either TextEdit Rewrite])]
suggests Text
identifier),
    (Text, [Either TextEdit Rewrite])
hideAll <- (Text
"Hide " forall a. Semigroup a => a -> a -> a
<> Text
identifier forall a. Semigroup a => a -> a -> a
<> Text
" from all occurrence imports", forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(Text, [Either TextEdit Rewrite])]
result) =
    [(Text, [Either TextEdit Rewrite])]
result forall a. Semigroup a => a -> a -> a
<> [(Text, [Either TextEdit Rewrite])
hideAll]
  | Bool
otherwise = []
  where
    L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports} = forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps

    suggests :: Text -> Text -> Text -> [(Text, [Either TextEdit Rewrite])]
suggests Text
identifier Text
modName Text
s
      | Just TcModuleResult
tcM <- Maybe TcModuleResult
mTcM,
        Just HieAstResult
har <- Maybe HieAstResult
mHar,
        [RealSrcSpan
s'] <- [RealSrcSpan
x | (RealSrcSpan
x, String
"") <- ReadS RealSrcSpan
readSrcSpan forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s],
        TcModuleResult
-> HieAstResult -> String -> String -> SrcSpan -> Bool
isUnusedImportedId TcModuleResult
tcM HieAstResult
har (Text -> String
T.unpack Text
identifier) (Text -> String
T.unpack Text
modName) (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
s' forall a. Maybe a
Nothing),
        Maybe (LImportDecl GhcPs)
mDecl <- [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
hsmodImports forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
modName,
        Text
title <- Text
"Hide " forall a. Semigroup a => a -> a -> a
<> Text
identifier forall a. Semigroup a => a -> a -> a
<> Text
" from " forall a. Semigroup a => a -> a -> a
<> Text
modName =
        if Text
modName forall a. Eq a => a -> a -> Bool
== Text
"Prelude" Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (LImportDecl GhcPs)
mDecl
          then forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ (\(Text
_, TextEdit
te) -> (Text
title, [forall a b. a -> Either a b
Left TextEdit
te])) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewImport
-> Annotated ParsedSource -> Text -> Maybe (Text, TextEdit)
newImportToEdit (Text -> NewImport
hideImplicitPreludeSymbol Text
identifier) Annotated ParsedSource
ps Text
fileContents
          else forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ (Text
title,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LImportDecl GhcPs -> Rewrite
hideSymbol (Text -> String
T.unpack Text
identifier) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LImportDecl GhcPs)
mDecl
      | Bool
otherwise = []

findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
decls String
modName = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find [LImportDecl GhcPs]
decls forall a b. (a -> b) -> a -> b
$ \case
  (L SrcSpanAnnA
_ ImportDecl {Bool
Maybe (Bool, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
Maybe StringLiteral
ImportDeclQualifiedStyle
XRec GhcPs ModuleName
XCImportDecl GhcPs
SourceText
IsBootInterface
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclImplicit :: forall a. ImportDecl a -> Bool
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclSafe :: forall a. ImportDecl a -> Bool
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: XRec GhcPs ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
..}) -> String
modName forall a. Eq a => a -> a -> Bool
== ModuleName -> String
moduleNameString (forall l e. GenLocated l e -> e
unLoc XRec GhcPs ModuleName
ideclName)
  GenLocated SrcSpanAnnA (ImportDecl GhcPs)
_                     -> forall a. HasCallStack => String -> a
error String
"impossible"

isTheSameLine :: SrcSpan -> SrcSpan -> Bool
isTheSameLine :: SrcSpan -> SrcSpan -> Bool
isTheSameLine SrcSpan
s1 SrcSpan
s2
  | Just Int
sl1 <- SrcSpan -> Maybe Int
getStartLine SrcSpan
s1,
    Just Int
sl2 <- SrcSpan -> Maybe Int
getStartLine SrcSpan
s2 =
    Int
sl1 forall a. Eq a => a -> a -> Bool
== Int
sl2
  | Bool
otherwise = Bool
False
  where
    getStartLine :: SrcSpan -> Maybe Int
getStartLine SrcSpan
x = RealSrcLoc -> Int
srcLocLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> RealSrcLoc
realSrcSpanStart forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe RealSrcSpan
realSpan SrcSpan
x

isUnusedImportedId :: TcModuleResult -> HieAstResult -> String -> String -> SrcSpan -> Bool
isUnusedImportedId :: TcModuleResult
-> HieAstResult -> String -> String -> SrcSpan -> Bool
isUnusedImportedId
  TcModuleResult {tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTypechecked = TcGblEnv {tcg_imports :: TcGblEnv -> ImportAvails
tcg_imports = ImportAvails {ImportedMods
imp_mods :: ImportAvails -> ImportedMods
imp_mods :: ImportedMods
imp_mods}}}
  HAR {RefMap a
refMap :: ()
refMap :: RefMap a
refMap}
  String
identifier
  String
modName
  SrcSpan
importSpan
    | OccName
occ <- String -> OccName
mkVarOcc String
identifier,
      [ImportedModsVal]
impModsVals <- [ImportedBy] -> [ImportedModsVal]
importedByUser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. ModuleEnv a -> [a]
moduleEnvElts ImportedMods
imp_mods,
      Just GlobalRdrEnv
rdrEnv <-
        forall a. [a] -> Maybe a
listToMaybe
          [ GlobalRdrEnv
imv_all_exports
            | ImportedModsVal {Bool
GlobalRdrEnv
SrcSpan
ModuleName
imv_all_exports :: ImportedModsVal -> GlobalRdrEnv
imv_is_hiding :: ImportedModsVal -> Bool
imv_is_safe :: ImportedModsVal -> Bool
imv_name :: ImportedModsVal -> ModuleName
imv_qualified :: ImportedModsVal -> Bool
imv_span :: ImportedModsVal -> SrcSpan
imv_qualified :: Bool
imv_is_hiding :: Bool
imv_is_safe :: Bool
imv_span :: SrcSpan
imv_name :: ModuleName
imv_all_exports :: GlobalRdrEnv
..} <- [ImportedModsVal]
impModsVals,
              ModuleName
imv_name forall a. Eq a => a -> a -> Bool
== String -> ModuleName
mkModuleName String
modName,
              SrcSpan -> SrcSpan -> Bool
isTheSameLine SrcSpan
imv_span SrcSpan
importSpan
          ],
      [GRE {gre_name :: GlobalRdrElt -> Name
gre_name = Name
name}] <- GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
rdrEnv OccName
occ,
      Either ModuleName Name
importedIdentifier <- forall a b. b -> Either a b
Right Name
name,
      Maybe [(RealSrcSpan, IdentifierDetails a)]
refs <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Either ModuleName Name
importedIdentifier RefMap a
refMap =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(RealSrcSpan
_, IdentifierDetails {Maybe a
Set ContextInfo
identInfo :: forall a. IdentifierDetails a -> Set ContextInfo
identType :: forall a. IdentifierDetails a -> Maybe a
identInfo :: Set ContextInfo
identType :: Maybe a
..}) -> Set ContextInfo
identInfo forall a. Eq a => a -> a -> Bool
== forall a. a -> Set a
S.singleton ContextInfo
Use)) Maybe [(RealSrcSpan, IdentifierDetails a)]
refs
    | Bool
otherwise = Bool
False

suggestRemoveRedundantImport :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestRemoveRedundantImport :: ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestRemoveRedundantImport ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_  HsModule{[LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodImports}} Maybe Text
contents Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
--     The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant
    | Just [Text
_, Text
bindings] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"
    , Just (L SrcSpanAnnA
_ ImportDecl GhcPs
impDecl) <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l) ImportDecl GhcPs
_) -> Range -> Position
_start Range
_range Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l Bool -> Bool -> Bool
&& Range -> Position
_end Range
_range Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l ) [LImportDecl GhcPs]
hsmodImports
    , Just Text
c <- Maybe Text
contents
    , [[Range]]
ranges <- forall a b. (a -> b) -> [a] -> [b]
map (ImportDecl GhcPs -> String -> [Range]
rangesForBindingImport ImportDecl GhcPs
impDecl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (Text -> Text -> [Text]
T.splitOn Text
", " Text
bindings)
    , [Range]
ranges' <- Bool -> PositionIndexedString -> [Range] -> [Range]
extendAllToIncludeCommaIfPossible Bool
False (String -> PositionIndexedString
indexedByPosition forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
c) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Range]]
ranges)
    , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Range]
ranges')
    = [( Text
"Remove " forall a. Semigroup a => a -> a -> a
<> Text
bindings forall a. Semigroup a => a -> a -> a
<> Text
" from import" , [ Range -> Text -> TextEdit
TextEdit Range
r Text
"" | Range
r <- [Range]
ranges' ] )]

-- File.hs:16:1: warning:
--     The import of `Data.List' is redundant
--       except perhaps to import instances from `Data.List'
--     To import instances alone, use: import Data.List()
    | Text
_message forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (String
"The( qualified)? import of [^ ]* is redundant" :: String)
        = [(Text
"Remove import", [Range -> Text -> TextEdit
TextEdit (Maybe Text -> Range -> Range
extendToWholeLineIfPossible Maybe Text
contents Range
_range) Text
""])]
    | Bool
otherwise = []


-- Note [Removing imports is preferred]
-- It's good to prefer the remove imports code action because an unused import
-- is likely to be removed and less likely the warning will be disabled.
-- Therefore actions to remove a single or all redundant imports should be
-- preferred, so that the client can prioritize them higher.
caRemoveRedundantImports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [Command |? CodeAction]
caRemoveRedundantImports :: Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> [Diagnostic]
-> Uri
-> [Command |? CodeAction]
caRemoveRedundantImports Maybe ParsedModule
m Maybe Text
contents [Diagnostic]
digs [Diagnostic]
ctxDigs Uri
uri
  | Just ParsedModule
pm <- Maybe ParsedModule
m,
    [(Diagnostic, (Text, [TextEdit]))]
r <- forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Diagnostic
d -> forall a. a -> [a]
repeat Diagnostic
d forall a b. [a] -> [b] -> [(a, b)]
`zip` ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestRemoveRedundantImport ParsedModule
pm Maybe Text
contents Diagnostic
d) [Diagnostic]
digs,
    [TextEdit]
allEdits <- [ TextEdit
e | (Diagnostic
_, (Text
_, [TextEdit]
edits)) <- [(Diagnostic, (Text, [TextEdit]))]
r, TextEdit
e <- [TextEdit]
edits],
    Command |? CodeAction
caRemoveAll <- [TextEdit] -> Command |? CodeAction
removeAll [TextEdit]
allEdits,
    [(Diagnostic, (Text, [TextEdit]))]
ctxEdits <- [ (Diagnostic, (Text, [TextEdit]))
x | x :: (Diagnostic, (Text, [TextEdit]))
x@(Diagnostic
d, (Text, [TextEdit])
_) <- [(Diagnostic, (Text, [TextEdit]))]
r, Diagnostic
d forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Diagnostic]
ctxDigs],
    Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Diagnostic, (Text, [TextEdit]))]
ctxEdits,
    [Command |? CodeAction]
caRemoveCtx <- forall a b. (a -> b) -> [a] -> [b]
map (\(Diagnostic
d, (Text
title, [TextEdit]
tedit)) -> Text -> [TextEdit] -> Diagnostic -> Command |? CodeAction
removeSingle Text
title [TextEdit]
tedit Diagnostic
d) [(Diagnostic, (Text, [TextEdit]))]
ctxEdits
      = [Command |? CodeAction]
caRemoveCtx forall a. [a] -> [a] -> [a]
++ [Command |? CodeAction
caRemoveAll]
  | Bool
otherwise = []
  where
    removeSingle :: Text -> [TextEdit] -> Diagnostic -> Command |? CodeAction
removeSingle Text
title [TextEdit]
tedit Diagnostic
diagnostic = Text
-> Maybe CodeActionKind
-> Maybe Bool
-> [Diagnostic]
-> WorkspaceEdit
-> Command |? CodeAction
mkCA Text
title (forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix) forall a. Maybe a
Nothing [Diagnostic
diagnostic] WorkspaceEdit{Maybe WorkspaceEditMap
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
..} where
        _changes :: Maybe WorkspaceEditMap
_changes = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [TextEdit]
tedit
        _documentChanges :: Maybe a
_documentChanges = forall a. Maybe a
Nothing
        _changeAnnotations :: Maybe a
_changeAnnotations = forall a. Maybe a
Nothing
    removeAll :: [TextEdit] -> Command |? CodeAction
removeAll [TextEdit]
tedit = forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ CodeAction{Maybe Bool
Maybe WorkspaceEdit
Maybe CodeActionKind
Text
forall a. Maybe a
$sel:_title:CodeAction :: Text
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_disabled:CodeAction :: Maybe Reason
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
$sel:_xdata:CodeAction :: Maybe Value
_xdata :: forall a. Maybe a
_disabled :: forall a. Maybe a
_command :: forall a. Maybe a
_isPreferred :: Maybe Bool
_edit :: Maybe WorkspaceEdit
_diagnostics :: forall a. Maybe a
_kind :: Maybe CodeActionKind
_title :: Text
..} where
        _changes :: Maybe WorkspaceEditMap
_changes = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [TextEdit]
tedit
        _title :: Text
_title = Text
"Remove all redundant imports"
        _kind :: Maybe CodeActionKind
_kind = forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
        _diagnostics :: Maybe a
_diagnostics = forall a. Maybe a
Nothing
        _documentChanges :: Maybe a
_documentChanges = forall a. Maybe a
Nothing
        _edit :: Maybe WorkspaceEdit
_edit = forall a. a -> Maybe a
Just WorkspaceEdit{Maybe WorkspaceEditMap
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
..}
        -- See Note [Removing imports is preferred]
        _isPreferred :: Maybe Bool
_isPreferred = forall a. a -> Maybe a
Just Bool
True
        _command :: Maybe a
_command = forall a. Maybe a
Nothing
        _disabled :: Maybe a
_disabled = forall a. Maybe a
Nothing
        _xdata :: Maybe a
_xdata = forall a. Maybe a
Nothing
        _changeAnnotations :: Maybe a
_changeAnnotations = forall a. Maybe a
Nothing

caRemoveInvalidExports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [Command |? CodeAction]
caRemoveInvalidExports :: Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> [Diagnostic]
-> Uri
-> [Command |? CodeAction]
caRemoveInvalidExports Maybe ParsedModule
m Maybe Text
contents [Diagnostic]
digs [Diagnostic]
ctxDigs Uri
uri
  | Just ParsedModule
pm <- Maybe ParsedModule
m,
    Just Text
txt <- Maybe Text
contents,
    PositionIndexedString
txt' <- String -> PositionIndexedString
indexedByPosition forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
txt,
    [(Text, Diagnostic, [Range])]
r <- forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ParsedModule -> Diagnostic -> Maybe (Text, Diagnostic, [Range])
groupDiag ParsedModule
pm) [Diagnostic]
digs,
    [(Text, Diagnostic, [Range])]
r' <- forall a b. (a -> b) -> [a] -> [b]
map (\(Text
t,Diagnostic
d,[Range]
rs) -> (Text
t,Diagnostic
d,PositionIndexedString -> [Range] -> [Range]
extend PositionIndexedString
txt' [Range]
rs)) [(Text, Diagnostic, [Range])]
r,
    [Command |? CodeAction]
caRemoveCtx <- forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Diagnostic, [Range]) -> Maybe (Command |? CodeAction)
removeSingle [(Text, Diagnostic, [Range])]
r',
    [Range]
allRanges <- forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ [ Range
range | (Text
_,Diagnostic
_,[Range]
ranges) <- [(Text, Diagnostic, [Range])]
r, Range
range <- [Range]
ranges],
    [Range]
allRanges' <- PositionIndexedString -> [Range] -> [Range]
extend PositionIndexedString
txt' [Range]
allRanges,
    Just Command |? CodeAction
caRemoveAll <- [Range] -> Maybe (Command |? CodeAction)
removeAll [Range]
allRanges',
    [(Text, Diagnostic, [Range])]
ctxEdits <- [ (Text, Diagnostic, [Range])
x | x :: (Text, Diagnostic, [Range])
x@(Text
_, Diagnostic
d, [Range]
_) <- [(Text, Diagnostic, [Range])]
r, Diagnostic
d forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Diagnostic]
ctxDigs],
    Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Diagnostic, [Range])]
ctxEdits
      = [Command |? CodeAction]
caRemoveCtx forall a. [a] -> [a] -> [a]
++ [Command |? CodeAction
caRemoveAll]
  | Bool
otherwise = []
  where
    extend :: PositionIndexedString -> [Range] -> [Range]
extend PositionIndexedString
txt [Range]
ranges = Bool -> PositionIndexedString -> [Range] -> [Range]
extendAllToIncludeCommaIfPossible Bool
True PositionIndexedString
txt [Range]
ranges

    groupDiag :: ParsedModule -> Diagnostic -> Maybe (Text, Diagnostic, [Range])
groupDiag ParsedModule
pm Diagnostic
dig
      | Just (Text
title, [Range]
ranges) <- ParsedModule -> Diagnostic -> Maybe (Text, [Range])
suggestRemoveRedundantExport ParsedModule
pm Diagnostic
dig
      = forall a. a -> Maybe a
Just (Text
title, Diagnostic
dig, [Range]
ranges)
      | Bool
otherwise = forall a. Maybe a
Nothing

    removeSingle :: (Text, Diagnostic, [Range]) -> Maybe (Command |? CodeAction)
removeSingle (Text
_, Diagnostic
_, []) = forall a. Maybe a
Nothing
    removeSingle (Text
title, Diagnostic
diagnostic, [Range]
ranges) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ CodeAction{Maybe Bool
Maybe (List Diagnostic)
Maybe WorkspaceEdit
Maybe CodeActionKind
Text
forall a. Maybe a
_xdata :: forall a. Maybe a
_disabled :: forall a. Maybe a
_isPreferred :: Maybe Bool
_command :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_diagnostics :: Maybe (List Diagnostic)
_kind :: Maybe CodeActionKind
_title :: Text
$sel:_title:CodeAction :: Text
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_disabled:CodeAction :: Maybe Reason
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
$sel:_xdata:CodeAction :: Maybe Value
..} where
        tedit :: [TextEdit]
tedit = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Range
r -> [Range -> Text -> TextEdit
TextEdit Range
r Text
""]) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
nubOrd [Range]
ranges
        _changes :: Maybe WorkspaceEditMap
_changes = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [TextEdit]
tedit
        _title :: Text
_title = Text
title
        _kind :: Maybe CodeActionKind
_kind = forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
        _diagnostics :: Maybe (List Diagnostic)
_diagnostics = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [Diagnostic
diagnostic]
        _documentChanges :: Maybe a
_documentChanges = forall a. Maybe a
Nothing
        _edit :: Maybe WorkspaceEdit
_edit = forall a. a -> Maybe a
Just WorkspaceEdit{Maybe WorkspaceEditMap
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
..}
        _command :: Maybe a
_command = forall a. Maybe a
Nothing
        -- See Note [Removing imports is preferred]
        _isPreferred :: Maybe Bool
_isPreferred = forall a. a -> Maybe a
Just Bool
True
        _disabled :: Maybe a
_disabled = forall a. Maybe a
Nothing
        _xdata :: Maybe a
_xdata = forall a. Maybe a
Nothing
        _changeAnnotations :: Maybe a
_changeAnnotations = forall a. Maybe a
Nothing
    removeAll :: [Range] -> Maybe (Command |? CodeAction)
removeAll [] = forall a. Maybe a
Nothing
    removeAll [Range]
ranges = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ CodeAction{Maybe Bool
Maybe WorkspaceEdit
Maybe CodeActionKind
Text
forall a. Maybe a
_xdata :: forall a. Maybe a
_disabled :: forall a. Maybe a
_isPreferred :: Maybe Bool
_command :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_diagnostics :: forall a. Maybe a
_kind :: Maybe CodeActionKind
_title :: Text
$sel:_title:CodeAction :: Text
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_disabled:CodeAction :: Maybe Reason
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
$sel:_xdata:CodeAction :: Maybe Value
..} where
        tedit :: [TextEdit]
tedit = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Range
r -> [Range -> Text -> TextEdit
TextEdit Range
r Text
""]) [Range]
ranges
        _changes :: Maybe WorkspaceEditMap
_changes = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [TextEdit]
tedit
        _title :: Text
_title = Text
"Remove all redundant exports"
        _kind :: Maybe CodeActionKind
_kind = forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
        _diagnostics :: Maybe a
_diagnostics = forall a. Maybe a
Nothing
        _documentChanges :: Maybe a
_documentChanges = forall a. Maybe a
Nothing
        _edit :: Maybe WorkspaceEdit
_edit = forall a. a -> Maybe a
Just WorkspaceEdit{Maybe WorkspaceEditMap
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
..}
        _command :: Maybe a
_command = forall a. Maybe a
Nothing
        -- See Note [Removing imports is preferred]
        _isPreferred :: Maybe Bool
_isPreferred = forall a. a -> Maybe a
Just Bool
True
        _disabled :: Maybe a
_disabled = forall a. Maybe a
Nothing
        _xdata :: Maybe a
_xdata = forall a. Maybe a
Nothing
        _changeAnnotations :: Maybe a
_changeAnnotations = forall a. Maybe a
Nothing

suggestRemoveRedundantExport :: ParsedModule -> Diagnostic -> Maybe (T.Text, [Range])
suggestRemoveRedundantExport :: ParsedModule -> Diagnostic -> Maybe (Text, [Range])
suggestRemoveRedundantExport ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (LocatedP WarningTxt)
Maybe (LocatedA ModuleName)
Maybe (LocatedL [LIE GhcPs])
Maybe LHsDocString
EpAnn AnnsModule
LayoutInfo
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDeprecMessage :: HsModule -> Maybe (LocatedP WarningTxt)
hsmodExports :: HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodHaddockModHeader :: HsModule -> Maybe LHsDocString
hsmodLayout :: HsModule -> LayoutInfo
hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (LocatedP WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (LocatedL [LIE GhcPs])
hsmodName :: Maybe (LocatedA ModuleName)
hsmodLayout :: LayoutInfo
hsmodAnn :: EpAnn AnnsModule
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodAnn :: HsModule -> EpAnn AnnsModule
..}} Diagnostic{Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
  | Text
msg <- Text -> Text
unifySpaces Text
_message
  , Just LocatedL [LIE GhcPs]
export <- Maybe (LocatedL [LIE GhcPs])
hsmodExports
  , Just Range
exportRange <- forall a. HasSrcSpan a => a -> Maybe Range
getLocatedRange forall a b. (a -> b) -> a -> b
$ forall a e. LocatedAn a e -> Located e
reLoc LocatedL [LIE GhcPs]
export
  , [GenLocated SrcSpanAnnA (IE GhcPs)]
exports <- forall l e. GenLocated l e -> e
unLoc LocatedL [LIE GhcPs]
export
  , Just (Text
removeFromExport, ![Range]
ranges) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([GenLocated SrcSpanAnnA (IE GhcPs)] -> Text -> (Text, [Range])
getRanges [GenLocated SrcSpanAnnA (IE GhcPs)]
exports forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotInScope -> Text
notInScope) (Text -> Maybe NotInScope
extractNotInScopeName Text
msg)
                         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,[Range
_range]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
matchExportItem Text
msg
                         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,[Range
_range]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
matchDupExport Text
msg
  , Range -> Range -> Bool
subRange Range
_range Range
exportRange
    = forall a. a -> Maybe a
Just (Text
"Remove ‘" forall a. Semigroup a => a -> a -> a
<> Text
removeFromExport forall a. Semigroup a => a -> a -> a
<> Text
"’ from export", [Range]
ranges)
  where
    matchExportItem :: Text -> Maybe Text
matchExportItem Text
msg = Text -> Text -> Maybe Text
regexSingleMatch Text
msg Text
"The export item ‘([^’]+)’"
    matchDupExport :: Text -> Maybe Text
matchDupExport Text
msg = Text -> Text -> Maybe Text
regexSingleMatch Text
msg Text
"Duplicate ‘([^’]+)’ in export list"
    getRanges :: [GenLocated SrcSpanAnnA (IE GhcPs)] -> Text -> (Text, [Range])
getRanges [GenLocated SrcSpanAnnA (IE GhcPs)]
exports Text
txt = case [LIE GhcPs] -> String -> [Range]
smallerRangesForBindingExport [GenLocated SrcSpanAnnA (IE GhcPs)]
exports (Text -> String
T.unpack Text
txt) of
      []     -> (Text
txt, [Range
_range])
      [Range]
ranges -> (Text
txt, [Range]
ranges)
suggestRemoveRedundantExport ParsedModule
_ Diagnostic
_ = forall a. Maybe a
Nothing

suggestDeleteUnusedBinding :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestDeleteUnusedBinding :: ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDeleteUnusedBinding
  ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDecls}}
  Maybe Text
contents
  Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
-- Foo.hs:4:1: warning: [-Wunused-binds] Defined but not used: ‘f’
    | Just [Text
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
".*Defined but not used: ‘([^ ]+)’"
    , Just PositionIndexedString
indexedContent <- String -> PositionIndexedString
indexedByPosition forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
contents
      = let edits :: [TextEdit]
edits = forall a b c. (a -> b -> c) -> b -> a -> c
flip Range -> Text -> TextEdit
TextEdit Text
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionIndexedString -> String -> [Range]
relatedRanges PositionIndexedString
indexedContent (Text -> String
T.unpack Text
name)
        in ([(Text
"Delete ‘" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"’", [TextEdit]
edits) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TextEdit]
edits)])
    | Bool
otherwise = []
    where
      relatedRanges :: PositionIndexedString -> String -> [Range]
relatedRanges PositionIndexedString
indexedContent String
name =
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PositionIndexedString
-> String -> Located (HsDecl GhcPs) -> [Range]
findRelatedSpans PositionIndexedString
indexedContent String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LocatedAn a e -> Located e
reLoc) [LHsDecl GhcPs]
hsmodDecls
      toRange :: RealSrcSpan -> Range
toRange = RealSrcSpan -> Range
realSrcSpanToRange
      extendForSpaces :: PositionIndexedString -> Range -> Range
extendForSpaces = PositionIndexedString -> Range -> Range
extendToIncludePreviousNewlineIfPossible

      findRelatedSpans :: PositionIndexedString -> String -> Located (HsDecl GhcPs) -> [Range]
      findRelatedSpans :: PositionIndexedString
-> String -> Located (HsDecl GhcPs) -> [Range]
findRelatedSpans
        PositionIndexedString
indexedContent
        String
name
        (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) (ValD XValD GhcPs
_ (HsBind GhcPs
-> Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])
extractNameAndMatchesFromFunBind -> Just (Located (IdP GhcPs)
lname, [LMatch GhcPs (LHsExpr GhcPs)]
matches)))) =
        case Located (IdP GhcPs)
lname of
          (L SrcSpan
nLoc IdP GhcPs
_name) | SrcSpan -> Bool
isTheBinding SrcSpan
nLoc ->
            let findSig :: Located (HsDecl GhcPs) -> [Range]
findSig (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) (SigD XSigD GhcPs
_ Sig GhcPs
sig)) = PositionIndexedString
-> String -> RealSrcSpan -> Sig GhcPs -> [Range]
findRelatedSigSpan PositionIndexedString
indexedContent String
name RealSrcSpan
l Sig GhcPs
sig
                findSig Located (HsDecl GhcPs)
_ = []
            in
              PositionIndexedString -> Range -> Range
extendForSpaces PositionIndexedString
indexedContent (RealSrcSpan -> Range
toRange RealSrcSpan
l) forall a. a -> [a] -> [a]
:
              forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Located (HsDecl GhcPs) -> [Range]
findSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LocatedAn a e -> Located e
reLoc) [LHsDecl GhcPs]
hsmodDecls
          Located (IdP GhcPs)
_ -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PositionIndexedString
-> String -> LMatch GhcPs (LHsExpr GhcPs) -> [Range]
findRelatedSpanForMatch PositionIndexedString
indexedContent String
name) [LMatch GhcPs (LHsExpr GhcPs)]
matches
      findRelatedSpans PositionIndexedString
_ String
_ Located (HsDecl GhcPs)
_ = []

      extractNameAndMatchesFromFunBind
        :: HsBind GhcPs
        -> Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])
      extractNameAndMatchesFromFunBind :: HsBind GhcPs
-> Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])
extractNameAndMatchesFromFunBind
        FunBind
          { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id=LIdP GhcPs
lname
          , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches=MG {mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts=L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches}
          } = forall a. a -> Maybe a
Just (forall a e. LocatedAn a e -> Located e
reLoc LIdP GhcPs
lname, [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches)
      extractNameAndMatchesFromFunBind HsBind GhcPs
_ = forall a. Maybe a
Nothing

      findRelatedSigSpan :: PositionIndexedString -> String -> RealSrcSpan -> Sig GhcPs -> [Range]
      findRelatedSigSpan :: PositionIndexedString
-> String -> RealSrcSpan -> Sig GhcPs -> [Range]
findRelatedSigSpan PositionIndexedString
indexedContent String
name RealSrcSpan
l Sig GhcPs
sig =
        let maybeSpan :: Maybe (SrcSpan, Bool)
maybeSpan = String -> Sig GhcPs -> Maybe (SrcSpan, Bool)
findRelatedSigSpan1 String
name Sig GhcPs
sig
        in case Maybe (SrcSpan, Bool)
maybeSpan of
          Just (SrcSpan
_span, Bool
True) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PositionIndexedString -> Range -> Range
extendForSpaces PositionIndexedString
indexedContent forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
toRange RealSrcSpan
l -- a :: Int
          Just (RealSrcSpan RealSrcSpan
span Maybe BufSpan
_, Bool
False) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
toRange RealSrcSpan
span -- a, b :: Int, a is unused
          Maybe (SrcSpan, Bool)
_ -> []

      -- Second of the tuple means there is only one match
      findRelatedSigSpan1 :: String -> Sig GhcPs -> Maybe (SrcSpan, Bool)
      findRelatedSigSpan1 :: String -> Sig GhcPs -> Maybe (SrcSpan, Bool)
findRelatedSigSpan1 String
name (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
lnames LHsSigWcType GhcPs
_) =
        let maybeIdx :: Maybe Int
maybeIdx = forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(L SrcSpanAnnN
_ RdrName
id) -> IdP GhcPs -> String -> Bool
isSameName RdrName
id String
name) [LIdP GhcPs]
lnames
        in case Maybe Int
maybeIdx of
            Maybe Int
Nothing -> forall a. Maybe a
Nothing
            Just Int
_ | forall (t :: * -> *) a. Foldable t => t a -> Int
length [LIdP GhcPs]
lnames forall a. Eq a => a -> a -> Bool
== Int
1 -> forall a. a -> Maybe a
Just (forall a. HasSrcSpan a => a -> SrcSpan
getLoc forall a b. (a -> b) -> a -> b
$ forall a e. LocatedAn a e -> Located e
reLoc forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [LIdP GhcPs]
lnames, Bool
True)
            Just Int
idx ->
              let targetLname :: SrcSpan
targetLname = forall a. HasSrcSpan a => a -> SrcSpan
getLoc forall a b. (a -> b) -> a -> b
$ forall a e. LocatedAn a e -> Located e
reLoc forall a b. (a -> b) -> a -> b
$ [LIdP GhcPs]
lnames forall a. [a] -> Int -> a
!! Int
idx
                  startLoc :: SrcLoc
startLoc = SrcSpan -> SrcLoc
srcSpanStart SrcSpan
targetLname
                  endLoc :: SrcLoc
endLoc = SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
targetLname
                  startLoc' :: SrcLoc
startLoc' = if Int
idx forall a. Eq a => a -> a -> Bool
== Int
0
                              then SrcLoc
startLoc
                              else SrcSpan -> SrcLoc
srcSpanEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSrcSpan a => a -> SrcSpan
getLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LocatedAn a e -> Located e
reLoc forall a b. (a -> b) -> a -> b
$ [LIdP GhcPs]
lnames forall a. [a] -> Int -> a
!! (Int
idx forall a. Num a => a -> a -> a
- Int
1)
                  endLoc' :: SrcLoc
endLoc' = if Int
idx forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
idx forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [LIdP GhcPs]
lnames forall a. Num a => a -> a -> a
- Int
1
                            then SrcSpan -> SrcLoc
srcSpanStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSrcSpan a => a -> SrcSpan
getLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LocatedAn a e -> Located e
reLoc forall a b. (a -> b) -> a -> b
$ [LIdP GhcPs]
lnames forall a. [a] -> Int -> a
!! (Int
idx forall a. Num a => a -> a -> a
+ Int
1)
                            else SrcLoc
endLoc
              in forall a. a -> Maybe a
Just (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
startLoc' SrcLoc
endLoc', Bool
False)
      findRelatedSigSpan1 String
_ Sig GhcPs
_ = forall a. Maybe a
Nothing

      -- for where clause
      findRelatedSpanForMatch
        :: PositionIndexedString
        -> String
        -> LMatch GhcPs (LHsExpr GhcPs)
        -> [Range]
      findRelatedSpanForMatch :: PositionIndexedString
-> String -> LMatch GhcPs (LHsExpr GhcPs) -> [Range]
findRelatedSpanForMatch
        PositionIndexedString
indexedContent
        String
name
        (L SrcSpanAnnA
_ Match{m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss=GRHSs{HsLocalBinds GhcPs
grhssLocalBinds :: HsLocalBinds GhcPs
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds}}) = do
        let go :: Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)] -> [Range]
go Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
bag [GenLocated SrcSpanAnnA (Sig GhcPs)]
lsigs =
                if forall a. Bag a -> Bool
isEmptyBag Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
bag
                then []
                else forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PositionIndexedString
-> String -> [LSig GhcPs] -> LHsBind GhcPs -> [Range]
findRelatedSpanForHsBind PositionIndexedString
indexedContent String
name [GenLocated SrcSpanAnnA (Sig GhcPs)]
lsigs) Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
bag
#if !MIN_VERSION_ghc(9,2,0)
        case grhssLocalBinds of
          (L _ (HsValBinds _ (ValBinds _ bag lsigs))) -> go bag lsigs
          _                                           -> []
#else
        case HsLocalBinds GhcPs
grhssLocalBinds of
          (HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
bag [LSig GhcPs]
lsigs)) -> Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)] -> [Range]
go LHsBindsLR GhcPs GhcPs
bag [LSig GhcPs]
lsigs
          HsLocalBinds GhcPs
_                                     -> []
#endif
      findRelatedSpanForMatch PositionIndexedString
_ String
_ LMatch GhcPs (LHsExpr GhcPs)
_ = []

      findRelatedSpanForHsBind
        :: PositionIndexedString
        -> String
        -> [LSig GhcPs]
        -> LHsBind GhcPs
        -> [Range]
      findRelatedSpanForHsBind :: PositionIndexedString
-> String -> [LSig GhcPs] -> LHsBind GhcPs -> [Range]
findRelatedSpanForHsBind
        PositionIndexedString
indexedContent
        String
name
        [LSig GhcPs]
lsigs
        (L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (HsBind GhcPs
-> Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])
extractNameAndMatchesFromFunBind -> Just (Located (IdP GhcPs)
lname, [LMatch GhcPs (LHsExpr GhcPs)]
matches))) =
        if SrcSpan -> Bool
isTheBinding (forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (IdP GhcPs)
lname)
        then
          let findSig :: GenLocated SrcSpan (Sig GhcPs) -> [Range]
findSig (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) Sig GhcPs
sig) = PositionIndexedString
-> String -> RealSrcSpan -> Sig GhcPs -> [Range]
findRelatedSigSpan PositionIndexedString
indexedContent String
name RealSrcSpan
l Sig GhcPs
sig
              findSig GenLocated SrcSpan (Sig GhcPs)
_ = []
          in PositionIndexedString -> Range -> Range
extendForSpaces PositionIndexedString
indexedContent (RealSrcSpan -> Range
toRange RealSrcSpan
l) forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GenLocated SrcSpan (Sig GhcPs) -> [Range]
findSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LocatedAn a e -> Located e
reLoc) [LSig GhcPs]
lsigs
        else forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PositionIndexedString
-> String -> LMatch GhcPs (LHsExpr GhcPs) -> [Range]
findRelatedSpanForMatch PositionIndexedString
indexedContent String
name) [LMatch GhcPs (LHsExpr GhcPs)]
matches
      findRelatedSpanForHsBind PositionIndexedString
_ String
_ [LSig GhcPs]
_ LHsBind GhcPs
_ = []

      isTheBinding :: SrcSpan -> Bool
      isTheBinding :: SrcSpan -> Bool
isTheBinding SrcSpan
span = SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
span forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Range
_range

      isSameName :: IdP GhcPs -> String -> Bool
      isSameName :: IdP GhcPs -> String -> Bool
isSameName IdP GhcPs
x String
name = Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable IdP GhcPs
x) forall a. Eq a => a -> a -> Bool
== String
name

data ExportsAs = ExportName | ExportPattern | ExportFamily | ExportAll
  deriving (ExportsAs -> ExportsAs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportsAs -> ExportsAs -> Bool
$c/= :: ExportsAs -> ExportsAs -> Bool
== :: ExportsAs -> ExportsAs -> Bool
$c== :: ExportsAs -> ExportsAs -> Bool
Eq)

getLocatedRange :: HasSrcSpan a => a -> Maybe Range
getLocatedRange :: forall a. HasSrcSpan a => a -> Maybe Range
getLocatedRange = SrcSpan -> Maybe Range
srcSpanToRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSrcSpan a => a -> SrcSpan
getLoc

suggestExportUnusedTopBinding :: Maybe T.Text -> ParsedModule -> Diagnostic -> Maybe (T.Text, TextEdit)
suggestExportUnusedTopBinding :: Maybe Text -> ParsedModule -> Diagnostic -> Maybe (Text, TextEdit)
suggestExportUnusedTopBinding Maybe Text
srcOpt ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (LocatedP WarningTxt)
Maybe (LocatedA ModuleName)
Maybe (LocatedL [LIE GhcPs])
Maybe LHsDocString
EpAnn AnnsModule
LayoutInfo
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (LocatedP WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (LocatedL [LIE GhcPs])
hsmodName :: Maybe (LocatedA ModuleName)
hsmodLayout :: LayoutInfo
hsmodAnn :: EpAnn AnnsModule
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDeprecMessage :: HsModule -> Maybe (LocatedP WarningTxt)
hsmodExports :: HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodHaddockModHeader :: HsModule -> Maybe LHsDocString
hsmodLayout :: HsModule -> LayoutInfo
hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodAnn :: HsModule -> EpAnn AnnsModule
..}} Diagnostic{Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
-- Foo.hs:4:1: warning: [-Wunused-top-binds] Defined but not used: ‘f’
-- Foo.hs:5:1: warning: [-Wunused-top-binds] Defined but not used: type constructor or class ‘F’
-- Foo.hs:6:1: warning: [-Wunused-top-binds] Defined but not used: data constructor ‘Bar’
  | Just Text
source <- Maybe Text
srcOpt
  , Just [Text
_, Text
name] <-
      Text -> Text -> Maybe [Text]
matchRegexUnifySpaces
        Text
_message
        Text
".*Defined but not used: (type constructor or class |data constructor )?‘([^ ]+)’"
  , Just (ExportsAs
exportType, GenLocated SrcSpan RdrName
_) <-
      forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Range -> Located (IdP GhcPs) -> Bool
matchWithDiagnostic Range
_range forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(L SrcSpanAnnA
l HsDecl GhcPs
b) -> if SrcSpan -> Bool
isTopLevel (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) then HsDecl GhcPs -> Maybe (ExportsAs, Located (IdP GhcPs))
exportsAs HsDecl GhcPs
b else forall a. Maybe a
Nothing)
      forall a b. (a -> b) -> a -> b
$ [LHsDecl GhcPs]
hsmodDecls
  , Just GenLocated SrcSpan [Located (IE GhcPs)]
exports       <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a e. LocatedAn a e -> Located e
reLoc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LocatedAn a e -> Located e
reLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LocatedL [LIE GhcPs])
hsmodExports
  , Just Position
exportsEndPos <- Range -> Position
_end forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasSrcSpan a => a -> Maybe Range
getLocatedRange GenLocated SrcSpan [Located (IE GhcPs)]
exports
  , let name' :: Text
name'          = ExportsAs -> Text -> Text
printExport ExportsAs
exportType Text
name
        sep :: Maybe Text
sep            = Text -> Located [Maybe Range] -> Maybe Text
exportSep Text
source forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. HasSrcSpan a => a -> Maybe Range
getLocatedRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpan [Located (IE GhcPs)]
exports
        exportName :: Text
exportName     = case Maybe Text
sep of
          Maybe Text
Nothing -> (if Text -> GenLocated SrcSpan [Located (IE GhcPs)] -> Bool
needsComma Text
source GenLocated SrcSpan [Located (IE GhcPs)]
exports then Text
", " else Text
"") forall a. Semigroup a => a -> a -> a
<> Text
name'
          Just  Text
s -> Text
s forall a. Semigroup a => a -> a -> a
<> Text
name'
        exportsEndPos' :: Position
exportsEndPos' = Position
exportsEndPos { _character :: UInt
_character = forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ Position -> UInt
_character Position
exportsEndPos }
        insertPos :: Position
insertPos      = forall a. a -> Maybe a -> a
fromMaybe Position
exportsEndPos' forall a b. (a -> b) -> a -> b
$ case (Maybe Text
sep, forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan [Located (IE GhcPs)]
exports) of
          (Just Text
_, exports' :: [Located (IE GhcPs)]
exports'@(Located (IE GhcPs)
_:[Located (IE GhcPs)]
_)) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_end forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSrcSpan a => a -> Maybe Range
getLocatedRange forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Located (IE GhcPs)]
exports'
          (Maybe Text, [Located (IE GhcPs)])
_                        -> forall a. Maybe a
Nothing
  = forall a. a -> Maybe a
Just (Text
"Export ‘" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"’", Range -> Text -> TextEdit
TextEdit (Position -> Position -> Range
Range Position
insertPos Position
insertPos) Text
exportName)
  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    exportSep :: T.Text -> Located [Maybe Range] -> Maybe T.Text
    exportSep :: Text -> Located [Maybe Range] -> Maybe Text
exportSep Text
src (L (RealSrcSpan RealSrcSpan
_ Maybe BufSpan
_) xs :: [Maybe Range]
xs@(Maybe Range
_ : tl :: [Maybe Range]
tl@(Maybe Range
_ : [Maybe Range]
_))) =
      case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Maybe Position
e, Maybe Position
s) -> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Position
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Position
s) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_end forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Range]
xs) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Range]
tl) of
        []     -> forall a. Maybe a
Nothing
        [(Position, Position)]
bounds -> forall a. a -> Maybe a
Just Text
smallestSep
          where
            smallestSep :: Text
smallestSep
              = forall a b. (a, b) -> b
snd
              forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst)
              forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id)
              forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
nubOrd
              forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Position
prevEnd, Position
nextStart) -> Range -> Text -> Text
textInRange (Position -> Position -> Range
Range Position
prevEnd Position
nextStart) Text
src) [(Position, Position)]
bounds
    exportSep Text
_   Located [Maybe Range]
_ = forall a. Maybe a
Nothing

    -- We get the last export and the closing bracket and check for comma in that range.
    needsComma :: T.Text -> Located [Located (IE GhcPs)] -> Bool
    needsComma :: Text -> GenLocated SrcSpan [Located (IE GhcPs)] -> Bool
needsComma Text
_ (L SrcSpan
_ []) = Bool
False
    needsComma Text
source (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) [Located (IE GhcPs)]
exports) =
      let closeParen :: Position
closeParen = Range -> Position
_end forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
l
          lastExport :: Maybe Position
lastExport = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_end forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSrcSpan a => a -> Maybe Range
getLocatedRange forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Located (IE GhcPs)]
exports
      in
      case Maybe Position
lastExport of
        Just Position
lastExport ->
          Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
',') forall a b. (a -> b) -> a -> b
$ Range -> Text -> Text
textInRange (Position -> Position -> Range
Range Position
lastExport Position
closeParen) Text
source
        Maybe Position
_ -> Bool
False
    needsComma Text
_ GenLocated SrcSpan [Located (IE GhcPs)]
_ = Bool
False

    opLetter :: T.Text
    opLetter :: Text
opLetter = Text
":!#$%&*+./<=>?@\\^|-~"

    parenthesizeIfNeeds :: Bool -> T.Text -> T.Text
    parenthesizeIfNeeds :: Bool -> Text -> Text
parenthesizeIfNeeds Bool
needsTypeKeyword Text
x
      | (Char -> Bool) -> Text -> Bool
T.any (Char
c forall a. Eq a => a -> a -> Bool
==) Text
opLetter = (if Bool
needsTypeKeyword then Text
"type " else Text
"") forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
")"
      | Bool
otherwise = Text
x
      where
        c :: Char
c = Text -> Char
T.head Text
x

    matchWithDiagnostic :: Range -> Located (IdP GhcPs) -> Bool
    matchWithDiagnostic :: Range -> Located (IdP GhcPs) -> Bool
matchWithDiagnostic Range{_start :: Range -> Position
_start=Position
l,_end :: Range -> Position
_end=Position
r} Located (IdP GhcPs)
x =
      let loc :: Maybe Position
loc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_start forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSrcSpan a => a -> Maybe Range
getLocatedRange forall a b. (a -> b) -> a -> b
$ Located (IdP GhcPs)
x
       in Maybe Position
loc forall a. Ord a => a -> a -> Bool
>= forall a. a -> Maybe a
Just Position
l Bool -> Bool -> Bool
&& Maybe Position
loc forall a. Ord a => a -> a -> Bool
<= forall a. a -> Maybe a
Just Position
r

    printExport :: ExportsAs -> T.Text -> T.Text
    printExport :: ExportsAs -> Text -> Text
printExport ExportsAs
ExportName Text
x    = Bool -> Text -> Text
parenthesizeIfNeeds Bool
False Text
x
    printExport ExportsAs
ExportPattern Text
x = Text
"pattern " forall a. Semigroup a => a -> a -> a
<> Text
x
    printExport ExportsAs
ExportFamily Text
x  = Bool -> Text -> Text
parenthesizeIfNeeds Bool
True Text
x
    printExport ExportsAs
ExportAll Text
x     = Bool -> Text -> Text
parenthesizeIfNeeds Bool
True Text
x forall a. Semigroup a => a -> a -> a
<> Text
"(..)"

    isTopLevel :: SrcSpan -> Bool
    isTopLevel :: SrcSpan -> Bool
isTopLevel SrcSpan
span = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Position -> UInt
_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Position
_start) (SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
span) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just UInt
0

    exportsAs :: HsDecl GhcPs -> Maybe (ExportsAs, Located (IdP GhcPs))
    exportsAs :: HsDecl GhcPs -> Maybe (ExportsAs, Located (IdP GhcPs))
exportsAs (ValD XValD GhcPs
_ FunBind {LIdP GhcPs
fun_id :: LIdP GhcPs
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id})          = forall a. a -> Maybe a
Just (ExportsAs
ExportName, forall a e. LocatedAn a e -> Located e
reLoc LIdP GhcPs
fun_id)
    exportsAs (ValD XValD GhcPs
_ (PatSynBind XPatSynBind GhcPs GhcPs
_ PSB {LIdP GhcPs
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id :: LIdP GhcPs
psb_id})) = forall a. a -> Maybe a
Just (ExportsAs
ExportPattern, forall a e. LocatedAn a e -> Located e
reLoc LIdP GhcPs
psb_id)
    exportsAs (TyClD XTyClD GhcPs
_ SynDecl{LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName :: LIdP GhcPs
tcdLName})      = forall a. a -> Maybe a
Just (ExportsAs
ExportName, forall a e. LocatedAn a e -> Located e
reLoc LIdP GhcPs
tcdLName)
    exportsAs (TyClD XTyClD GhcPs
_ DataDecl{LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName})     = forall a. a -> Maybe a
Just (ExportsAs
ExportAll, forall a e. LocatedAn a e -> Located e
reLoc LIdP GhcPs
tcdLName)
    exportsAs (TyClD XTyClD GhcPs
_ ClassDecl{LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName})    = forall a. a -> Maybe a
Just (ExportsAs
ExportAll, forall a e. LocatedAn a e -> Located e
reLoc LIdP GhcPs
tcdLName)
    exportsAs (TyClD XTyClD GhcPs
_ FamDecl{FamilyDecl GhcPs
tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam :: FamilyDecl GhcPs
tcdFam})        = forall a. a -> Maybe a
Just (ExportsAs
ExportFamily, forall a e. LocatedAn a e -> Located e
reLoc forall a b. (a -> b) -> a -> b
$ forall pass. FamilyDecl pass -> LIdP pass
fdLName FamilyDecl GhcPs
tcdFam)
    exportsAs HsDecl GhcPs
_                                = forall a. Maybe a
Nothing

suggestAddTypeAnnotationToSatisfyConstraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyConstraints :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyConstraints Maybe Text
sourceOpt Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
-- File.hs:52:41: warning:
--     * Defaulting the following constraint to type ‘Integer’
--        Num p0 arising from the literal ‘1’
--     * In the expression: 1
--       In an equation for ‘f’: f = 1
-- File.hs:52:41: warning:
--     * Defaulting the following constraints to type ‘[Char]’
--        (Show a0)
--          arising from a use of ‘traceShow’
--          at A.hs:228:7-25
--        (IsString a0)
--          arising from the literal ‘"debug"’
--          at A.hs:228:17-23
--     * In the expression: traceShow "debug" a
--       In an equation for ‘f’: f a = traceShow "debug" a
-- File.hs:52:41: warning:
--     * Defaulting the following constraints to type ‘[Char]’
--         (Show a0)
--          arising from a use of ‘traceShow’
--          at A.hs:255:28-43
--        (IsString a0)
--          arising from the literal ‘"test"’
--          at /Users/serhiip/workspace/ghcide/src/Development/IDE/Plugin/CodeAction.hs:255:38-43
--     * In the fourth argument of ‘seq’, namely ‘(traceShow "test")’
--       In the expression: seq "test" seq "test" (traceShow "test")
--       In an equation for ‘f’:
--          f = seq "test" seq "test" (traceShow "test")
--
    | Just [Text
ty, Text
lit] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
False Bool
False Bool
True Bool
False)
                    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
False Bool
False Bool
False Bool
True)
                    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
False Bool
False Bool
False Bool
False)

            = forall {a}.
(Semigroup a, IsString a) =>
Range -> a -> a -> Text -> [(a, [TextEdit])]
codeEdit Range
_range Text
ty Text
lit (forall {a}. (Semigroup a, IsString a) => a -> a -> a
makeAnnotatedLit Text
ty Text
lit)
    | Just Text
source <- Maybe Text
sourceOpt
    , Just [Text
ty, Text
lit, Text
srcspan] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
True Bool
True Bool
False Bool
False)
    , Range
range <- case [ RealSrcSpan
x | (RealSrcSpan
x,String
"") <- ReadS RealSrcSpan
readSrcSpan (Text -> String
T.unpack Text
srcspan)] of
                 [RealSrcSpan
s] -> let x :: Range
x = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
s
                   in Range
x{_end :: Position
_end = (Range -> Position
_end Range
x){_character :: UInt
_character = forall a. Enum a => a -> a
succ (Position -> UInt
_character (Range -> Position
_end Range
x))}}
                 [RealSrcSpan]
_ -> forall a. HasCallStack => String -> a
error String
"bug in srcspan parser"
    = let lit' :: Text
lit' = forall {a}. (Semigroup a, IsString a) => a -> a -> a
makeAnnotatedLit Text
ty Text
lit;
          tir :: Text
tir = Range -> Text -> Text
textInRange Range
range Text
source
      in forall {a}.
(Semigroup a, IsString a) =>
Range -> a -> a -> Text -> [(a, [TextEdit])]
codeEdit Range
range Text
ty Text
lit (Text -> Text -> Text -> Text
T.replace Text
lit Text
lit' Text
tir)
    | Bool
otherwise = []
    where
      makeAnnotatedLit :: a -> a -> a
makeAnnotatedLit a
ty a
lit = a
"(" forall a. Semigroup a => a -> a -> a
<> a
lit forall a. Semigroup a => a -> a -> a
<> a
" :: " forall a. Semigroup a => a -> a -> a
<> a
ty forall a. Semigroup a => a -> a -> a
<> a
")"
#if MIN_VERSION_ghc(9,4,0)
      pat multiple at inArg inExpr = T.concat [ ".*Defaulting the type variable "
                                       , ".*to type ‘([^ ]+)’ "
                                       , "in the following constraint"
                                       , if multiple then "s" else " "
                                       , ".*arising from the literal ‘(.+)’"
                                       , if inArg then ".+In the.+argument" else ""
                                       , if at then ".+at ([^ ]*)" else ""
                                       , if inExpr then ".+In the expression" else ""
                                       , ".+In the expression"
                                       ]
#else
      pat :: Bool -> Bool -> Bool -> Bool -> Text
pat Bool
multiple Bool
at Bool
inArg Bool
inExpr = [Text] -> Text
T.concat [ Text
".*Defaulting the following constraint"
                                       , if Bool
multiple then Text
"s" else Text
""
                                       , Text
" to type ‘([^ ]+)’ "
                                       , Text
".*arising from the literal ‘(.+)’"
                                       , if Bool
inArg then Text
".+In the.+argument" else Text
""
                                       , if Bool
at then Text
".+at ([^ ]*)" else Text
""
                                       , if Bool
inExpr then Text
".+In the expression" else Text
""
                                       , Text
".+In the expression"
                                       ]
#endif
      codeEdit :: Range -> a -> a -> Text -> [(a, [TextEdit])]
codeEdit Range
range a
ty a
lit Text
replacement =
        let title :: a
title = a
"Add type annotation ‘" forall a. Semigroup a => a -> a -> a
<> a
ty forall a. Semigroup a => a -> a -> a
<> a
"’ to ‘" forall a. Semigroup a => a -> a -> a
<> a
lit forall a. Semigroup a => a -> a -> a
<> a
"’"
            edits :: [TextEdit]
edits = [Range -> Text -> TextEdit
TextEdit Range
range Text
replacement]
        in  [( a
title, [TextEdit]
edits )]

-- | GHC strips out backticks in case of infix functions as well as single quote
--   in case of quoted name when using TemplateHaskellQuotes. Which is not desired.
--
-- For example:
-- 1.
--
-- @
-- File.hs:52:41: error:
--     * Variable not in scope:
--         suggestAcion :: Maybe T.Text -> Range -> Range
--     * Perhaps you meant ‘suggestAction’ (line 83)
-- File.hs:94:37: error:
--     Not in scope: ‘T.isPrfixOf’
--     Perhaps you meant one of these:
--       ‘T.isPrefixOf’ (imported from Data.Text),
--       ‘T.isInfixOf’ (imported from Data.Text),
--       ‘T.isSuffixOf’ (imported from Data.Text)
--     Module ‘Data.Text’ does not export ‘isPrfixOf’.
-- @
--
-- * action: \`suggestAcion\` will be renamed to \`suggestAction\` keeping back ticks around the function
--
-- 2.
--
-- @
-- import Language.Haskell.TH (Name)
-- foo :: Name
-- foo = 'bread
--
-- File.hs:8:7: error:
--     Not in scope: ‘bread’
--       * Perhaps you meant one of these:
--         ‘break’ (imported from Prelude), ‘read’ (imported from Prelude)
--       * In the Template Haskell quotation 'bread
-- @
--
-- * action: 'bread will be renamed to 'break keeping single quote on beginning of name
suggestReplaceIdentifier :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestReplaceIdentifier :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestReplaceIdentifier Maybe Text
contents Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    | renameSuggestions :: [Text]
renameSuggestions@(Text
_:[Text]
_) <- Text -> [Text]
extractRenamableTerms Text
_message
        = [ (Text
"Replace with ‘" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"’", [Maybe Text -> Range -> Text -> TextEdit
mkRenameEdit Maybe Text
contents Range
_range Text
name]) | Text
name <- [Text]
renameSuggestions ]
    | Bool
otherwise = []

suggestNewDefinition :: IdeOptions -> ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestNewDefinition :: IdeOptions
-> ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestNewDefinition IdeOptions
ideOptions ParsedModule
parsedModule Maybe Text
contents Diagnostic {Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message, Range
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range}
  | Just (Text
name, Maybe Text
typ) <- Text -> Maybe (Text, Maybe Text)
matchVariableNotInScope Text
message =
      IdeOptions
-> ParsedModule
-> Range
-> Text
-> Maybe Text
-> [(Text, [TextEdit])]
newDefinitionAction IdeOptions
ideOptions ParsedModule
parsedModule Range
_range Text
name Maybe Text
typ
  | Just (Text
name, Text
typ) <- Text -> Maybe (Text, Text)
matchFoundHole Text
message,
    [(Text
label, [TextEdit]
newDefinitionEdits)] <- IdeOptions
-> ParsedModule
-> Range
-> Text
-> Maybe Text
-> [(Text, [TextEdit])]
newDefinitionAction IdeOptions
ideOptions ParsedModule
parsedModule Range
_range Text
name (forall a. a -> Maybe a
Just Text
typ) =
      [(Text
label, Maybe Text -> Range -> Text -> TextEdit
mkRenameEdit Maybe Text
contents Range
_range Text
name forall a. a -> [a] -> [a]
: [TextEdit]
newDefinitionEdits)]
  | Bool
otherwise = []
  where
    message :: Text
message = Text -> Text
unifySpaces Text
_message

newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> Maybe T.Text -> [(T.Text, [TextEdit])]
newDefinitionAction :: IdeOptions
-> ParsedModule
-> Range
-> Text
-> Maybe Text
-> [(Text, [TextEdit])]
newDefinitionAction IdeOptions {Bool
Int
String
[String]
[Text]
Maybe String
IO Bool
IO CheckParents
OptHaddockParse
IdeReportProgress
IdeDefer
IdeTesting
ProgressReportingStyle
IdePkgLocationOptions
Action IdeGhcSession
ShakeOptions
ParsedSource -> IdePreprocessedSource
Config -> DynFlagsModifications
forall a. Typeable a => a -> Bool
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optExtensions :: IdeOptions -> [String]
optShakeProfiling :: IdeOptions -> Maybe String
optTesting :: IdeOptions -> IdeTesting
optReportProgress :: IdeOptions -> IdeReportProgress
optMaxDirtyAge :: IdeOptions -> Int
optLanguageSyntax :: IdeOptions -> String
optNewColonConvention :: IdeOptions -> Bool
optKeywords :: IdeOptions -> [Text]
optDefer :: IdeOptions -> IdeDefer
optCheckProject :: IdeOptions -> IO Bool
optCheckParents :: IdeOptions -> IO CheckParents
optHaddockParse :: IdeOptions -> OptHaddockParse
optModifyDynFlags :: IdeOptions -> Config -> DynFlagsModifications
optShakeOptions :: IdeOptions -> ShakeOptions
optSkipProgress :: IdeOptions -> forall a. Typeable a => a -> Bool
optProgressStyle :: IdeOptions -> ProgressReportingStyle
optRunSubset :: IdeOptions -> Bool
optVerifyCoreFile :: IdeOptions -> Bool
optVerifyCoreFile :: Bool
optRunSubset :: Bool
optProgressStyle :: ProgressReportingStyle
optSkipProgress :: forall a. Typeable a => a -> Bool
optShakeOptions :: ShakeOptions
optModifyDynFlags :: Config -> DynFlagsModifications
optHaddockParse :: OptHaddockParse
optCheckParents :: IO CheckParents
optCheckProject :: IO Bool
optDefer :: IdeDefer
optKeywords :: [Text]
optNewColonConvention :: Bool
optLanguageSyntax :: String
optMaxDirtyAge :: Int
optReportProgress :: IdeReportProgress
optTesting :: IdeTesting
optShakeProfiling :: Maybe String
optExtensions :: [String]
optPkgLocationOpts :: IdePkgLocationOptions
optGhcSession :: Action IdeGhcSession
optPreprocessor :: ParsedSource -> IdePreprocessedSource
..} ParsedModule
parsedModule Range {Position
_start :: Position
_start :: Range -> Position
_start} Text
name Maybe Text
typ
  | Range Position
_ Position
lastLineP : [Range]
_ <-
      [ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
sp
        | (L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_)) HsDecl GhcPs
_) <- [LHsDecl GhcPs]
hsmodDecls,
          Position
_start Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l
      ],
    Position
nextLineP <- Position {_line :: UInt
_line = Position -> UInt
_line Position
lastLineP forall a. Num a => a -> a -> a
+ UInt
1, _character :: UInt
_character = UInt
0} =
      [ ( Text
"Define " forall a. Semigroup a => a -> a -> a
<> Text
sig,
          [Range -> Text -> TextEdit
TextEdit (Position -> Position -> Range
Range Position
nextLineP Position
nextLineP) ([Text] -> Text
T.unlines [Text
"", Text
sig, Text
name forall a. Semigroup a => a -> a -> a
<> Text
" = _"])]
        )
      ]
  | Bool
otherwise = []
  where
    colon :: Text
colon = if Bool
optNewColonConvention then Text
" : " else Text
" :: "
    sig :: Text
sig = Text
name forall a. Semigroup a => a -> a -> a
<> Text
colon forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpace (forall a. a -> Maybe a -> a
fromMaybe Text
"_" Maybe Text
typ)
    ParsedModule {pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDecls}} = ParsedModule
parsedModule

{- Handles two variants with different formatting

1. Could not find module ‘Data.Cha’
   Perhaps you meant Data.Char (from base-4.12.0.0)

2. Could not find module ‘Data.I’
   Perhaps you meant
      Data.Ix (from base-4.14.3.0)
      Data.Eq (from base-4.14.3.0)
      Data.Int (from base-4.14.3.0)
-}
suggestModuleTypo :: Diagnostic -> [(T.Text, TextEdit)]
suggestModuleTypo :: Diagnostic -> [(Text, TextEdit)]
suggestModuleTypo Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    | Text
"Could not find module" Text -> Text -> Bool
`T.isInfixOf` Text
_message =
      case Text -> Text -> [Text]
T.splitOn Text
"Perhaps you meant" Text
_message of
          [Text
_, Text
stuff] ->
              [ (Text
"replace with " forall a. Semigroup a => a -> a -> a
<> Text
modul, Range -> Text -> TextEdit
TextEdit Range
_range Text
modul)
              | Text
modul <- forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Text
extractModule (Text -> [Text]
T.lines Text
stuff)
              ]
          [Text]
_ -> []
    | Bool
otherwise = []
  where
    extractModule :: Text -> Maybe Text
extractModule Text
line = case Text -> [Text]
T.words Text
line of
        [Text
modul, Text
"(from", Text
_] -> forall a. a -> Maybe a
Just Text
modul
        [Text]
_                   -> forall a. Maybe a
Nothing

suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)]
suggestExtendImport :: ExportsMap
-> ParsedSource -> Diagnostic -> [(Text, CodeActionKind, Rewrite)]
suggestExtendImport ExportsMap
exportsMap (L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodImports}) Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    | Just [Text
binding, Text
mod, Text
srcspan] <-
      Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message
      Text
"Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\)."
    = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Text -> Text -> Text -> [(Text, CodeActionKind, Rewrite)]
suggestions [LImportDecl GhcPs]
hsmodImports Text
binding Text
mod Text
srcspan
    | Just (Text
binding, [(Text, Text)]
mod_srcspan) <-
      Text -> Maybe (Text, [(Text, Text)])
matchRegExMultipleImports Text
_message
    = [(Text, Text)]
mod_srcspan forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Text -> Text -> Text -> [(Text, CodeActionKind, Rewrite)]
suggestions [LImportDecl GhcPs]
hsmodImports Text
binding)
    | Bool
otherwise = []
    where
        canUseDatacon :: Bool
canUseDatacon = case Text -> Maybe NotInScope
extractNotInScopeName Text
_message of
                            Just NotInScopeTypeConstructorOrClass{} -> Bool
False
                            Maybe NotInScope
_                                       -> Bool
True

        suggestions :: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Text -> Text -> Text -> [(Text, CodeActionKind, Rewrite)]
suggestions [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
decls Text
binding Text
mod Text
srcspan
          | Range
range <- case [ RealSrcSpan
x | (RealSrcSpan
x,String
"") <- ReadS RealSrcSpan
readSrcSpan (Text -> String
T.unpack Text
srcspan)] of
                [RealSrcSpan
s] -> let x :: Range
x = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
s
                   in Range
x{_end :: Position
_end = (Range -> Position
_end Range
x){_character :: UInt
_character = forall a. Enum a => a -> a
succ (Position -> UInt
_character (Range -> Position
_end Range
x))}}
                [RealSrcSpan]
_ -> forall a. HasCallStack => String -> a
error String
"bug in srcspan parser",
            Just LImportDecl GhcPs
decl <- [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs)
findImportDeclByRange [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
decls Range
range,
            Just IdentInfo
ident <- Text -> Text -> Maybe IdentInfo
lookupExportMap Text
binding Text
mod
          = [ ( Text
"Add " forall a. Semigroup a => a -> a -> a
<> ImportStyle -> Text
renderImportStyle ImportStyle
importStyle forall a. Semigroup a => a -> a -> a
<> Text
" to the import list of " forall a. Semigroup a => a -> a -> a
<> Text
mod
              , Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"extend" ImportStyle
importStyle
              , forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe String -> String -> LImportDecl GhcPs -> Rewrite
extendImport (ImportStyle -> (Maybe String, String)
unImportStyle ImportStyle
importStyle) LImportDecl GhcPs
decl
              )
            | ImportStyle
importStyle <- forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo
ident
            ]
          | Bool
otherwise = []
        lookupExportMap :: Text -> Text -> Maybe IdentInfo
lookupExportMap Text
binding Text
mod
          | let em :: OccEnv (HashSet IdentInfo)
em = ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap ExportsMap
exportsMap
                match1 :: Maybe (HashSet IdentInfo)
match1 = forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (HashSet IdentInfo)
em (Text -> OccName
mkVarOrDataOcc Text
binding)
                match2 :: Maybe (HashSet IdentInfo)
match2 = forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (HashSet IdentInfo)
em (Text -> OccName
mkTypeOcc Text
binding)
          , Just HashSet IdentInfo
match <- Maybe (HashSet IdentInfo)
match1 forall a. Semigroup a => a -> a -> a
<> Maybe (HashSet IdentInfo)
match2
          -- Only for the situation that data constructor name is same as type constructor name,
          -- let ident with parent be in front of the one without.
          , [IdentInfo]
sortedMatch <- forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\IdentInfo
ident1 IdentInfo
ident2 -> IdentInfo -> Maybe OccName
parent IdentInfo
ident2 forall a. Ord a => a -> a -> Ordering
`compare` IdentInfo -> Maybe OccName
parent IdentInfo
ident1) (forall a. HashSet a -> [a]
Set.toList HashSet IdentInfo
match)
          , [IdentInfo]
idents <- forall a. (a -> Bool) -> [a] -> [a]
filter (\IdentInfo
ident -> IdentInfo -> Text
moduleNameText IdentInfo
ident forall a. Eq a => a -> a -> Bool
== Text
mod Bool -> Bool -> Bool
&& (Bool
canUseDatacon Bool -> Bool -> Bool
|| Bool -> Bool
not (IdentInfo -> Bool
isDatacon IdentInfo
ident))) [IdentInfo]
sortedMatch
          , (IdentInfo
ident:[IdentInfo]
_) <- [IdentInfo]
idents -- Ensure fallback while `idents` is empty
          = forall a. a -> Maybe a
Just IdentInfo
ident

            -- fallback to using GHC suggestion even though it is not always correct
          | Bool
otherwise
          = forall a. a -> Maybe a
Just IdentInfo
                { name :: OccName
name = Text -> OccName
mkVarOrDataOcc Text
binding
                , parent :: Maybe OccName
parent = forall a. Maybe a
Nothing
                , identModuleName :: ModuleName
identModuleName  = FastString -> ModuleName
mkModuleNameFS forall a b. (a -> b) -> a -> b
$ ByteString -> FastString
mkFastStringByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
mod}

data HidingMode
    = HideOthers [ModuleTarget]
    | ToQualified
        Bool
        -- ^ Parenthesised?
        ModuleName

data ModuleTarget
    = ExistingImp (NonEmpty (LImportDecl GhcPs))
    | ImplicitPrelude [LImportDecl GhcPs]

targetImports :: ModuleTarget -> [LImportDecl GhcPs]
targetImports :: ModuleTarget -> [LImportDecl GhcPs]
targetImports (ExistingImp NonEmpty (LImportDecl GhcPs)
ne)     = forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcPs)
ne
targetImports (ImplicitPrelude [LImportDecl GhcPs]
xs) = [LImportDecl GhcPs]
xs

oneAndOthers :: [a] -> [(a, [a])]
oneAndOthers :: forall a. [a] -> [(a, [a])]
oneAndOthers = forall a. [a] -> [(a, [a])]
go
    where
        go :: [a] -> [(a, [a])]
go []       = []
        go (a
x : [a]
xs) = (a
x, [a]
xs) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
x forall a. a -> [a] -> [a]
:)) ([a] -> [(a, [a])]
go [a]
xs)

isPreludeImplicit :: DynFlags -> Bool
isPreludeImplicit :: DynFlags -> Bool
isPreludeImplicit = Extension -> DynFlags -> Bool
xopt Extension
Lang.ImplicitPrelude

-- | Suggests disambiguation for ambiguous symbols.
suggestImportDisambiguation ::
    DynFlags ->
    Maybe T.Text ->
    Annotated ParsedSource ->
    T.Text ->
    Diagnostic ->
    [(T.Text, [Either TextEdit Rewrite])]
suggestImportDisambiguation :: DynFlags
-> Maybe Text
-> Annotated ParsedSource
-> Text
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])]
suggestImportDisambiguation DynFlags
df (Just Text
txt) Annotated ParsedSource
ps Text
fileContents diag :: Diagnostic
diag@Diagnostic {Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    | Just [Text
ambiguous] <-
        Text -> Text -> Maybe [Text]
matchRegexUnifySpaces
            Text
_message
            Text
"Ambiguous occurrence ‘([^’]+)’"
      , Just [Text]
modules <-
            forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
last
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe [[Text]]
allMatchRegexUnifySpaces Text
_message Text
"imported from ‘([^’]+)’"
      , Maybe [Text]
local <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"defined at .+:[0-9]+:[0-9]+" =
        Text -> [Text] -> Bool -> [(Text, [Either TextEdit Rewrite])]
suggestions Text
ambiguous [Text]
modules (forall a. Maybe a -> Bool
isJust Maybe [Text]
local)
    | Bool
otherwise = []
    where
        L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodImports} = forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps

        locDic :: HashMap Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
locDic =
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> NonEmpty a
NE.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DList a -> [a]
DL.toList) forall a b. (a -> b) -> a -> b
$
            forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$
                forall a b. (a -> b) -> [a] -> [b]
map
                    ( \i :: GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i@(L SrcSpanAnnA
_ ImportDecl GhcPs
idecl) ->
                        ( String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
idecl
                        , forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i
                        )
                    )
                    [LImportDecl GhcPs]
hsmodImports
        toModuleTarget :: Text -> Maybe ModuleTarget
toModuleTarget Text
"Prelude"
            | DynFlags -> Bool
isPreludeImplicit DynFlags
df
             = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [LImportDecl GhcPs] -> ModuleTarget
ImplicitPrelude forall a b. (a -> b) -> a -> b
$
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. NonEmpty a -> [a]
NE.toList (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
"Prelude" HashMap Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
locDic)
        toModuleTarget Text
mName = NonEmpty (LImportDecl GhcPs) -> ModuleTarget
ExistingImp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
mName HashMap Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
locDic
        parensed :: Bool
parensed =
            Text
"(" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.strip (Range -> Text -> Text
textInRange Range
_range Text
txt)
        -- > removeAllDuplicates [1, 1, 2, 3, 2] = [3]
        removeAllDuplicates :: [Text] -> [Text]
removeAllDuplicates = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==Int
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
        hasDuplicate :: [a] -> Bool
hasDuplicate [a]
xs = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Ord a => [a] -> Set a
S.fromList [a]
xs)
        suggestions :: Text -> [Text] -> Bool -> [(Text, [Either TextEdit Rewrite])]
suggestions Text
symbol [Text]
mods Bool
local
          | forall {a}. Ord a => [a] -> Bool
hasDuplicate [Text]
mods = case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Maybe ModuleTarget
toModuleTarget ([Text] -> [Text]
removeAllDuplicates [Text]
mods) of
                                  Just [ModuleTarget]
targets -> Text
-> [(ModuleTarget, [ModuleTarget])]
-> Bool
-> [(Text, [Either TextEdit Rewrite])]
suggestionsImpl Text
symbol (forall a b. (a -> b) -> [a] -> [b]
map (, []) [ModuleTarget]
targets) Bool
local
                                  Maybe [ModuleTarget]
Nothing      -> []
          | Bool
otherwise         = case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Maybe ModuleTarget
toModuleTarget [Text]
mods of
                                  Just [ModuleTarget]
targets -> Text
-> [(ModuleTarget, [ModuleTarget])]
-> Bool
-> [(Text, [Either TextEdit Rewrite])]
suggestionsImpl Text
symbol (forall a. [a] -> [(a, [a])]
oneAndOthers [ModuleTarget]
targets) Bool
local
                                  Maybe [ModuleTarget]
Nothing      -> []
        suggestionsImpl :: Text
-> [(ModuleTarget, [ModuleTarget])]
-> Bool
-> [(Text, [Either TextEdit Rewrite])]
suggestionsImpl Text
symbol [(ModuleTarget, [ModuleTarget])]
targetsWithRestImports Bool
local =
            forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst
            [ ( HidingMode -> Text -> Text -> Bool -> Text
renderUniquify HidingMode
mode Text
modNameText Text
symbol Bool
False
              , Annotated ParsedSource
-> Text
-> Diagnostic
-> Text
-> HidingMode
-> [Either TextEdit Rewrite]
disambiguateSymbol Annotated ParsedSource
ps Text
fileContents Diagnostic
diag Text
symbol HidingMode
mode
              )
            | (ModuleTarget
modTarget, [ModuleTarget]
restImports) <- [(ModuleTarget, [ModuleTarget])]
targetsWithRestImports
            , let modName :: ModuleName
modName = ModuleTarget -> ModuleName
targetModuleName ModuleTarget
modTarget
                  modNameText :: Text
modNameText = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
modName
            , HidingMode
mode <-
                [ Bool -> ModuleName -> HidingMode
ToQualified Bool
parensed ModuleName
qual
                | ExistingImp NonEmpty (LImportDecl GhcPs)
imps <- [ModuleTarget
modTarget]
#if MIN_VERSION_ghc(9,0,0)
                {- HLINT ignore suggestImportDisambiguation "Use nubOrd" -}
                -- TODO: The use of nub here is slow and maybe wrong for UnhelpfulLocation
                -- nubOrd can't be used since SrcSpan is intentionally no Ord
                , L SrcSpanAnnA
_ ModuleName
qual <- forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc)
#else
                , L _ qual <- nubOrd $ mapMaybe (ideclAs . unLoc)
#endif
                    forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcPs)
imps
                ]
                forall a. [a] -> [a] -> [a]
++ [Bool -> ModuleName -> HidingMode
ToQualified Bool
parensed ModuleName
modName
                    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> ImportDecl GhcPs -> Bool
occursUnqualified Text
symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc)
                        (ModuleTarget -> [LImportDecl GhcPs]
targetImports ModuleTarget
modTarget)
                    Bool -> Bool -> Bool
|| case ModuleTarget
modTarget of
                        ImplicitPrelude{} -> Bool
True
                        ModuleTarget
_                 -> Bool
False
                    ]
                forall a. [a] -> [a] -> [a]
++ [[ModuleTarget] -> HidingMode
HideOthers [ModuleTarget]
restImports | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleTarget]
restImports)]
            ] forall a. [a] -> [a] -> [a]
++ [ ( HidingMode -> Text -> Text -> Bool -> Text
renderUniquify HidingMode
mode Text
T.empty Text
symbol Bool
True
              , Annotated ParsedSource
-> Text
-> Diagnostic
-> Text
-> HidingMode
-> [Either TextEdit Rewrite]
disambiguateSymbol Annotated ParsedSource
ps Text
fileContents Diagnostic
diag Text
symbol HidingMode
mode
              ) | Bool
local, Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleTarget, [ModuleTarget])]
targetsWithRestImports)
                , let mode :: HidingMode
mode = [ModuleTarget] -> HidingMode
HideOthers (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (forall a. [a] -> a
head [(ModuleTarget, [ModuleTarget])]
targetsWithRestImports))
            ]
        renderUniquify :: HidingMode -> Text -> Text -> Bool -> Text
renderUniquify HideOthers {} Text
modName Text
symbol Bool
local =
            Text
"Use " forall a. Semigroup a => a -> a -> a
<> (if Bool
local then Text
"local definition" else Text
modName) forall a. Semigroup a => a -> a -> a
<> Text
" for " forall a. Semigroup a => a -> a -> a
<> Text
symbol forall a. Semigroup a => a -> a -> a
<> Text
", hiding other imports"
        renderUniquify (ToQualified Bool
_ ModuleName
qual) Text
_ Text
symbol Bool
_ =
            Text
"Replace with qualified: "
                forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ModuleName -> String
moduleNameString ModuleName
qual)
                forall a. Semigroup a => a -> a -> a
<> Text
"."
                forall a. Semigroup a => a -> a -> a
<> Text
symbol
suggestImportDisambiguation DynFlags
_ Maybe Text
_ Annotated ParsedSource
_ Text
_ Diagnostic
_ = []

occursUnqualified :: T.Text -> ImportDecl GhcPs -> Bool
occursUnqualified :: Text -> ImportDecl GhcPs -> Bool
occursUnqualified Text
symbol ImportDecl{Bool
Maybe (Bool, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
Maybe StringLiteral
ImportDeclQualifiedStyle
XRec GhcPs ModuleName
XCImportDecl GhcPs
SourceText
IsBootInterface
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: XRec GhcPs ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclImplicit :: forall a. ImportDecl a -> Bool
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclSafe :: forall a. ImportDecl a -> Bool
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
..}
    | forall a. Maybe a -> Bool
isNothing Maybe (XRec GhcPs ModuleName)
ideclAs = forall a. a -> Maybe a
Just Bool
False forall a. Eq a => a -> a -> Bool
/=
            -- I don't find this particularly comprehensible,
            -- but HLint suggested me to do so...
#if MIN_VERSION_ghc(9,5,0)
        (ideclImportList <&> \(isHiding, L _ ents) ->
            let occurs = any ((symbol `symbolOccursIn`) . unLoc) ents
            in (isHiding == EverythingBut) && not occurs || (isHiding == Exactly) && occurs
        )
#else
        (Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Bool
isHiding, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcPs)]
ents) ->
            let occurs :: Bool
occurs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text
symbol Text -> IE GhcPs -> Bool
`symbolOccursIn`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (IE GhcPs)]
ents
            in Bool
isHiding Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
occurs Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isHiding Bool -> Bool -> Bool
&& Bool
occurs
        )
#endif
occursUnqualified Text
_ ImportDecl GhcPs
_ = Bool
False

symbolOccursIn :: T.Text -> IE GhcPs -> Bool
symbolOccursIn :: Text -> IE GhcPs -> Bool
symbolOccursIn Text
symb = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== Text
symb)forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> Text
printOutputable) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: Pass). IE (GhcPass p) -> [IdP (GhcPass p)]
ieNames

targetModuleName :: ModuleTarget -> ModuleName
targetModuleName :: ModuleTarget -> ModuleName
targetModuleName ImplicitPrelude{} = String -> ModuleName
mkModuleName String
"Prelude"
targetModuleName (ExistingImp (L SrcSpanAnnA
_ ImportDecl{Bool
Maybe (Bool, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
Maybe StringLiteral
ImportDeclQualifiedStyle
XRec GhcPs ModuleName
XCImportDecl GhcPs
SourceText
IsBootInterface
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: XRec GhcPs ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclImplicit :: forall a. ImportDecl a -> Bool
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclSafe :: forall a. ImportDecl a -> Bool
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
..} :| [LImportDecl GhcPs]
_)) =
    forall l e. GenLocated l e -> e
unLoc XRec GhcPs ModuleName
ideclName
targetModuleName (ExistingImp NonEmpty (LImportDecl GhcPs)
_) =
    forall a. HasCallStack => String -> a
error String
"Cannot happen!"

disambiguateSymbol ::
    Annotated ParsedSource ->
    T.Text ->
    Diagnostic ->
    T.Text ->
    HidingMode ->
    [Either TextEdit Rewrite]
disambiguateSymbol :: Annotated ParsedSource
-> Text
-> Diagnostic
-> Text
-> HidingMode
-> [Either TextEdit Rewrite]
disambiguateSymbol Annotated ParsedSource
ps Text
fileContents Diagnostic {Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..} (Text -> String
T.unpack -> String
symbol) = \case
    (HideOthers [ModuleTarget]
hiddens0) ->
        [ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> LImportDecl GhcPs -> Rewrite
hideSymbol String
symbol GenLocated SrcSpanAnnA (ImportDecl GhcPs)
idecl
        | ExistingImp NonEmpty (LImportDecl GhcPs)
idecls <- [ModuleTarget]
hiddens0
        , GenLocated SrcSpanAnnA (ImportDecl GhcPs)
idecl <- forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcPs)
idecls
        ]
            forall a. [a] -> [a] -> [a]
++ forall a. Monoid a => [a] -> a
mconcat
                [ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LImportDecl GhcPs]
imps
                    then forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewImport
-> Annotated ParsedSource -> Text -> Maybe (Text, TextEdit)
newImportToEdit (Text -> NewImport
hideImplicitPreludeSymbol forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
symbol) Annotated ParsedSource
ps Text
fileContents
                    else forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LImportDecl GhcPs -> Rewrite
hideSymbol String
symbol forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LImportDecl GhcPs]
imps
                | ImplicitPrelude [LImportDecl GhcPs]
imps <- [ModuleTarget]
hiddens0
                ]
    (ToQualified Bool
parensed ModuleName
qualMod) ->
        let occSym :: OccName
occSym = String -> OccName
mkVarOcc String
symbol
            rdr :: RdrName
rdr = ModuleName -> OccName -> RdrName
Qual ModuleName
qualMod OccName
occSym
         in forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ if Bool
parensed
                then forall ast.
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast),
 Outputable (GenLocated (Anno ast) ast),
 Data (GenLocated (Anno ast) ast)) =>
SrcSpan
-> (DynFlags
    -> TransformT (Either String) (GenLocated (Anno ast) ast))
-> Rewrite
Rewrite (NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
"<dummy>" Range
_range) forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
                    forall ast l.
(ASTElement l ast, ExactPrint (LocatedAn l ast)) =>
DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
liftParseAST @(HsExpr GhcPs) DynFlags
df forall a b. (a -> b) -> a -> b
$
                    Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
printOutputable forall a b. (a -> b) -> a -> b
$
                        forall p. XVar p -> LIdP p -> HsExpr p
HsVar @GhcPs NoExtField
noExtField forall a b. (a -> b) -> a -> b
$
                            forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L (FastString -> SrcSpan
mkGeneralSrcSpan  FastString
"") RdrName
rdr
                else forall ast.
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast),
 Outputable (GenLocated (Anno ast) ast),
 Data (GenLocated (Anno ast) ast)) =>
SrcSpan
-> (DynFlags
    -> TransformT (Either String) (GenLocated (Anno ast) ast))
-> Rewrite
Rewrite (NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
"<dummy>" Range
_range) forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
                    forall ast l.
(ASTElement l ast, ExactPrint (LocatedAn l ast)) =>
DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
liftParseAST @RdrName DynFlags
df forall a b. (a -> b) -> a -> b
$
                    Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
printOutputable forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L (FastString -> SrcSpan
mkGeneralSrcSpan  FastString
"") RdrName
rdr
            ]

findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs)
findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs)
findImportDeclByRange [LImportDecl GhcPs]
xs Range
range = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l) ImportDecl GhcPs
_)-> SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
l forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Range
range) [LImportDecl GhcPs]
xs

suggestFixConstructorImport :: Diagnostic -> [(T.Text, TextEdit)]
suggestFixConstructorImport :: Diagnostic -> [(Text, TextEdit)]
suggestFixConstructorImport Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    -- ‘Success’ is a data constructor of ‘Result’
    -- To import it use
    -- import Data.Aeson.Types( Result( Success ) )
    -- or
    -- import Data.Aeson.Types( Result(..) ) (lsp-ui)
  | Just [Text
constructor, Text
typ] <-
    Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message
    Text
"‘([^’]*)’ is a data constructor of ‘([^’]*)’ To import it use"
  = let fixedImport :: Text
fixedImport = Text
typ forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
constructor forall a. Semigroup a => a -> a -> a
<> Text
")"
    in [(Text
"Fix import of " forall a. Semigroup a => a -> a -> a
<> Text
fixedImport, Range -> Text -> TextEdit
TextEdit Range
_range Text
fixedImport)]
  | Bool
otherwise = []

-- | Suggests a constraint for a declaration for which a constraint is missing.
suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]
suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestConstraint DynFlags
df (forall ast. ExactPrint ast => ast -> ast
makeDeltaAst -> ParsedSource
parsedModule) diag :: Diagnostic
diag@Diagnostic {Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
  | Just Text
missingConstraint <- Text -> Maybe Text
findMissingConstraint Text
_message
  = let codeAction :: Diagnostic -> Text -> [(Text, Rewrite)]
codeAction = if Text
_message forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (String
"the type signature for:" :: String)
                        then DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestFunctionConstraint DynFlags
df ParsedSource
parsedModule
                        else DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestInstanceConstraint DynFlags
df ParsedSource
parsedModule
     in Diagnostic -> Text -> [(Text, Rewrite)]
codeAction Diagnostic
diag Text
missingConstraint
  | Bool
otherwise = []
    where
      findMissingConstraint :: T.Text -> Maybe T.Text
      findMissingConstraint :: Text -> Maybe Text
findMissingConstraint Text
t =
        let -- The regex below can be tested at:
            --   https://regex101.com/r/dfSivJ/1
            regex :: Text
regex = Text
"(No instance for|Could not deduce):? (\\((.+)\\)|‘(.+)’|.+) arising from" -- a use of / a do statement

            match :: Maybe [Text]
match = Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
regex

            -- For a string like:
            --   "Could not deduce: ?a::() arising from"
            -- The `matchRegexUnifySpaces` function returns two empty match
            -- groups at the end of the list. It's not clear why this is the
            -- case, so we select the last non-empty match group.
            getCorrectGroup :: [Text] -> Text
getCorrectGroup = forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Text
"")

        in [Text] -> Text
getCorrectGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Text]
match

-- | Suggests a constraint for an instance declaration for which a constraint is missing.
suggestInstanceConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)]

suggestInstanceConstraint :: DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestInstanceConstraint DynFlags
df (L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDecls}) Diagnostic {Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..} Text
missingConstraint
  | Just GenLocated SrcSpanAnnA (HsType GhcPs)
instHead <- Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
instanceHead
  = [(Text -> Text
actionTitle Text
missingConstraint , String -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> String
T.unpack Text
missingConstraint) GenLocated SrcSpanAnnA (HsType GhcPs)
instHead)]
  | Bool
otherwise = []
    where
      instanceHead :: Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
instanceHead
        -- Suggests a constraint for an instance declaration with no existing constraints.
        -- • No instance for (Eq a) arising from a use of ‘==’
        --   Possible fix: add (Eq a) to the context of the instance declaration
        -- • In the expression: x == y
        --   In an equation for ‘==’: (Wrap x) == (Wrap y) = x == y
        --   In the instance declaration for ‘Eq (Wrap a)’
        | Just [Text
instanceDeclaration] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"In the instance declaration for ‘([^`]*)’"
        , Just LHsType GhcPs
instHead <- forall p (p0 :: Pass).
(Outputable (HsType p), p ~ GhcPass p0) =>
DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p)
findInstanceHead DynFlags
df (Text -> String
T.unpack Text
instanceDeclaration) [LHsDecl GhcPs]
hsmodDecls
        = forall a. a -> Maybe a
Just LHsType GhcPs
instHead
        -- Suggests a constraint for an instance declaration with one or more existing constraints.
        -- • Could not deduce (Eq b) arising from a use of ‘==’
        --   from the context: Eq a
        --     bound by the instance declaration at /path/to/Main.hs:7:10-32
        --   Possible fix: add (Eq b) to the context of the instance declaration
        -- • In the second argument of ‘(&&)’, namely ‘x' == y'’
        --   In the expression: x == y && x' == y'
        --   In an equation for ‘==’:
        --       (Pair x x') == (Pair y y') = x == y && x' == y'
        | Just [Text
instanceLineStr, Text
constraintFirstCharStr]
            <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"bound by the instance declaration at .+:([0-9]+):([0-9]+)"
#if !MIN_VERSION_ghc(9,2,0)
        , Just (L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = HsIB{hsib_body}})))
#else
        , Just (L SrcSpanAnnA
_ (InstD XInstD GhcPs
_ (ClsInstD XClsInstD GhcPs
_ ClsInstDecl {cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = (forall l e. GenLocated l e -> e
unLoc -> HsSig{sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
hsib_body})})))
#endif
            <- forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (UInt -> UInt -> Position
Position (Text -> UInt
readPositionNumber Text
instanceLineStr) (Text -> UInt
readPositionNumber Text
constraintFirstCharStr)) [LHsDecl GhcPs]
hsmodDecls
        = forall a. a -> Maybe a
Just LHsType GhcPs
hsib_body
        | Bool
otherwise
        = forall a. Maybe a
Nothing

      readPositionNumber :: T.Text -> UInt
      readPositionNumber :: Text -> UInt
readPositionNumber = Text -> String
T.unpack forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. Read a => String -> a
read @Integer forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. (Integral a, Num b) => a -> b
fromIntegral

      actionTitle :: T.Text -> T.Text
      actionTitle :: Text -> Text
actionTitle Text
constraint = Text
"Add `" forall a. Semigroup a => a -> a -> a
<> Text
constraint
        forall a. Semigroup a => a -> a -> a
<> Text
"` to the context of the instance declaration"

suggestImplicitParameter ::
  ParsedSource ->
  Diagnostic ->
  [(T.Text, Rewrite)]
suggestImplicitParameter :: ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestImplicitParameter (L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDecls}) Diagnostic {Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message, Range
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range}
  | Just [Text
implicitT] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"Unbound implicit parameter \\(([^:]+::.+)\\) arising",
    Just (L SrcSpanAnnA
_ (ValD XValD GhcPs
_ FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L SrcSpanAnnN
_ RdrName
funId})) <- forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
_range) [LHsDecl GhcPs]
hsmodDecls,
#if !MIN_VERSION_ghc(9,2,0)
    Just (TypeSig _ _ HsWC {hswc_body = HsIB {hsib_body}})
#else
    Just (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
_ HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = (forall l e. GenLocated l e -> e
unLoc -> HsSig {sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
hsib_body})})
#endif
      <- forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
(IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDecl (forall a. Eq a => a -> a -> Bool
== RdrName
funId) [LHsDecl GhcPs]
hsmodDecls
    =
      [( Text
"Add " forall a. Semigroup a => a -> a -> a
<> Text
implicitT forall a. Semigroup a => a -> a -> a
<> Text
" to the context of " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RdrName -> String
printRdrName RdrName
funId)
        , String -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> String
T.unpack Text
implicitT) LHsType GhcPs
hsib_body)]
  | Bool
otherwise = []

findTypeSignatureName :: T.Text -> Maybe T.Text
findTypeSignatureName :: Text -> Maybe Text
findTypeSignatureName Text
t = Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
"([^ ]+) :: " forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. [a] -> a
head

-- | Suggests a constraint for a type signature with any number of existing constraints.
suggestFunctionConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)]

suggestFunctionConstraint :: DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestFunctionConstraint DynFlags
df (L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDecls}) Diagnostic {Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..} Text
missingConstraint
-- • No instance for (Eq a) arising from a use of ‘==’
--   Possible fix:
--     add (Eq a) to the context of
--       the type signature for:
--         eq :: forall a. a -> a -> Bool
-- • In the expression: x == y
--   In an equation for ‘eq’: eq x y = x == y

-- • Could not deduce (Eq b) arising from a use of ‘==’
--   from the context: Eq a
--     bound by the type signature for:
--                eq :: forall a b. Eq a => Pair a b -> Pair a b -> Bool
--     at Main.hs:5:1-42
--   Possible fix:
--     add (Eq b) to the context of
--       the type signature for:
--         eq :: forall a b. Eq a => Pair a b -> Pair a b -> Bool
-- • In the second argument of ‘(&&)’, namely ‘y == y'’
--   In the expression: x == x' && y == y'
--   In an equation for ‘eq’:
--       eq (Pair x y) (Pair x' y') = x == x' && y == y'
  | Just Text
typeSignatureName <- Text -> Maybe Text
findTypeSignatureName Text
_message
#if !MIN_VERSION_ghc(9,2,0)
  , Just (TypeSig _ _ HsWC{hswc_body = HsIB {hsib_body = sig}})
#else
  , Just (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
_ HsWC{hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = (forall l e. GenLocated l e -> e
unLoc -> HsSig {sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
sig})})
#endif
    <- forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
(IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDecl ((Text -> String
T.unpack Text
typeSignatureName forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> SDoc -> String
showSDoc DynFlags
df forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> SDoc
ppr) [LHsDecl GhcPs]
hsmodDecls
  , Text
title <- Text -> Text -> Text
actionTitle Text
missingConstraint Text
typeSignatureName
  = [(Text
title, String -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> String
T.unpack Text
missingConstraint) LHsType GhcPs
sig)]
  | Bool
otherwise
  = []
    where
      actionTitle :: T.Text -> T.Text -> T.Text
      actionTitle :: Text -> Text -> Text
actionTitle Text
constraint Text
typeSignatureName = Text
"Add `" forall a. Semigroup a => a -> a -> a
<> Text
constraint
        forall a. Semigroup a => a -> a -> a
<> Text
"` to the context of the type signature for `" forall a. Semigroup a => a -> a -> a
<> Text
typeSignatureName forall a. Semigroup a => a -> a -> a
<> Text
"`"

-- | Suggests the removal of a redundant constraint for a type signature.
removeRedundantConstraints :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]
removeRedundantConstraints :: DynFlags -> ParsedSource -> Diagnostic -> [(Text, Rewrite)]
removeRedundantConstraints DynFlags
df (forall ast. ExactPrint ast => ast -> ast
makeDeltaAst -> L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDecls}) Diagnostic{Maybe Text
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
-- • Redundant constraint: Eq a
-- • In the type signature for:
--      foo :: forall a. Eq a => a -> a
-- • Redundant constraints: (Monoid a, Show a)
-- • In the type signature for:
--      foo :: forall a. (Num a, Monoid a, Eq a, Show a) => a -> Bool
  -- Account for both "Redundant constraint" and "Redundant constraints".
  | Text
"Redundant constraint" Text -> Text -> Bool
`T.isInfixOf` Text
_message
  , Just Text
typeSignatureName <- Text -> Maybe Text
findTypeSignatureName Text
_message
#if !MIN_VERSION_ghc(9,2,0)
  , Just (TypeSig _ _ HsWC{hswc_body = HsIB {hsib_body = sig}})
#else
  , Just (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
_ HsWC{hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = (forall l e. GenLocated l e -> e
unLoc -> HsSig {sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
sig})})
#endif
    <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(forall a.
(Data a, ExactPrint a, Outputable a, HasCallStack) =>
String -> a -> a
traceAst String
"redundantConstraint") forall a b. (a -> b) -> a -> b
$ forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDeclRanged Range
_range [LHsDecl GhcPs]
hsmodDecls
  , Just [Text]
redundantConstraintList <- Text -> Maybe [Text]
findRedundantConstraints Text
_message
  , Rewrite
rewrite <- (LHsType GhcPs -> Bool) -> LHsType GhcPs -> Rewrite
removeConstraint (forall {t :: * -> *} {a}.
(Foldable t, Outputable a) =>
DynFlags -> t Text -> a -> Bool
toRemove DynFlags
df [Text]
redundantConstraintList) LHsType GhcPs
sig
      = [([Text] -> Text -> Text
actionTitle [Text]
redundantConstraintList Text
typeSignatureName, Rewrite
rewrite)]
  | Bool
otherwise = []
    where
      toRemove :: DynFlags -> t Text -> a -> Bool
toRemove DynFlags
df t Text
list a
a = String -> Text
T.pack (DynFlags -> SDoc -> String
showSDoc DynFlags
df (forall a. Outputable a => a -> SDoc
ppr a
a)) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
list

      parseConstraints :: T.Text -> [T.Text]
      parseConstraints :: Text -> [Text]
parseConstraints Text
t = Text
t
        forall a b. a -> (a -> b) -> b
& (Text -> Text
T.strip forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Text
stripConstraintsParens forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Text -> [Text]
T.splitOn Text
",")
        forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
T.strip

      stripConstraintsParens :: T.Text -> T.Text
      stripConstraintsParens :: Text -> Text
stripConstraintsParens Text
constraints =
        if Text
"(" Text -> Text -> Bool
`T.isPrefixOf` Text
constraints
           then Text
constraints forall a b. a -> (a -> b) -> b
& Int -> Text -> Text
T.drop Int
1 forall a b. a -> (a -> b) -> b
& Int -> Text -> Text
T.dropEnd Int
1 forall a b. a -> (a -> b) -> b
& Text -> Text
T.strip
           else Text
constraints

{-
9.2: "message": "/private/var/folders/4m/d38fhm3936x_gy_9883zbq8h0000gn/T/extra-dir-53173393699/Testing.hs:4:1: warning:
    ⢠Redundant constraints: (Eq a, Show a)
    ⢠In the type signature for:
               foo :: forall a. (Eq a, Show a) => a -> Bool",

9.0: "message": "⢠Redundant constraints: (Eq a, Show a)
    ⢠In the type signature for:
           foo :: forall a. (Eq a, Show a) => a -> Bool",
-}
      findRedundantConstraints :: T.Text -> Maybe [T.Text]
      findRedundantConstraints :: Text -> Maybe [Text]
findRedundantConstraints Text
t = Text
t
        forall a b. a -> (a -> b) -> b
& Text -> [Text]
T.lines
        -- In <9.2 it's the first line, in 9.2 it' the second line
        forall a b. a -> (a -> b) -> b
& forall a. Int -> [a] -> [a]
take Int
2
        forall a b. a -> (a -> b) -> b
& forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Text -> Text -> Maybe [Text]
`matchRegexUnifySpaces` Text
"Redundant constraints?: (.+)") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip)
        forall a b. a -> (a -> b) -> b
& forall a. [a] -> Maybe a
listToMaybe
        forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall a. [a] -> a
head forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> [Text]
parseConstraints)

      formatConstraints :: [T.Text] -> T.Text
      formatConstraints :: [Text] -> Text
formatConstraints [] = Text
""
      formatConstraints [Text
constraint] = Text
constraint
      formatConstraints [Text]
constraintList = [Text]
constraintList
        forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
", "
        forall a b. a -> (a -> b) -> b
& \Text
cs -> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
cs forall a. Semigroup a => a -> a -> a
<> Text
")"

      actionTitle :: [T.Text] -> T.Text -> T.Text
      actionTitle :: [Text] -> Text -> Text
actionTitle [Text]
constraintList Text
typeSignatureName =
        Text
"Remove redundant constraint" forall a. Semigroup a => a -> a -> a
<> (if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
constraintList forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"s") forall a. Semigroup a => a -> a -> a
<> Text
" `"
        forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
formatConstraints [Text]
constraintList
        forall a. Semigroup a => a -> a -> a
<> Text
"` from the context of the type signature for `" forall a. Semigroup a => a -> a -> a
<> Text
typeSignatureName forall a. Semigroup a => a -> a -> a
<> Text
"`"

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

suggestNewOrExtendImportForClassMethod :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])]
suggestNewOrExtendImportForClassMethod :: ExportsMap
-> Annotated ParsedSource
-> Text
-> Diagnostic
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
suggestNewOrExtendImportForClassMethod ExportsMap
packageExportsMap Annotated ParsedSource
ps Text
fileContents Diagnostic {Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message}
  | Just [Text
methodName, Text
className] <-
      Text -> Text -> Maybe [Text]
matchRegexUnifySpaces
        Text
_message
        Text
"‘([^’]*)’ is not a \\(visible\\) method of class ‘([^’]*)’",
    [IdentInfo]
idents <-
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. HashSet a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> HashSet a -> HashSet a
Set.filter (\IdentInfo
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OccName -> Text
occNameText (IdentInfo -> Maybe OccName
parent IdentInfo
x) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
className)) forall a b. (a -> b) -> a -> b
$
        forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv (ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap ExportsMap
packageExportsMap) (Text -> OccName
mkVarOrDataOcc Text
methodName) =
    forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ IdentInfo -> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
suggest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IdentInfo]
idents
  | Bool
otherwise = []
  where
    suggest :: IdentInfo -> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
suggest IdentInfo
identInfo
      | [ImportStyle]
importStyle <- forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo
identInfo,
        Maybe (LImportDecl GhcPs)
mImportDecl <- [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName (HsModule -> [LImportDecl GhcPs]
hsmodImports forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ast. Annotated ast -> ast
astA forall a b. (a -> b) -> a -> b
$ Annotated ParsedSource
ps) (Text -> String
T.unpack Text
moduleText) =
        case Maybe (LImportDecl GhcPs)
mImportDecl of
          -- extend
          Just LImportDecl GhcPs
decl ->
            [ ( Text
"Add " forall a. Semigroup a => a -> a -> a
<> ImportStyle -> Text
renderImportStyle ImportStyle
style forall a. Semigroup a => a -> a -> a
<> Text
" to the import list of " forall a. Semigroup a => a -> a -> a
<> Text
moduleText,
                Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"extend" ImportStyle
style,
                [forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe String -> String -> LImportDecl GhcPs -> Rewrite
extendImport (ImportStyle -> (Maybe String, String)
unImportStyle ImportStyle
style) LImportDecl GhcPs
decl]
              )
              | ImportStyle
style <- [ImportStyle]
importStyle
            ]
          -- new
          Maybe (LImportDecl GhcPs)
_
            | Just (Range
range, Int
indent) <- Annotated ParsedSource -> Text -> Maybe (Range, Int)
newImportInsertRange Annotated ParsedSource
ps Text
fileContents
            ->
             (\(CodeActionKind
kind, NewImport -> Text
unNewImport -> Text
x) -> (Text
x, CodeActionKind
kind, [forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Range -> Text -> TextEdit
TextEdit Range
range (Text
x forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
indent Text
" ")])) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            [ (Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"new" ImportStyle
style, Text -> Text -> Bool -> NewImport
newUnqualImport Text
moduleText Text
rendered Bool
False)
              | ImportStyle
style <- [ImportStyle]
importStyle,
                let rendered :: Text
rendered = ImportStyle -> Text
renderImportStyle ImportStyle
style
            ]
              forall a. Semigroup a => a -> a -> a
<> [(Text -> CodeActionKind
quickFixImportKind Text
"new.all", Text -> NewImport
newImportAll Text
moduleText)]
            | Bool
otherwise -> []
        where moduleText :: Text
moduleText = IdentInfo -> Text
moduleNameText IdentInfo
identInfo

suggestNewImport :: DynFlags -> ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]
suggestNewImport :: DynFlags
-> ExportsMap
-> Annotated ParsedSource
-> Text
-> Diagnostic
-> [(Text, CodeActionKind, TextEdit)]
suggestNewImport DynFlags
df ExportsMap
packageExportsMap Annotated ParsedSource
ps Text
fileContents Diagnostic{Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message}
  | Text
msg <- Text -> Text
unifySpaces Text
_message
  , Just NotInScope
thingMissing <- Text -> Maybe NotInScope
extractNotInScopeName Text
msg
  , Maybe Text
qual <- Text -> Maybe Text
extractQualifiedModuleName Text
msg
  , Maybe Text
qual' <-
      Text -> Maybe Text
extractDoesNotExportModuleName Text
msg
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
hsmodImports forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc
        forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc
  , Just (Range
range, Int
indent) <- Annotated ParsedSource -> Text -> Maybe (Range, Int)
newImportInsertRange Annotated ParsedSource
ps Text
fileContents
  , Maybe [Text]
extendImportSuggestions <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
msg
    Text
"Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"
  = let qis :: QualifiedImportStyle
qis = DynFlags -> QualifiedImportStyle
qualifiedImportStyle DynFlags
df
        suggestions :: [ImportSuggestion]
suggestions = forall a. (a -> a -> Ordering) -> [a] -> [a]
nubSortBy ImportSuggestion -> ImportSuggestion -> Ordering
simpleCompareImportSuggestion
          (ExportsMap
-> (Maybe Text, NotInScope)
-> Maybe [Text]
-> QualifiedImportStyle
-> [ImportSuggestion]
constructNewImportSuggestions ExportsMap
packageExportsMap (Maybe Text
qual forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
qual', NotInScope
thingMissing) Maybe [Text]
extendImportSuggestions QualifiedImportStyle
qis) in
    forall a b. (a -> b) -> [a] -> [b]
map (\(ImportSuggestion Int
_ CodeActionKind
kind (NewImport -> Text
unNewImport -> Text
imp)) -> (Text
imp, CodeActionKind
kind, Range -> Text -> TextEdit
TextEdit Range
range (Text
imp forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
indent Text
" "))) [ImportSuggestion]
suggestions
  where
    L SrcSpan
_ HsModule {[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (LocatedP WarningTxt)
Maybe (LocatedA ModuleName)
Maybe (LocatedL [LIE GhcPs])
Maybe LHsDocString
EpAnn AnnsModule
LayoutInfo
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (LocatedP WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodExports :: Maybe (LocatedL [LIE GhcPs])
hsmodName :: Maybe (LocatedA ModuleName)
hsmodLayout :: LayoutInfo
hsmodAnn :: EpAnn AnnsModule
hsmodImports :: [LImportDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDeprecMessage :: HsModule -> Maybe (LocatedP WarningTxt)
hsmodExports :: HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodHaddockModHeader :: HsModule -> Maybe LHsDocString
hsmodLayout :: HsModule -> LayoutInfo
hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodAnn :: HsModule -> EpAnn AnnsModule
..} = forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps
suggestNewImport DynFlags
_ ExportsMap
_ Annotated ParsedSource
_ Text
_ Diagnostic
_ = []

constructNewImportSuggestions
  :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> QualifiedImportStyle -> [ImportSuggestion]
constructNewImportSuggestions :: ExportsMap
-> (Maybe Text, NotInScope)
-> Maybe [Text]
-> QualifiedImportStyle
-> [ImportSuggestion]
constructNewImportSuggestions ExportsMap
exportsMap (Maybe Text
qual, NotInScope
thingMissing) Maybe [Text]
notTheseModules QualifiedImportStyle
qis = forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy ImportSuggestion -> ImportSuggestion -> Ordering
simpleCompareImportSuggestion
  [ ImportSuggestion
suggestion
  | Just Text
name <- [Text -> Text -> Maybe Text
T.stripPrefix (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall a. Semigroup a => a -> a -> a
<> Text
".") Maybe Text
qual) forall a b. (a -> b) -> a -> b
$ NotInScope -> Text
notInScope NotInScope
thingMissing] -- strip away qualified module names from the unknown name
  , IdentInfo
identInfo <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. HashSet a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ (forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv (ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap ExportsMap
exportsMap) (Text -> OccName
mkVarOrDataOcc Text
name)) forall a. Semigroup a => a -> a -> a
<> (forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv (ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap ExportsMap
exportsMap) (Text -> OccName
mkTypeOcc Text
name)) -- look up the modified unknown name in the export map
  , NotInScope -> IdentInfo -> Bool
canUseIdent NotInScope
thingMissing IdentInfo
identInfo                                              -- check if the identifier information retrieved can be used
  , IdentInfo -> Text
moduleNameText IdentInfo
identInfo forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
notTheseModules                 -- check if the module of the identifier is allowed
  , ImportSuggestion
suggestion <- IdentInfo -> [ImportSuggestion]
renderNewImport IdentInfo
identInfo                                         -- creates a list of import suggestions for the retrieved identifier information
  ]
 where
  renderNewImport :: IdentInfo -> [ImportSuggestion]
  renderNewImport :: IdentInfo -> [ImportSuggestion]
renderNewImport IdentInfo
identInfo
    | Just Text
q <- Maybe Text
qual
    = [Int -> CodeActionKind -> NewImport -> ImportSuggestion
ImportSuggestion Int
importanceScore (Text -> CodeActionKind
quickFixImportKind Text
"new.qualified") (Text -> Text -> QualifiedImportStyle -> NewImport
newQualImport Text
m Text
q QualifiedImportStyle
qis)]
    | Bool
otherwise
    = [Int -> CodeActionKind -> NewImport -> ImportSuggestion
ImportSuggestion Int
importanceScore (Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"new" ImportStyle
importStyle) (Text -> Text -> Bool -> NewImport
newUnqualImport Text
m (ImportStyle -> Text
renderImportStyle ImportStyle
importStyle) Bool
False)
      | ImportStyle
importStyle <- forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo
identInfo] forall a. [a] -> [a] -> [a]
++
      [Int -> CodeActionKind -> NewImport -> ImportSuggestion
ImportSuggestion Int
importanceScore (Text -> CodeActionKind
quickFixImportKind Text
"new.all") (Text -> NewImport
newImportAll Text
m)]
    where
        -- The importance score takes 2 metrics into account. The first being the similarity using
        -- the Text.Fuzzy.Parallel.match function. The second is a factor of the relation between
        -- the modules prefix import suggestion and the unknown identifier names.
        importanceScore :: Int
importanceScore
          | Just Text
q <- Maybe Text
qual
          = let
              similarityScore :: Double
similarityScore = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall {a}. Num a => Maybe a -> a
unpackMatchScore (Text -> Text -> Maybe Int
TFP.match (Text -> Text
T.toLower Text
q) (Text -> Text
T.toLower Text
m)) :: Double
              (Double
maxLength, Double
minLength) = case (Text -> Int
T.length Text
q, Text -> Int
T.length Text
m) of
                 (Int
la, Int
lb)
                   | Int
la forall a. Ord a => a -> a -> Bool
>= Int
lb -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
la, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lb)
                   | Bool
otherwise -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lb, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
la)
              lengthPenaltyFactor :: Double
lengthPenaltyFactor = Double
100 forall a. Num a => a -> a -> a
* Double
minLength forall a. Fractional a => a -> a -> a
/ Double
maxLength
            in forall a. Ord a => a -> a -> a
max Int
0 (forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
similarityScore forall a. Num a => a -> a -> a
* Double
lengthPenaltyFactor))
          | Bool
otherwise
          = Int
0
          where
            unpackMatchScore :: Maybe a -> a
unpackMatchScore Maybe a
pScore
              | Just a
score <- Maybe a
pScore = a
score
              | Bool
otherwise = a
0
        m :: Text
m = IdentInfo -> Text
moduleNameText IdentInfo
identInfo

data ImportSuggestion = ImportSuggestion !Int !CodeActionKind !NewImport
  deriving ( ImportSuggestion -> ImportSuggestion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportSuggestion -> ImportSuggestion -> Bool
$c/= :: ImportSuggestion -> ImportSuggestion -> Bool
== :: ImportSuggestion -> ImportSuggestion -> Bool
$c== :: ImportSuggestion -> ImportSuggestion -> Bool
Eq )

-- | Implements a lexicographic order for import suggestions that ignores the code action.
-- First it compares the importance score in DESCENDING order.
-- If the scores are equal it compares the import names alphabetical order.
--
-- TODO: this should be a correct Ord instance but CodeActionKind does not implement a Ord
-- which would lead to an unlawful Ord instance.
simpleCompareImportSuggestion :: ImportSuggestion -> ImportSuggestion -> Ordering
simpleCompareImportSuggestion :: ImportSuggestion -> ImportSuggestion -> Ordering
simpleCompareImportSuggestion (ImportSuggestion Int
s1 CodeActionKind
_ NewImport
i1) (ImportSuggestion Int
s2 CodeActionKind
_ NewImport
i2)
  = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare Int
s1 Int
s2 forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare NewImport
i1 NewImport
i2

newtype NewImport = NewImport {NewImport -> Text
unNewImport :: T.Text}
  deriving (Int -> NewImport -> ShowS
[NewImport] -> ShowS
NewImport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewImport] -> ShowS
$cshowList :: [NewImport] -> ShowS
show :: NewImport -> String
$cshow :: NewImport -> String
showsPrec :: Int -> NewImport -> ShowS
$cshowsPrec :: Int -> NewImport -> ShowS
Show, NewImport -> NewImport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewImport -> NewImport -> Bool
$c/= :: NewImport -> NewImport -> Bool
== :: NewImport -> NewImport -> Bool
$c== :: NewImport -> NewImport -> Bool
Eq, Eq NewImport
NewImport -> NewImport -> Bool
NewImport -> NewImport -> Ordering
NewImport -> NewImport -> NewImport
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NewImport -> NewImport -> NewImport
$cmin :: NewImport -> NewImport -> NewImport
max :: NewImport -> NewImport -> NewImport
$cmax :: NewImport -> NewImport -> NewImport
>= :: NewImport -> NewImport -> Bool
$c>= :: NewImport -> NewImport -> Bool
> :: NewImport -> NewImport -> Bool
$c> :: NewImport -> NewImport -> Bool
<= :: NewImport -> NewImport -> Bool
$c<= :: NewImport -> NewImport -> Bool
< :: NewImport -> NewImport -> Bool
$c< :: NewImport -> NewImport -> Bool
compare :: NewImport -> NewImport -> Ordering
$ccompare :: NewImport -> NewImport -> Ordering
Ord)

newImportToEdit :: NewImport -> Annotated ParsedSource -> T.Text -> Maybe (T.Text, TextEdit)
newImportToEdit :: NewImport
-> Annotated ParsedSource -> Text -> Maybe (Text, TextEdit)
newImportToEdit (NewImport -> Text
unNewImport -> Text
imp) Annotated ParsedSource
ps Text
fileContents
  | Just (Range
range, Int
indent) <- Annotated ParsedSource -> Text -> Maybe (Range, Int)
newImportInsertRange Annotated ParsedSource
ps Text
fileContents
  = forall a. a -> Maybe a
Just (Text
imp, Range -> Text -> TextEdit
TextEdit Range
range (Text
imp forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
indent Text
" "))
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Finds the next valid position for inserting a new import declaration
-- * If the file already has existing imports it will be inserted under the last of these,
-- it is assumed that the existing last import declaration is in a valid position
-- * If the file does not have existing imports, but has a (module ... where) declaration,
-- the new import will be inserted directly under this declaration (accounting for explicit exports)
-- * If the file has neither existing imports nor a module declaration,
-- the import will be inserted at line zero if there are no pragmas,
-- * otherwise inserted one line after the last file-header pragma
newImportInsertRange :: Annotated ParsedSource -> T.Text -> Maybe (Range, Int)
newImportInsertRange :: Annotated ParsedSource -> Text -> Maybe (Range, Int)
newImportInsertRange Annotated ParsedSource
ps Text
fileContents
  |  Just ((Int
l, Int
c), Int
col) <- case [LImportDecl GhcPs]
hsmodImports of
      -- When there is no existing imports, we only cares about the line number, setting column and indent to zero.
      [] -> (\Int
line -> ((Int
line, Int
0), Int
0)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotated ParsedSource -> Text -> Maybe Int
findPositionNoImports Annotated ParsedSource
ps Text
fileContents
      [LImportDecl GhcPs]
_  -> forall a t.
HasSrcSpan a =>
t -> (t -> a) -> Maybe ((Int, Int), Int)
findPositionFromImports (forall a b. (a -> b) -> [a] -> [b]
map forall a e. LocatedAn a e -> Located e
reLoc [LImportDecl GhcPs]
hsmodImports) forall a. [a] -> a
last
  , let insertPos :: Position
insertPos = UInt -> UInt -> Position
Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c)
    = forall a. a -> Maybe a
Just (Position -> Position -> Range
Range Position
insertPos Position
insertPos, Int
col)
  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    L SrcSpan
_ HsModule {[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (LocatedP WarningTxt)
Maybe (LocatedA ModuleName)
Maybe (LocatedL [LIE GhcPs])
Maybe LHsDocString
EpAnn AnnsModule
LayoutInfo
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (LocatedP WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodExports :: Maybe (LocatedL [LIE GhcPs])
hsmodName :: Maybe (LocatedA ModuleName)
hsmodLayout :: LayoutInfo
hsmodAnn :: EpAnn AnnsModule
hsmodImports :: [LImportDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDeprecMessage :: HsModule -> Maybe (LocatedP WarningTxt)
hsmodExports :: HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodHaddockModHeader :: HsModule -> Maybe LHsDocString
hsmodLayout :: HsModule -> LayoutInfo
hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodAnn :: HsModule -> EpAnn AnnsModule
..} = forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps

-- | Find the position for a new import when there isn't an existing one.
-- * If there is a module declaration, a new import should be inserted under the module declaration (including exports list)
-- * Otherwise, a new import should be inserted after any file-header pragma.
findPositionNoImports :: Annotated ParsedSource -> T.Text -> Maybe Int
findPositionNoImports :: Annotated ParsedSource -> Text -> Maybe Int
findPositionNoImports Annotated ParsedSource
ps Text
fileContents =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just (Text -> Int
findNextPragmaPosition Text
fileContents)) (Annotated ParsedSource -> LocatedA ModuleName -> Maybe Int
findPositionAfterModuleName Annotated ParsedSource
ps) Maybe (LocatedA ModuleName)
hsmodName
  where
    L SrcSpan
_ HsModule {[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (LocatedP WarningTxt)
Maybe (LocatedA ModuleName)
Maybe (LocatedL [LIE GhcPs])
Maybe LHsDocString
EpAnn AnnsModule
LayoutInfo
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (LocatedP WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (LocatedL [LIE GhcPs])
hsmodLayout :: LayoutInfo
hsmodAnn :: EpAnn AnnsModule
hsmodName :: Maybe (LocatedA ModuleName)
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDeprecMessage :: HsModule -> Maybe (LocatedP WarningTxt)
hsmodExports :: HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodHaddockModHeader :: HsModule -> Maybe LHsDocString
hsmodLayout :: HsModule -> LayoutInfo
hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodAnn :: HsModule -> EpAnn AnnsModule
..} = forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps

-- | find line number right after module ... where
findPositionAfterModuleName :: Annotated ParsedSource
                            -> LocatedA ModuleName
                            -> Maybe Int
findPositionAfterModuleName :: Annotated ParsedSource -> LocatedA ModuleName -> Maybe Int
findPositionAfterModuleName Annotated ParsedSource
ps LocatedA ModuleName
hsmodName' = do
    -- Note that 'where' keyword and comments are not part of the AST. They belongs to
    -- the exact-print information. To locate it, we need to find the previous AST node,
    -- calculate the gap between it and 'where', then add them up to produce the absolute
    -- position of 'where'.

    Int
lineOffset <- Maybe Int
whereKeywordLineOffset -- Calculate the gap before 'where' keyword.
    case SrcSpan
prevSrcSpan of
        UnhelpfulSpan UnhelpfulSpanReason
_ -> forall a. Maybe a
Nothing
        (RealSrcSpan RealSrcSpan
prevSrcSpan' Maybe BufSpan
_) ->
            -- add them up produce the absolute location of 'where' keyword
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RealSrcLoc -> Int
srcLocLine (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
prevSrcSpan') forall a. Num a => a -> a -> a
+ Int
lineOffset
  where
    L SrcSpan
_ HsModule {[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (LocatedP WarningTxt)
Maybe (LocatedA ModuleName)
Maybe (LocatedL [LIE GhcPs])
Maybe LHsDocString
EpAnn AnnsModule
LayoutInfo
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (LocatedP WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (LocatedL [LIE GhcPs])
hsmodName :: Maybe (LocatedA ModuleName)
hsmodLayout :: LayoutInfo
hsmodAnn :: EpAnn AnnsModule
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDeprecMessage :: HsModule -> Maybe (LocatedP WarningTxt)
hsmodExports :: HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodHaddockModHeader :: HsModule -> Maybe LHsDocString
hsmodLayout :: HsModule -> LayoutInfo
hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodAnn :: HsModule -> EpAnn AnnsModule
..} = forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps

    -- The last AST node before 'where' keyword. Might be module name or export list.
    prevSrcSpan :: SrcSpan
prevSrcSpan = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasSrcSpan a => a -> SrcSpan
getLoc LocatedA ModuleName
hsmodName') forall a. HasSrcSpan a => a -> SrcSpan
getLoc Maybe (LocatedL [LIE GhcPs])
hsmodExports

    -- The relative position of 'where' keyword (in lines, relative to the previous AST node).
    -- The exact-print API changed a lot in ghc-9.2, so we need to handle it separately for different compiler versions.
    whereKeywordLineOffset :: Maybe Int
#if MIN_VERSION_ghc(9,2,0)
#if MIN_VERSION_ghc(9,5,0)
    whereKeywordLineOffset = case hsmodAnn hsmodExt of
#else
    whereKeywordLineOffset :: Maybe Int
whereKeywordLineOffset = case EpAnn AnnsModule
hsmodAnn of
#endif
        EpAnn Anchor
_ AnnsModule
annsModule EpAnnComments
_ -> do
            -- Find the first 'where'
            EpaLocation
whereLocation <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NonEmpty a -> a
NE.head forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AddEpAnn -> Maybe EpaLocation
filterWhere forall b c a. (b -> c) -> (a -> b) -> a -> c
.  AnnsModule -> [AddEpAnn]
am_main forall a b. (a -> b) -> a -> b
$ AnnsModule
annsModule
            EpaLocation -> Maybe Int
epaLocationToLine EpaLocation
whereLocation
        EpAnn AnnsModule
EpAnnNotUsed -> forall a. Maybe a
Nothing
    filterWhere :: AddEpAnn -> Maybe EpaLocation
filterWhere (AddEpAnn AnnKeywordId
AnnWhere EpaLocation
loc) = forall a. a -> Maybe a
Just EpaLocation
loc
    filterWhere AddEpAnn
_                       = forall a. Maybe a
Nothing

    epaLocationToLine :: EpaLocation -> Maybe Int
#if MIN_VERSION_ghc(9,5,0)
    epaLocationToLine (EpaSpan sp _)
#else
    epaLocationToLine :: EpaLocation -> Maybe Int
epaLocationToLine (EpaSpan RealSrcSpan
sp)
#endif
      = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcLoc -> Int
srcLocLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> RealSrcLoc
realSrcSpanEnd forall a b. (a -> b) -> a -> b
$ RealSrcSpan
sp
    epaLocationToLine (EpaDelta (SameLine Int
_) [LEpaComment]
priorComments) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [LEpaComment] -> Int
sumCommentsOffset [LEpaComment]
priorComments
    -- 'priorComments' contains the comments right before the current EpaLocation
    -- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and
    -- the current AST node
    epaLocationToLine (EpaDelta (DifferentLine Int
line Int
_) [LEpaComment]
priorComments) = forall a. a -> Maybe a
Just (Int
line forall a. Num a => a -> a -> a
+ [LEpaComment] -> Int
sumCommentsOffset [LEpaComment]
priorComments)

    sumCommentsOffset :: [LEpaComment] -> Int
    sumCommentsOffset :: [LEpaComment] -> Int
sumCommentsOffset = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(L Anchor
anchor EpaComment
_) -> AnchorOperation -> Int
anchorOpLine (Anchor -> AnchorOperation
anchor_op Anchor
anchor))

    anchorOpLine :: AnchorOperation -> Int
    anchorOpLine :: AnchorOperation -> Int
anchorOpLine AnchorOperation
UnchangedAnchor                      = Int
0
    anchorOpLine (MovedAnchor (SameLine Int
_))           = Int
0
    anchorOpLine (MovedAnchor (DifferentLine Int
line Int
_)) = Int
line
#else
    whereKeywordLineOffset = do
        ann <- annsA ps M.!? mkAnnKey (astA ps)
        deltaPos <- fmap NE.head . NE.nonEmpty .mapMaybe filterWhere $ annsDP ann
        pure $ deltaRow deltaPos

    -- Before ghc 9.2, DeltaPos doesn't take comment into account, so we don't need to sum line offset of comments.
    filterWhere :: (KeywordId, DeltaPos) -> Maybe DeltaPos
    filterWhere (keywordId, deltaPos) =
        if keywordId == G AnnWhere then Just deltaPos else Nothing
#endif

findPositionFromImports :: HasSrcSpan a => t -> (t -> a) -> Maybe ((Int, Int), Int)
findPositionFromImports :: forall a t.
HasSrcSpan a =>
t -> (t -> a) -> Maybe ((Int, Int), Int)
findPositionFromImports t
hsField t -> a
f = case forall a. HasSrcSpan a => a -> SrcSpan
getLoc (t -> a
f t
hsField) of
  RealSrcSpan RealSrcSpan
s Maybe BufSpan
_ ->
    let col :: Int
col = RealSrcSpan -> Int
calcCol RealSrcSpan
s
     in forall a. a -> Maybe a
Just ((RealSrcLoc -> Int
srcLocLine (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
s), Int
col), Int
col)
  SrcSpan
_ -> forall a. Maybe a
Nothing
  where calcCol :: RealSrcSpan -> Int
calcCol RealSrcSpan
s = RealSrcLoc -> Int
srcLocCol (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
s) forall a. Num a => a -> a -> a
- Int
1

-- | Find the position one after the last file-header pragma
-- Defaults to zero if there are no pragmas in file
findNextPragmaPosition :: T.Text -> Int
findNextPragmaPosition :: Text -> Int
findNextPragmaPosition Text
contents = Int
lineNumber
  where
    lineNumber :: Int
lineNumber = Int -> Int
afterLangPragma forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
afterOptsGhc forall a b. (a -> b) -> a -> b
$ Int
afterShebang
    afterLangPragma :: Int -> Int
afterLangPragma = Text -> [Text] -> Int -> Int
afterPragma Text
"LANGUAGE" [Text]
contents'
    afterOptsGhc :: Int -> Int
afterOptsGhc = Text -> [Text] -> Int -> Int
afterPragma Text
"OPTIONS_GHC" [Text]
contents'
    afterShebang :: Int
afterShebang = (Text -> Bool) -> [Text] -> Int -> Int
lastLineWithPrefix (Text -> Text -> Bool
T.isPrefixOf Text
"#!") [Text]
contents' Int
0
    contents' :: [Text]
contents' = Text -> [Text]
T.lines Text
contents

afterPragma :: T.Text -> [T.Text] -> Int -> Int
afterPragma :: Text -> [Text] -> Int -> Int
afterPragma Text
name [Text]
contents Int
lineNum = (Text -> Bool) -> [Text] -> Int -> Int
lastLineWithPrefix (Text -> Text -> Bool
checkPragma Text
name) [Text]
contents Int
lineNum

lastLineWithPrefix :: (T.Text -> Bool) -> [T.Text] -> Int -> Int
lastLineWithPrefix :: (Text -> Bool) -> [Text] -> Int -> Int
lastLineWithPrefix Text -> Bool
p [Text]
contents Int
lineNum = forall a. Ord a => a -> a -> a
max Int
lineNum Int
next
  where
    next :: Int
next = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
lineNum forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [Int]
findIndices Text -> Bool
p [Text]
contents

checkPragma :: T.Text -> T.Text -> Bool
checkPragma :: Text -> Text -> Bool
checkPragma Text
name = Text -> Bool
check
  where
    check :: Text -> Bool
check Text
l = Text -> Bool
isPragma Text
l Bool -> Bool -> Bool
&& Text -> Text
getName Text
l forall a. Eq a => a -> a -> Bool
== Text
name
    getName :: Text -> Text
getName Text
l = Int -> Text -> Text
T.take (Text -> Int
T.length Text
name) forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
3 Text
l
    isPragma :: Text -> Bool
isPragma = Text -> Text -> Bool
T.isPrefixOf Text
"{-#"

-- | Construct an import declaration with at most one symbol
newImport
  :: T.Text -- ^ module name
  -> Maybe T.Text -- ^  the symbol
  -> Maybe (T.Text, QualifiedImportStyle) -- ^ qualified name and style
  -> Bool -- ^ the symbol is to be imported or hidden
  -> NewImport
newImport :: Text
-> Maybe Text
-> Maybe (Text, QualifiedImportStyle)
-> Bool
-> NewImport
newImport Text
modName Maybe Text
mSymbol Maybe (Text, QualifiedImportStyle)
mQualNameStyle Bool
hiding = Text -> NewImport
NewImport Text
impStmt
  where
     symImp :: Text
symImp
            | Just Text
symbol <- Maybe Text
mSymbol
              , OccName
symOcc <- String -> OccName
mkVarOcc forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
symbol =
              Text
" (" forall a. Semigroup a => a -> a -> a
<> forall a. Outputable a => a -> Text
printOutputable (OccName -> SDoc -> SDoc
parenSymOcc OccName
symOcc forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr OccName
symOcc) forall a. Semigroup a => a -> a -> a
<> Text
")"
            | Bool
otherwise = Text
""
     impStmt :: Text
impStmt =
       Text
"import "
         forall a. Semigroup a => a -> a -> a
<> Maybe QualifiedImportStyle -> Text
qualifiedModName (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, QualifiedImportStyle)
mQualNameStyle)
         forall a. Semigroup a => a -> a -> a
<> (if Bool
hiding then Text
" hiding" else Text
"")
         forall a. Semigroup a => a -> a -> a
<> Text
symImp
         forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
qual -> if Text
modName forall a. Eq a => a -> a -> Bool
== Text
qual then Text
"" else Text
" as " forall a. Semigroup a => a -> a -> a
<> Text
qual) Maybe Text
mQual
     mQual :: Maybe Text
mQual = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, QualifiedImportStyle)
mQualNameStyle
     qualifiedModName :: Maybe QualifiedImportStyle -> Text
qualifiedModName Maybe QualifiedImportStyle
Nothing                       = Text
modName
     qualifiedModName (Just QualifiedImportStyle
QualifiedImportPrefix)  = Text
"qualified " forall a. Semigroup a => a -> a -> a
<> Text
modName
     qualifiedModName (Just QualifiedImportStyle
QualifiedImportPostfix) = Text
modName forall a. Semigroup a => a -> a -> a
<> Text
" qualified"


newQualImport :: T.Text -> T.Text -> QualifiedImportStyle -> NewImport
newQualImport :: Text -> Text -> QualifiedImportStyle -> NewImport
newQualImport Text
modName Text
qual QualifiedImportStyle
qis = Text
-> Maybe Text
-> Maybe (Text, QualifiedImportStyle)
-> Bool
-> NewImport
newImport Text
modName forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (Text
qual, QualifiedImportStyle
qis)) Bool
False

newUnqualImport :: T.Text -> T.Text -> Bool -> NewImport
newUnqualImport :: Text -> Text -> Bool -> NewImport
newUnqualImport Text
modName Text
symbol = Text
-> Maybe Text
-> Maybe (Text, QualifiedImportStyle)
-> Bool
-> NewImport
newImport Text
modName (forall a. a -> Maybe a
Just Text
symbol) forall a. Maybe a
Nothing

newImportAll :: T.Text -> NewImport
newImportAll :: Text -> NewImport
newImportAll Text
modName = Text
-> Maybe Text
-> Maybe (Text, QualifiedImportStyle)
-> Bool
-> NewImport
newImport Text
modName forall a. Maybe a
Nothing forall a. Maybe a
Nothing Bool
False

hideImplicitPreludeSymbol :: T.Text -> NewImport
hideImplicitPreludeSymbol :: Text -> NewImport
hideImplicitPreludeSymbol Text
symbol = Text -> Text -> Bool -> NewImport
newUnqualImport Text
"Prelude" Text
symbol Bool
True

canUseIdent :: NotInScope -> IdentInfo -> Bool
canUseIdent :: NotInScope -> IdentInfo -> Bool
canUseIdent NotInScopeDataConstructor{}        = IdentInfo -> Bool
isDatacon
canUseIdent NotInScopeTypeConstructorOrClass{} = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> Bool
isDatacon
canUseIdent NotInScope
_                                  = forall a b. a -> b -> a
const Bool
True

data NotInScope
    = NotInScopeDataConstructor T.Text
    | NotInScopeTypeConstructorOrClass T.Text
    | NotInScopeThing T.Text
    deriving Int -> NotInScope -> ShowS
[NotInScope] -> ShowS
NotInScope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotInScope] -> ShowS
$cshowList :: [NotInScope] -> ShowS
show :: NotInScope -> String
$cshow :: NotInScope -> String
showsPrec :: Int -> NotInScope -> ShowS
$cshowsPrec :: Int -> NotInScope -> ShowS
Show

notInScope :: NotInScope -> T.Text
notInScope :: NotInScope -> Text
notInScope (NotInScopeDataConstructor Text
t)        = Text
t
notInScope (NotInScopeTypeConstructorOrClass Text
t) = Text
t
notInScope (NotInScopeThing Text
t)                  = Text
t

extractNotInScopeName :: T.Text -> Maybe NotInScope
extractNotInScopeName :: Text -> Maybe NotInScope
extractNotInScopeName Text
x
  | Just [Text
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"Data constructor not in scope: ([^ ]+)"
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> NotInScope
NotInScopeDataConstructor Text
name
  | Just [Text
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"Not in scope: data constructor [^‘]*‘([^’]*)’"
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> NotInScope
NotInScopeDataConstructor Text
name
  | Just [Text
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"ot in scope: type constructor or class [^‘]*‘([^’]*)’"
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> NotInScope
NotInScopeTypeConstructorOrClass Text
name
  | Just [Text
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"ot in scope: \\(([^‘ ]+)\\)"
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> NotInScope
NotInScopeThing Text
name
  | Just [Text
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"ot in scope: ([^‘ ]+)"
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> NotInScope
NotInScopeThing Text
name
  | Just [Text
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"ot in scope:[^‘]*‘([^’]*)’"
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> NotInScope
NotInScopeThing Text
name
  | Bool
otherwise
  = forall a. Maybe a
Nothing

extractQualifiedModuleName :: T.Text -> Maybe T.Text
extractQualifiedModuleName :: Text -> Maybe Text
extractQualifiedModuleName Text
x
  | Just [Text
m] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"module named [^‘]*‘([^’]*)’"
  = forall a. a -> Maybe a
Just Text
m
  | Bool
otherwise
  = forall a. Maybe a
Nothing

-- | If a module has been imported qualified, and we want to ues the same qualifier for other modules
-- which haven't been imported, 'extractQualifiedModuleName' won't work. Thus we need extract the qualifier
-- from the imported one.
--
-- For example, we write f = T.putStrLn, where putStrLn comes from Data.Text.IO, with the following import(s):
-- 1.
-- import qualified Data.Text as T
--
-- Module ‘Data.Text’ does not export ‘putStrLn’.
--
-- 2.
-- import qualified Data.Text as T
-- import qualified Data.Functor as T
--
-- Neither ‘Data.Functor’ nor ‘Data.Text’ exports ‘putStrLn’.
--
-- 3.
-- import qualified Data.Text as T
-- import qualified Data.Functor as T
-- import qualified Data.Function as T
--
-- Neither ‘Data.Function’,
--         ‘Data.Functor’ nor ‘Data.Text’ exports ‘putStrLn’.
extractDoesNotExportModuleName :: T.Text -> Maybe T.Text
extractDoesNotExportModuleName :: Text -> Maybe Text
extractDoesNotExportModuleName Text
x
  | Just [Text
m] <-
#if MIN_VERSION_ghc(9,4,0)
    matchRegexUnifySpaces x "the module ‘([^’]*)’ does not export"
      <|> matchRegexUnifySpaces x "nor ‘([^’]*)’ export"
#else
    Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"Module ‘([^’]*)’ does not export"
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"nor ‘([^’]*)’ exports"
#endif
  = forall a. a -> Maybe a
Just Text
m
  | Bool
otherwise
  = forall a. Maybe a
Nothing
-------------------------------------------------------------------------------------------------


mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit
mkRenameEdit :: Maybe Text -> Range -> Text -> TextEdit
mkRenameEdit Maybe Text
contents Range
range Text
name
    | Maybe Bool
maybeIsInfixFunction forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True = Range -> Text -> TextEdit
TextEdit Range
range (Text
"`" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"`")
    | Maybe Bool
maybeIsTemplateFunction forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True = Range -> Text -> TextEdit
TextEdit Range
range (Text
"'" forall a. Semigroup a => a -> a -> a
<> Text
name)
    | Bool
otherwise = Range -> Text -> TextEdit
TextEdit Range
range Text
name
  where
    maybeIsInfixFunction :: Maybe Bool
maybeIsInfixFunction = do
      Text
curr <- Range -> Text -> Text
textInRange Range
range forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
contents
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
"`" Text -> Text -> Bool
`T.isPrefixOf` Text
curr Bool -> Bool -> Bool
&& Text
"`" Text -> Text -> Bool
`T.isSuffixOf` Text
curr
    maybeIsTemplateFunction :: Maybe Bool
maybeIsTemplateFunction = do
      Text
curr <- Range -> Text -> Text
textInRange Range
range forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
contents
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
"'" Text -> Text -> Bool
`T.isPrefixOf` Text
curr

extractRenamableTerms :: T.Text -> [T.Text]
extractRenamableTerms :: Text -> [Text]
extractRenamableTerms Text
msg
  -- Account for both "Variable not in scope" and "Not in scope"
  | Text
"ot in scope:" Text -> Text -> Bool
`T.isInfixOf` Text
msg = Text -> [Text]
extractSuggestions Text
msg
  | Bool
otherwise = []
  where
    extractSuggestions :: Text -> [Text]
extractSuggestions = forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
getEnclosed
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
singleSuggestions
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isKnownSymbol
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
    singleSuggestions :: Text -> [Text]
singleSuggestions = Text -> Text -> [Text]
T.splitOn Text
"), " -- Each suggestion is comma delimited
    isKnownSymbol :: Text -> Bool
isKnownSymbol Text
t = Text
" (imported from" Text -> Text -> Bool
`T.isInfixOf` Text
t Bool -> Bool -> Bool
|| Text
" (line " Text -> Text -> Bool
`T.isInfixOf` Text
t
    getEnclosed :: Text -> Text
getEnclosed = (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'‘')
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'’')
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropAround (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'‘' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'’')

-- | If a range takes up a whole line (it begins at the start of the line and there's only whitespace
-- between the end of the range and the next newline), extend the range to take up the whole line.
extendToWholeLineIfPossible :: Maybe T.Text -> Range -> Range
extendToWholeLineIfPossible :: Maybe Text -> Range -> Range
extendToWholeLineIfPossible Maybe Text
contents range :: Range
range@Range{Position
_end :: Position
_start :: Position
_end :: Range -> Position
_start :: Range -> Position
..} =
    let newlineAfter :: Bool
newlineAfter = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Text -> Bool
T.isPrefixOf Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (\Char
x -> Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Text -> (Text, Text)
splitTextAtPosition Position
_end) Maybe Text
contents
        extend :: Bool
extend = Bool
newlineAfter Bool -> Bool -> Bool
&& Position -> UInt
_character Position
_start forall a. Eq a => a -> a -> Bool
== UInt
0 -- takes up an entire line, so remove the whole line
    in if Bool
extend then Position -> Position -> Range
Range Position
_start (UInt -> UInt -> Position
Position (Position -> UInt
_line Position
_end forall a. Num a => a -> a -> a
+ UInt
1) UInt
0) else Range
range

splitTextAtPosition :: Position -> T.Text -> (T.Text, T.Text)
splitTextAtPosition :: Position -> Text -> (Text, Text)
splitTextAtPosition (Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
row) (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
col)) Text
x
    | ([Text]
preRow, Text
mid:[Text]
postRow) <- forall a. Int -> [a] -> ([a], [a])
splitAt Int
row forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"\n" Text
x
    , (Text
preCol, Text
postCol) <- Int -> Text -> (Text, Text)
T.splitAt Int
col Text
mid
        = (Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ [Text]
preRow forall a. [a] -> [a] -> [a]
++ [Text
preCol], Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ Text
postCol forall a. a -> [a] -> [a]
: [Text]
postRow)
    | Bool
otherwise = (Text
x, Text
T.empty)

-- | Returns [start .. end[
textInRange :: Range -> T.Text -> T.Text
textInRange :: Range -> Text -> Text
textInRange (Range (Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
startRow) (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
startCol)) (Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
endRow) (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
endCol))) Text
text =
    case forall a. Ord a => a -> a -> Ordering
compare Int
startRow Int
endRow of
      Ordering
LT ->
        let ([Text]
linesInRangeBeforeEndLine, [Text]
endLineAndFurtherLines) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
endRow forall a. Num a => a -> a -> a
- Int
startRow) [Text]
linesBeginningWithStartLine
            (Text
textInRangeInFirstLine, [Text]
linesBetween) = case [Text]
linesInRangeBeforeEndLine of
              [] -> (Text
"", [])
              Text
firstLine:[Text]
linesInBetween -> (Int -> Text -> Text
T.drop Int
startCol Text
firstLine, [Text]
linesInBetween)
            maybeTextInRangeInEndLine :: Maybe Text
maybeTextInRangeInEndLine = Int -> Text -> Text
T.take Int
endCol forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
listToMaybe [Text]
endLineAndFurtherLines
        in Text -> [Text] -> Text
T.intercalate Text
"\n" (Text
textInRangeInFirstLine forall a. a -> [a] -> [a]
: [Text]
linesBetween forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe Text
maybeTextInRangeInEndLine)
      Ordering
EQ ->
        let line :: Text
line = forall a. a -> Maybe a -> a
fromMaybe Text
"" (forall a. [a] -> Maybe a
listToMaybe [Text]
linesBeginningWithStartLine)
        in Int -> Text -> Text
T.take (Int
endCol forall a. Num a => a -> a -> a
- Int
startCol) (Int -> Text -> Text
T.drop Int
startCol Text
line)
      Ordering
GT -> Text
""
    where
      linesBeginningWithStartLine :: [Text]
linesBeginningWithStartLine = forall a. Int -> [a] -> [a]
drop Int
startRow (Text -> Text -> [Text]
T.splitOn Text
"\n" Text
text)

-- | Returns the ranges for a binding in an import declaration
rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range]
rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range]
rangesForBindingImport ImportDecl{
#if MIN_VERSION_ghc(9,5,0)
  ideclImportList = Just (Exactly, L _ lies)
#else
  ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding = Just (Bool
False, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcPs)]
lies)
#endif
  } String
b =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SrcSpan -> Maybe Range
srcSpanToRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LIE GhcPs -> [SrcSpan]
rangesForBinding' String
b') [GenLocated SrcSpanAnnA (IE GhcPs)]
lies
  where
    b' :: String
b' = ShowS
wrapOperatorInParens String
b
rangesForBindingImport ImportDecl GhcPs
_ String
_ = []

wrapOperatorInParens :: String -> String
wrapOperatorInParens :: ShowS
wrapOperatorInParens String
x =
  case forall a. [a] -> Maybe (a, [a])
uncons String
x of
    -- see #2483 and #2859
    -- common lens functions use the _ prefix, and should not be wrapped in parens
    Just (Char
'_', String
_t) -> String
x
    Just (Char
h, String
_t)   -> if Char -> Bool
isAlpha Char
h then String
x else String
"(" forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
")"
    Maybe (Char, String)
Nothing        -> forall a. Monoid a => a
mempty

smallerRangesForBindingExport :: [LIE GhcPs] -> String -> [Range]
smallerRangesForBindingExport :: [LIE GhcPs] -> String -> [Range]
smallerRangesForBindingExport [LIE GhcPs]
lies String
b =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SrcSpan -> Maybe Range
srcSpanToRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> [SrcSpan]
ranges') [LIE GhcPs]
lies
  where
    unqualify :: ShowS
unqualify = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOnEnd String
"."
    b' :: String
b' = ShowS
wrapOperatorInParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unqualify forall a b. (a -> b) -> a -> b
$ String
b
#if !MIN_VERSION_ghc(9,2,0)
    ranges' (L _ (IEThingWith _ thing _  inners labels))
      | T.unpack (printOutputable thing) == b' = []
      | otherwise =
          [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b']
          ++ [ l' | L l' x <- labels, T.unpack (printOutputable x) == b']
#else
    ranges' :: GenLocated SrcSpanAnnA (IE GhcPs) -> [SrcSpan]
ranges' (L SrcSpanAnnA
_ (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
thing IEWildcard
_  [LIEWrappedName (IdP GhcPs)]
inners))
      | Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable LIEWrappedName (IdP GhcPs)
thing) forall a. Eq a => a -> a -> Bool
== String
b' = []
      | Bool
otherwise =
          [ forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l' | L SrcSpanAnnA
l' IEWrappedName (IdP GhcPs)
x <- [LIEWrappedName (IdP GhcPs)]
inners, Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable IEWrappedName (IdP GhcPs)
x) forall a. Eq a => a -> a -> Bool
== String
b']
#endif
    ranges' GenLocated SrcSpanAnnA (IE GhcPs)
_ = []

rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]
#if !MIN_VERSION_ghc(9,2,0)
rangesForBinding' b (L (locA -> l) (IEVar _ nm))
  | L _ (IEPattern (L _ b')) <- nm
  , T.unpack (printOutputable b') == b
  = [l]
#else
rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]
rangesForBinding' String
b (L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l) (IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
nm))
  | L SrcSpanAnnA
_ (IEPattern EpaLocation
_ (L SrcSpanAnnN
_ IdP GhcPs
b')) <- LIEWrappedName (IdP GhcPs)
nm
  , Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable IdP GhcPs
b') forall a. Eq a => a -> a -> Bool
== String
b
  = [SrcSpan
l]
#endif
rangesForBinding' String
b (L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l) x :: IE GhcPs
x@IEVar{})
  | Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable IE GhcPs
x) forall a. Eq a => a -> a -> Bool
== String
b = [SrcSpan
l]
rangesForBinding' String
b (L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l) x :: IE GhcPs
x@IEThingAbs{}) | Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable IE GhcPs
x) forall a. Eq a => a -> a -> Bool
== String
b = [SrcSpan
l]
rangesForBinding' String
b (L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l) (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
x)) | Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable LIEWrappedName (IdP GhcPs)
x) forall a. Eq a => a -> a -> Bool
== String
b = [SrcSpan
l]
#if !MIN_VERSION_ghc(9,2,0)
rangesForBinding' b (L l (IEThingWith _ thing _  inners labels))
#else
rangesForBinding' String
b (L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l) (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
thing IEWildcard
_  [LIEWrappedName (IdP GhcPs)]
inners))
#endif
    | Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable LIEWrappedName (IdP GhcPs)
thing) forall a. Eq a => a -> a -> Bool
== String
b = [SrcSpan
l]
    | Bool
otherwise =
        [ forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l' | L SrcSpanAnnA
l' IEWrappedName RdrName
x <- [LIEWrappedName (IdP GhcPs)]
inners, Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable IEWrappedName RdrName
x) forall a. Eq a => a -> a -> Bool
== String
b]
#if !MIN_VERSION_ghc(9,2,0)
        ++ [ l' | L l' x <- labels, T.unpack (printOutputable x) == b]
#endif
rangesForBinding' String
_ LIE GhcPs
_ = []

-- | 'allMatchRegex' combined with 'unifySpaces'
allMatchRegexUnifySpaces :: T.Text -> T.Text -> Maybe [[T.Text]]
allMatchRegexUnifySpaces :: Text -> Text -> Maybe [[Text]]
allMatchRegexUnifySpaces Text
message =
    Text -> Text -> Maybe [[Text]]
allMatchRegex (Text -> Text
unifySpaces Text
message)

-- | Returns Just (all matches) for the first capture, or Nothing.
allMatchRegex :: T.Text -> T.Text -> Maybe [[T.Text]]
allMatchRegex :: Text -> Text -> Maybe [[Text]]
allMatchRegex Text
message Text
regex = Text
message forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
regex


-- functions to help parse multiple import suggestions

-- | Returns the first match if found
regexSingleMatch :: T.Text -> T.Text -> Maybe T.Text
regexSingleMatch :: Text -> Text -> Maybe Text
regexSingleMatch Text
msg Text
regex = case Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
msg Text
regex of
    Just (Text
h:[Text]
_) -> forall a. a -> Maybe a
Just Text
h
    Maybe [Text]
_          -> forall a. Maybe a
Nothing

-- | Parses tuples like (‘Data.Map’, (app/ModuleB.hs:2:1-18)) and
-- | return (Data.Map, app/ModuleB.hs:2:1-18)
regExPair :: (T.Text, T.Text) -> Maybe (T.Text, T.Text)
regExPair :: (Text, Text) -> Maybe (Text, Text)
regExPair (Text
modname, Text
srcpair) = do
  Text
x <- Text -> Text -> Maybe Text
regexSingleMatch Text
modname Text
"‘([^’]*)’"
  Text
y <- Text -> Text -> Maybe Text
regexSingleMatch Text
srcpair Text
"\\((.*)\\)"
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Text
y)

-- | Process a list of (module_name, filename:src_span) values
-- | Eg. [(Data.Map, app/ModuleB.hs:2:1-18), (Data.HashMap.Strict, app/ModuleB.hs:3:1-29)]
regExImports :: T.Text -> Maybe [(T.Text, T.Text)]
regExImports :: Text -> Maybe [(Text, Text)]
regExImports Text
msg = Maybe [(Text, Text)]
result
  where
    parts :: [Text]
parts = Text -> [Text]
T.words Text
msg
    isPrefix :: Text -> Bool
isPrefix = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
T.isPrefixOf Text
"("
    ([Text]
mod, [Text]
srcspan) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Text -> Bool
isPrefix  [Text]
parts
    -- check we have matching pairs like (Data.Map, (app/src.hs:1:2-18))
    result :: Maybe [(Text, Text)]
result = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
mod forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
srcspan then
               (Text, Text) -> Maybe (Text, Text)
regExPair forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
mod [Text]
srcspan
             else forall a. Maybe a
Nothing

matchRegExMultipleImports :: T.Text -> Maybe (T.Text, [(T.Text, T.Text)])
matchRegExMultipleImports :: Text -> Maybe (Text, [(Text, Text)])
matchRegExMultipleImports Text
message = do
  let pat :: Text
pat = String -> Text
T.pack String
"Perhaps you want to add ‘([^’]*)’ to one of these import lists: *(‘.*\\))$"
  (Text
binding, Text
imports) <- case Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
message Text
pat of
                            Just [Text
x, Text
xs] -> forall a. a -> Maybe a
Just (Text
x, Text
xs)
                            Maybe [Text]
_            -> forall a. Maybe a
Nothing
  [(Text, Text)]
imps <- Text -> Maybe [(Text, Text)]
regExImports Text
imports
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
binding, [(Text, Text)]
imps)