-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs                 #-}

-- | Go to the definition of a variable.

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

import           Control.Applicative                               ((<|>))
import           Control.Arrow                                     (second,
                                                                    (>>>))
import           Control.Concurrent.STM.Stats                      (atomically)
import           Control.Monad                                     (guard, join,
                                                                    msum)
import           Control.Monad.IO.Class
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                                          as M
import           Data.Maybe
import qualified Data.Rope.UTF16                                   as Rope
import qualified Data.Set                                          as S
import qualified Data.Text                                         as T
import           Data.Tuple.Extra                                  (fst3)
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Rules
import           Development.IDE.Core.Service
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Compat.Util
import           Development.IDE.GHC.Error
import           Development.IDE.GHC.ExactPrint
import           Development.IDE.GHC.Util                          (printOutputable,
                                                                    printRdrName,
                                                                    traceAst)
import           Development.IDE.Plugin.CodeAction.Args
import           Development.IDE.Plugin.CodeAction.ExactPrint
import           Development.IDE.Plugin.CodeAction.PositionIndexed
import           Development.IDE.Plugin.TypeLenses                 (suggestSignature)
import           Development.IDE.Types.Exports
import           Development.IDE.Types.Location
import           Development.IDE.Types.Options
import qualified GHC.LanguageExtensions                            as Lang
import           Ide.PluginUtils                                   (subRange)
import           Ide.Types
import qualified Language.LSP.Server                               as LSP
import           Language.LSP.Types                                (CodeAction (..),
                                                                    CodeActionContext (CodeActionContext, _diagnostics),
                                                                    CodeActionKind (CodeActionQuickFix, CodeActionUnknown),
                                                                    CodeActionParams (CodeActionParams),
                                                                    Command,
                                                                    Diagnostic (..),
                                                                    List (..),
                                                                    ResponseError,
                                                                    SMethod (STextDocumentCodeAction),
                                                                    TextDocumentIdentifier (TextDocumentIdentifier),
                                                                    TextEdit (TextEdit),
                                                                    UInt,
                                                                    WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges),
                                                                    type (|?) (InR),
                                                                    uriToFilePath)
import           Language.LSP.VFS
import           Text.Regex.TDFA                                   (mrAfter,
                                                                    (=~), (=~~))

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

-- | Generate code actions.
codeAction
    :: IdeState
    -> PluginId
    -> CodeActionParams
    -> LSP.LspM c (Either ResponseError (List (Command |? CodeAction)))
codeAction :: 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 <- NormalizedUri -> LspT c IO (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
LSP.getVirtualFile (NormalizedUri -> LspT c IO (Maybe VirtualFile))
-> NormalizedUri -> LspT c IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
  IO (Either ResponseError (List (Command |? CodeAction)))
-> LspM c (Either ResponseError (List (Command |? CodeAction)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ResponseError (List (Command |? CodeAction)))
 -> LspM c (Either ResponseError (List (Command |? CodeAction))))
-> IO (Either ResponseError (List (Command |? CodeAction)))
-> LspM c (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ do
    let text :: Maybe Text
text = Rope -> Text
Rope.toText (Rope -> Text) -> (VirtualFile -> Rope) -> VirtualFile -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VirtualFile -> Rope
_text :: VirtualFile -> Rope.Rope) (VirtualFile -> Text) -> Maybe VirtualFile -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe VirtualFile
contents
        mbFile :: Maybe NormalizedFilePath
mbFile = FilePath -> NormalizedFilePath
toNormalizedFilePath' (FilePath -> NormalizedFilePath)
-> Maybe FilePath -> Maybe NormalizedFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> Maybe FilePath
uriToFilePath Uri
uri
    [Diagnostic]
diag <- STM [Diagnostic] -> IO [Diagnostic]
forall a. STM a -> IO a
atomically (STM [Diagnostic] -> IO [Diagnostic])
-> STM [Diagnostic] -> IO [Diagnostic]
forall a b. (a -> b) -> a -> b
$ ((NormalizedFilePath, ShowDiagnostic, Diagnostic) -> Diagnostic)
-> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
-> [Diagnostic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(NormalizedFilePath
_, ShowDiagnostic
_, Diagnostic
d) -> Diagnostic
d) ([(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
 -> [Diagnostic])
-> ([(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
    -> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)])
-> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
-> [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NormalizedFilePath, ShowDiagnostic, Diagnostic) -> Bool)
-> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
-> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(NormalizedFilePath
p, ShowDiagnostic
_, Diagnostic
_) -> Maybe NormalizedFilePath
mbFile Maybe NormalizedFilePath -> Maybe NormalizedFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== NormalizedFilePath -> Maybe NormalizedFilePath
forall a. a -> Maybe a
Just NormalizedFilePath
p) ([(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
 -> [Diagnostic])
-> STM [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
-> STM [Diagnostic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdeState -> STM [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
getDiagnostics IdeState
state
    (Maybe (Maybe ParsedModule) -> Maybe ParsedModule
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe ParsedModule
parsedModule) <- FilePath
-> IdeState
-> Action (Maybe (Maybe ParsedModule))
-> IO (Maybe (Maybe ParsedModule))
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"GhcideCodeActions.getParsedModule" IdeState
state (Action (Maybe (Maybe ParsedModule))
 -> IO (Maybe (Maybe ParsedModule)))
-> Action (Maybe (Maybe ParsedModule))
-> IO (Maybe (Maybe ParsedModule))
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Action (Maybe ParsedModule)
getParsedModule (NormalizedFilePath -> Action (Maybe ParsedModule))
-> Maybe NormalizedFilePath -> Action (Maybe (Maybe ParsedModule))
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
               [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
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
    Either ResponseError (List (Command |? CodeAction))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (List (Command |? CodeAction))
 -> IO (Either ResponseError (List (Command |? CodeAction))))
-> Either ResponseError (List (Command |? CodeAction))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. b -> Either a b
Right (List (Command |? CodeAction)
 -> Either ResponseError (List (Command |? CodeAction)))
-> List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> List (Command |? CodeAction)
forall a. [a] -> List a
List [Command |? CodeAction]
actions

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

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

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

bindingsPluginDescriptor :: PluginId -> PluginDescriptor IdeState
bindingsPluginDescriptor :: PluginId -> PluginDescriptor IdeState
bindingsPluginDescriptor =
  [GhcideCodeAction] -> PluginId -> PluginDescriptor IdeState
mkGhcideCAsPlugin [
      (Maybe Text -> Diagnostic -> [(Text, [TextEdit])])
-> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestReplaceIdentifier
    , (ParsedSource -> Diagnostic -> [(Text, Rewrite)])
-> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
wrap ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestImplicitParameter
    , (IdeOptions
 -> ParsedModule
 -> Maybe Text
 -> Diagnostic
 -> [(Text, [TextEdit])])
-> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
wrap IdeOptions
-> ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestNewDefinition
    , (ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])])
-> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
wrap ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDeleteUnusedBinding
    ]

fillHolePluginDescriptor :: PluginId -> PluginDescriptor IdeState
fillHolePluginDescriptor :: PluginId -> PluginDescriptor IdeState
fillHolePluginDescriptor = GhcideCodeAction -> PluginId -> PluginDescriptor IdeState
mkGhcideCAPlugin (GhcideCodeAction -> PluginId -> PluginDescriptor IdeState)
-> GhcideCodeAction -> PluginId -> PluginDescriptor IdeState
forall a b. (a -> b) -> a -> b
$ (Diagnostic -> [(Text, TextEdit)]) -> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Diagnostic -> [(Text, TextEdit)]
suggestFillHole

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

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

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

findSigOfBind :: forall p p0. p ~ GhcPass p0 => Range -> HsBind p -> Maybe (Sig p)
findSigOfBind :: 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 (Located [LMatch p (LHsExpr p)]
-> SrcSpanLess (Located [LMatch p (LHsExpr p)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located [LMatch p (LHsExpr p)]
 -> SrcSpanLess (Located [LMatch p (LHsExpr p)]))
-> Located [LMatch p (LHsExpr p)]
-> SrcSpanLess (Located [LMatch p (LHsExpr p)])
forall a b. (a -> b) -> a -> b
$ MatchGroup p (LHsExpr p) -> Located [LMatch p (LHsExpr p)]
forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts (HsBind p -> MatchGroup p (LHsExpr p)
forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches HsBind p
bind))
      HsBind p
_          -> Maybe (Sig 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
      LMatch p (LHsExpr p)
match <- Position -> [LMatch p (LHsExpr p)] -> Maybe (LMatch p (LHsExpr p))
forall (t :: * -> *) e.
Foldable t =>
Position
-> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e)
findDeclContainingLoc (Range -> Position
_start Range
range) [LMatch p (LHsExpr p)]
ls
      let grhs :: GRHSs (GhcPass p0) (LHsExpr (GhcPass p0))
grhs = Match (GhcPass p0) (LHsExpr (GhcPass p0))
-> GRHSs (GhcPass p0) (LHsExpr (GhcPass p0))
forall p body. Match p body -> GRHSs p body
m_grhss (Match (GhcPass p0) (LHsExpr (GhcPass p0))
 -> GRHSs (GhcPass p0) (LHsExpr (GhcPass p0)))
-> Match (GhcPass p0) (LHsExpr (GhcPass p0))
-> GRHSs (GhcPass p0) (LHsExpr (GhcPass p0))
forall a b. (a -> b) -> a -> b
$ LMatch p (LHsExpr p) -> SrcSpanLess (LMatch p (LHsExpr p))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LMatch p (LHsExpr p)
match
#if !MIN_VERSION_ghc(9,2,0)
          span :: SrcSpan
span = Located (HsLocalBinds (GhcPass p0)) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located (HsLocalBinds (GhcPass p0)) -> SrcSpan)
-> Located (HsLocalBinds (GhcPass p0)) -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Located (HsLocalBinds (GhcPass p0))
-> Located (HsLocalBinds (GhcPass p0))
forall a. Located a -> Located a
reLoc (Located (HsLocalBinds (GhcPass p0))
 -> Located (HsLocalBinds (GhcPass p0)))
-> Located (HsLocalBinds (GhcPass p0))
-> Located (HsLocalBinds (GhcPass p0))
forall a b. (a -> b) -> a -> b
$ GRHSs (GhcPass p0) (LHsExpr (GhcPass p0))
-> Located (HsLocalBinds (GhcPass p0))
forall p body. GRHSs p body -> LHsLocalBinds p
grhssLocalBinds GRHSs (GhcPass p0) (LHsExpr (GhcPass p0))
grhs
      if Range -> Position
_start Range
range Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
span
        then Range -> HsLocalBinds p -> Maybe (Sig p)
forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsLocalBinds p -> Maybe (Sig p)
findSigOfBinds Range
range (Located (HsLocalBinds (GhcPass p0))
-> SrcSpanLess (Located (HsLocalBinds (GhcPass p0)))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (GRHSs (GhcPass p0) (LHsExpr (GhcPass p0))
-> Located (HsLocalBinds (GhcPass p0))
forall p body. GRHSs p body -> LHsLocalBinds p
grhssLocalBinds GRHSs (GhcPass p0) (LHsExpr (GhcPass p0))
grhs)) -- where clause
        else do
          GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))
grhs <- Position
-> [GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))]
-> Maybe
     (GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0))))
forall (t :: * -> *) e.
Foldable t =>
Position
-> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e)
findDeclContainingLoc (Range -> Position
_start Range
range) ((GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))
 -> GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0))))
-> [GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))]
-> [GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))
-> GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))
forall a. Located a -> Located a
reLocA ([GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))]
 -> [GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))])
-> [GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))]
-> [GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))]
forall a b. (a -> b) -> a -> b
$ GRHSs (GhcPass p0) (LHsExpr (GhcPass p0))
-> [GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs GRHSs (GhcPass p0) (LHsExpr (GhcPass p0))
grhs)
          case GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))
-> SrcSpanLess
     (GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0))))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0)))
grhs of
            GRHS _ _ bd -> HsExpr p -> Maybe (Sig p)
findSigOfExpr (LHsExpr (GhcPass p0) -> SrcSpanLess (LHsExpr (GhcPass p0))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr (GhcPass p0)
bd)
            SrcSpanLess
  (GenLocated SrcSpan (GRHS (GhcPass p0) (LHsExpr (GhcPass p0))))
_           -> Maybe (Sig p)
forall a. Maybe a
Nothing
#else
      msum
        [findSigOfBinds range (grhssLocalBinds grhs) -- where clause
        , do
          grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs)
          case unLoc grhs of
            GRHS _ _ bd -> findSigOfExpr (unLoc bd)
        ]
#endif

    findSigOfExpr :: HsExpr p -> Maybe (Sig p)
    findSigOfExpr :: HsExpr p -> Maybe (Sig p)
findSigOfExpr = HsExpr p -> Maybe (Sig p)
go
      where
        go :: HsExpr p -> Maybe (Sig p)
go (HsLet XLet p
_ SrcSpanLess (LHsLocalBinds p)
binds LHsExpr p
_) = Range -> HsLocalBinds p -> Maybe (Sig p)
forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsLocalBinds p -> Maybe (Sig p)
findSigOfBinds Range
range HsLocalBinds p
SrcSpanLess (LHsLocalBinds p)
binds
        go (HsDo XDo p
_ HsStmtContext Name
_ Located [ExprLStmt p]
stmts) = do
          StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0))
stmtlr <- GenLocated
  SrcSpan (StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0)))
-> StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (GenLocated
   SrcSpan (StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0)))
 -> StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0)))
-> Maybe
     (GenLocated
        SrcSpan (StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0))))
-> Maybe (StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> [GenLocated
      SrcSpan (StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0)))]
-> Maybe
     (GenLocated
        SrcSpan (StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0))))
forall (t :: * -> *) e.
Foldable t =>
Position
-> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e)
findDeclContainingLoc (Range -> Position
_start Range
range) (Located [ExprLStmt p] -> SrcSpanLess (Located [ExprLStmt p])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [ExprLStmt p]
stmts)
          case StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0))
stmtlr of
            LetStmt XLetStmt (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0))
_ SrcSpanLess (Located (HsLocalBinds (GhcPass p0)))
lhsLocalBindsLR -> Range -> HsLocalBinds p -> Maybe (Sig p)
forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsLocalBinds p -> Maybe (Sig p)
findSigOfBinds Range
range HsLocalBinds p
SrcSpanLess (Located (HsLocalBinds (GhcPass p0)))
lhsLocalBindsLR
            StmtLR (GhcPass p0) (GhcPass p0) (LHsExpr (GhcPass p0))
_                         -> Maybe (Sig p)
forall a. Maybe a
Nothing
        go HsExpr p
_ = Maybe (Sig p)
forall a. Maybe a
Nothing

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

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

#if MIN_VERSION_ghc(9,2,0)
findDeclContainingLoc :: Foldable t => Position -> t (GenLocated (SrcSpanAnn' a) e) -> Maybe (GenLocated (SrcSpanAnn' a) e)
#else
-- TODO populate this type signature for GHC versions <9.2
#endif
findDeclContainingLoc :: Position
-> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e)
findDeclContainingLoc Position
loc = (GenLocated SrcSpan e -> Bool)
-> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L SrcSpan
l e
_) -> Position
loc Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
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 :: ParsedSource -> T.Text -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])]
suggestHideShadow :: ParsedSource
-> Text
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])]
suggestHideShadow ps :: ParsedSource
ps@(L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports}) 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 <- ((Text, [Either TextEdit Rewrite])
 -> (Text, [Either TextEdit Rewrite]) -> Ordering)
-> [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> ((Text, [Either TextEdit Rewrite]) -> Text)
-> (Text, [Either TextEdit Rewrite])
-> (Text, [Either TextEdit Rewrite])
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text, [Either TextEdit Rewrite]) -> Text
forall a b. (a, b) -> a
fst) ([(Text, [Either TextEdit Rewrite])]
 -> [(Text, [Either TextEdit Rewrite])])
-> [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
mods [(Text, Text)]
-> ((Text, Text) -> [(Text, [Either TextEdit Rewrite])])
-> [(Text, [Either TextEdit Rewrite])]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> [(Text, [Either TextEdit Rewrite])])
-> (Text, Text) -> [(Text, [Either TextEdit Rewrite])]
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from all occurence imports", [[Either TextEdit Rewrite]] -> [Either TextEdit Rewrite]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either TextEdit Rewrite]] -> [Either TextEdit Rewrite])
-> [[Either TextEdit Rewrite]] -> [Either TextEdit Rewrite]
forall a b. (a -> b) -> a -> b
$ (Text, [Either TextEdit Rewrite]) -> [Either TextEdit Rewrite]
forall a b. (a, b) -> b
snd ((Text, [Either TextEdit Rewrite]) -> [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])]
-> [[Either TextEdit Rewrite]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [Either TextEdit Rewrite])]
result) =
    [(Text, [Either TextEdit Rewrite])]
result [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
forall a. Semigroup a => a -> a -> a
<> [(Text, [Either TextEdit Rewrite])
hideAll]
  | Bool
otherwise = []
  where
    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, FilePath
"") <- ReadS RealSrcSpan
readSrcSpan ReadS RealSrcSpan -> ReadS RealSrcSpan
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
s],
        TcModuleResult
-> HieAstResult -> FilePath -> FilePath -> SrcSpan -> Bool
isUnusedImportedId TcModuleResult
tcM HieAstResult
har (Text -> FilePath
T.unpack Text
identifier) (Text -> FilePath
T.unpack Text
modName) (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
s' Maybe BufSpan
forall a. Maybe a
Nothing),
        Maybe (LImportDecl GhcPs)
mDecl <- [LImportDecl GhcPs] -> FilePath -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
hsmodImports (FilePath -> Maybe (LImportDecl GhcPs))
-> FilePath -> Maybe (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
modName,
        Text
title <- Text
"Hide " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modName =
        if Text
modName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Prelude" Bool -> Bool -> Bool
&& Maybe (LImportDecl GhcPs) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (LImportDecl GhcPs)
mDecl
          then Maybe (Text, [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])]
forall a. Maybe a -> [a]
maybeToList (Maybe (Text, [Either TextEdit Rewrite])
 -> [(Text, [Either TextEdit Rewrite])])
-> Maybe (Text, [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])]
forall a b. (a -> b) -> a -> b
$ (\(Text
_, TextEdit
te) -> (Text
title, [TextEdit -> Either TextEdit Rewrite
forall a b. a -> Either a b
Left TextEdit
te])) ((Text, TextEdit) -> (Text, [Either TextEdit Rewrite]))
-> Maybe (Text, TextEdit)
-> Maybe (Text, [Either TextEdit Rewrite])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewImport -> ParsedSource -> Text -> Maybe (Text, TextEdit)
newImportToEdit (Text -> NewImport
hideImplicitPreludeSymbol Text
identifier) ParsedSource
ps Text
fileContents
          else Maybe (Text, [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])]
forall a. Maybe a -> [a]
maybeToList (Maybe (Text, [Either TextEdit Rewrite])
 -> [(Text, [Either TextEdit Rewrite])])
-> Maybe (Text, [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])]
forall a b. (a -> b) -> a -> b
$ (Text
title,) ([Either TextEdit Rewrite] -> (Text, [Either TextEdit Rewrite]))
-> (LImportDecl GhcPs -> [Either TextEdit Rewrite])
-> LImportDecl GhcPs
-> (Text, [Either TextEdit Rewrite])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TextEdit Rewrite -> [Either TextEdit Rewrite]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TextEdit Rewrite -> [Either TextEdit Rewrite])
-> (LImportDecl GhcPs -> Either TextEdit Rewrite)
-> LImportDecl GhcPs
-> [Either TextEdit Rewrite]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rewrite -> Either TextEdit Rewrite
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rewrite -> Either TextEdit Rewrite)
-> (LImportDecl GhcPs -> Rewrite)
-> LImportDecl GhcPs
-> Either TextEdit Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> LImportDecl GhcPs -> Rewrite
hideSymbol (Text -> FilePath
T.unpack Text
identifier) (LImportDecl GhcPs -> (Text, [Either TextEdit Rewrite]))
-> Maybe (LImportDecl GhcPs)
-> Maybe (Text, [Either TextEdit Rewrite])
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] -> FilePath -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
decls FilePath
modName = ((LImportDecl GhcPs -> Bool)
 -> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs))
-> [LImportDecl GhcPs]
-> (LImportDecl GhcPs -> Bool)
-> Maybe (LImportDecl GhcPs)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find [LImportDecl GhcPs]
decls ((LImportDecl GhcPs -> Bool) -> Maybe (LImportDecl GhcPs))
-> (LImportDecl GhcPs -> Bool) -> Maybe (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ \case
  (L SrcSpan
_ ImportDecl {Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
SourceText
Located ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> Bool
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: Bool
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..}) -> FilePath
modName FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName -> FilePath
moduleNameString (Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
ideclName)
  LImportDecl GhcPs
_                     -> FilePath -> Bool
forall a. HasCallStack => FilePath -> a
error FilePath
"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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl2
  | Bool
otherwise = Bool
False
  where
    getStartLine :: SrcSpan -> Maybe Int
getStartLine SrcSpan
x = RealSrcLoc -> Int
srcLocLine (RealSrcLoc -> Int)
-> (RealSrcSpan -> RealSrcLoc) -> RealSrcSpan -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> RealSrcLoc
realSrcSpanStart (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
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 -> FilePath -> FilePath -> 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 :: BufSpan
refMap :: RefMap a
refMap}
  FilePath
identifier
  FilePath
modName
  SrcSpan
importSpan
    | OccName
occ <- FilePath -> OccName
mkVarOcc FilePath
identifier,
      [ImportedModsVal]
impModsVals <- [ImportedBy] -> [ImportedModsVal]
importedByUser ([ImportedBy] -> [ImportedModsVal])
-> ([[ImportedBy]] -> [ImportedBy])
-> [[ImportedBy]]
-> [ImportedModsVal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ImportedBy]] -> [ImportedBy]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ImportedBy]] -> [ImportedModsVal])
-> [[ImportedBy]] -> [ImportedModsVal]
forall a b. (a -> b) -> a -> b
$ ImportedMods -> [[ImportedBy]]
forall a. ModuleEnv a -> [a]
moduleEnvElts ImportedMods
imp_mods,
      Just GlobalRdrEnv
rdrEnv <-
        [GlobalRdrEnv] -> Maybe GlobalRdrEnv
forall a. [a] -> Maybe a
listToMaybe
          [ GlobalRdrEnv
imv_all_exports
            | ImportedModsVal {Bool
GlobalRdrEnv
SrcSpan
ModuleName
imv_name :: ImportedModsVal -> ModuleName
imv_span :: ImportedModsVal -> SrcSpan
imv_is_safe :: ImportedModsVal -> Bool
imv_is_hiding :: ImportedModsVal -> Bool
imv_all_exports :: ImportedModsVal -> GlobalRdrEnv
imv_qualified :: ImportedModsVal -> Bool
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 ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> ModuleName
mkModuleName FilePath
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 <- Name -> Either ModuleName Name
forall a b. b -> Either a b
Right Name
name,
      Maybe [(RealSrcSpan, IdentifierDetails a)]
refs <- Either ModuleName Name
-> RefMap a -> Maybe [(RealSrcSpan, IdentifierDetails a)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Either ModuleName Name
importedIdentifier RefMap a
refMap =
      Bool
-> ([(RealSrcSpan, IdentifierDetails a)] -> Bool)
-> Maybe [(RealSrcSpan, IdentifierDetails a)]
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not (Bool -> Bool)
-> ([(RealSrcSpan, IdentifierDetails a)] -> Bool)
-> [(RealSrcSpan, IdentifierDetails a)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RealSrcSpan, IdentifierDetails a) -> Bool)
-> [(RealSrcSpan, IdentifierDetails a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(RealSrcSpan
_, IdentifierDetails {Maybe a
Set ContextInfo
identType :: forall a. IdentifierDetails a -> Maybe a
identInfo :: forall a. IdentifierDetails a -> Set ContextInfo
identInfo :: Set ContextInfo
identType :: Maybe a
..}) -> Set ContextInfo
identInfo Set ContextInfo -> Set ContextInfo -> Bool
forall a. Eq a => a -> a -> Bool
== ContextInfo -> Set ContextInfo
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 :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports}} Maybe Text
contents Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
_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 SrcSpan
_ ImportDecl GhcPs
impDecl) <- (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> SrcSpan
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 <- (Text -> [Range]) -> [Text] -> [[Range]]
forall a b. (a -> b) -> [a] -> [b]
map (ImportDecl GhcPs -> FilePath -> [Range]
rangesForBindingImport ImportDecl GhcPs
impDecl (FilePath -> [Range]) -> (Text -> FilePath) -> Text -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) (Text -> Text -> [Text]
T.splitOn Text
", " Text
bindings)
    , [Range]
ranges' <- Bool -> PositionIndexedString -> [Range] -> [Range]
extendAllToIncludeCommaIfPossible Bool
False (FilePath -> PositionIndexedString
indexedByPosition (FilePath -> PositionIndexedString)
-> FilePath -> PositionIndexedString
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
c) ([[Range]] -> [Range]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Range]]
ranges)
    , Bool -> Bool
not ([Range] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Range]
ranges')
    = [( Text
"Remove " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bindings Text -> Text -> Text
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 Text -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (FilePath
"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 = []

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 <- [[(Diagnostic, (Text, [TextEdit]))]]
-> [(Diagnostic, (Text, [TextEdit]))]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Diagnostic, (Text, [TextEdit]))]]
 -> [(Diagnostic, (Text, [TextEdit]))])
-> [[(Diagnostic, (Text, [TextEdit]))]]
-> [(Diagnostic, (Text, [TextEdit]))]
forall a b. (a -> b) -> a -> b
$ (Diagnostic -> [(Diagnostic, (Text, [TextEdit]))])
-> [Diagnostic] -> [[(Diagnostic, (Text, [TextEdit]))]]
forall a b. (a -> b) -> [a] -> [b]
map (\Diagnostic
d -> Diagnostic -> [Diagnostic]
forall a. a -> [a]
repeat Diagnostic
d [Diagnostic]
-> [(Text, [TextEdit])] -> [(Diagnostic, (Text, [TextEdit]))]
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 Diagnostic -> [Diagnostic] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Diagnostic]
ctxDigs],
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Diagnostic, (Text, [TextEdit]))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Diagnostic, (Text, [TextEdit]))]
ctxEdits,
    [Command |? CodeAction]
caRemoveCtx <- ((Diagnostic, (Text, [TextEdit])) -> Command |? CodeAction)
-> [(Diagnostic, (Text, [TextEdit]))] -> [Command |? CodeAction]
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 [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
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 (CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix) Maybe Bool
forall a. Maybe a
Nothing [Diagnostic
diagnostic] WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit{Maybe ChangeAnnotationMap
Maybe WorkspaceEditMap
Maybe (List DocumentChange)
forall a. Maybe a
_changeAnnotations :: forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
..} where
        _changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit
        _documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
        _changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing
    removeAll :: [TextEdit] -> Command |? CodeAction
removeAll [TextEdit]
tedit = CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> CodeAction -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$ CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction{Maybe Bool
Maybe Value
Maybe WorkspaceEdit
Maybe Reason
Maybe CodeActionKind
Maybe Command
Maybe (List Diagnostic)
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 :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_diagnostics :: forall a. Maybe a
_kind :: Maybe CodeActionKind
_title :: Text
..} where
        _changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit
        _title :: Text
_title = Text
"Remove all redundant imports"
        _kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
        _diagnostics :: Maybe a
_diagnostics = Maybe a
forall a. Maybe a
Nothing
        _documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
        _edit :: Maybe WorkspaceEdit
_edit = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit{Maybe ChangeAnnotationMap
Maybe WorkspaceEditMap
Maybe (List DocumentChange)
forall a. Maybe a
_changeAnnotations :: forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
..}
        _isPreferred :: Maybe a
_isPreferred = Maybe a
forall a. Maybe a
Nothing
        _command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
        _disabled :: Maybe a
_disabled = Maybe a
forall a. Maybe a
Nothing
        _xdata :: Maybe a
_xdata = Maybe a
forall a. Maybe a
Nothing
        _changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing

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' <- FilePath -> PositionIndexedString
indexedByPosition (FilePath -> PositionIndexedString)
-> FilePath -> PositionIndexedString
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
txt,
    [(Text, Diagnostic, [Range])]
r <- (Diagnostic -> Maybe (Text, Diagnostic, [Range]))
-> [Diagnostic] -> [(Text, Diagnostic, [Range])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ParsedModule -> Diagnostic -> Maybe (Text, Diagnostic, [Range])
groupDiag ParsedModule
pm) [Diagnostic]
digs,
    [(Text, Diagnostic, [Range])]
r' <- ((Text, Diagnostic, [Range]) -> (Text, Diagnostic, [Range]))
-> [(Text, Diagnostic, [Range])] -> [(Text, Diagnostic, [Range])]
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 <- ((Text, Diagnostic, [Range]) -> Maybe (Command |? CodeAction))
-> [(Text, Diagnostic, [Range])] -> [Command |? CodeAction]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Diagnostic, [Range]) -> Maybe (Command |? CodeAction)
removeSingle [(Text, Diagnostic, [Range])]
r',
    [Range]
allRanges <- [Range] -> [Range]
forall a. Ord a => [a] -> [a]
nubOrd ([Range] -> [Range]) -> [Range] -> [Range]
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 Diagnostic -> [Diagnostic] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Diagnostic]
ctxDigs],
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Text, Diagnostic, [Range])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Diagnostic, [Range])]
ctxEdits
      = [Command |? CodeAction]
caRemoveCtx [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
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
      = (Text, Diagnostic, [Range]) -> Maybe (Text, Diagnostic, [Range])
forall a. a -> Maybe a
Just (Text
title, Diagnostic
dig, [Range]
ranges)
      | Bool
otherwise = Maybe (Text, Diagnostic, [Range])
forall a. Maybe a
Nothing

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

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 (Located [LIE GhcPs])
Maybe LHsDocString
Maybe (Located WarningTxt)
Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodName :: Maybe (Located ModuleName)
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
..}} Diagnostic{Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
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:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
  | Text
msg <- Text -> Text
unifySpaces Text
_message
  , Just Located [LIE GhcPs]
export <- Maybe (Located [LIE GhcPs])
hsmodExports
  , Just Range
exportRange <- Located [LIE GhcPs] -> Maybe Range
forall a. Located a -> Maybe Range
getLocatedRange (Located [LIE GhcPs] -> Maybe Range)
-> Located [LIE GhcPs] -> Maybe Range
forall a b. (a -> b) -> a -> b
$ Located [LIE GhcPs] -> Located [LIE GhcPs]
forall a. Located a -> Located a
reLoc Located [LIE GhcPs]
export
  , SrcSpanLess (Located [LIE GhcPs])
exports <- Located [LIE GhcPs] -> SrcSpanLess (Located [LIE GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LIE GhcPs]
export
  , Just (Text
removeFromExport, ![Range]
ranges) <- (NotInScope -> (Text, [Range]))
-> Maybe NotInScope -> Maybe (Text, [Range])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([LIE GhcPs] -> Text -> (Text, [Range])
getRanges [LIE GhcPs]
SrcSpanLess (Located [LIE GhcPs])
exports (Text -> (Text, [Range]))
-> (NotInScope -> Text) -> NotInScope -> (Text, [Range])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotInScope -> Text
notInScope) (Text -> Maybe NotInScope
extractNotInScopeName Text
msg)
                         Maybe (Text, [Range])
-> Maybe (Text, [Range]) -> Maybe (Text, [Range])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,[Range
_range]) (Text -> (Text, [Range])) -> Maybe Text -> Maybe (Text, [Range])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
matchExportItem Text
msg
                         Maybe (Text, [Range])
-> Maybe (Text, [Range]) -> Maybe (Text, [Range])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,[Range
_range]) (Text -> (Text, [Range])) -> Maybe Text -> Maybe (Text, [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
    = (Text, [Range]) -> Maybe (Text, [Range])
forall a. a -> Maybe a
Just (Text
"Remove ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
removeFromExport Text -> Text -> Text
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 :: [LIE GhcPs] -> Text -> (Text, [Range])
getRanges [LIE GhcPs]
exports Text
txt = case [LIE GhcPs] -> FilePath -> [Range]
smallerRangesForBindingExport [LIE GhcPs]
exports (Text -> FilePath
T.unpack Text
txt) of
      []     -> (Text
txt, [Range
_range])
      [Range]
ranges -> (Text
txt, [Range]
ranges)
suggestRemoveRedundantExport ParsedModule
_ Diagnostic
_ = Maybe (Text, [Range])
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 :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls}}
  Maybe Text
contents
  Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$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 <- FilePath -> PositionIndexedString
indexedByPosition (FilePath -> PositionIndexedString)
-> (Text -> FilePath) -> Text -> PositionIndexedString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> PositionIndexedString)
-> Maybe Text -> Maybe PositionIndexedString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
contents
      = let edits :: [TextEdit]
edits = (Range -> Text -> TextEdit) -> Text -> Range -> TextEdit
forall a b c. (a -> b -> c) -> b -> a -> c
flip Range -> Text -> TextEdit
TextEdit Text
"" (Range -> TextEdit) -> [Range] -> [TextEdit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionIndexedString -> FilePath -> [Range]
relatedRanges PositionIndexedString
indexedContent (Text -> FilePath
T.unpack Text
name)
        in ([(Text
"Delete ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’", [TextEdit]
edits) | Bool -> Bool
not ([TextEdit] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TextEdit]
edits)])
    | Bool
otherwise = []
    where
      relatedRanges :: PositionIndexedString -> FilePath -> [Range]
relatedRanges PositionIndexedString
indexedContent FilePath
name =
        (LHsDecl GhcPs -> [Range]) -> [LHsDecl GhcPs] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PositionIndexedString -> FilePath -> LHsDecl GhcPs -> [Range]
findRelatedSpans PositionIndexedString
indexedContent FilePath
name (LHsDecl GhcPs -> [Range])
-> (LHsDecl GhcPs -> LHsDecl GhcPs) -> LHsDecl GhcPs -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDecl GhcPs -> LHsDecl GhcPs
forall a. Located a -> Located a
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 -> FilePath -> LHsDecl GhcPs -> [Range]
findRelatedSpans
        PositionIndexedString
indexedContent
        FilePath
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 :: LHsDecl GhcPs -> [Range]
findSig (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) (SigD XSigD GhcPs
_ Sig GhcPs
sig)) = PositionIndexedString
-> FilePath -> RealSrcSpan -> Sig GhcPs -> [Range]
findRelatedSigSpan PositionIndexedString
indexedContent FilePath
name RealSrcSpan
l Sig GhcPs
sig
                findSig LHsDecl GhcPs
_ = []
            in
              PositionIndexedString -> Range -> Range
extendForSpaces PositionIndexedString
indexedContent (RealSrcSpan -> Range
toRange RealSrcSpan
l) Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
:
              (LHsDecl GhcPs -> [Range]) -> [LHsDecl GhcPs] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LHsDecl GhcPs -> [Range]
findSig (LHsDecl GhcPs -> [Range])
-> (LHsDecl GhcPs -> LHsDecl GhcPs) -> LHsDecl GhcPs -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDecl GhcPs -> LHsDecl GhcPs
forall a. Located a -> Located a
reLoc) [LHsDecl GhcPs]
hsmodDecls
          Located (IdP GhcPs)
_ -> (LMatch GhcPs (LHsExpr GhcPs) -> [Range])
-> [LMatch GhcPs (LHsExpr GhcPs)] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PositionIndexedString
-> FilePath -> LMatch GhcPs (LHsExpr GhcPs) -> [Range]
findRelatedSpanForMatch PositionIndexedString
indexedContent FilePath
name) [LMatch GhcPs (LHsExpr GhcPs)]
matches
      findRelatedSpans PositionIndexedString
_ FilePath
_ LHsDecl 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 -> Located (IdP idL)
fun_id=Located (IdP 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 -> Located [LMatch p body]
mg_alts=L SrcSpan
_ [LMatch GhcPs (LHsExpr GhcPs)]
matches}
          } = (Located RdrName, [LMatch GhcPs (LHsExpr GhcPs)])
-> Maybe (Located RdrName, [LMatch GhcPs (LHsExpr GhcPs)])
forall a. a -> Maybe a
Just (Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLoc Located (IdP GhcPs)
Located RdrName
lname, [LMatch GhcPs (LHsExpr GhcPs)]
matches)
      extractNameAndMatchesFromFunBind HsBind GhcPs
_ = Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])
forall a. Maybe a
Nothing

      findRelatedSigSpan :: PositionIndexedString -> String -> RealSrcSpan -> Sig GhcPs -> [Range]
      findRelatedSigSpan :: PositionIndexedString
-> FilePath -> RealSrcSpan -> Sig GhcPs -> [Range]
findRelatedSigSpan PositionIndexedString
indexedContent FilePath
name RealSrcSpan
l Sig GhcPs
sig =
        let maybeSpan :: Maybe (SrcSpan, Bool)
maybeSpan = FilePath -> Sig GhcPs -> Maybe (SrcSpan, Bool)
findRelatedSigSpan1 FilePath
name Sig GhcPs
sig
        in case Maybe (SrcSpan, Bool)
maybeSpan of
          Just (SrcSpan
_span, Bool
True) -> Range -> [Range]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range -> [Range]) -> Range -> [Range]
forall a b. (a -> b) -> a -> b
$ PositionIndexedString -> Range -> Range
extendForSpaces PositionIndexedString
indexedContent (Range -> Range) -> Range -> Range
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
toRange RealSrcSpan
l -- a :: Int
          Just (RealSrcSpan RealSrcSpan
span Maybe BufSpan
_, Bool
False) -> Range -> [Range]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range -> [Range]) -> Range -> [Range]
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 :: FilePath -> Sig GhcPs -> Maybe (SrcSpan, Bool)
findRelatedSigSpan1 FilePath
name (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
lnames LHsSigWcType GhcPs
_) =
        let maybeIdx :: Maybe Int
maybeIdx = (Located RdrName -> Bool) -> [Located RdrName] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(L SrcSpan
_ RdrName
id) -> IdP GhcPs -> FilePath -> Bool
isSameName IdP GhcPs
RdrName
id FilePath
name) [Located (IdP GhcPs)]
[Located RdrName]
lnames
        in case Maybe Int
maybeIdx of
            Maybe Int
Nothing -> Maybe (SrcSpan, Bool)
forall a. Maybe a
Nothing
            Just Int
_ | [Located RdrName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Located (IdP GhcPs)]
[Located RdrName]
lnames Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> (SrcSpan, Bool) -> Maybe (SrcSpan, Bool)
forall a. a -> Maybe a
Just (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located RdrName -> SrcSpan) -> Located RdrName -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLoc (Located RdrName -> Located RdrName)
-> Located RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ [Located RdrName] -> Located RdrName
forall a. [a] -> a
head [Located (IdP GhcPs)]
[Located RdrName]
lnames, Bool
True)
            Just Int
idx ->
              let targetLname :: SrcSpan
targetLname = Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located RdrName -> SrcSpan) -> Located RdrName -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLoc (Located RdrName -> Located RdrName)
-> Located RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ [Located (IdP GhcPs)]
[Located RdrName]
lnames [Located RdrName] -> Int -> Located RdrName
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                              then SrcLoc
startLoc
                              else SrcSpan -> SrcLoc
srcSpanEnd (SrcSpan -> SrcLoc)
-> (Located RdrName -> SrcSpan) -> Located RdrName -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located RdrName -> SrcSpan)
-> (Located RdrName -> Located RdrName)
-> Located RdrName
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLoc (Located RdrName -> SrcLoc) -> Located RdrName -> SrcLoc
forall a b. (a -> b) -> a -> b
$ [Located (IdP GhcPs)]
[Located RdrName]
lnames [Located RdrName] -> Int -> Located RdrName
forall a. [a] -> Int -> a
!! (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                  endLoc' :: SrcLoc
endLoc' = if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Located RdrName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Located (IdP GhcPs)]
[Located RdrName]
lnames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                            then SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (Located RdrName -> SrcSpan) -> Located RdrName -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located RdrName -> SrcSpan)
-> (Located RdrName -> Located RdrName)
-> Located RdrName
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLoc (Located RdrName -> SrcLoc) -> Located RdrName -> SrcLoc
forall a b. (a -> b) -> a -> b
$ [Located (IdP GhcPs)]
[Located RdrName]
lnames [Located RdrName] -> Int -> Located RdrName
forall a. [a] -> Int -> a
!! (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                            else SrcLoc
endLoc
              in (SrcSpan, Bool) -> Maybe (SrcSpan, Bool)
forall a. a -> Maybe a
Just (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
startLoc' SrcLoc
endLoc', Bool
False)
      findRelatedSigSpan1 FilePath
_ Sig GhcPs
_ = Maybe (SrcSpan, Bool)
forall a. Maybe a
Nothing

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

      findRelatedSpanForHsBind
        :: PositionIndexedString
        -> String
        -> [LSig GhcPs]
        -> LHsBind GhcPs
        -> [Range]
      findRelatedSpanForHsBind :: PositionIndexedString
-> FilePath -> [LSig GhcPs] -> LHsBind GhcPs -> [Range]
findRelatedSpanForHsBind
        PositionIndexedString
indexedContent
        FilePath
name
        [LSig GhcPs]
lsigs
        (L (SrcSpan -> SrcSpan
forall a. a -> a
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 (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (IdP GhcPs)
Located RdrName
lname)
        then
          let findSig :: LSig GhcPs -> [Range]
findSig (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) Sig GhcPs
sig) = PositionIndexedString
-> FilePath -> RealSrcSpan -> Sig GhcPs -> [Range]
findRelatedSigSpan PositionIndexedString
indexedContent FilePath
name RealSrcSpan
l Sig GhcPs
sig
              findSig LSig GhcPs
_ = []
          in PositionIndexedString -> Range -> Range
extendForSpaces PositionIndexedString
indexedContent (RealSrcSpan -> Range
toRange RealSrcSpan
l) Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: (LSig GhcPs -> [Range]) -> [LSig GhcPs] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LSig GhcPs -> [Range]
findSig (LSig GhcPs -> [Range])
-> (LSig GhcPs -> LSig GhcPs) -> LSig GhcPs -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSig GhcPs -> LSig GhcPs
forall a. Located a -> Located a
reLoc) [LSig GhcPs]
lsigs
        else (LMatch GhcPs (LHsExpr GhcPs) -> [Range])
-> [LMatch GhcPs (LHsExpr GhcPs)] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PositionIndexedString
-> FilePath -> LMatch GhcPs (LHsExpr GhcPs) -> [Range]
findRelatedSpanForMatch PositionIndexedString
indexedContent FilePath
name) [LMatch GhcPs (LHsExpr GhcPs)]
matches
      findRelatedSpanForHsBind PositionIndexedString
_ FilePath
_ [LSig GhcPs]
_ LHsBind GhcPs
_ = []

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

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

data ExportsAs = ExportName | ExportPattern | ExportFamily | ExportAll
  deriving (ExportsAs -> ExportsAs -> Bool
(ExportsAs -> ExportsAs -> Bool)
-> (ExportsAs -> ExportsAs -> Bool) -> Eq ExportsAs
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 :: Located a -> Maybe Range
getLocatedRange :: Located a -> Maybe Range
getLocatedRange = SrcSpan -> Maybe Range
srcSpanToRange (SrcSpan -> Maybe Range)
-> (Located a -> SrcSpan) -> Located a -> Maybe Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc

suggestExportUnusedTopBinding :: Maybe T.Text -> ParsedModule -> Diagnostic -> [(T.Text, TextEdit)]
suggestExportUnusedTopBinding :: Maybe Text -> ParsedModule -> Diagnostic -> [(Text, TextEdit)]
suggestExportUnusedTopBinding Maybe Text
srcOpt ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (Located [LIE GhcPs])
Maybe LHsDocString
Maybe (Located WarningTxt)
Maybe (Located ModuleName)
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodName :: Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
..}} Diagnostic{Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
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:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$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
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
".*Defined but not used: ‘([^ ]+)’"
                   Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
".*Defined but not used: type constructor or class ‘([^ ]+)’"
                   Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
".*Defined but not used: data constructor ‘([^ ]+)’"
  , Just (ExportsAs
exportType, Located RdrName
_) <- ((ExportsAs, Located RdrName) -> Bool)
-> [(ExportsAs, Located RdrName)]
-> Maybe (ExportsAs, Located RdrName)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Range -> Located (IdP GhcPs) -> Bool
matchWithDiagnostic Range
_range (Located RdrName -> Bool)
-> ((ExportsAs, Located RdrName) -> Located RdrName)
-> (ExportsAs, Located RdrName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExportsAs, Located RdrName) -> Located RdrName
forall a b. (a, b) -> b
snd)
                            ([(ExportsAs, Located RdrName)]
 -> Maybe (ExportsAs, Located RdrName))
-> ([LHsDecl GhcPs] -> [(ExportsAs, Located RdrName)])
-> [LHsDecl GhcPs]
-> Maybe (ExportsAs, Located RdrName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsDecl GhcPs -> Maybe (ExportsAs, Located RdrName))
-> [LHsDecl GhcPs] -> [(ExportsAs, Located RdrName)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                                (\(L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> SrcSpan
l) HsDecl GhcPs
b) -> if Bool -> (Range -> Bool) -> Maybe Range -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Range -> Bool
isTopLevel (Maybe Range -> Bool) -> Maybe Range -> Bool
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
l
                                                then HsDecl GhcPs -> Maybe (ExportsAs, Located (IdP GhcPs))
exportsAs HsDecl GhcPs
b else Maybe (ExportsAs, Located RdrName)
forall a. Maybe a
Nothing)
                            ([LHsDecl GhcPs] -> Maybe (ExportsAs, Located RdrName))
-> [LHsDecl GhcPs] -> Maybe (ExportsAs, Located RdrName)
forall a b. (a -> b) -> a -> b
$ [LHsDecl GhcPs]
hsmodDecls
  , Just Position
pos <- ((Range -> Position) -> Maybe Range -> Maybe Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_end (Maybe Range -> Maybe Position)
-> (Located [LIE GhcPs] -> Maybe Range)
-> Located [LIE GhcPs]
-> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [LIE GhcPs] -> Maybe Range
forall a. Located a -> Maybe Range
getLocatedRange) (Located [LIE GhcPs] -> Maybe Position)
-> (Located [LIE GhcPs] -> Located [LIE GhcPs])
-> Located [LIE GhcPs]
-> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [LIE GhcPs] -> Located [LIE GhcPs]
forall a. Located a -> Located a
reLoc (Located [LIE GhcPs] -> Maybe Position)
-> Maybe (Located [LIE GhcPs]) -> Maybe Position
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Located [LIE GhcPs])
hsmodExports
  , Just Bool
needComma <- Text -> Located [LIE GhcPs] -> Bool
needsComma Text
source (Located [LIE GhcPs] -> Bool)
-> Maybe (Located [LIE GhcPs]) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Located [LIE GhcPs] -> Located [LIE GhcPs])
-> Maybe (Located [LIE GhcPs]) -> Maybe (Located [LIE GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located [LIE GhcPs] -> Located [LIE GhcPs]
forall a. Located a -> Located a
reLoc Maybe (Located [LIE GhcPs])
hsmodExports
  , let exportName :: Text
exportName = (if Bool
needComma then Text
", " else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExportsAs -> Text -> Text
printExport ExportsAs
exportType Text
name
        insertPos :: Position
insertPos = Position
pos {_character :: UInt
_character = UInt -> UInt
forall a. Enum a => a -> a
pred (UInt -> UInt) -> UInt -> UInt
forall a b. (a -> b) -> a -> b
$ Position -> UInt
_character Position
pos}
  = [(Text
"Export ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’", Range -> Text -> TextEdit
TextEdit (Position -> Position -> Range
Range Position
insertPos Position
insertPos) Text
exportName)]
  | Bool
otherwise = []
  where
    -- we get the last export and the closing bracket and check for comma in that range
    needsComma :: T.Text -> Located [LIE GhcPs] -> Bool
    needsComma :: Text -> Located [LIE GhcPs] -> Bool
needsComma Text
_ (L SrcSpan
_ []) = Bool
False
    needsComma Text
source (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) [LIE GhcPs]
exports) =
      let closeParan :: Position
closeParan = Range -> Position
_end (Range -> Position) -> Range -> Position
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
l
          lastExport :: Maybe Position
lastExport = (Range -> Position) -> Maybe Range -> Maybe Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_end (Maybe Range -> Maybe Position)
-> (LIE GhcPs -> Maybe Range) -> LIE GhcPs -> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> Maybe Range
forall a. Located a -> Maybe Range
getLocatedRange (LIE GhcPs -> Maybe Position) -> LIE GhcPs -> Maybe Position
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs] -> LIE GhcPs
forall a. [a] -> a
last ([LIE GhcPs] -> LIE GhcPs) -> [LIE GhcPs] -> LIE GhcPs
forall a b. (a -> b) -> a -> b
$ (LIE GhcPs -> LIE GhcPs) -> [LIE GhcPs] -> [LIE GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LIE GhcPs -> LIE GhcPs
forall a. Located a -> Located a
reLoc [LIE GhcPs]
exports
      in case Maybe Position
lastExport of
        Just Position
lastExport -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
T.isInfixOf Text
"," (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Range -> Text -> Text
textInRange (Position -> Position -> Range
Range Position
lastExport Position
closeParan) Text
source
        Maybe Position
_ -> Bool
False
    needsComma Text
_ Located [LIE GhcPs]
_ = Bool
False

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

    parenthesizeIfNeeds :: Bool -> T.Text -> T.Text
    parenthesizeIfNeeds :: Bool -> Text -> Text
parenthesizeIfNeeds Bool
needsTypeKeyword Text
x
      | Text -> Char
T.head Text
x Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
opLetter = (if Bool
needsTypeKeyword then Text
"type " else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
")"
      | Bool
otherwise = 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 = (Range -> Position) -> Maybe Range -> Maybe Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_start (Maybe Range -> Maybe Position)
-> (Located RdrName -> Maybe Range)
-> Located RdrName
-> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> Maybe Range
forall a. Located a -> Maybe Range
getLocatedRange (Located RdrName -> Maybe Position)
-> Located RdrName -> Maybe Position
forall a b. (a -> b) -> a -> b
$ Located (IdP GhcPs)
Located RdrName
x
       in Maybe Position
loc Maybe Position -> Maybe Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Position -> Maybe Position
forall a. a -> Maybe a
Just Position
l Bool -> Bool -> Bool
&& Maybe Position
loc Maybe Position -> Maybe Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position -> Maybe Position
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 " Text -> Text -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(..)"

    isTopLevel :: Range -> Bool
    isTopLevel :: Range -> Bool
isTopLevel Range
l = (Position -> UInt
_character (Position -> UInt) -> (Range -> Position) -> Range -> UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Position
_start) Range
l UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
0

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

suggestAddTypeAnnotationToSatisfyContraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyContraints :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyContraints Maybe Text
sourceOpt Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$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)
                        Maybe [Text] -> Maybe [Text] -> Maybe [Text]
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)
                        Maybe [Text] -> Maybe [Text] -> Maybe [Text]
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)
            = Text -> Text -> Text -> [(Text, [TextEdit])]
codeEdit Text
ty Text
lit (Text -> Text -> Text
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 -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
True Bool
True Bool
False Bool
False)
            = let lit' :: Text
lit' = Text -> Text -> Text
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 Text -> Text -> Text -> [(Text, [TextEdit])]
codeEdit 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
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lit a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" :: " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
ty a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
      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"
                                       ]
      codeEdit :: Text -> Text -> Text -> [(Text, [TextEdit])]
codeEdit Text
ty Text
lit Text
replacement =
        let title :: Text
title = Text
"Add type annotation ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ty Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’ to ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’"
            edits :: [TextEdit]
edits = [Range -> Text -> TextEdit
TextEdit Range
_range Text
replacement]
        in  [( Text
title, [TextEdit]
edits )]


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 DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
-- 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’.
    | renameSuggestions :: [Text]
renameSuggestions@(Text
_:[Text]
_) <- Text -> [Text]
extractRenamableTerms Text
_message
        = [ (Text
"Replace with ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
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}
--     * Variable not in scope:
--         suggestAcion :: Maybe T.Text -> Range -> Range
    | Just [Text
name, Text
typ] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
message Text
"Variable not in scope: ([^ ]+) :: ([^*•]+)"
    = IdeOptions
-> ParsedModule -> Range -> Text -> Text -> [(Text, [TextEdit])]
newDefinitionAction IdeOptions
ideOptions ParsedModule
parsedModule Range
_range Text
name Text
typ
    | Just [Text
name, Text
typ] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
message Text
"Found hole: _([^ ]+) :: ([^*•]+) Or perhaps"
    , [(Text
label, [TextEdit]
newDefinitionEdits)] <- IdeOptions
-> ParsedModule -> Range -> Text -> Text -> [(Text, [TextEdit])]
newDefinitionAction IdeOptions
ideOptions ParsedModule
parsedModule Range
_range Text
name Text
typ
    = [(Text
label, Maybe Text -> Range -> Text -> TextEdit
mkRenameEdit Maybe Text
contents Range
_range Text
name TextEdit -> [TextEdit] -> [TextEdit]
forall a. a -> [a] -> [a]
: [TextEdit]
newDefinitionEdits)]
    | Bool
otherwise = []
    where
      message :: Text
message = Text -> Text
unifySpaces Text
_message

newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> T.Text -> [(T.Text, [TextEdit])]
newDefinitionAction :: IdeOptions
-> ParsedModule -> Range -> Text -> Text -> [(Text, [TextEdit])]
newDefinitionAction IdeOptions{Bool
Int
FilePath
[FilePath]
[Text]
Maybe FilePath
IO Bool
IO CheckParents
ShakeOptions
Action IdeGhcSession
IdePkgLocationOptions
ProgressReportingStyle
IdeOTMemoryProfiling
IdeTesting
IdeDefer
IdeReportProgress
OptHaddockParse
ParsedSource -> IdePreprocessedSource
Config -> DynFlagsModifications
forall a. Typeable a => a -> Bool
optRunSubset :: IdeOptions -> Bool
optProgressStyle :: IdeOptions -> ProgressReportingStyle
optSkipProgress :: IdeOptions -> forall a. Typeable a => a -> Bool
optShakeOptions :: IdeOptions -> ShakeOptions
optModifyDynFlags :: IdeOptions -> Config -> DynFlagsModifications
optHaddockParse :: IdeOptions -> OptHaddockParse
optCheckParents :: IdeOptions -> IO CheckParents
optCheckProject :: IdeOptions -> IO Bool
optDefer :: IdeOptions -> IdeDefer
optKeywords :: IdeOptions -> [Text]
optNewColonConvention :: IdeOptions -> Bool
optLanguageSyntax :: IdeOptions -> FilePath
optMaxDirtyAge :: IdeOptions -> Int
optReportProgress :: IdeOptions -> IdeReportProgress
optTesting :: IdeOptions -> IdeTesting
optOTMemoryProfiling :: IdeOptions -> IdeOTMemoryProfiling
optShakeProfiling :: IdeOptions -> Maybe FilePath
optExtensions :: IdeOptions -> [FilePath]
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
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 :: FilePath
optMaxDirtyAge :: Int
optReportProgress :: IdeReportProgress
optTesting :: IdeTesting
optOTMemoryProfiling :: IdeOTMemoryProfiling
optShakeProfiling :: Maybe FilePath
optExtensions :: [FilePath]
optPkgLocationOpts :: IdePkgLocationOptions
optGhcSession :: Action IdeGhcSession
optPreprocessor :: ParsedSource -> IdePreprocessedSource
..} ParsedModule
parsedModule Range{Position
_start :: Position
_start :: Range -> Position
_start} Text
name Text
typ
    | Range Position
_ Position
lastLineP : [Range]
_ <-
      [ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
sp
      | (L (SrcSpan -> SrcSpan
forall a. a -> a
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 :: UInt -> UInt -> Position
Position{ _line :: UInt
_line = Position -> UInt
_line Position
lastLineP UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1, _character :: UInt
_character = UInt
0}
    = [ (Text
"Define " Text -> Text -> Text
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 Text -> Text -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
colon Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpace Text
typ
    ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls}} = ParsedModule
parsedModule

suggestFillTypeWildcard :: Diagnostic -> [(T.Text, TextEdit)]
suggestFillTypeWildcard :: Diagnostic -> [(Text, TextEdit)]
suggestFillTypeWildcard Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
-- Foo.hs:3:8: error:
--     * Found type wildcard `_' standing for `p -> p1 -> p'

    | Text
"Found type wildcard" Text -> Text -> Bool
`T.isInfixOf` Text
_message
    , Text
" standing for " Text -> Text -> Bool
`T.isInfixOf` Text
_message
    , Text
typeSignature <- Text -> Text
extractWildCardTypeSignature Text
_message
        =  [(Text
"Use type signature: ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeSignature Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’", Range -> Text -> TextEdit
TextEdit Range
_range Text
typeSignature)]
    | Bool
otherwise = []

{- 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 DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modul, Range -> Text -> TextEdit
TextEdit Range
_range Text
modul)
              | Text
modul <- (Text -> Maybe Text) -> [Text] -> [Text]
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
_] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
modul
        [Text]
_                   -> Maybe Text
forall a. Maybe a
Nothing


suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)]
suggestFillHole :: Diagnostic -> [(Text, TextEdit)]
suggestFillHole Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    | Just Text
holeName <- Text -> Maybe Text
extractHoleName Text
_message
    , ([Text]
holeFits, [Text]
refFits) <- [Text] -> ([Text], [Text])
processHoleSuggestions (Text -> [Text]
T.lines Text
_message) =
      let isInfixHole :: Bool
isInfixHole = Text
_message Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
addBackticks Text
holeName :: Bool in
        (Text -> (Text, TextEdit)) -> [Text] -> [(Text, TextEdit)]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Bool -> Bool -> Text -> (Text, TextEdit)
proposeHoleFit Text
holeName Bool
False Bool
isInfixHole) [Text]
holeFits
        [(Text, TextEdit)] -> [(Text, TextEdit)] -> [(Text, TextEdit)]
forall a. [a] -> [a] -> [a]
++ (Text -> (Text, TextEdit)) -> [Text] -> [(Text, TextEdit)]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Bool -> Bool -> Text -> (Text, TextEdit)
proposeHoleFit Text
holeName Bool
True Bool
isInfixHole) [Text]
refFits
    | Bool
otherwise = []
    where
      extractHoleName :: Text -> Maybe Text
extractHoleName = ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
forall a. [a] -> a
head (Maybe [Text] -> Maybe Text)
-> (Text -> Maybe [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Maybe [Text]) -> Text -> Text -> Maybe [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
"Found hole: ([^ ]*)"
      addBackticks :: a -> a
addBackticks a
text = a
"`" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
text a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"`"
      addParens :: a -> a
addParens a
text = a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
text a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
      proposeHoleFit :: Text -> Bool -> Bool -> Text -> (Text, TextEdit)
proposeHoleFit Text
holeName Bool
parenthise Bool
isInfixHole Text
name =
        let isInfixOperator :: Bool
isInfixOperator = Text -> Char
T.head Text
name Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
            name' :: Text
name' = Bool -> Bool -> Text -> Text
getOperatorNotation Bool
isInfixHole Bool
isInfixOperator Text
name in
          ( Text
"replace " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
holeName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
          , Range -> Text -> TextEdit
TextEdit Range
_range (if Bool
parenthise then Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
addParens Text
name' else Text
name')
          )
      getOperatorNotation :: Bool -> Bool -> Text -> Text
getOperatorNotation Bool
True Bool
False Text
name                    = Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
addBackticks Text
name
      getOperatorNotation Bool
True Bool
True Text
name                     = Int -> Text -> Text
T.drop Int
1 (Int -> Text -> Text
T.dropEnd Int
1 Text
name)
      getOperatorNotation Bool
_isInfixHole Bool
_isInfixOperator Text
name = Text
name

processHoleSuggestions :: [T.Text] -> ([T.Text], [T.Text])
processHoleSuggestions :: [Text] -> ([Text], [Text])
processHoleSuggestions [Text]
mm = ([Text]
holeSuggestions, [Text]
refSuggestions)
{-
    • Found hole: _ :: LSP.Handlers

      Valid hole fits include def
      Valid refinement hole fits include
        fromMaybe (_ :: LSP.Handlers) (_ :: Maybe LSP.Handlers)
        fromJust (_ :: Maybe LSP.Handlers)
        haskell-lsp-types-0.22.0.0:Language.LSP.Types.Window.$sel:_value:ProgressParams (_ :: ProgressParams
                                                                                                        LSP.Handlers)
        T.foldl (_ :: LSP.Handlers -> Char -> LSP.Handlers)
                (_ :: LSP.Handlers)
                (_ :: T.Text)
        T.foldl' (_ :: LSP.Handlers -> Char -> LSP.Handlers)
                 (_ :: LSP.Handlers)
                 (_ :: T.Text)
-}
  where
    t :: Text -> Text
t = Text -> Text
forall a. a -> a
id @T.Text
    holeSuggestions :: [Text]
holeSuggestions = do
      -- get the text indented under Valid hole fits
      [Text]
validHolesSection <-
        (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy (Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
" *Valid (hole fits|substitutions) include") [Text]
mm
      -- the Valid hole fits line can contain a hole fit
      Text
holeFitLine <-
        (Text -> Text) -> [Text] -> [Text]
forall a. (a -> a) -> [a] -> [a]
mapHead
            (MatchResult Text -> Text
forall a. MatchResult a -> a
mrAfter (MatchResult Text -> Text)
-> (Text -> MatchResult Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> MatchResult Text
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
" *Valid (hole fits|substitutions) include"))
            [Text]
validHolesSection
      let holeFit :: Text
holeFit = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Text
holeFitLine
      Bool -> [BufSpan]
forall (f :: * -> *). Alternative f => Bool -> f BufSpan
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
holeFit)
      Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return Text
holeFit
    refSuggestions :: [Text]
refSuggestions = do -- @[]
      -- get the text indented under Valid refinement hole fits
      [Text]
refinementSection <-
        (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy (Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
" *Valid refinement hole fits include") [Text]
mm
      -- get the text for each hole fit
      [Text]
holeFitLines <- [Text] -> [[Text]]
getIndentedGroups ([Text] -> [Text]
forall a. [a] -> [a]
tail [Text]
refinementSection)
      let holeFit :: Text
holeFit = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
holeFitLines
      Bool -> [BufSpan]
forall (f :: * -> *). Alternative f => Bool -> f BufSpan
guard (Bool -> [BufSpan]) -> Bool -> [BufSpan]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
holeFit Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
"Some refinement hole fits suppressed"
      Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return Text
holeFit

    mapHead :: (a -> a) -> [a] -> [a]
mapHead a -> a
f (a
a:[a]
aa) = a -> a
f a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
aa
    mapHead a -> a
_ []     = []

-- > getIndentedGroups [" H1", "  l1", "  l2", " H2", "  l3"] = [[" H1,", "  l1", "  l2"], [" H2", "  l3"]]
getIndentedGroups :: [T.Text] -> [[T.Text]]
getIndentedGroups :: [Text] -> [[Text]]
getIndentedGroups [] = []
getIndentedGroups ll :: [Text]
ll@(Text
l:[Text]
_) = (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Int
indentation Text
l) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
indentation) [Text]
ll
-- |
-- > getIndentedGroupsBy (" H" `isPrefixOf`) [" H1", "  l1", "  l2", " H2", "  l3"] = [[" H1", "  l1", "  l2"], [" H2", "  l3"]]
getIndentedGroupsBy :: (T.Text -> Bool) -> [T.Text] -> [[T.Text]]
getIndentedGroupsBy :: (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy Text -> Bool
pred [Text]
inp = case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not(Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Text -> Bool
pred) [Text]
inp of
    (Text
l:[Text]
ll) -> case (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Text
l' -> Text -> Int
indentation Text
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
indentation Text
l') [Text]
ll of
        ([Text]
indented, [Text]
rest) -> (Text
lText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
indented) [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy Text -> Bool
pred [Text]
rest
    [Text]
_ -> []

indentation :: T.Text -> Int
indentation :: Text -> Int
indentation = Text -> Int
T.length (Text -> Int) -> (Text -> Text) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace

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 :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports}) Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$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 ‘([^’]*)’ *\\((.*)\\).$"
    = [LImportDecl 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 [(Text, Text)]
-> ((Text, Text) -> [(Text, CodeActionKind, Rewrite)])
-> [(Text, CodeActionKind, Rewrite)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> [(Text, CodeActionKind, Rewrite)])
-> (Text, Text) -> [(Text, CodeActionKind, Rewrite)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([LImportDecl 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 :: [LImportDecl GhcPs]
-> Text -> Text -> Text -> [(Text, CodeActionKind, Rewrite)]
suggestions [LImportDecl GhcPs]
decls Text
binding Text
mod Text
srcspan
          | Range
range <- case [ RealSrcSpan
x | (RealSrcSpan
x,FilePath
"") <- ReadS RealSrcSpan
readSrcSpan (Text -> FilePath
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 = UInt -> UInt
forall a. Enum a => a -> a
succ (Position -> UInt
_character (Range -> Position
_end Range
x))}}
                [RealSrcSpan]
_ -> FilePath -> Range
forall a. HasCallStack => FilePath -> a
error FilePath
"bug in srcspan parser",
            Just LImportDecl GhcPs
decl <- [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs)
findImportDeclByRange [LImportDecl GhcPs]
decls Range
range,
            Just IdentInfo
ident <- Text -> Text -> Maybe IdentInfo
lookupExportMap Text
binding Text
mod
          = [ ( Text
"Add " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ImportStyle -> Text
renderImportStyle ImportStyle
importStyle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the import list of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod
              , Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"extend" ImportStyle
importStyle
              , (Maybe FilePath -> FilePath -> LImportDecl GhcPs -> Rewrite)
-> (Maybe FilePath, FilePath) -> LImportDecl GhcPs -> Rewrite
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe FilePath -> FilePath -> LImportDecl GhcPs -> Rewrite
extendImport (ImportStyle -> (Maybe FilePath, FilePath)
unImportStyle ImportStyle
importStyle) LImportDecl GhcPs
decl
              )
            | ImportStyle
importStyle <- NonEmpty ImportStyle -> [ImportStyle]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ImportStyle -> [ImportStyle])
-> NonEmpty ImportStyle -> [ImportStyle]
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
          | Just HashSet IdentInfo
match <- Text
-> HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
binding (ExportsMap -> HashMap Text (HashSet IdentInfo)
getExportsMap ExportsMap
exportsMap)
          -- 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 <- (IdentInfo -> IdentInfo -> Ordering) -> [IdentInfo] -> [IdentInfo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\IdentInfo
ident1 IdentInfo
ident2 -> IdentInfo -> Maybe Text
parent IdentInfo
ident2 Maybe Text -> Maybe Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` IdentInfo -> Maybe Text
parent IdentInfo
ident1) (HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList HashSet IdentInfo
match)
          , [IdentInfo]
idents <- (IdentInfo -> Bool) -> [IdentInfo] -> [IdentInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (\IdentInfo
ident -> IdentInfo -> Text
moduleNameText IdentInfo
ident Text -> Text -> Bool
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
          , (Bool -> Bool
not (Bool -> Bool) -> ([IdentInfo] -> Bool) -> [IdentInfo] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IdentInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [IdentInfo]
idents -- Ensure fallback while `idents` is empty
          , IdentInfo
ident <- [IdentInfo] -> IdentInfo
forall a. [a] -> a
head [IdentInfo]
idents
          = IdentInfo -> Maybe IdentInfo
forall a. a -> Maybe a
Just IdentInfo
ident

            -- fallback to using GHC suggestion even though it is not always correct
          | Bool
otherwise
          = IdentInfo -> Maybe IdentInfo
forall a. a -> Maybe a
Just IdentInfo :: OccName -> Text -> Maybe Text -> Bool -> Text -> IdentInfo
IdentInfo
                { name :: OccName
name = FilePath -> OccName
mkVarOcc (FilePath -> OccName) -> FilePath -> OccName
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
binding
                , rendered :: Text
rendered = Text
binding
                , parent :: Maybe Text
parent = Maybe Text
forall a. Maybe a
Nothing
                , isDatacon :: Bool
isDatacon = Bool
False
                , moduleNameText :: Text
moduleNameText = 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)     = NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcPs)
ne
targetImports (ImplicitPrelude [LImportDecl GhcPs]
xs) = [LImportDecl GhcPs]
xs

oneAndOthers :: [a] -> [(a, [a])]
oneAndOthers :: [a] -> [(a, [a])]
oneAndOthers = [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
go
    where
        go :: [a] -> [(a, [a])]
go []       = []
        go (a
x : [a]
xs) = (a
x, [a]
xs) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: ((a, [a]) -> (a, [a])) -> [(a, [a])] -> [(a, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [a]) -> (a, [a]) -> (a, [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
x a -> [a] -> [a]
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 ->
    ParsedSource ->
    T.Text ->
    Diagnostic ->
    [(T.Text, [Either TextEdit Rewrite])]
suggestImportDisambiguation :: DynFlags
-> Maybe Text
-> ParsedSource
-> Text
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])]
suggestImportDisambiguation DynFlags
df (Just Text
txt) ps :: ParsedSource
ps@(L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports}) Text
fileContents diag :: Diagnostic
diag@Diagnostic {Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
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:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$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 <-
            ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
forall a. [a] -> a
last
                ([[Text]] -> [Text]) -> Maybe [[Text]] -> Maybe [Text]
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 (Maybe [Text] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [Text]
local)
    | Bool
otherwise = []
    where
        locDic :: HashMap Text (NonEmpty (LImportDecl GhcPs))
locDic =
            (DList (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs))
-> HashMap Text (DList (LImportDecl GhcPs))
-> HashMap Text (NonEmpty (LImportDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([LImportDecl GhcPs] -> NonEmpty (LImportDecl GhcPs)
forall a. [a] -> NonEmpty a
NE.fromList ([LImportDecl GhcPs] -> NonEmpty (LImportDecl GhcPs))
-> (DList (LImportDecl GhcPs) -> [LImportDecl GhcPs])
-> DList (LImportDecl GhcPs)
-> NonEmpty (LImportDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall a. DList a -> [a]
DL.toList) (HashMap Text (DList (LImportDecl GhcPs))
 -> HashMap Text (NonEmpty (LImportDecl GhcPs)))
-> HashMap Text (DList (LImportDecl GhcPs))
-> HashMap Text (NonEmpty (LImportDecl GhcPs))
forall a b. (a -> b) -> a -> b
$
            (DList (LImportDecl GhcPs)
 -> DList (LImportDecl GhcPs) -> DList (LImportDecl GhcPs))
-> [(Text, DList (LImportDecl GhcPs))]
-> HashMap Text (DList (LImportDecl GhcPs))
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith DList (LImportDecl GhcPs)
-> DList (LImportDecl GhcPs) -> DList (LImportDecl GhcPs)
forall a. Semigroup a => a -> a -> a
(<>) ([(Text, DList (LImportDecl GhcPs))]
 -> HashMap Text (DList (LImportDecl GhcPs)))
-> [(Text, DList (LImportDecl GhcPs))]
-> HashMap Text (DList (LImportDecl GhcPs))
forall a b. (a -> b) -> a -> b
$
                (LImportDecl GhcPs -> (Text, DList (LImportDecl GhcPs)))
-> [LImportDecl GhcPs] -> [(Text, DList (LImportDecl GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map
                    ( \i :: LImportDecl GhcPs
i@(L SrcSpan
_ ImportDecl GhcPs
idecl) ->
                        ( FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
moduleNameString (ModuleName -> FilePath) -> ModuleName -> FilePath
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> SrcSpanLess (Located ModuleName))
-> Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
idecl
                        , LImportDecl GhcPs -> DList (LImportDecl GhcPs)
forall a. a -> DList a
DL.singleton LImportDecl GhcPs
i
                        )
                    )
                    [LImportDecl GhcPs]
hsmodImports
        toModuleTarget :: Text -> Maybe ModuleTarget
toModuleTarget Text
"Prelude"
            | DynFlags -> Bool
isPreludeImplicit DynFlags
df
             = ModuleTarget -> Maybe ModuleTarget
forall a. a -> Maybe a
Just (ModuleTarget -> Maybe ModuleTarget)
-> ModuleTarget -> Maybe ModuleTarget
forall a b. (a -> b) -> a -> b
$ [LImportDecl GhcPs] -> ModuleTarget
ImplicitPrelude ([LImportDecl GhcPs] -> ModuleTarget)
-> [LImportDecl GhcPs] -> ModuleTarget
forall a b. (a -> b) -> a -> b
$
                [LImportDecl GhcPs]
-> (NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs])
-> Maybe (NonEmpty (LImportDecl GhcPs))
-> [LImportDecl GhcPs]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall a. NonEmpty a -> [a]
NE.toList (Text
-> HashMap Text (NonEmpty (LImportDecl GhcPs))
-> Maybe (NonEmpty (LImportDecl GhcPs))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
"Prelude" HashMap Text (NonEmpty (LImportDecl GhcPs))
locDic)
        toModuleTarget Text
mName = NonEmpty (LImportDecl GhcPs) -> ModuleTarget
ExistingImp (NonEmpty (LImportDecl GhcPs) -> ModuleTarget)
-> Maybe (NonEmpty (LImportDecl GhcPs)) -> Maybe ModuleTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> HashMap Text (NonEmpty (LImportDecl GhcPs))
-> Maybe (NonEmpty (LImportDecl GhcPs))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
mName HashMap Text (NonEmpty (LImportDecl 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 = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
forall a. [a] -> a
head ([[Text]] -> [Text]) -> ([Text] -> [[Text]]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Bool) -> [[Text]] -> [[Text]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1) (Int -> Bool) -> ([Text] -> Int) -> [Text] -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Text]] -> [[Text]])
-> ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [[Text]]
forall a. Eq a => [a] -> [[a]]
group ([Text] -> [[Text]]) -> ([Text] -> [Text]) -> [Text] -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort
        hasDuplicate :: [a] -> Bool
hasDuplicate [a]
xs = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Set a
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
          | [Text] -> Bool
forall a. Ord a => [a] -> Bool
hasDuplicate [Text]
mods = case (Text -> Maybe ModuleTarget) -> [Text] -> Maybe [ModuleTarget]
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 ((ModuleTarget -> (ModuleTarget, [ModuleTarget]))
-> [ModuleTarget] -> [(ModuleTarget, [ModuleTarget])]
forall a b. (a -> b) -> [a] -> [b]
map (, []) [ModuleTarget]
targets) Bool
local
                                  Maybe [ModuleTarget]
Nothing      -> []
          | Bool
otherwise         = case (Text -> Maybe ModuleTarget) -> [Text] -> Maybe [ModuleTarget]
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 ([ModuleTarget] -> [(ModuleTarget, [ModuleTarget])]
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 =
            ((Text, [Either TextEdit Rewrite]) -> Text)
-> [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, [Either TextEdit Rewrite]) -> Text
forall a b. (a, b) -> a
fst
            [ ( HidingMode -> Text -> Text -> Bool -> Text
renderUniquify HidingMode
mode Text
modNameText Text
symbol Bool
False
              , ParsedSource
-> Text
-> Diagnostic
-> Text
-> HidingMode
-> [Either TextEdit Rewrite]
disambiguateSymbol 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 = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
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 _ qual <- nub $ mapMaybe (ideclAs . unLoc)
#else
                , L SrcSpan
_ ModuleName
qual <- [Located ModuleName] -> [Located ModuleName]
forall a. Ord a => [a] -> [a]
nubOrd ([Located ModuleName] -> [Located ModuleName])
-> [Located ModuleName] -> [Located ModuleName]
forall a b. (a -> b) -> a -> b
$ (LImportDecl GhcPs -> Maybe (Located ModuleName))
-> [LImportDecl GhcPs] -> [Located ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs (ImportDecl GhcPs -> Maybe (Located ModuleName))
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> Maybe (Located ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
#endif
                    ([LImportDecl GhcPs] -> [Located ModuleName])
-> [LImportDecl GhcPs] -> [Located ModuleName]
forall a b. (a -> b) -> a -> b
$ NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcPs)
imps
                ]
                [HidingMode] -> [HidingMode] -> [HidingMode]
forall a. [a] -> [a] -> [a]
++ [Bool -> ModuleName -> HidingMode
ToQualified Bool
parensed ModuleName
modName
                    | (LImportDecl GhcPs -> Bool) -> [LImportDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> ImportDecl GhcPs -> Bool
occursUnqualified Text
symbol (ImportDecl GhcPs -> Bool)
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
                        (ModuleTarget -> [LImportDecl GhcPs]
targetImports ModuleTarget
modTarget)
                    Bool -> Bool -> Bool
|| case ModuleTarget
modTarget of
                        ImplicitPrelude{} -> Bool
True
                        ModuleTarget
_                 -> Bool
False
                    ]
                [HidingMode] -> [HidingMode] -> [HidingMode]
forall a. [a] -> [a] -> [a]
++ [[ModuleTarget] -> HidingMode
HideOthers [ModuleTarget]
restImports | Bool -> Bool
not ([ModuleTarget] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleTarget]
restImports)]
            ] [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
forall a. [a] -> [a] -> [a]
++ [ ( HidingMode -> Text -> Text -> Bool -> Text
renderUniquify HidingMode
mode Text
T.empty Text
symbol Bool
True
              , ParsedSource
-> Text
-> Diagnostic
-> Text
-> HidingMode
-> [Either TextEdit Rewrite]
disambiguateSymbol ParsedSource
ps Text
fileContents Diagnostic
diag Text
symbol HidingMode
mode
              ) | Bool
local, Bool -> Bool
not ([(ModuleTarget, [ModuleTarget])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleTarget, [ModuleTarget])]
targetsWithRestImports)
                , let mode :: HidingMode
mode = [ModuleTarget] -> HidingMode
HideOthers ((ModuleTarget -> [ModuleTarget] -> [ModuleTarget])
-> (ModuleTarget, [ModuleTarget]) -> [ModuleTarget]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ([(ModuleTarget, [ModuleTarget])] -> (ModuleTarget, [ModuleTarget])
forall a. [a] -> a
head [(ModuleTarget, [ModuleTarget])]
targetsWithRestImports))
            ]
        renderUniquify :: HidingMode -> Text -> Text -> Bool -> Text
renderUniquify HideOthers {} Text
modName Text
symbol Bool
local =
            Text
"Use " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
local then Text
"local definition" else Text
modName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
symbol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", hiding other imports"
        renderUniquify (ToQualified Bool
_ ModuleName
qual) Text
_ Text
symbol Bool
_ =
            Text
"Replace with qualified: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (ModuleName -> FilePath
moduleNameString ModuleName
qual)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
symbol
suggestImportDisambiguation DynFlags
_ Maybe Text
_ ParsedSource
_ Text
_ Diagnostic
_ = []

occursUnqualified :: T.Text -> ImportDecl GhcPs -> Bool
occursUnqualified :: Text -> ImportDecl GhcPs -> Bool
occursUnqualified Text
symbol ImportDecl{Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
SourceText
Located ModuleName
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: Bool
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> Bool
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
..}
    | Maybe (Located ModuleName) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Located ModuleName)
ideclAs = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/=
            -- I don't find this particularly comprehensible,
            -- but HLint suggested me to do so...
        (Maybe (Bool, Located [LIE GhcPs])
ideclHiding Maybe (Bool, Located [LIE GhcPs])
-> ((Bool, Located [LIE GhcPs]) -> Bool) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Bool
isHiding, L SrcSpan
_ [LIE GhcPs]
ents) ->
            let occurs :: Bool
occurs = (LIE GhcPs -> Bool) -> [LIE GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text
symbol Text -> IE GhcPs -> Bool
`symbolOccursIn`) (IE GhcPs -> Bool) -> (LIE GhcPs -> IE GhcPs) -> LIE GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> IE GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LIE 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
        )
occursUnqualified Text
_ ImportDecl GhcPs
_ = Bool
False

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

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

disambiguateSymbol ::
    ParsedSource ->
    T.Text ->
    Diagnostic ->
    T.Text ->
    HidingMode ->
    [Either TextEdit Rewrite]
disambiguateSymbol :: ParsedSource
-> Text
-> Diagnostic
-> Text
-> HidingMode
-> [Either TextEdit Rewrite]
disambiguateSymbol ParsedSource
pm Text
fileContents Diagnostic {Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
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:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..} (Text -> FilePath
T.unpack -> FilePath
symbol) = \case
    (HideOthers [ModuleTarget]
hiddens0) ->
        [ Rewrite -> Either TextEdit Rewrite
forall a b. b -> Either a b
Right (Rewrite -> Either TextEdit Rewrite)
-> Rewrite -> Either TextEdit Rewrite
forall a b. (a -> b) -> a -> b
$ FilePath -> LImportDecl GhcPs -> Rewrite
hideSymbol FilePath
symbol LImportDecl GhcPs
idecl
        | ExistingImp NonEmpty (LImportDecl GhcPs)
idecls <- [ModuleTarget]
hiddens0
        , LImportDecl GhcPs
idecl <- NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcPs)
idecls
        ]
            [Either TextEdit Rewrite]
-> [Either TextEdit Rewrite] -> [Either TextEdit Rewrite]
forall a. [a] -> [a] -> [a]
++ [[Either TextEdit Rewrite]] -> [Either TextEdit Rewrite]
forall a. Monoid a => [a] -> a
mconcat
                [ if [LImportDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LImportDecl GhcPs]
imps
                    then Maybe (Either TextEdit Rewrite) -> [Either TextEdit Rewrite]
forall a. Maybe a -> [a]
maybeToList (Maybe (Either TextEdit Rewrite) -> [Either TextEdit Rewrite])
-> Maybe (Either TextEdit Rewrite) -> [Either TextEdit Rewrite]
forall a b. (a -> b) -> a -> b
$ TextEdit -> Either TextEdit Rewrite
forall a b. a -> Either a b
Left (TextEdit -> Either TextEdit Rewrite)
-> ((Text, TextEdit) -> TextEdit)
-> (Text, TextEdit)
-> Either TextEdit Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, TextEdit) -> TextEdit
forall a b. (a, b) -> b
snd ((Text, TextEdit) -> Either TextEdit Rewrite)
-> Maybe (Text, TextEdit) -> Maybe (Either TextEdit Rewrite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewImport -> ParsedSource -> Text -> Maybe (Text, TextEdit)
newImportToEdit (Text -> NewImport
hideImplicitPreludeSymbol (Text -> NewImport) -> Text -> NewImport
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
symbol) ParsedSource
pm Text
fileContents
                    else Rewrite -> Either TextEdit Rewrite
forall a b. b -> Either a b
Right (Rewrite -> Either TextEdit Rewrite)
-> (LImportDecl GhcPs -> Rewrite)
-> LImportDecl GhcPs
-> Either TextEdit Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> LImportDecl GhcPs -> Rewrite
hideSymbol FilePath
symbol (LImportDecl GhcPs -> Either TextEdit Rewrite)
-> [LImportDecl GhcPs] -> [Either TextEdit Rewrite]
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 = FilePath -> OccName
mkVarOcc FilePath
symbol
            rdr :: RdrName
rdr = ModuleName -> OccName -> RdrName
Qual ModuleName
qualMod OccName
occSym
         in Rewrite -> Either TextEdit Rewrite
forall a b. b -> Either a b
Right (Rewrite -> Either TextEdit Rewrite)
-> [Rewrite] -> [Either TextEdit Rewrite]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ if Bool
parensed
                then SrcSpan
-> (DynFlags -> TransformT (Either FilePath) (LHsExpr GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either FilePath) (Located ast))
-> Rewrite
Rewrite (NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
"<dummy>" Range
_range) ((DynFlags -> TransformT (Either FilePath) (LHsExpr GhcPs))
 -> Rewrite)
-> (DynFlags -> TransformT (Either FilePath) (LHsExpr GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
                    DynFlags
-> FilePath -> TransformT (Either FilePath) (LHsExpr GhcPs)
forall ast l.
(ASTElement l ast, ExactPrint (LocatedAn l ast)) =>
DynFlags
-> FilePath -> TransformT (Either FilePath) (LocatedAn l ast)
liftParseAST @(HsExpr GhcPs) DynFlags
df (FilePath -> TransformT (Either FilePath) (LHsExpr GhcPs))
-> FilePath -> TransformT (Either FilePath) (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
                    Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> Text
forall a. Outputable a => a -> Text
printOutputable (HsExpr GhcPs -> Text) -> HsExpr GhcPs -> Text
forall a b. (a -> b) -> a -> b
$
                        XVar GhcPs -> Located (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar @GhcPs NoExtField
XVar GhcPs
noExtField (Located (IdP GhcPs) -> HsExpr GhcPs)
-> Located (IdP GhcPs) -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$
                            Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLocA (Located RdrName -> Located RdrName)
-> Located RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L (FastString -> SrcSpan
mkGeneralSrcSpan  FastString
"") RdrName
rdr
                else SrcSpan
-> (DynFlags -> TransformT (Either FilePath) (Located RdrName))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either FilePath) (Located ast))
-> Rewrite
Rewrite (NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
"<dummy>" Range
_range) ((DynFlags -> TransformT (Either FilePath) (Located RdrName))
 -> Rewrite)
-> (DynFlags -> TransformT (Either FilePath) (Located RdrName))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
                    DynFlags
-> FilePath -> TransformT (Either FilePath) (Located RdrName)
forall ast l.
(ASTElement l ast, ExactPrint (LocatedAn l ast)) =>
DynFlags
-> FilePath -> TransformT (Either FilePath) (LocatedAn l ast)
liftParseAST @RdrName DynFlags
df (FilePath -> TransformT (Either FilePath) (Located RdrName))
-> FilePath -> TransformT (Either FilePath) (Located RdrName)
forall a b. (a -> b) -> a -> b
$
                    Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Text
forall a. Outputable a => a -> Text
printOutputable (Located RdrName -> Text) -> Located RdrName -> Text
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> Located RdrName
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 = (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> SrcSpan
l) ImportDecl GhcPs
_)-> SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
l Maybe Range -> Maybe Range -> Bool
forall a. Eq a => a -> a -> Bool
== Range -> Maybe Range
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 DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int32 |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    in [(Text
"Fix import of " Text -> Text -> Text
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 (ParsedSource -> ParsedSource
forall ast. ExactPrint ast => ast -> ast
makeDeltaAst -> ParsedSource
parsedModule) diag :: Diagnostic
diag@Diagnostic {Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
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:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$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 Text -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (FilePath
"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 regex :: Text
regex = Text
"(No instance for|Could not deduce) \\((.+)\\) arising from" -- a use of / a do statement
            regexImplicitParams :: Text
regexImplicitParams = Text
"Could not deduce: (\\?.+) arising from a use of"
            match :: Maybe [Text]
match = Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
regex
            matchImplicitParams :: Maybe [Text]
matchImplicitParams = Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
regexImplicitParams
        in Maybe [Text]
match Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Text]
matchImplicitParams Maybe [Text] -> ([Text] -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Text] -> Text
forall a. [a] -> a
last

-- | 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 :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls}) Diagnostic {Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
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:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..} Text
missingConstraint
  | Just LHsType GhcPs
instHead <- Maybe (LHsType GhcPs)
instanceHead
  = [(Text -> Text
actionTitle Text
missingConstraint , FilePath -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> FilePath
T.unpack Text
missingConstraint) LHsType GhcPs
instHead)]
  | Bool
otherwise = []
    where
      instanceHead :: Maybe (LHsType 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 <- DynFlags -> FilePath -> [LHsDecl GhcPs] -> Maybe (LHsType GhcPs)
forall p (p0 :: Pass).
(Outputable (HsType p), p ~ GhcPass p0) =>
DynFlags -> FilePath -> [LHsDecl p] -> Maybe (LHsType p)
findInstanceHead DynFlags
df (Text -> FilePath
T.unpack Text
instanceDeclaration) [LHsDecl GhcPs]
hsmodDecls
        = LHsType GhcPs -> Maybe (LHsType GhcPs)
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 SrcSpan
_ (InstD XInstD GhcPs
_ (ClsInstD XClsInstD GhcPs
_ ClsInstDecl {cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = HsIB{LHsType GhcPs
hsib_body :: LHsType GhcPs
hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body}})))
#else
        , Just (L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig{sig_body = hsib_body})})))
#endif
            <- Position -> [LHsDecl GhcPs] -> Maybe (LHsDecl GhcPs)
forall (t :: * -> *) e.
Foldable t =>
Position
-> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e)
findDeclContainingLoc (UInt -> UInt -> Position
Position (Text -> UInt
readPositionNumber Text
instanceLineStr) (Text -> UInt
readPositionNumber Text
constraintFirstCharStr)) [LHsDecl GhcPs]
hsmodDecls
        = LHsType GhcPs -> Maybe (LHsType GhcPs)
forall a. a -> Maybe a
Just LHsType GhcPs
hsib_body
        | Bool
otherwise
        = Maybe (LHsType GhcPs)
forall a. Maybe a
Nothing

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

      actionTitle :: T.Text -> T.Text
      actionTitle :: Text -> Text
actionTitle Text
constraint = Text
"Add `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constraint
        Text -> Text -> Text
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 :: forall pass. HsModule pass -> [LHsDecl pass]
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 SrcSpan
_ (ValD XValD GhcPs
_ FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = L SrcSpan
_ IdP GhcPs
funId})) <- Position -> [LHsDecl GhcPs] -> Maybe (LHsDecl GhcPs)
forall (t :: * -> *) e.
Foldable t =>
Position
-> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e)
findDeclContainingLoc (Range -> Position
_start Range
_range) [LHsDecl GhcPs]
hsmodDecls,
#if !MIN_VERSION_ghc(9,2,0)
    Just (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
_ HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB {LHsType GhcPs
hsib_body :: LHsType GhcPs
hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body}})
#else
    Just (TypeSig _ _ HsWC {hswc_body = (unLoc -> HsSig {sig_body = hsib_body})})
#endif
      <- (IdP GhcPs -> Bool) -> [LHsDecl GhcPs] -> Maybe (Sig GhcPs)
forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
(IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDecl (RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== IdP GhcPs
RdrName
funId) [LHsDecl GhcPs]
hsmodDecls
    =
      [( Text
"Add " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
implicitT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the context of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (RdrName -> FilePath
printRdrName IdP GhcPs
RdrName
funId)
        , FilePath -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> FilePath
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
"([^ ]+) :: " Maybe [Text] -> ([Text] -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Text] -> Text
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 :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls}) Diagnostic {Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
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:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$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 XTypeSig GhcPs
_ [Located (IdP GhcPs)]
_ HsWC{hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB {hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcPs
sig}})
#else
  , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})})
#endif
    <- (IdP GhcPs -> Bool) -> [LHsDecl GhcPs] -> Maybe (Sig GhcPs)
forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
(IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDecl ((Text -> FilePath
T.unpack Text
typeSignatureName FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==) (FilePath -> Bool) -> (RdrName -> FilePath) -> RdrName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> SDoc -> FilePath
showSDoc DynFlags
df (SDoc -> FilePath) -> (RdrName -> SDoc) -> RdrName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [LHsDecl GhcPs]
hsmodDecls
  , Text
title <- Text -> Text -> Text
actionTitle Text
missingConstraint Text
typeSignatureName
  = [(Text
title, FilePath -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> FilePath
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 `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constraint
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` to the context of the type signature for `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeSignatureName Text -> Text -> Text
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 (L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls}) Diagnostic{Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
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:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$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 XTypeSig GhcPs
_ [Located (IdP GhcPs)]
_ HsWC{hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB {hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcPs
sig}})
#else
  , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})})
#endif
    <- (Sig GhcPs -> Sig GhcPs) -> Maybe (Sig GhcPs) -> Maybe (Sig GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(FilePath -> Sig GhcPs -> Sig GhcPs
forall a.
(Data a, ExactPrint a, Outputable a, HasCallStack) =>
FilePath -> a -> a
traceAst FilePath
"redundantConstraint") (Maybe (Sig GhcPs) -> Maybe (Sig GhcPs))
-> Maybe (Sig GhcPs) -> Maybe (Sig GhcPs)
forall a b. (a -> b) -> a -> b
$ Range -> [LHsDecl GhcPs] -> Maybe (Sig GhcPs)
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 (DynFlags -> [Text] -> LHsType GhcPs -> Bool
forall (t :: * -> *) a.
(Foldable t, Outputable a, Functor t) =>
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 = DynFlags -> SDoc -> FilePath
showSDoc DynFlags
df (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a) FilePath -> t FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> FilePath
T.unpack (Text -> FilePath) -> t Text -> t FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t Text
list)

      parseConstraints :: T.Text -> [T.Text]
      parseConstraints :: Text -> [Text]
parseConstraints Text
t = Text
t
        Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text
T.strip (Text -> Text) -> (Text -> [Text]) -> Text -> [Text]
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 (Text -> Text) -> (Text -> [Text]) -> Text -> [Text]
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
",")
        [Text] -> (Text -> Text) -> [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 Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Int -> Text -> Text
T.drop Int
1 Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Int -> Text -> Text
T.dropEnd Int
1 Text -> (Text -> Text) -> Text
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
        Text -> (Text -> [Text]) -> [Text]
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
        [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
2
        [Text] -> ([Text] -> [[Text]]) -> [[Text]]
forall a b. a -> (a -> b) -> b
& (Text -> Maybe [Text]) -> [Text] -> [[Text]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Text -> Text -> Maybe [Text]
`matchRegexUnifySpaces` Text
"Redundant constraints?: (.+)") (Text -> Maybe [Text]) -> (Text -> Text) -> Text -> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip)
        [[Text]] -> ([[Text]] -> Maybe [Text]) -> Maybe [Text]
forall a b. a -> (a -> b) -> b
& [[Text]] -> Maybe [Text]
forall a. [a] -> Maybe a
listToMaybe
        Maybe [Text] -> ([Text] -> [Text]) -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> (Text -> [Text]) -> [Text] -> [Text]
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
        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
", "
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& \Text
cs -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs Text -> Text -> Text
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
constraintList Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"s") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" `"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
formatConstraints [Text]
constraintList
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` from the context of the type signature for `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeSignatureName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

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

suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])]
suggestNewOrExtendImportForClassMethod :: ExportsMap
-> ParsedSource
-> Text
-> Diagnostic
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
suggestNewOrExtendImportForClassMethod ExportsMap
packageExportsMap 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 <-
      [IdentInfo]
-> (HashSet IdentInfo -> [IdentInfo])
-> Maybe (HashSet IdentInfo)
-> [IdentInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList (HashSet IdentInfo -> [IdentInfo])
-> (HashSet IdentInfo -> HashSet IdentInfo)
-> HashSet IdentInfo
-> [IdentInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdentInfo -> Bool) -> HashSet IdentInfo -> HashSet IdentInfo
forall a. (a -> Bool) -> HashSet a -> HashSet a
Set.filter (\IdentInfo
x -> IdentInfo -> Maybe Text
parent IdentInfo
x Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
className)) (Maybe (HashSet IdentInfo) -> [IdentInfo])
-> Maybe (HashSet IdentInfo) -> [IdentInfo]
forall a b. (a -> b) -> a -> b
$
        Text
-> HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
methodName (HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo))
-> HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ExportsMap -> HashMap Text (HashSet IdentInfo)
getExportsMap ExportsMap
packageExportsMap =
    [[(Text, CodeActionKind, [Either TextEdit Rewrite])]]
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
forall a. Monoid a => [a] -> a
mconcat ([[(Text, CodeActionKind, [Either TextEdit Rewrite])]]
 -> [(Text, CodeActionKind, [Either TextEdit Rewrite])])
-> [[(Text, CodeActionKind, [Either TextEdit Rewrite])]]
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
forall a b. (a -> b) -> a -> b
$ IdentInfo -> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
suggest (IdentInfo -> [(Text, CodeActionKind, [Either TextEdit Rewrite])])
-> [IdentInfo]
-> [[(Text, CodeActionKind, [Either TextEdit Rewrite])]]
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
identInfo@IdentInfo {Text
moduleNameText :: Text
moduleNameText :: IdentInfo -> Text
moduleNameText}
      | [ImportStyle]
importStyle <- NonEmpty ImportStyle -> [ImportStyle]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ImportStyle -> [ImportStyle])
-> NonEmpty ImportStyle -> [ImportStyle]
forall a b. (a -> b) -> a -> b
$ IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo
identInfo,
        Maybe (LImportDecl GhcPs)
mImportDecl <- [LImportDecl GhcPs] -> FilePath -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName (HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports (HsModule GhcPs -> [LImportDecl GhcPs])
-> HsModule GhcPs -> [LImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ ParsedSource -> SrcSpanLess ParsedSource
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ParsedSource
ps) (Text -> FilePath
T.unpack Text
moduleNameText) =
        case Maybe (LImportDecl GhcPs)
mImportDecl of
          -- extend
          Just LImportDecl GhcPs
decl ->
            [ ( Text
"Add " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ImportStyle -> Text
renderImportStyle ImportStyle
style Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the import list of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
moduleNameText,
                Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"extend" ImportStyle
style,
                [Rewrite -> Either TextEdit Rewrite
forall a b. b -> Either a b
Right (Rewrite -> Either TextEdit Rewrite)
-> Rewrite -> Either TextEdit Rewrite
forall a b. (a -> b) -> a -> b
$ (Maybe FilePath -> FilePath -> LImportDecl GhcPs -> Rewrite)
-> (Maybe FilePath, FilePath) -> LImportDecl GhcPs -> Rewrite
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe FilePath -> FilePath -> LImportDecl GhcPs -> Rewrite
extendImport (ImportStyle -> (Maybe FilePath, FilePath)
unImportStyle ImportStyle
style) LImportDecl GhcPs
decl]
              )
              | ImportStyle
style <- [ImportStyle]
importStyle
            ]
          -- new
          Maybe (LImportDecl GhcPs)
_
            | Just (Range
range, Int
indent) <- ParsedSource -> Text -> Maybe (Range, Int)
newImportInsertRange ParsedSource
ps Text
fileContents
            ->
             (\(CodeActionKind
kind, NewImport -> Text
unNewImport -> Text
x) -> (Text
x, CodeActionKind
kind, [TextEdit -> Either TextEdit Rewrite
forall a b. a -> Either a b
Left (TextEdit -> Either TextEdit Rewrite)
-> TextEdit -> Either TextEdit Rewrite
forall a b. (a -> b) -> a -> b
$ Range -> Text -> TextEdit
TextEdit Range
range (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
indent Text
" ")])) ((CodeActionKind, NewImport)
 -> (Text, CodeActionKind, [Either TextEdit Rewrite]))
-> [(CodeActionKind, NewImport)]
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
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
moduleNameText Text
rendered Bool
False)
              | ImportStyle
style <- [ImportStyle]
importStyle,
                let rendered :: Text
rendered = ImportStyle -> Text
renderImportStyle ImportStyle
style
            ]
              [(CodeActionKind, NewImport)]
-> [(CodeActionKind, NewImport)] -> [(CodeActionKind, NewImport)]
forall a. Semigroup a => a -> a -> a
<> [(Text -> CodeActionKind
quickFixImportKind Text
"new.all", Text -> NewImport
newImportAll Text
moduleNameText)]
            | Bool
otherwise -> []

suggestNewImport :: ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]
suggestNewImport :: ExportsMap
-> ParsedSource
-> Text
-> Diagnostic
-> [(Text, CodeActionKind, TextEdit)]
suggestNewImport ExportsMap
packageExportsMap ps :: ParsedSource
ps@(L SrcSpan
_ HsModule {[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (Located [LIE GhcPs])
Maybe LHsDocString
Maybe (Located WarningTxt)
Maybe (Located ModuleName)
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodName :: Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
..}) 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
        Maybe Text
-> (Text -> Maybe (LImportDecl GhcPs)) -> Maybe (LImportDecl GhcPs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([LImportDecl GhcPs] -> FilePath -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
hsmodImports (FilePath -> Maybe (LImportDecl GhcPs))
-> (Text -> FilePath) -> Text -> Maybe (LImportDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)
        Maybe (LImportDecl GhcPs)
-> (LImportDecl GhcPs -> Maybe (Located ModuleName))
-> Maybe (Located ModuleName)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs (ImportDecl GhcPs -> Maybe (Located ModuleName))
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> Maybe (Located ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
        Maybe (Located ModuleName)
-> (Located ModuleName -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FilePath -> Text
T.pack (FilePath -> Text)
-> (Located ModuleName -> FilePath) -> Located ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
moduleNameString (ModuleName -> FilePath)
-> (Located ModuleName -> ModuleName)
-> Located ModuleName
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
  , Just (Range
range, Int
indent) <- ParsedSource -> Text -> Maybe (Range, Int)
newImportInsertRange 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 ‘([^’]*)’"
  = ((Text, CodeActionKind, TextEdit) -> Text)
-> [(Text, CodeActionKind, TextEdit)]
-> [(Text, CodeActionKind, TextEdit)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, CodeActionKind, TextEdit) -> Text
forall a b c. (a, b, c) -> a
fst3 [(Text
imp, CodeActionKind
kind, Range -> Text -> TextEdit
TextEdit Range
range (Text
imp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
indent Text
" "))
    | (CodeActionKind
kind, NewImport -> Text
unNewImport -> Text
imp) <- ExportsMap
-> (Maybe Text, NotInScope)
-> Maybe [Text]
-> [(CodeActionKind, NewImport)]
constructNewImportSuggestions ExportsMap
packageExportsMap (Maybe Text
qual Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
qual', NotInScope
thingMissing) Maybe [Text]
extendImportSuggestions
    ]
suggestNewImport ExportsMap
_ ParsedSource
_ Text
_ Diagnostic
_ = []

constructNewImportSuggestions
  :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [(CodeActionKind, NewImport)]
constructNewImportSuggestions :: ExportsMap
-> (Maybe Text, NotInScope)
-> Maybe [Text]
-> [(CodeActionKind, NewImport)]
constructNewImportSuggestions ExportsMap
exportsMap (Maybe Text
qual, NotInScope
thingMissing) Maybe [Text]
notTheseModules = ((CodeActionKind, NewImport) -> NewImport)
-> [(CodeActionKind, NewImport)] -> [(CodeActionKind, NewImport)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (CodeActionKind, NewImport) -> NewImport
forall a b. (a, b) -> b
snd
  [ (CodeActionKind, NewImport)
suggestion
  | Just Text
name <- [Text -> Text -> Maybe Text
T.stripPrefix (Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") Maybe Text
qual) (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ NotInScope -> Text
notInScope NotInScope
thingMissing]
  , IdentInfo
identInfo <- [IdentInfo]
-> (HashSet IdentInfo -> [IdentInfo])
-> Maybe (HashSet IdentInfo)
-> [IdentInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList (Maybe (HashSet IdentInfo) -> [IdentInfo])
-> Maybe (HashSet IdentInfo) -> [IdentInfo]
forall a b. (a -> b) -> a -> b
$ Text
-> HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
name (ExportsMap -> HashMap Text (HashSet IdentInfo)
getExportsMap ExportsMap
exportsMap)
  , NotInScope -> IdentInfo -> Bool
canUseIdent NotInScope
thingMissing IdentInfo
identInfo
  , IdentInfo -> Text
moduleNameText IdentInfo
identInfo Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
notTheseModules
  , (CodeActionKind, NewImport)
suggestion <- IdentInfo -> [(CodeActionKind, NewImport)]
renderNewImport IdentInfo
identInfo
  ]
 where
  renderNewImport :: IdentInfo -> [(CodeActionKind, NewImport)]
  renderNewImport :: IdentInfo -> [(CodeActionKind, NewImport)]
renderNewImport IdentInfo
identInfo
    | Just Text
q <- Maybe Text
qual
    = [(Text -> CodeActionKind
quickFixImportKind Text
"new.qualified", Text -> Text -> NewImport
newQualImport Text
m Text
q)]
    | Bool
otherwise
    = [(Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"new" ImportStyle
importStyle, Text -> Text -> Bool -> NewImport
newUnqualImport Text
m (ImportStyle -> Text
renderImportStyle ImportStyle
importStyle) Bool
False)
      | ImportStyle
importStyle <- NonEmpty ImportStyle -> [ImportStyle]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ImportStyle -> [ImportStyle])
-> NonEmpty ImportStyle -> [ImportStyle]
forall a b. (a -> b) -> a -> b
$ IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo
identInfo] [(CodeActionKind, NewImport)]
-> [(CodeActionKind, NewImport)] -> [(CodeActionKind, NewImport)]
forall a. [a] -> [a] -> [a]
++
      [(Text -> CodeActionKind
quickFixImportKind Text
"new.all", Text -> NewImport
newImportAll Text
m)]
    where
        m :: Text
m = IdentInfo -> Text
moduleNameText IdentInfo
identInfo

newtype NewImport = NewImport {NewImport -> Text
unNewImport :: T.Text}
  deriving (Int -> NewImport -> ShowS
[NewImport] -> ShowS
NewImport -> FilePath
(Int -> NewImport -> ShowS)
-> (NewImport -> FilePath)
-> ([NewImport] -> ShowS)
-> Show NewImport
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewImport] -> ShowS
$cshowList :: [NewImport] -> ShowS
show :: NewImport -> FilePath
$cshow :: NewImport -> FilePath
showsPrec :: Int -> NewImport -> ShowS
$cshowsPrec :: Int -> NewImport -> ShowS
Show, NewImport -> NewImport -> Bool
(NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> Bool) -> Eq NewImport
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
Eq NewImport
-> (NewImport -> NewImport -> Ordering)
-> (NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> NewImport)
-> (NewImport -> NewImport -> NewImport)
-> Ord 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
$cp1Ord :: Eq NewImport
Ord)

newImportToEdit :: NewImport -> ParsedSource -> T.Text -> Maybe (T.Text, TextEdit)
newImportToEdit :: NewImport -> ParsedSource -> Text -> Maybe (Text, TextEdit)
newImportToEdit (NewImport -> Text
unNewImport -> Text
imp) ParsedSource
ps Text
fileContents
  | Just (Range
range, Int
indent) <- ParsedSource -> Text -> Maybe (Range, Int)
newImportInsertRange ParsedSource
ps Text
fileContents
  = (Text, TextEdit) -> Maybe (Text, TextEdit)
forall a. a -> Maybe a
Just (Text
imp, Range -> Text -> TextEdit
TextEdit Range
range (Text
imp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
indent Text
" "))
  | Bool
otherwise = Maybe (Text, TextEdit)
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 :: ParsedSource -> T.Text -> Maybe (Range, Int)
newImportInsertRange :: ParsedSource -> Text -> Maybe (Range, Int)
newImportInsertRange (L SrcSpan
_ HsModule {[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (Located [LIE GhcPs])
Maybe LHsDocString
Maybe (Located WarningTxt)
Maybe (Located ModuleName)
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodName :: Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
..}) Text
fileContents
  |  Just ((Int
l, Int
c), Int
col) <- case [LImportDecl GhcPs]
hsmodImports of
      [] -> Maybe (Located ModuleName)
-> Maybe (Located [LIE GhcPs]) -> Text -> Maybe ((Int, Int), Int)
forall name.
Maybe (Located ModuleName)
-> Maybe (Located [LIE name]) -> Text -> Maybe ((Int, Int), Int)
findPositionNoImports ((Located ModuleName -> Located ModuleName)
-> Maybe (Located ModuleName) -> Maybe (Located ModuleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located ModuleName -> Located ModuleName
forall a. Located a -> Located a
reLoc Maybe (Located ModuleName)
hsmodName) ((Located [LIE GhcPs] -> Located [LIE GhcPs])
-> Maybe (Located [LIE GhcPs]) -> Maybe (Located [LIE GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located [LIE GhcPs] -> Located [LIE GhcPs]
forall a. Located a -> Located a
reLoc Maybe (Located [LIE GhcPs])
hsmodExports) Text
fileContents
      [LImportDecl GhcPs]
_  -> [LImportDecl GhcPs]
-> ([LImportDecl GhcPs] -> LImportDecl GhcPs)
-> Bool
-> Maybe ((Int, Int), Int)
forall a t.
HasSrcSpan a =>
t -> (t -> a) -> Bool -> Maybe ((Int, Int), Int)
findPositionFromImportsOrModuleDecl ((LImportDecl GhcPs -> LImportDecl GhcPs)
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcPs -> LImportDecl GhcPs
forall a. Located a -> Located a
reLoc [LImportDecl GhcPs]
hsmodImports) [LImportDecl GhcPs] -> LImportDecl GhcPs
forall a. [a] -> a
last Bool
True
  , let insertPos :: Position
insertPos = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c)
    = (Range, Int) -> Maybe (Range, Int)
forall a. a -> Maybe a
Just (Position -> Position -> Range
Range Position
insertPos Position
insertPos, Int
col)
  | Bool
otherwise = Maybe (Range, Int)
forall a. Maybe a
Nothing

-- | Insert the import under the Module declaration exports if they exist, otherwise just under the module declaration.
-- If no module declaration exists, then no exports will exist either, in that case
-- insert the import after any file-header pragmas or at position zero if there are no pragmas
findPositionNoImports :: Maybe (Located ModuleName) -> Maybe (Located [LIE name]) -> T.Text -> Maybe ((Int, Int), Int)
findPositionNoImports :: Maybe (Located ModuleName)
-> Maybe (Located [LIE name]) -> Text -> Maybe ((Int, Int), Int)
findPositionNoImports Maybe (Located ModuleName)
Nothing Maybe (Located [LIE name])
_ Text
fileContents = Text -> Maybe ((Int, Int), Int)
findNextPragmaPosition Text
fileContents
findPositionNoImports Maybe (Located ModuleName)
_ (Just Located [LIE name]
hsmodExports) Text
_ = Located [LIE name]
-> (Located [LIE name] -> Located [LIE name])
-> Bool
-> Maybe ((Int, Int), Int)
forall a t.
HasSrcSpan a =>
t -> (t -> a) -> Bool -> Maybe ((Int, Int), Int)
findPositionFromImportsOrModuleDecl Located [LIE name]
hsmodExports Located [LIE name] -> Located [LIE name]
forall a. a -> a
id Bool
False
findPositionNoImports (Just Located ModuleName
hsmodName) Maybe (Located [LIE name])
_ Text
_ = Located ModuleName
-> (Located ModuleName -> Located ModuleName)
-> Bool
-> Maybe ((Int, Int), Int)
forall a t.
HasSrcSpan a =>
t -> (t -> a) -> Bool -> Maybe ((Int, Int), Int)
findPositionFromImportsOrModuleDecl Located ModuleName
hsmodName Located ModuleName -> Located ModuleName
forall a. a -> a
id Bool
False

findPositionFromImportsOrModuleDecl :: HasSrcSpan a => t -> (t -> a) -> Bool -> Maybe ((Int, Int), Int)
findPositionFromImportsOrModuleDecl :: t -> (t -> a) -> Bool -> Maybe ((Int, Int), Int)
findPositionFromImportsOrModuleDecl t
hsField t -> a
f Bool
hasImports = case a -> SrcSpan
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 ((Int, Int), Int) -> Maybe ((Int, Int), Int)
forall a. a -> Maybe a
Just ((RealSrcLoc -> Int
srcLocLine (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
s), Int
col), Int
col)
  SrcSpan
_ -> Maybe ((Int, Int), Int)
forall a. Maybe a
Nothing
  where calcCol :: RealSrcSpan -> Int
calcCol RealSrcSpan
s = if Bool
hasImports then RealSrcLoc -> Int
srcLocCol (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
0

-- | Find the position one after the last file-header pragma
-- Defaults to zero if there are no pragmas in file
findNextPragmaPosition :: T.Text -> Maybe ((Int, Int), Int)
findNextPragmaPosition :: Text -> Maybe ((Int, Int), Int)
findNextPragmaPosition Text
contents = ((Int, Int), Int) -> Maybe ((Int, Int), Int)
forall a. a -> Maybe a
Just ((Int
lineNumber, Int
0), Int
0)
  where
    lineNumber :: Int
lineNumber = Int -> Int
afterLangPragma (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
afterOptsGhc (Int -> Int) -> Int -> Int
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 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
lineNum Int
next
  where
    next :: Int
next = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
lineNum Int -> Int
forall a. Enum a => a -> a
succ (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe ([Int] -> Maybe Int) -> ([Int] -> [Int]) -> [Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> Maybe Int) -> [Int] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Int]
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 Text -> Text -> Bool
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) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace (Text -> Text) -> Text -> Text
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 -- ^ qualified name
  -> Bool -- ^ the symbol is to be imported or hidden
  -> NewImport
newImport :: Text -> Maybe Text -> Maybe Text -> Bool -> NewImport
newImport Text
modName Maybe Text
mSymbol Maybe Text
mQual Bool
hiding = Text -> NewImport
NewImport Text
impStmt
  where
     symImp :: Text
symImp
            | Just Text
symbol <- Maybe Text
mSymbol
              , OccName
symOcc <- FilePath -> OccName
mkVarOcc (FilePath -> OccName) -> FilePath -> OccName
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
symbol =
              Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SDoc -> Text
forall a. Outputable a => a -> Text
printOutputable (OccName -> SDoc -> SDoc
parenSymOcc OccName
symOcc (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
symOcc) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            | Bool
otherwise = Text
""
     impStmt :: Text
impStmt =
       Text
"import "
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a b. a -> b -> a
const Text
"qualified ") Maybe Text
mQual
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modName
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
hiding then Text
" hiding" else Text
"")
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
symImp
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
qual -> if Text
modName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
qual then Text
"" else Text
" as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qual) Maybe Text
mQual

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

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

newImportAll :: T.Text -> NewImport
newImportAll :: Text -> NewImport
newImportAll Text
modName = Text -> Maybe Text -> Maybe Text -> Bool -> NewImport
newImport Text
modName Maybe Text
forall a. Maybe a
Nothing Maybe Text
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 (Bool -> Bool) -> (IdentInfo -> Bool) -> IdentInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> Bool
isDatacon
canUseIdent NotInScope
_                                  = Bool -> IdentInfo -> Bool
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 -> FilePath
(Int -> NotInScope -> ShowS)
-> (NotInScope -> FilePath)
-> ([NotInScope] -> ShowS)
-> Show NotInScope
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NotInScope] -> ShowS
$cshowList :: [NotInScope] -> ShowS
show :: NotInScope -> FilePath
$cshow :: NotInScope -> FilePath
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: ([^ ]+)"
  = NotInScope -> Maybe NotInScope
forall a. a -> Maybe a
Just (NotInScope -> Maybe NotInScope) -> NotInScope -> Maybe NotInScope
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 [^‘]*‘([^’]*)’"
  = NotInScope -> Maybe NotInScope
forall a. a -> Maybe a
Just (NotInScope -> Maybe NotInScope) -> NotInScope -> Maybe NotInScope
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 [^‘]*‘([^’]*)’"
  = NotInScope -> Maybe NotInScope
forall a. a -> Maybe a
Just (NotInScope -> Maybe NotInScope) -> NotInScope -> Maybe NotInScope
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: \\(([^‘ ]+)\\)"
  = NotInScope -> Maybe NotInScope
forall a. a -> Maybe a
Just (NotInScope -> Maybe NotInScope) -> NotInScope -> Maybe NotInScope
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: ([^‘ ]+)"
  = NotInScope -> Maybe NotInScope
forall a. a -> Maybe a
Just (NotInScope -> Maybe NotInScope) -> NotInScope -> Maybe NotInScope
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:[^‘]*‘([^’]*)’"
  = NotInScope -> Maybe NotInScope
forall a. a -> Maybe a
Just (NotInScope -> Maybe NotInScope) -> NotInScope -> Maybe NotInScope
forall a b. (a -> b) -> a -> b
$ Text -> NotInScope
NotInScopeThing Text
name
  | Bool
otherwise
  = Maybe NotInScope
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 [^‘]*‘([^’]*)’"
  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
m
  | Bool
otherwise
  = Maybe Text
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] <-
    Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"Module ‘([^’]*)’ does not export"
      Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"nor ‘([^’]*)’ exports"
  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
m
  | Bool
otherwise
  = Maybe Text
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 =
    if Maybe Bool
maybeIsInfixFunction Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
      then Range -> Text -> TextEdit
TextEdit Range
range (Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`")
      else Range -> Text -> TextEdit
TextEdit Range
range Text
name
  where
    maybeIsInfixFunction :: Maybe Bool
maybeIsInfixFunction = do
      Text
curr <- Range -> Text -> Text
textInRange Range
range (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
contents
      Bool -> Maybe Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
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


-- | Extract the type and surround it in parentheses except in obviously safe cases.
--
-- Inferring when parentheses are actually needed around the type signature would
-- require understanding both the precedence of the context of the hole and of
-- the signature itself. Inserting them (almost) unconditionally is ugly but safe.
extractWildCardTypeSignature :: T.Text -> T.Text
extractWildCardTypeSignature :: Text -> Text
extractWildCardTypeSignature Text
msg = (if Bool
enclosed Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
application then Text -> Text
forall a. a -> a
id else Text -> Text
bracket) Text
signature
  where
    msgSigPart :: Text
msgSigPart = (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
T.breakOnEnd Text
"standing for " Text
msg
    signature :: Text
signature = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'’') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'‘') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'‘') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
msgSigPart
    -- parenthesize type applications, e.g. (Maybe Char)
    application :: Bool
application = (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace (FilePath -> Bool) -> (Text -> FilePath) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text
signature
    -- do not add extra parentheses to lists, tuples and already parenthesized types
    enclosed :: Bool
enclosed = Bool -> Bool
not (Text -> Bool
T.null Text
signature) Bool -> Bool -> Bool
&& (Text -> Char
T.head Text
signature, Text -> Char
T.last Text
signature) (Char, Char) -> [(Char, Char)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Char
'(',Char
')'), (Char
'[',Char
']')]
    bracket :: Text -> Text
bracket = (Text
"(" Text -> Text -> Text
`T.append`) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
`T.append` Text
")")

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 = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
getEnclosed
                       ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
singleSuggestions
                       ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isKnownSymbol
                       ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'‘')
                (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'’')
                (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropAround (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'‘' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
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 = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Text -> Bool
T.isPrefixOf Text
"\n" (Text -> Bool) -> (Text -> Text) -> Text -> Bool
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
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 UInt -> UInt -> Bool
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 UInt -> UInt -> UInt
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 (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
row) (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
col)) Text
x
    | ([Text]
preRow, Text
mid:[Text]
postRow) <- Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
row ([Text] -> ([Text], [Text])) -> [Text] -> ([Text], [Text])
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" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
preRow [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
preCol], Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
postCol Text -> [Text] -> [Text]
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 (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
startRow) (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
startCol)) (Position (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
endRow) (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
endCol))) Text
text =
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
startRow Int
endRow of
      Ordering
LT ->
        let ([Text]
linesInRangeBeforeEndLine, [Text]
endLineAndFurtherLines) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
endRow Int -> Int -> Int
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 (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
endLineAndFurtherLines
        in Text -> [Text] -> Text
T.intercalate Text
"\n" (Text
textInRangeInFirstLine Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
linesBetween [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
maybeTextInRangeInEndLine)
      Ordering
EQ ->
        let line :: Text
line = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
linesBeginningWithStartLine)
        in Int -> Text -> Text
T.take (Int
endCol Int -> Int -> Int
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 = Int -> [Text] -> [Text]
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 -> FilePath -> [Range]
rangesForBindingImport ImportDecl{ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding = Just (Bool
False, L SrcSpan
_ [LIE GhcPs]
lies)} FilePath
b =
    (LIE GhcPs -> [Range]) -> [LIE GhcPs] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SrcSpan -> Maybe Range) -> [SrcSpan] -> [Range]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SrcSpan -> Maybe Range
srcSpanToRange ([SrcSpan] -> [Range])
-> (LIE GhcPs -> [SrcSpan]) -> LIE GhcPs -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> LIE GhcPs -> [SrcSpan]
rangesForBinding' FilePath
b') [LIE GhcPs]
lies
  where
    b' :: FilePath
b' = ShowS
wrapOperatorInParens FilePath
b
rangesForBindingImport ImportDecl GhcPs
_ FilePath
_ = []

wrapOperatorInParens :: String -> String
wrapOperatorInParens :: ShowS
wrapOperatorInParens FilePath
x =
  case FilePath -> Maybe (Char, FilePath)
forall a. [a] -> Maybe (a, [a])
uncons FilePath
x of
    Just (Char
h, FilePath
_t) -> if Char -> Bool
is_ident Char
h then FilePath
x else FilePath
"(" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
x FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
")"
    Maybe (Char, FilePath)
Nothing      -> FilePath
forall a. Monoid a => a
mempty

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

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

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

-- | '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 (the submatches) for the first capture, or Nothing.
matchRegex :: T.Text -> T.Text -> Maybe [T.Text]
matchRegex :: Text -> Text -> Maybe [Text]
matchRegex Text
message Text
regex = case Text
message Text -> Text -> Maybe (Text, Text, Text, [Text])
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
regex of
    Just (Text
_ :: T.Text, Text
_ :: T.Text, Text
_ :: T.Text, [Text]
bindings) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
bindings
    Maybe (Text, Text, Text, [Text])
Nothing                                                -> Maybe [Text]
forall a. Maybe a
Nothing

-- | 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 Text -> Text -> Maybe [[Text]]
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
regex


unifySpaces :: T.Text -> T.Text
unifySpaces :: Text -> Text
unifySpaces    = [Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words

-- 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]
_) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
h
    Maybe [Text]
_          -> 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
"\\((.*)\\)"
  (Text, Text) -> Maybe (Text, 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 (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
T.isPrefixOf Text
"("
    ([Text]
mod, [Text]
srcspan) = (Text -> Bool) -> [Text] -> ([Text], [Text])
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 [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
mod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
srcspan then
               (Text, Text) -> Maybe (Text, Text)
regExPair ((Text, Text) -> Maybe (Text, Text))
-> [(Text, Text)] -> Maybe [(Text, Text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
mod [Text]
srcspan
             else Maybe [(Text, Text)]
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 = FilePath -> Text
T.pack FilePath
"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] -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
x, Text
xs)
                            Maybe [Text]
_            -> Maybe (Text, Text)
forall a. Maybe a
Nothing
  [(Text, Text)]
imps <- Text -> Maybe [(Text, Text)]
regExImports Text
imports
  (Text, [(Text, Text)]) -> Maybe (Text, [(Text, Text)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
binding, [(Text, Text)]
imps)

-- | Possible import styles for an 'IdentInfo'.
--
-- The first 'Text' parameter corresponds to the 'rendered' field of the
-- 'IdentInfo'.
data ImportStyle
    = ImportTopLevel T.Text
      -- ^ Import a top-level export from a module, e.g., a function, a type, a
      -- class.
      --
      -- > import M (?)
      --
      -- Some exports that have a parent, like a type-class method or an
      -- associated type/data family, can still be imported as a top-level
      -- import.
      --
      -- Note that this is not the case for constructors, they must always be
      -- imported as part of their parent data type.

    | ImportViaParent T.Text T.Text
      -- ^ Import an export (first parameter) through its parent (second
      -- parameter).
      --
      -- import M (P(?))
      --
      -- @P@ and @?@ can be a data type and a constructor, a class and a method,
      -- a class and an associated type/data family, etc.

    | ImportAllConstructors T.Text
      -- ^ Import all constructors for a specific data type.
      --
      -- import M (P(..))
      --
      -- @P@ can be a data type or a class.
  deriving Int -> ImportStyle -> ShowS
[ImportStyle] -> ShowS
ImportStyle -> FilePath
(Int -> ImportStyle -> ShowS)
-> (ImportStyle -> FilePath)
-> ([ImportStyle] -> ShowS)
-> Show ImportStyle
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ImportStyle] -> ShowS
$cshowList :: [ImportStyle] -> ShowS
show :: ImportStyle -> FilePath
$cshow :: ImportStyle -> FilePath
showsPrec :: Int -> ImportStyle -> ShowS
$cshowsPrec :: Int -> ImportStyle -> ShowS
Show

importStyles :: IdentInfo -> NonEmpty ImportStyle
importStyles :: IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo {Maybe Text
parent :: Maybe Text
parent :: IdentInfo -> Maybe Text
parent, Text
rendered :: Text
rendered :: IdentInfo -> Text
rendered, Bool
isDatacon :: Bool
isDatacon :: IdentInfo -> Bool
isDatacon}
  | Just Text
p <- Maybe Text
parent
    -- Constructors always have to be imported via their parent data type, but
    -- methods and associated type/data families can also be imported as
    -- top-level exports.
  = Text -> Text -> ImportStyle
ImportViaParent Text
rendered Text
p
      ImportStyle -> [ImportStyle] -> NonEmpty ImportStyle
forall a. a -> [a] -> NonEmpty a
:| [Text -> ImportStyle
ImportTopLevel Text
rendered | Bool -> Bool
not Bool
isDatacon]
      [ImportStyle] -> [ImportStyle] -> [ImportStyle]
forall a. Semigroup a => a -> a -> a
<> [Text -> ImportStyle
ImportAllConstructors Text
p]
  | Bool
otherwise
  = Text -> ImportStyle
ImportTopLevel Text
rendered ImportStyle -> [ImportStyle] -> NonEmpty ImportStyle
forall a. a -> [a] -> NonEmpty a
:| []

-- | Used for adding new imports
renderImportStyle :: ImportStyle -> T.Text
renderImportStyle :: ImportStyle -> Text
renderImportStyle (ImportTopLevel Text
x)   = Text
x
renderImportStyle (ImportViaParent Text
x p :: Text
p@(Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'(', Text
_))) = Text
"type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
renderImportStyle (ImportViaParent Text
x Text
p) = Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
renderImportStyle (ImportAllConstructors Text
p) = Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(..)"

-- | Used for extending import lists
unImportStyle :: ImportStyle -> (Maybe String, String)
unImportStyle :: ImportStyle -> (Maybe FilePath, FilePath)
unImportStyle (ImportTopLevel Text
x)    = (Maybe FilePath
forall a. Maybe a
Nothing, Text -> FilePath
T.unpack Text
x)
unImportStyle (ImportViaParent Text
x Text
y) = (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
y, Text -> FilePath
T.unpack Text
x)
unImportStyle (ImportAllConstructors Text
x) = (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
x, FilePath
wildCardSymbol)


quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind
quickFixImportKind' :: Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
x (ImportTopLevel Text
_) = Text -> CodeActionKind
CodeActionUnknown (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".list.topLevel"
quickFixImportKind' Text
x (ImportViaParent Text
_ Text
_) = Text -> CodeActionKind
CodeActionUnknown (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".list.withParent"
quickFixImportKind' Text
x (ImportAllConstructors Text
_) = Text -> CodeActionKind
CodeActionUnknown (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".list.allConstructors"

quickFixImportKind :: T.Text -> CodeActionKind
quickFixImportKind :: Text -> CodeActionKind
quickFixImportKind Text
x = Text -> CodeActionKind
CodeActionUnknown (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x