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

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

import           Control.Applicative                               ((<|>))
import           Control.Applicative.Combinators.NonEmpty          (sepBy1)
import           Control.Arrow                                     (second,
                                                                    (&&&),
                                                                    (>>>))
import           Control.Concurrent.STM.Stats                      (atomically)
import           Control.Monad.Extra
import           Control.Monad.IO.Class
import           Control.Monad.Trans
import           Control.Monad.Trans.Except                        (ExceptT (ExceptT))
import           Control.Monad.Trans.Maybe
import           Data.Char
import qualified Data.DList                                        as DL
import           Data.Function
import           Data.Functor
import qualified Data.HashMap.Strict                               as Map
import qualified Data.HashSet                                      as Set
import           Data.List.Extra
import           Data.List.NonEmpty                                (NonEmpty ((:|)))
import qualified Data.List.NonEmpty                                as NE
import qualified Data.Map.Strict                                   as M
import           Data.Maybe
import           Data.Ord                                          (comparing)
import qualified Data.Set                                          as S
import qualified Data.Text                                         as T
import qualified Data.Text.Encoding                                as T
import           Development.IDE.Core.Rules
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Service
import           Development.IDE.Core.Shake                        hiding (Log)
import           Development.IDE.GHC.Compat                        hiding
                                                                   (ImplicitPrelude)
import           Development.IDE.GHC.Compat.ExactPrint
import           Development.IDE.GHC.Compat.Util
import           Development.IDE.GHC.Error
import           Development.IDE.GHC.ExactPrint
import qualified Development.IDE.GHC.ExactPrint                    as E
import           Development.IDE.GHC.Util                          (printOutputable,
                                                                    printRdrName)
import           Development.IDE.Plugin.CodeAction.Args
import           Development.IDE.Plugin.CodeAction.ExactPrint
import           Development.IDE.Plugin.CodeAction.PositionIndexed
import           Development.IDE.Plugin.CodeAction.Util
import           Development.IDE.Plugin.Completions.Types
import qualified Development.IDE.Plugin.Plugins.AddArgument
import           Development.IDE.Plugin.Plugins.Diagnostic
import           Development.IDE.Plugin.Plugins.FillHole           (suggestFillHole)
import           Development.IDE.Plugin.Plugins.FillTypeWildcard   (suggestFillTypeWildcard)
import           Development.IDE.Plugin.Plugins.ImportUtils
import           Development.IDE.Plugin.TypeLenses                 (suggestSignature)
import           Development.IDE.Types.Exports
import           Development.IDE.Types.Location
import           Development.IDE.Types.Options
import           GHC                                               (AddEpAnn (AddEpAnn),
                                                                    AnnsModule (am_main),
                                                                    DeltaPos (..),
                                                                    EpAnn (..),
                                                                    LEpaComment)
import qualified GHC.LanguageExtensions                            as Lang
import           Ide.Logger                                        hiding
                                                                   (group)
import           Ide.PluginUtils                                   (extendToFullLines,
                                                                    extractTextInRange,
                                                                    subRange)
import           Ide.Types
import           Language.LSP.Protocol.Message                     (Method (..),
                                                                    SMethod (..))
import           Language.LSP.Protocol.Types                       (ApplyWorkspaceEditParams (..),
                                                                    CodeAction (..),
                                                                    CodeActionKind (CodeActionKind_QuickFix),
                                                                    CodeActionParams (CodeActionParams),
                                                                    Command,
                                                                    Diagnostic (..),
                                                                    MessageType (..),
                                                                    Null (Null),
                                                                    ShowMessageParams (..),
                                                                    TextDocumentIdentifier (TextDocumentIdentifier),
                                                                    TextEdit (TextEdit, _range),
                                                                    UInt,
                                                                    WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges),
                                                                    type (|?) (InL, InR),
                                                                    uriToFilePath)
import           Language.LSP.VFS                                  (virtualFileText)
import qualified Text.Fuzzy.Parallel                               as TFP
import qualified Text.Regex.Applicative                            as RE
import           Text.Regex.TDFA                                   ((=~), (=~~))

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

#if !MIN_VERSION_ghc(9,9,0)
import           GHC                                               (Anchor (anchor_op),
                                                                    AnchorOperation (..),
                                                                    EpaLocation (..))
#endif

#if MIN_VERSION_ghc(9,9,0)
import           GHC                                               (EpaLocation,
                                                                    EpaLocation' (..),
                                                                    HasLoc (..))
import           GHC.Types.SrcLoc                                  (srcSpanToRealSrcSpan)
#endif

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

-- | Generate code actions.
codeAction :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeAction :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeAction IdeState
state PluginId
_ (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ (TextDocumentIdentifier Uri
uri) Range
range CodeActionContext
_) = do
  Maybe VirtualFile
contents <- HandlerM Config (Maybe VirtualFile)
-> ExceptT PluginError (HandlerM Config) (Maybe VirtualFile)
forall (m :: * -> *) a. Monad m => m a -> ExceptT PluginError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HandlerM Config (Maybe VirtualFile)
 -> ExceptT PluginError (HandlerM Config) (Maybe VirtualFile))
-> HandlerM Config (Maybe VirtualFile)
-> ExceptT PluginError (HandlerM Config) (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ NormalizedUri -> HandlerM Config (Maybe VirtualFile)
forall config. NormalizedUri -> HandlerM config (Maybe VirtualFile)
pluginGetVirtualFile (NormalizedUri -> HandlerM Config (Maybe VirtualFile))
-> NormalizedUri -> HandlerM Config (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
  IO ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a. IO a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (HandlerM Config) ([Command |? CodeAction] |? Null))
-> IO ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ do
    let text :: Maybe Text
text = VirtualFile -> Text
virtualFileText (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 = String -> NormalizedFilePath
toNormalizedFilePath' (String -> NormalizedFilePath)
-> Maybe String -> Maybe NormalizedFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> Maybe String
uriToFilePath Uri
uri
    [Diagnostic]
allDiags <- 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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(NormalizedFilePath
_, ShowDiagnostic
_, Diagnostic
d) -> Diagnostic
d) ([(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) <- String
-> IdeState
-> Action (Maybe (Maybe ParsedModule))
-> IO (Maybe (Maybe ParsedModule))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
`traverse` Maybe NormalizedFilePath
mbFile
    let
      actions :: [Command |? CodeAction]
actions = Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> Range
-> Uri
-> [Command |? CodeAction]
caRemoveRedundantImports Maybe ParsedModule
parsedModule Maybe Text
text [Diagnostic]
allDiags Range
range Uri
uri
               [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall a. Semigroup a => a -> a -> a
<> Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> Range
-> Uri
-> [Command |? CodeAction]
caRemoveInvalidExports Maybe ParsedModule
parsedModule Maybe Text
text [Diagnostic]
allDiags Range
range Uri
uri
    ([Command |? CodeAction] |? Null)
-> IO ([Command |? CodeAction] |? Null)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Command |? CodeAction] |? Null)
 -> IO ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> IO ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL [Command |? CodeAction]
actions

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

iePluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
iePluginDescriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
iePluginDescriptor Recorder (WithPriority Log)
recorder PluginId
plId =
  let old :: PluginDescriptor IdeState
old =
        [GhcideCodeAction] -> PluginId -> Text -> PluginDescriptor IdeState
mkGhcideCAsPlugin [
            (Maybe Text
 -> ParsedModule -> Diagnostic -> Maybe (Text, TextEdit))
-> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
wrap Maybe Text -> ParsedModule -> Diagnostic -> Maybe (Text, TextEdit)
suggestExportUnusedTopBinding
          , (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
          , (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
          , (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
          , (DynFlags
 -> ExportsMap
 -> ParsedSource
 -> Text
 -> Diagnostic
 -> [(Text, CodeActionKind, TextEdit)])
-> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
wrap DynFlags
-> ExportsMap
-> ParsedSource
-> Text
-> Diagnostic
-> [(Text, CodeActionKind, TextEdit)]
suggestNewImport
          , (ExportsMap
 -> DynFlags
 -> ParsedSource
 -> Text
 -> Diagnostic
 -> [(Text, CodeActionKind, TextEdit)])
-> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
wrap ExportsMap
-> DynFlags
-> ParsedSource
-> Text
-> Diagnostic
-> [(Text, CodeActionKind, TextEdit)]
suggestAddRecordFieldImport
          ]
          PluginId
plId
          Text
"Provides various quick fixes"
   in Recorder (WithPriority Log)
-> PluginDescriptor IdeState -> PluginDescriptor IdeState
forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder (PluginDescriptor IdeState -> PluginDescriptor IdeState)
-> PluginDescriptor IdeState -> PluginDescriptor IdeState
forall a b. (a -> b) -> a -> b
$ PluginDescriptor IdeState
old {pluginHandlers = pluginHandlers old <> mkPluginHandler SMethod_TextDocumentCodeAction codeAction }

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

bindingsPluginDescriptor :: Recorder (WithPriority E.Log) ->  PluginId -> PluginDescriptor IdeState
bindingsPluginDescriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
bindingsPluginDescriptor Recorder (WithPriority Log)
recorder PluginId
plId = Recorder (WithPriority Log)
-> PluginDescriptor IdeState -> PluginDescriptor IdeState
forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder (PluginDescriptor IdeState -> PluginDescriptor IdeState)
-> PluginDescriptor IdeState -> PluginDescriptor IdeState
forall a b. (a -> b) -> a -> b
$
  [GhcideCodeAction] -> PluginId -> Text -> 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
 -> Diagnostic -> Either PluginError [(Text, [TextEdit])])
-> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
wrap ParsedModule
-> Diagnostic -> Either PluginError [(Text, [TextEdit])]
Development.IDE.Plugin.Plugins.AddArgument.plugin
    , (ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])])
-> GhcideCodeAction
forall a. ToCodeAction a => a -> GhcideCodeAction
wrap ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDeleteUnusedBinding
    ]
    PluginId
plId
    Text
"Provides various quick fixes for bindings"

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

extendImportPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
extendImportPluginDescriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
extendImportPluginDescriptor Recorder (WithPriority Log)
recorder PluginId
plId = Recorder (WithPriority Log)
-> PluginDescriptor IdeState -> PluginDescriptor IdeState
forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder (PluginDescriptor IdeState -> PluginDescriptor IdeState)
-> PluginDescriptor IdeState -> PluginDescriptor IdeState
forall a b. (a -> b) -> a -> b
$ (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
"Provides a command to extend the import list")
  { pluginCommands = [extendImportCommand] }


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

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


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

extendImportHandler :: CommandFunction IdeState ExtendImport
extendImportHandler :: CommandFunction IdeState ExtendImport
extendImportHandler IdeState
ideState Maybe ProgressToken
_ edit :: ExtendImport
edit@ExtendImport {Maybe Text
Text
Uri
doc :: Uri
newThing :: Text
thingParent :: Maybe Text
importName :: Text
importQual :: Maybe Text
doc :: ExtendImport -> Uri
newThing :: ExtendImport -> Text
thingParent :: ExtendImport -> Maybe Text
importName :: ExtendImport -> Text
importQual :: ExtendImport -> Maybe Text
..} = HandlerM Config (Either PluginError (Value |? Null))
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (HandlerM Config (Either PluginError (Value |? Null))
 -> ExceptT PluginError (HandlerM Config) (Value |? Null))
-> HandlerM Config (Either PluginError (Value |? Null))
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ do
  Maybe (NormalizedFilePath, WorkspaceEdit)
res <- IO (Maybe (NormalizedFilePath, WorkspaceEdit))
-> HandlerM Config (Maybe (NormalizedFilePath, WorkspaceEdit))
forall a. IO a -> HandlerM Config a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (NormalizedFilePath, WorkspaceEdit))
 -> HandlerM Config (Maybe (NormalizedFilePath, WorkspaceEdit)))
-> IO (Maybe (NormalizedFilePath, WorkspaceEdit))
-> HandlerM Config (Maybe (NormalizedFilePath, WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$ MaybeT IO (NormalizedFilePath, WorkspaceEdit)
-> IO (Maybe (NormalizedFilePath, WorkspaceEdit))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (NormalizedFilePath, WorkspaceEdit)
 -> IO (Maybe (NormalizedFilePath, WorkspaceEdit)))
-> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
-> IO (Maybe (NormalizedFilePath, WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$ IdeState
-> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
extendImportHandler' IdeState
ideState ExtendImport
edit
  Maybe (NormalizedFilePath, WorkspaceEdit)
-> ((NormalizedFilePath, WorkspaceEdit) -> HandlerM Config ())
-> HandlerM Config ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (NormalizedFilePath, WorkspaceEdit)
res (((NormalizedFilePath, WorkspaceEdit) -> HandlerM Config ())
 -> HandlerM Config ())
-> ((NormalizedFilePath, WorkspaceEdit) -> HandlerM Config ())
-> HandlerM Config ()
forall a b. (a -> b) -> a -> b
$ \(NormalizedFilePath
nfp, wedit :: WorkspaceEdit
wedit@WorkspaceEdit {Maybe (Map Uri [TextEdit])
$sel:_changes:WorkspaceEdit :: WorkspaceEdit -> Maybe (Map Uri [TextEdit])
_changes :: Maybe (Map Uri [TextEdit])
_changes}) -> do
    Maybe TextEdit
-> (TextEdit -> HandlerM Config ()) -> HandlerM Config ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust ([TextEdit] -> Maybe TextEdit
forall a. [a] -> Maybe a
listToMaybe ([TextEdit] -> Maybe TextEdit)
-> Maybe [TextEdit] -> Maybe TextEdit
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[TextEdit]] -> Maybe [TextEdit]
forall a. [a] -> Maybe a
listToMaybe ([[TextEdit]] -> Maybe [TextEdit])
-> (Map Uri [TextEdit] -> [[TextEdit]])
-> Map Uri [TextEdit]
-> Maybe [TextEdit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Uri [TextEdit] -> [[TextEdit]]
forall k a. Map k a -> [a]
M.elems (Map Uri [TextEdit] -> Maybe [TextEdit])
-> Maybe (Map Uri [TextEdit]) -> Maybe [TextEdit]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Map Uri [TextEdit])
_changes) ((TextEdit -> HandlerM Config ()) -> HandlerM Config ())
-> (TextEdit -> HandlerM Config ()) -> HandlerM Config ()
forall a b. (a -> b) -> a -> b
$ \TextEdit {Range
$sel:_range:TextEdit :: TextEdit -> Range
_range :: Range
_range} -> do
      let srcSpan :: SrcSpan
srcSpan = NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
nfp Range
_range
      SServerMethod 'Method_WindowShowMessage
-> MessageParams 'Method_WindowShowMessage -> HandlerM Config ()
forall (m :: Method 'ServerToClient 'Notification) config.
SServerMethod m -> MessageParams m -> HandlerM config ()
pluginSendNotification SServerMethod 'Method_WindowShowMessage
SMethod_WindowShowMessage (MessageParams 'Method_WindowShowMessage -> HandlerM Config ())
-> MessageParams 'Method_WindowShowMessage -> HandlerM Config ()
forall a b. (a -> b) -> a -> b
$
        MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
MessageType_Info (Text -> ShowMessageParams) -> Text -> ShowMessageParams
forall a b. (a -> b) -> a -> b
$
          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. Semigroup a => a -> a -> a
<> Text
newThing) (\Text
x -> Text
"‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newThing Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") Maybe Text
thingParent
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’ from "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
importName
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (at "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SrcSpan -> Text
forall a. Outputable a => a -> Text
printOutputable SrcSpan
srcSpan
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      HandlerM Config (LspId 'Method_WorkspaceApplyEdit)
-> HandlerM Config ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HandlerM Config (LspId 'Method_WorkspaceApplyEdit)
 -> HandlerM Config ())
-> HandlerM Config (LspId 'Method_WorkspaceApplyEdit)
-> HandlerM Config ()
forall a b. (a -> b) -> a -> b
$ SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> (Either
      (TResponseError 'Method_WorkspaceApplyEdit)
      (MessageResult 'Method_WorkspaceApplyEdit)
    -> HandlerM Config ())
-> HandlerM Config (LspId 'Method_WorkspaceApplyEdit)
forall (m :: Method 'ServerToClient 'Request) config.
SServerMethod m
-> MessageParams m
-> (Either (TResponseError m) (MessageResult m)
    -> HandlerM config ())
-> HandlerM config (LspId m)
pluginSendRequest SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
wedit) (\Either
  (TResponseError 'Method_WorkspaceApplyEdit)
  (MessageResult 'Method_WorkspaceApplyEdit)
_ -> () -> HandlerM Config ()
forall a. a -> HandlerM Config a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  Either PluginError (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall a. a -> HandlerM Config a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PluginError (Value |? Null)
 -> HandlerM Config (Either PluginError (Value |? Null)))
-> Either PluginError (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall a b. (a -> b) -> a -> b
$ (Value |? Null) -> Either PluginError (Value |? Null)
forall a b. b -> Either a b
Right ((Value |? Null) -> Either PluginError (Value |? Null))
-> (Value |? Null) -> Either PluginError (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Null -> Value |? Null
forall a b. b -> a |? b
InR Null
Null

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

        Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
Nothing -> do
            let qns :: Maybe (Text, QualifiedImportStyle)
qns = (,) (Text -> QualifiedImportStyle -> (Text, QualifiedImportStyle))
-> Maybe Text
-> Maybe (QualifiedImportStyle -> (Text, QualifiedImportStyle))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
importQual Maybe (QualifiedImportStyle -> (Text, QualifiedImportStyle))
-> Maybe QualifiedImportStyle -> Maybe (Text, QualifiedImportStyle)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QualifiedImportStyle -> Maybe QualifiedImportStyle
forall a. a -> Maybe a
Just (DynFlags -> QualifiedImportStyle
qualifiedImportStyle DynFlags
df)
                n :: NewImport
n = Text
-> Maybe Text
-> Maybe (Text, QualifiedImportStyle)
-> Bool
-> NewImport
newImport Text
importName Maybe Text
sym Maybe (Text, QualifiedImportStyle)
qns Bool
False
                sym :: Maybe Text
sym = if Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
importQual then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
it else Maybe Text
forall a. Maybe a
Nothing
                it :: Text
it = case Maybe Text
thingParent of
                  Maybe Text
Nothing -> Text
newThing
                  Just 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
newThing Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            TextEdit
t <- Maybe TextEdit -> MaybeT IO TextEdit
forall (m :: * -> *) a. Monad m => Maybe a -> MaybeT m a
liftMaybe (Maybe TextEdit -> MaybeT IO TextEdit)
-> Maybe TextEdit -> MaybeT IO TextEdit
forall a b. (a -> b) -> a -> b
$ (Text, TextEdit) -> TextEdit
forall a b. (a, b) -> b
snd ((Text, TextEdit) -> TextEdit)
-> Maybe (Text, TextEdit) -> Maybe TextEdit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewImport -> ParsedSource -> Text -> Maybe (Text, TextEdit)
newImportToEdit NewImport
n ParsedSource
ps (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
contents)
            (NormalizedFilePath, WorkspaceEdit)
-> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
forall a. a -> MaybeT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (NormalizedFilePath
nfp, WorkspaceEdit {$sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
_changes=Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
M.singleton Uri
doc [TextEdit
t]), $sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_documentChanges=Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing, $sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
_changeAnnotations=Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing})
  | Bool
otherwise =
    MaybeT IO (NormalizedFilePath, WorkspaceEdit)
forall a. MaybeT IO a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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


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

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

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

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

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

findSigOfBind :: forall p p0. p ~ GhcPass p0 => Range -> HsBind p -> Maybe (Sig p)
findSigOfBind :: forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsBind p -> Maybe (Sig p)
findSigOfBind Range
range HsBind p
bind =
    case HsBind p
bind of
      FunBind {} -> [LMatch p (LHsExpr p)] -> Maybe (Sig p)
findSigOfLMatch (GenLocated
  (Anno
     [GenLocated
        (Anno
           (Match
              (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))))
        (Match
           (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))])
  [LMatch p (LHsExpr p)]
-> [LMatch p (LHsExpr p)]
forall l e. GenLocated l e -> e
unLoc (GenLocated
   (Anno
      [GenLocated
         (Anno
            (Match
               (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))))
         (Match
            (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))])
   [LMatch p (LHsExpr p)]
 -> [LMatch p (LHsExpr p)])
-> GenLocated
     (Anno
        [GenLocated
           (Anno
              (Match
                 (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))))
           (Match
              (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))])
     [LMatch p (LHsExpr p)]
-> [LMatch p (LHsExpr p)]
forall a b. (a -> b) -> a -> b
$ MatchGroup p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
-> XRec p [LMatch p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))]
forall p body. MatchGroup p body -> XRec p [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
      GenLocated
  SrcSpanAnnA
  (Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))
match <- Position
-> [GenLocated
      SrcSpanAnnA
      (Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))]
-> Maybe
     (GenLocated
        SrcSpanAnnA
        (Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))))
forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) [LMatch p (LHsExpr p)]
[GenLocated
   SrcSpanAnnA
   (Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))]
ls
      let grhs :: GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
grhs = Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
-> GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
forall p body. Match p body -> GRHSs p body
m_grhss (Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
 -> GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))
-> Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
-> GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
forall a b. (a -> b) -> a -> b
$ GenLocated
  SrcSpanAnnA
  (Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))
-> Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
forall l e. GenLocated l e -> e
unLoc GenLocated
  SrcSpanAnnA
  (Match p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))
match
      [Maybe (Sig p)] -> Maybe (Sig p)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
        [Range -> HsLocalBinds p -> Maybe (Sig p)
forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsLocalBinds p -> Maybe (Sig p)
findSigOfBinds Range
range (GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
-> HsLocalBinds p
forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
grhs) -- where clause
        , do
#if MIN_VERSION_ghc(9,3,0)
          GenLocated
  (SrcSpanAnn' (EpAnn NoEpAnns))
  (GRHS (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr p)))
grhs <- Position
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr p)))]
-> Maybe
     (GenLocated
        (SrcSpanAnn' (EpAnn NoEpAnns))
        (GRHS (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr p))))
forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) (GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
-> [LGRHS p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs GRHSs p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
grhs)
#else
          grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs)
#endif
          case GenLocated
  (SrcSpanAnn' (EpAnn NoEpAnns))
  (GRHS (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr p)))
-> GRHS (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr p))
forall l e. GenLocated l e -> e
unLoc GenLocated
  (SrcSpanAnn' (EpAnn NoEpAnns))
  (GRHS (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr p)))
grhs of
            GRHS XCGRHS (GhcPass p0) (GenLocated SrcSpanAnnA (HsExpr p))
_ [GuardLStmt (GhcPass p0)]
_ GenLocated SrcSpanAnnA (HsExpr p)
bd -> HsExpr p -> Maybe (Sig p)
findSigOfExpr (GenLocated SrcSpanAnnA (HsExpr p) -> HsExpr p
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr p)
bd)
        ]

    findSigOfExpr :: HsExpr p -> Maybe (Sig p)
    findSigOfExpr :: HsExpr p -> Maybe (Sig p)
findSigOfExpr = HsExpr p -> Maybe (Sig p)
go
      where
#if MIN_VERSION_ghc(9,3,0) && !MIN_VERSION_ghc(9,9,0)
        go :: HsExpr p -> Maybe (Sig p)
go (HsLet XLet p
_ LHsToken "let" p
_ HsLocalBinds p
binds LHsToken "in" p
_ 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
binds
#else
        go (HsLet _ binds _) = findSigOfBinds range binds
#endif
        go (HsDo XDo p
_ HsDoFlavour
_ XRec p [ExprLStmt p]
stmts) = do
          StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
stmtlr <- GenLocated
  SrcSpanAnnA
  (StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))
-> StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
forall l e. GenLocated l e -> e
unLoc (GenLocated
   SrcSpanAnnA
   (StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))
 -> StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))
-> Maybe
     (GenLocated
        SrcSpanAnnA
        (StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))))
-> Maybe
     (StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> [GenLocated
      SrcSpanAnnA
      (StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))]
-> Maybe
     (GenLocated
        SrcSpanAnnA
        (StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))))
forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) (GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))]
forall l e. GenLocated l e -> e
unLoc XRec p [ExprLStmt p]
GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0))))]
stmts)
          case StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
stmtlr of
            LetStmt XLetStmt p p (GenLocated SrcSpanAnnA (HsExpr (GhcPass p0)))
_ HsLocalBinds p
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
lhsLocalBindsLR
            StmtLR p p (GenLocated SrcSpanAnnA (HsExpr (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 :: forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsLocalBinds p -> Maybe (Sig p)
findSigOfBinds Range
range = HsLocalBindsLR p p -> Maybe (Sig p)
go
  where
    go :: HsLocalBindsLR p p -> Maybe (Sig p)
go (HsValBinds XHsValBinds p p
_ (ValBinds XValBinds p p
_ LHsBindsLR p p
binds [LSig p]
lsigs)) =
        case GenLocated SrcSpanAnnA (Sig p) -> Sig p
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (Sig p) -> Sig p)
-> Maybe (GenLocated SrcSpanAnnA (Sig p)) -> Maybe (Sig p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> [GenLocated SrcSpanAnnA (Sig p)]
-> Maybe (GenLocated SrcSpanAnnA (Sig p))
forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) [LSig p]
[GenLocated SrcSpanAnnA (Sig 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 SrcSpanAnnA (HsBind p)
lHsBindLR <- Position
-> [GenLocated SrcSpanAnnA (HsBind p)]
-> Maybe (GenLocated SrcSpanAnnA (HsBind p))
forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
range) (Bag (GenLocated SrcSpanAnnA (HsBind p))
-> [GenLocated SrcSpanAnnA (HsBind p)]
forall a. Bag a -> [a]
bagToList LHsBindsLR p p
Bag (GenLocated SrcSpanAnnA (HsBind p))
binds)
            Range -> HsBind p -> Maybe (Sig p)
forall p (p0 :: Pass).
(p ~ GhcPass p0) =>
Range -> HsBind p -> Maybe (Sig p)
findSigOfBind Range
range (GenLocated SrcSpanAnnA (HsBind p) -> HsBind p
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsBind p)
lHsBindLR)
    go HsLocalBindsLR p p
_ = Maybe (Sig p)
forall a. Maybe a
Nothing

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

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

-- Single:
-- This binding for ‘mod’ shadows the existing binding
--   imported from ‘Prelude’ at haskell-language-server/ghcide/src/Development/IDE/Plugin/CodeAction.hs:10:8-40
--   (and originally defined in ‘GHC.Real’)typecheck(-Wname-shadowing)
-- Multi:
--This binding for ‘pack’ shadows the existing bindings
--  imported from ‘Data.ByteString’ at B.hs:6:1-22
--  imported from ‘Data.ByteString.Lazy’ at B.hs:8:1-27
--  imported from ‘Data.Text’ at B.hs:7:1-16
suggestHideShadow :: 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 ParsedSource
ps Text
fileContents Maybe TcModuleResult
mTcM Maybe HieAstResult
mHar Diagnostic {Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message, Range
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> 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 a b. [a] -> (a -> [b]) -> [b]
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 occurrence imports", ((Text, [Either TextEdit Rewrite]) -> [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])] -> [Either TextEdit Rewrite]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [Either TextEdit Rewrite]) -> [Either TextEdit Rewrite]
forall a b. (a, b) -> b
snd [(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
    L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodImports} = ParsedSource
ps

    suggests :: Text -> Text -> Text -> [(Text, [Either TextEdit Rewrite])]
suggests Text
identifier Text
modName Text
s
      | Just TcModuleResult
tcM <- Maybe TcModuleResult
mTcM,
        Just HieAstResult
har <- Maybe HieAstResult
mHar,
        [RealSrcSpan
s'] <- [RealSrcSpan
x | (RealSrcSpan
x, String
"") <- ReadS RealSrcSpan
readSrcSpan ReadS RealSrcSpan -> ReadS RealSrcSpan
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s],
        TcModuleResult
-> HieAstResult -> String -> String -> SrcSpan -> Bool
isUnusedImportedId TcModuleResult
tcM HieAstResult
har (Text -> String
T.unpack Text
identifier) (Text -> String
T.unpack Text
modName) (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
s' Maybe BufSpan
forall a. Maybe a
Nothing),
        Maybe (LImportDecl GhcPs)
mDecl <- [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
hsmodImports (String -> Maybe (LImportDecl GhcPs))
-> String -> Maybe (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ Text -> String
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 (GenLocated SrcSpanAnnA (ImportDecl GhcPs)) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (LImportDecl GhcPs)
Maybe (GenLocated SrcSpanAnnA (ImportDecl 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]))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> [Either TextEdit Rewrite])
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> (Text, [Either TextEdit Rewrite])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TextEdit Rewrite -> [Either TextEdit Rewrite]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TextEdit Rewrite -> [Either TextEdit Rewrite])
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> Either TextEdit Rewrite)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [Either TextEdit Rewrite]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rewrite -> Either TextEdit Rewrite
forall a. a -> Either TextEdit a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rewrite -> Either TextEdit Rewrite)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Rewrite)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Either TextEdit Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LImportDecl GhcPs -> Rewrite
hideSymbol (Text -> String
T.unpack Text
identifier) (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> (Text, [Either TextEdit Rewrite]))
-> Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> Maybe (Text, [Either TextEdit Rewrite])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LImportDecl GhcPs)
Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
mDecl
      | Bool
otherwise = []

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

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 -> String -> String -> SrcSpan -> Bool
isUnusedImportedId
  TcModuleResult {tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTypechecked = TcGblEnv {tcg_imports :: TcGblEnv -> ImportAvails
tcg_imports = ImportAvails {ImportedMods
imp_mods :: ImportedMods
imp_mods :: ImportAvails -> ImportedMods
imp_mods}}}
  HAR {RefMap a
refMap :: RefMap a
refMap :: ()
refMap}
  String
identifier
  String
modName
  SrcSpan
importSpan
    | OccName
occ <- String -> OccName
mkVarOcc String
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
ModuleName
SrcSpan
GlobalRdrEnv
imv_all_exports :: GlobalRdrEnv
imv_name :: ModuleName
imv_span :: SrcSpan
imv_is_safe :: Bool
imv_is_hiding :: Bool
imv_qualified :: Bool
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
..} <- [ImportedModsVal]
impModsVals,
              ModuleName
imv_name ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ModuleName
mkModuleName String
modName,
              SrcSpan -> SrcSpan -> Bool
isTheSameLine SrcSpan
imv_span SrcSpan
importSpan
          ],
      [GRE {gre_name :: GlobalRdrElt -> Name
gre_name = Name
name}] <- GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
rdrEnv OccName
occ,
      Either ModuleName Name
importedIdentifier <- 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 :: Maybe a
identInfo :: Set ContextInfo
identType :: forall a. IdentifierDetails a -> Maybe a
identInfo :: forall a. IdentifierDetails a -> Set ContextInfo
..}) -> 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 :: forall p. HsModule p -> [LImportDecl p]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports}} Maybe Text
contents Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
..}
--     The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant
    | Just [Text
_, Text
bindings] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"
    , Just (L SrcSpanAnnA
_ ImportDecl GhcPs
impDecl) <- (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l) ImportDecl GhcPs
_) -> Range -> Position
_start Range
_range Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l Bool -> Bool -> Bool
&& Range -> Position
_end Range
_range Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l ) [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
hsmodImports
    , Just Text
c <- Maybe Text
contents
    , [[Range]]
ranges <- (Text -> [Range]) -> [Text] -> [[Range]]
forall a b. (a -> b) -> [a] -> [b]
map (ImportDecl GhcPs -> String -> [Range]
rangesForBindingImport ImportDecl GhcPs
impDecl (String -> [Range]) -> (Text -> String) -> Text -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
", " Text
bindings [Text] -> (Text -> [Text]) -> [Text]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [Text]
trySplitIntoOriginalAndRecordField)
    , [Range]
ranges' <- Bool -> PositionIndexedString -> [Range] -> [Range]
extendAllToIncludeCommaIfPossible Bool
False (String -> PositionIndexedString
indexedByPosition (String -> PositionIndexedString)
-> String -> PositionIndexedString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
c) ([[Range]] -> [Range]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Range]]
ranges)
    , Bool -> Bool
not ([Range] -> Bool
forall a. [a] -> 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 -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (String
"The( qualified)? import of [^ ]* is redundant" :: String)
        = [(Text
"Remove import", [Range -> Text -> TextEdit
TextEdit (Maybe Text -> Range -> Range
extendToWholeLineIfPossible Maybe Text
contents Range
_range) Text
""])]
    | Bool
otherwise = []
    where
      -- In case of an unused record field import, the binding from the message will not match any import directly
      -- In this case, we try if we can additionally extract a record field name
      -- Example: The import of ‘B(b2)’ from module ‘ModuleB’ is redundant
      trySplitIntoOriginalAndRecordField :: T.Text -> [T.Text]
      trySplitIntoOriginalAndRecordField :: Text -> [Text]
trySplitIntoOriginalAndRecordField Text
binding =
        case Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
binding Text
"([^ ]+)\\(([^)]+)\\)" of
          Just [Text
_, Text
fields] -> [Text
binding, Text
fields]
          Maybe [Text]
_                -> [Text
binding]

diagInRange :: Diagnostic -> Range -> Bool
diagInRange :: Diagnostic -> Range -> Bool
diagInRange Diagnostic {$sel:_range:Diagnostic :: Diagnostic -> Range
_range = Range
dr} Range
r = Range
dr Range -> Range -> Bool
`subRange` Range
extendedRange
  where
    -- Ensures the range captures full lines. Makes it easier to trigger the correct
    -- "remove redundant" code actions from anywhere on the offending line.
    extendedRange :: Range
extendedRange = Range -> Range
extendToFullLines Range
r

-- Note [Removing imports is preferred]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- It's good to prefer the remove imports code action because an unused import
-- is likely to be removed and less likely the warning will be disabled.
-- Therefore actions to remove a single or all redundant imports should be
-- preferred, so that the client can prioritize them higher.
caRemoveRedundantImports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> Range -> Uri -> [Command |? CodeAction]
caRemoveRedundantImports :: Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> Range
-> Uri
-> [Command |? CodeAction]
caRemoveRedundantImports Maybe ParsedModule
m Maybe Text
contents [Diagnostic]
allDiags Range
contextRange 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]
allDiags,
    [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 -> Range -> Bool
`diagInRange` Range
contextRange],
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Diagnostic, (Text, [TextEdit]))] -> Bool
forall a. [a] -> 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
CodeActionKind_QuickFix) Maybe Bool
forall a. Maybe a
Nothing [Diagnostic
diagnostic] WorkspaceEdit{Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
Maybe (Map Uri [TextEdit])
Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
$sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
$sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
$sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_changes :: Maybe (Map Uri [TextEdit])
_documentChanges :: forall a. Maybe a
_changeAnnotations :: forall a. Maybe a
..} where
        _changes :: Maybe (Map Uri [TextEdit])
_changes = Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit]))
-> Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a b. (a -> b) -> a -> b
$ Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
M.singleton Uri
uri [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{Maybe Bool
Maybe [Diagnostic]
Maybe Value
Maybe WorkspaceEdit
Maybe CodeActionDisabled
Maybe CodeActionKind
Maybe Command
Text
forall a. Maybe a
_title :: Text
_kind :: Maybe CodeActionKind
_diagnostics :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_isPreferred :: Maybe Bool
_command :: forall a. Maybe a
_disabled :: forall a. Maybe a
_data_ :: forall a. Maybe a
$sel:_command:CodeAction :: Maybe Command
$sel:_data_:CodeAction :: Maybe Value
$sel:_diagnostics:CodeAction :: Maybe [Diagnostic]
$sel:_disabled:CodeAction :: Maybe CodeActionDisabled
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_title:CodeAction :: Text
..} where
        _changes :: Maybe (Map Uri [TextEdit])
_changes = Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit]))
-> Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a b. (a -> b) -> a -> b
$ Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
M.singleton Uri
uri [TextEdit]
tedit
        _title :: Text
_title = Text
"Remove all redundant imports"
        _kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionKind_QuickFix
        _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
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
Maybe (Map Uri [TextEdit])
Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
$sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
$sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
$sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_changes :: Maybe (Map Uri [TextEdit])
_documentChanges :: forall a. Maybe a
_changeAnnotations :: forall a. Maybe a
..}
        -- See Note [Removing imports is preferred]
        _isPreferred :: Maybe Bool
_isPreferred = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
        _command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
        _disabled :: Maybe a
_disabled = Maybe a
forall a. Maybe a
Nothing
        _data_ :: Maybe a
_data_ = Maybe a
forall a. Maybe a
Nothing
        _changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing

caRemoveInvalidExports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> Range -> Uri -> [Command |? CodeAction]
caRemoveInvalidExports :: Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> Range
-> Uri
-> [Command |? CodeAction]
caRemoveInvalidExports Maybe ParsedModule
m Maybe Text
contents [Diagnostic]
allDiags Range
contextRange Uri
uri
  | Just ParsedModule
pm <- Maybe ParsedModule
m,
    Just Text
txt <- Maybe Text
contents,
    PositionIndexedString
txt' <- String -> PositionIndexedString
indexedByPosition (String -> PositionIndexedString)
-> String -> PositionIndexedString
forall a b. (a -> b) -> a -> b
$ Text -> String
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]
allDiags,
    [(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 -> Range -> Bool
`diagInRange` Range
contextRange],
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Text, Diagnostic, [Range])] -> Bool
forall a. [a] -> 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{Maybe Bool
Maybe [Diagnostic]
Maybe Value
Maybe WorkspaceEdit
Maybe CodeActionDisabled
Maybe CodeActionKind
Maybe Command
Text
forall a. Maybe a
$sel:_command:CodeAction :: Maybe Command
$sel:_data_:CodeAction :: Maybe Value
$sel:_diagnostics:CodeAction :: Maybe [Diagnostic]
$sel:_disabled:CodeAction :: Maybe CodeActionDisabled
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_title:CodeAction :: Text
_title :: Text
_kind :: Maybe CodeActionKind
_diagnostics :: Maybe [Diagnostic]
_edit :: Maybe WorkspaceEdit
_command :: forall a. Maybe a
_isPreferred :: Maybe Bool
_disabled :: forall a. Maybe a
_data_ :: forall a. Maybe a
..} 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 (Map Uri [TextEdit])
_changes = Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit]))
-> Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a b. (a -> b) -> a -> b
$ Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
M.singleton Uri
uri [TextEdit]
tedit
        _title :: Text
_title = Text
title
        _kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionKind_QuickFix
        _diagnostics :: Maybe [Diagnostic]
_diagnostics = [Diagnostic] -> Maybe [Diagnostic]
forall a. a -> Maybe a
Just [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
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
Maybe (Map Uri [TextEdit])
Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
$sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
$sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
$sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_changes :: Maybe (Map Uri [TextEdit])
_documentChanges :: forall a. Maybe a
_changeAnnotations :: forall a. Maybe a
..}
        _command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
        -- See Note [Removing imports is preferred]
        _isPreferred :: Maybe Bool
_isPreferred = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
        _disabled :: Maybe a
_disabled = Maybe a
forall a. Maybe a
Nothing
        _data_ :: Maybe a
_data_ = Maybe a
forall a. Maybe a
Nothing
        _changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing
    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{Maybe Bool
Maybe [Diagnostic]
Maybe Value
Maybe WorkspaceEdit
Maybe CodeActionDisabled
Maybe CodeActionKind
Maybe Command
Text
forall a. Maybe a
$sel:_command:CodeAction :: Maybe Command
$sel:_data_:CodeAction :: Maybe Value
$sel:_diagnostics:CodeAction :: Maybe [Diagnostic]
$sel:_disabled:CodeAction :: Maybe CodeActionDisabled
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_title:CodeAction :: Text
_title :: Text
_kind :: Maybe CodeActionKind
_diagnostics :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_command :: forall a. Maybe a
_isPreferred :: Maybe Bool
_disabled :: forall a. Maybe a
_data_ :: forall a. Maybe a
..} 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 (Map Uri [TextEdit])
_changes = Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit]))
-> Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a b. (a -> b) -> a -> b
$ Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
M.singleton Uri
uri [TextEdit]
tedit
        _title :: Text
_title = Text
"Remove all redundant exports"
        _kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionKind_QuickFix
        _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
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
Maybe (Map Uri [TextEdit])
Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
$sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
$sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
$sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_changes :: Maybe (Map Uri [TextEdit])
_documentChanges :: forall a. Maybe a
_changeAnnotations :: forall a. Maybe a
..}
        _command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
        -- See Note [Removing imports is preferred]
        _isPreferred :: Maybe Bool
_isPreferred = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
        _disabled :: Maybe a
_disabled = Maybe a
forall a. Maybe a
Nothing
        _data_ :: Maybe a
_data_ = Maybe a
forall a. Maybe a
Nothing
        _changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing

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{[LImportDecl GhcPs]
[LHsDecl GhcPs]
Maybe (XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
XCModule GhcPs
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodExt :: XCModule GhcPs
hsmodName :: Maybe (XRec GhcPs ModuleName)
hsmodExports :: Maybe (XRec GhcPs [LIE GhcPs])
hsmodImports :: [LImportDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodExt :: forall p. HsModule p -> XCModule p
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
..}} Diagnostic{Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
Range
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_range :: Range
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
  | Text
msg <- Text -> Text
unifySpaces Text
_message
  , Just XRec GhcPs [LIE GhcPs]
export <- Maybe (XRec GhcPs [LIE GhcPs])
hsmodExports
  , Just Range
exportRange <- XRec GhcPs [LIE GhcPs] -> Maybe Range
forall a. HasSrcSpan a => a -> Maybe Range
getLocatedRange (XRec GhcPs [LIE GhcPs] -> Maybe Range)
-> XRec GhcPs [LIE GhcPs] -> Maybe Range
forall a b. (a -> b) -> a -> b
$ XRec GhcPs [LIE GhcPs]
export
  , [GenLocated SrcSpanAnnA (IE GhcPs)]
exports <- GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LIE GhcPs]
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
export
  , Just (Text
removeFromExport, ![Range]
ranges) <- (NotInScope -> (Text, [Range]))
-> Maybe NotInScope -> Maybe (Text, [Range])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([GenLocated SrcSpanAnnA (IE GhcPs)] -> Text -> (Text, [Range])
getRanges [GenLocated SrcSpanAnnA (IE GhcPs)]
exports (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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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 :: [GenLocated SrcSpanAnnA (IE GhcPs)] -> Text -> (Text, [Range])
getRanges [GenLocated SrcSpanAnnA (IE GhcPs)]
exports Text
txt = case [LIE GhcPs] -> String -> [Range]
smallerRangesForBindingExport [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
exports (Text -> String
T.unpack Text
txt) of
      []     -> (Text
txt, [Range
_range])
      [Range]
ranges -> (Text
txt, [Range]
ranges)
suggestRemoveRedundantExport ParsedModule
_ Diagnostic
_ = 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 :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls}}
  Maybe Text
contents
  Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
-- Foo.hs:4:1: warning: [-Wunused-binds] Defined but not used: ‘f’
    | Just [Text
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
".*Defined but not used: ‘([^ ]+)’"
    , Just PositionIndexedString
indexedContent <- String -> PositionIndexedString
indexedByPosition (String -> PositionIndexedString)
-> (Text -> String) -> Text -> PositionIndexedString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
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 -> String -> [Range]
relatedRanges PositionIndexedString
indexedContent (Text -> String
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TextEdit]
edits)])
    | Bool
otherwise = []
    where
      relatedRanges :: PositionIndexedString -> String -> [Range]
relatedRanges PositionIndexedString
indexedContent String
name =
        (LocatedAn AnnListItem (HsDecl GhcPs) -> [Range])
-> [LocatedAn AnnListItem (HsDecl GhcPs)] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PositionIndexedString
-> String -> Located (HsDecl GhcPs) -> [Range]
findRelatedSpans PositionIndexedString
indexedContent String
name (Located (HsDecl GhcPs) -> [Range])
-> (LocatedAn AnnListItem (HsDecl GhcPs) -> Located (HsDecl GhcPs))
-> LocatedAn AnnListItem (HsDecl GhcPs)
-> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedAn AnnListItem (HsDecl GhcPs) -> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc) [LHsDecl GhcPs]
[LocatedAn AnnListItem (HsDecl GhcPs)]
hsmodDecls
      toRange :: RealSrcSpan -> Range
toRange = RealSrcSpan -> Range
realSrcSpanToRange
      extendForSpaces :: PositionIndexedString -> Range -> Range
extendForSpaces = PositionIndexedString -> Range -> Range
extendToIncludePreviousNewlineIfPossible

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

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

      findRelatedSigSpan :: PositionIndexedString -> String -> RealSrcSpan -> Sig GhcPs -> [Range]
      findRelatedSigSpan :: PositionIndexedString
-> String -> RealSrcSpan -> Sig GhcPs -> [Range]
findRelatedSigSpan PositionIndexedString
indexedContent String
name RealSrcSpan
l Sig GhcPs
sig =
        let maybeSpan :: Maybe (SrcSpan, Bool)
maybeSpan = String -> Sig GhcPs -> Maybe (SrcSpan, Bool)
findRelatedSigSpan1 String
name Sig GhcPs
sig
        in case Maybe (SrcSpan, Bool)
maybeSpan of
          Just (SrcSpan
_span, Bool
True) -> Range -> [Range]
forall a. a -> [a]
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 a. a -> [a]
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 :: String -> Sig GhcPs -> Maybe (SrcSpan, Bool)
findRelatedSigSpan1 String
name (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
lnames LHsSigWcType GhcPs
_) =
        let maybeIdx :: Maybe Int
maybeIdx = (LocatedAn NameAnn RdrName -> Bool)
-> [LocatedAn NameAnn RdrName] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(L SrcSpanAnnN
_ RdrName
id) -> IdP GhcPs -> String -> Bool
isSameName IdP GhcPs
RdrName
id String
name) [LIdP GhcPs]
[LocatedAn NameAnn RdrName]
lnames
        in case Maybe Int
maybeIdx of
            Maybe Int
Nothing -> Maybe (SrcSpan, Bool)
forall a. Maybe a
Nothing
            Just Int
_ | [LIdP GhcPs
lname] <- [LIdP GhcPs]
lnames -> (SrcSpan, Bool) -> Maybe (SrcSpan, Bool)
forall a. a -> Maybe a
Just (LocatedAn NameAnn RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LIdP GhcPs
LocatedAn NameAnn RdrName
lname, Bool
True)
            Just Int
idx ->
              let targetLname :: SrcSpan
targetLname = LocatedAn NameAnn RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LocatedAn NameAnn RdrName -> SrcSpan)
-> LocatedAn NameAnn RdrName -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [LIdP GhcPs]
[LocatedAn NameAnn RdrName]
lnames [LocatedAn NameAnn RdrName] -> Int -> LocatedAn NameAnn RdrName
forall a. HasCallStack => [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)
-> (LocatedAn NameAnn RdrName -> SrcSpan)
-> LocatedAn NameAnn RdrName
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedAn NameAnn RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LocatedAn NameAnn RdrName -> SrcLoc)
-> LocatedAn NameAnn RdrName -> SrcLoc
forall a b. (a -> b) -> a -> b
$ [LIdP GhcPs]
[LocatedAn NameAnn RdrName]
lnames [LocatedAn NameAnn RdrName] -> Int -> LocatedAn NameAnn RdrName
forall a. HasCallStack => [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
< [LocatedAn NameAnn RdrName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LIdP GhcPs]
[LocatedAn NameAnn RdrName]
lnames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                            then SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LocatedAn NameAnn RdrName -> SrcSpan)
-> LocatedAn NameAnn RdrName
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedAn NameAnn RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LocatedAn NameAnn RdrName -> SrcLoc)
-> LocatedAn NameAnn RdrName -> SrcLoc
forall a b. (a -> b) -> a -> b
$ [LIdP GhcPs]
[LocatedAn NameAnn RdrName]
lnames [LocatedAn NameAnn RdrName] -> Int -> LocatedAn NameAnn RdrName
forall a. HasCallStack => [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 String
_ Sig GhcPs
_ = Maybe (SrcSpan, Bool)
forall a. Maybe a
Nothing

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

      findRelatedSpanForHsBind
        :: PositionIndexedString
        -> String
        -> [LSig GhcPs]
        -> LHsBind GhcPs
        -> [Range]
      findRelatedSpanForHsBind :: PositionIndexedString
-> String -> [LSig GhcPs] -> LHsBind GhcPs -> [Range]
findRelatedSpanForHsBind
        PositionIndexedString
indexedContent
        String
name
        [LSig GhcPs]
lsigs
        (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (HsBind GhcPs
-> Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])
extractNameAndMatchesFromFunBind -> Just (Located (IdP GhcPs)
lname, [LMatch GhcPs (LHsExpr GhcPs)]
matches))) =
        if SrcSpan -> Bool
isTheBinding (GenLocated SrcSpan RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (IdP GhcPs)
GenLocated SrcSpan RdrName
lname)
        then
          let findSig :: GenLocated SrcSpan (Sig GhcPs) -> [Range]
findSig (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) Sig GhcPs
sig) = PositionIndexedString
-> String -> RealSrcSpan -> Sig GhcPs -> [Range]
findRelatedSigSpan PositionIndexedString
indexedContent String
name RealSrcSpan
l Sig GhcPs
sig
              findSig GenLocated SrcSpan (Sig GhcPs)
_ = []
          in PositionIndexedString -> Range -> Range
extendForSpaces PositionIndexedString
indexedContent (RealSrcSpan -> Range
toRange RealSrcSpan
l) Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (Sig GhcPs) -> [Range])
-> [GenLocated SrcSpanAnnA (Sig GhcPs)] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GenLocated SrcSpan (Sig GhcPs) -> [Range]
findSig (GenLocated SrcSpan (Sig GhcPs) -> [Range])
-> (GenLocated SrcSpanAnnA (Sig GhcPs)
    -> GenLocated SrcSpan (Sig GhcPs))
-> GenLocated SrcSpanAnnA (Sig GhcPs)
-> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated SrcSpan (Sig GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc) [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
lsigs
        else (GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
 -> [Range])
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
-> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PositionIndexedString
-> String -> LMatch GhcPs (LHsExpr GhcPs) -> [Range]
findRelatedSpanForMatch PositionIndexedString
indexedContent String
name) [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches
      findRelatedSpanForHsBind PositionIndexedString
_ String
_ [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 -> String -> Bool
isSameName IdP GhcPs
x String
name = Text -> String
T.unpack (RdrName -> Text
forall a. Outputable a => a -> Text
printOutputable IdP GhcPs
RdrName
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
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
$c== :: ExportsAs -> ExportsAs -> Bool
== :: ExportsAs -> ExportsAs -> Bool
$c/= :: ExportsAs -> ExportsAs -> Bool
/= :: ExportsAs -> ExportsAs -> Bool
Eq)

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

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

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

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

    parenthesizeIfNeeds :: Bool -> T.Text -> T.Text
    parenthesizeIfNeeds :: Bool -> Text -> Text
parenthesizeIfNeeds Bool
needsTypeKeyword Text
x
      | (Char -> Bool) -> Text -> Bool
T.any (Char
c ==) Text
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
      where
        c :: Char
c = HasCallStack => Text -> Char
Text -> Char
T.head Text
x

    matchWithDiagnostic :: Range -> Located (IdP GhcPs) -> Bool
    matchWithDiagnostic :: Range -> Located (IdP GhcPs) -> Bool
matchWithDiagnostic Range{$sel:_start:Range :: Range -> Position
_start=Position
l,$sel:_end:Range :: Range -> Position
_end=Position
r} Located (IdP GhcPs)
x =
      let loc :: Maybe Position
loc = (Range -> Position) -> Maybe Range -> Maybe Position
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_start (Maybe Range -> Maybe Position)
-> (Located (IdP GhcPs) -> Maybe Range)
-> Located (IdP GhcPs)
-> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (IdP GhcPs) -> Maybe Range
GenLocated SrcSpan RdrName -> Maybe Range
forall a. HasSrcSpan a => a -> Maybe Range
getLocatedRange (Located (IdP GhcPs) -> Maybe Position)
-> Located (IdP GhcPs) -> Maybe Position
forall a b. (a -> b) -> a -> b
$ Located (IdP GhcPs)
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 :: SrcSpan -> Bool
    isTopLevel :: SrcSpan -> Bool
isTopLevel SrcSpan
span = (Range -> UInt) -> Maybe Range -> Maybe UInt
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Position -> UInt
_character (Position -> UInt) -> (Range -> Position) -> Range -> UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Position
_start) (SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
span) Maybe UInt -> Maybe UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt -> Maybe UInt
forall a. a -> Maybe a
Just UInt
0

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

suggestAddTypeAnnotationToSatisfyConstraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyConstraints :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyConstraints Maybe Text
sourceOpt Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
-- 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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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)

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

-- | GHC strips out backticks in case of infix functions as well as single quote
--   in case of quoted name when using TemplateHaskellQuotes. Which is not desired.
--
-- For example:
-- 1.
--
-- @
-- File.hs:52:41: error:
--     * Variable not in scope:
--         suggestAcion :: Maybe T.Text -> Range -> Range
--     * Perhaps you meant ‘suggestAction’ (line 83)
-- File.hs:94:37: error:
--     Not in scope: ‘T.isPrfixOf’
--     Perhaps you meant one of these:
--       ‘T.isPrefixOf’ (imported from Data.Text),
--       ‘T.isInfixOf’ (imported from Data.Text),
--       ‘T.isSuffixOf’ (imported from Data.Text)
--     Module ‘Data.Text’ does not export ‘isPrfixOf’.
-- @
--
-- * action: \`suggestAcion\` will be renamed to \`suggestAction\` keeping back ticks around the function
--
-- 2.
--
-- @
-- import Language.Haskell.TH (Name)
-- foo :: Name
-- foo = 'bread
--
-- File.hs:8:7: error:
--     Not in scope: ‘bread’
--       * Perhaps you meant one of these:
--         ‘break’ (imported from Prelude), ‘read’ (imported from Prelude)
--       * In the Template Haskell quotation 'bread
-- @
--
-- * action: 'bread will be renamed to 'break keeping single quote on beginning of name
suggestReplaceIdentifier :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestReplaceIdentifier :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestReplaceIdentifier Maybe Text
contents Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
    | 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
$sel:_message:Diagnostic :: Diagnostic -> Text
_message :: Text
_message, Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range :: Range
_range}
  | Just (Text
name, Maybe Text
typ) <- Text -> Maybe (Text, Maybe Text)
matchVariableNotInScope Text
message =
      IdeOptions
-> ParsedModule
-> Range
-> Text
-> Maybe Text
-> [(Text, [TextEdit])]
newDefinitionAction IdeOptions
ideOptions ParsedModule
parsedModule Range
_range Text
name Maybe Text
typ
  | Just (Text
name, Text
typ) <- Text -> Maybe (Text, Text)
matchFoundHole Text
message,
    [(Text
label, [TextEdit]
newDefinitionEdits)] <- IdeOptions
-> ParsedModule
-> Range
-> Text
-> Maybe Text
-> [(Text, [TextEdit])]
newDefinitionAction IdeOptions
ideOptions ParsedModule
parsedModule Range
_range Text
name (Text -> Maybe Text
forall a. a -> Maybe a
Just 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 -> Maybe T.Text -> [(T.Text, [TextEdit])]
newDefinitionAction :: IdeOptions
-> ParsedModule
-> Range
-> Text
-> Maybe Text
-> [(Text, [TextEdit])]
newDefinitionAction IdeOptions {Bool
Int
String
[String]
[Text]
Maybe String
IO Bool
IO CheckParents
Action IdeGhcSession
IdePkgLocationOptions
ProgressReportingStyle
IdeTesting
IdeDefer
IdeReportProgress
OptHaddockParse
ShakeOptions
ParsedSource -> IdePreprocessedSource
Config -> DynFlagsModifications
forall a. Typeable a => a -> Bool
optPreprocessor :: ParsedSource -> IdePreprocessedSource
optGhcSession :: Action IdeGhcSession
optPkgLocationOpts :: IdePkgLocationOptions
optExtensions :: [String]
optShakeProfiling :: Maybe String
optTesting :: IdeTesting
optReportProgress :: IdeReportProgress
optMaxDirtyAge :: Int
optLanguageSyntax :: String
optNewColonConvention :: Bool
optKeywords :: [Text]
optDefer :: IdeDefer
optCheckProject :: IO Bool
optCheckParents :: IO CheckParents
optHaddockParse :: OptHaddockParse
optModifyDynFlags :: Config -> DynFlagsModifications
optShakeOptions :: ShakeOptions
optSkipProgress :: forall a. Typeable a => a -> Bool
optProgressStyle :: ProgressReportingStyle
optRunSubset :: Bool
optVerifyCoreFile :: Bool
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optExtensions :: IdeOptions -> [String]
optShakeProfiling :: IdeOptions -> Maybe String
optTesting :: IdeOptions -> IdeTesting
optReportProgress :: IdeOptions -> IdeReportProgress
optMaxDirtyAge :: IdeOptions -> Int
optLanguageSyntax :: IdeOptions -> String
optNewColonConvention :: IdeOptions -> Bool
optKeywords :: IdeOptions -> [Text]
optDefer :: IdeOptions -> IdeDefer
optCheckProject :: IdeOptions -> IO Bool
optCheckParents :: IdeOptions -> IO CheckParents
optHaddockParse :: IdeOptions -> OptHaddockParse
optModifyDynFlags :: IdeOptions -> Config -> DynFlagsModifications
optShakeOptions :: IdeOptions -> ShakeOptions
optSkipProgress :: IdeOptions -> forall a. Typeable a => a -> Bool
optProgressStyle :: IdeOptions -> ProgressReportingStyle
optRunSubset :: IdeOptions -> Bool
optVerifyCoreFile :: IdeOptions -> Bool
..} ParsedModule
parsedModule Range {Position
$sel:_start:Range :: Range -> Position
_start :: Position
_start} Text
name Maybe Text
typ
  | Range Position
_ Position
lastLineP : [Range]
_ <-
      [ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
sp
        | (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_)) HsDecl GhcPs
_) <- [LHsDecl GhcPs]
[LocatedAn AnnListItem (HsDecl GhcPs)]
hsmodDecls,
          Position
_start Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l
      ],
    Position
nextLineP <- Position {$sel:_line:Position :: UInt
_line = Position -> UInt
_line Position
lastLineP UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1, $sel:_character:Position :: 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 -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"_" Maybe Text
typ)
    ParsedModule {pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls}} = ParsedModule
parsedModule

{- Handles two variants with different formatting

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

2. Could not find module ‘Data.I’
   Perhaps you meant
      Data.Ix (from base-4.14.3.0)
      Data.Eq (from base-4.14.3.0)
      Data.Int (from base-4.14.3.0)
-}
suggestModuleTypo :: Diagnostic -> [(T.Text, TextEdit)]
suggestModuleTypo :: Diagnostic -> [(Text, TextEdit)]
suggestModuleTypo Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
    | Text
"Could not find module" Text -> Text -> Bool
`T.isInfixOf` Text
_message =
      case HasCallStack => Text -> Text -> [Text]
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

suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)]
suggestExtendImport :: ExportsMap
-> ParsedSource -> Diagnostic -> [(Text, CodeActionKind, Rewrite)]
suggestExtendImport ExportsMap
exportsMap (L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports}) Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
    | Just [Text
binding, Text
mod, Text
srcspan] <-
      Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message
#if MIN_VERSION_ghc(9,7,0)
      "Add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\(at (.*)\\)\\."
#else
      Text
"Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\)\\."
#endif
    = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Text -> Text -> Text -> [(Text, CodeActionKind, Rewrite)]
suggestions [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl 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 a b. [a] -> (a -> [b]) -> [b]
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 ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Text -> Text -> Text -> [(Text, CodeActionKind, Rewrite)]
suggestions [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
hsmodImports Text
binding)
    | Bool
otherwise = []
    where
        canUseDatacon :: Bool
canUseDatacon = case Text -> Maybe NotInScope
extractNotInScopeName Text
_message of
                            Just NotInScopeTypeConstructorOrClass{} -> Bool
False
                            Maybe NotInScope
_                                       -> Bool
True

        suggestions :: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Text -> Text -> Text -> [(Text, CodeActionKind, Rewrite)]
suggestions [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
decls Text
binding Text
mod Text
srcspan
          | Range
range <- case [ RealSrcSpan
x | (RealSrcSpan
x,String
"") <- ReadS RealSrcSpan
readSrcSpan (Text -> String
T.unpack Text
srcspan)] of
                [RealSrcSpan
s] -> let x :: Range
x = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
s
                   in Range
x{_end = (_end x){_character = succ (_character (_end x))}}
                [RealSrcSpan]
_ -> String -> Range
forall a. HasCallStack => String -> a
error String
"bug in srcspan parser",
            Just LImportDecl GhcPs
decl <- [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs)
findImportDeclByRange [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl 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 String
 -> String -> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Rewrite)
-> (Maybe String, String)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Rewrite
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe String -> String -> LImportDecl GhcPs -> Rewrite
Maybe String
-> String -> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Rewrite
extendImport (ImportStyle -> (Maybe String, String)
unImportStyle ImportStyle
importStyle) LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl 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
          | let em :: OccEnv (HashSet IdentInfo)
em = ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap ExportsMap
exportsMap
#if MIN_VERSION_ghc(9,7,0)
                match = mconcat $ lookupOccEnv_AllNameSpaces em (mkVarOrDataOcc binding)
#else
                match1 :: Maybe (HashSet IdentInfo)
match1 = OccEnv (HashSet IdentInfo) -> OccName -> Maybe (HashSet IdentInfo)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (HashSet IdentInfo)
em (Text -> OccName
mkVarOrDataOcc Text
binding)
                match2 :: Maybe (HashSet IdentInfo)
match2 = OccEnv (HashSet IdentInfo) -> OccName -> Maybe (HashSet IdentInfo)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (HashSet IdentInfo)
em (Text -> OccName
mkTypeOcc Text
binding)
          , Just HashSet IdentInfo
match <- Maybe (HashSet IdentInfo)
match1 Maybe (HashSet IdentInfo)
-> Maybe (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall a. Semigroup a => a -> a -> a
<> Maybe (HashSet IdentInfo)
match2
#endif
          -- 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 OccName
parent IdentInfo
ident2 Maybe OccName -> Maybe OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` IdentInfo -> Maybe OccName
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
          , (IdentInfo
ident:[IdentInfo]
_) <- [IdentInfo]
idents -- Ensure fallback while `idents` is empty
          = 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
                { name :: OccName
name = Text -> OccName
mkVarOrDataOcc Text
binding
                , parent :: Maybe OccName
parent = Maybe OccName
forall a. Maybe a
Nothing
                , identModuleName :: ModuleName
identModuleName  = FastString -> ModuleName
mkModuleNameFS (FastString -> ModuleName) -> FastString -> ModuleName
forall a b. (a -> b) -> a -> b
$ ByteString -> FastString
mkFastStringByteString (ByteString -> FastString) -> ByteString -> FastString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
mod}

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

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

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

oneAndOthers :: [a] -> [(a, [a])]
oneAndOthers :: forall a. [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 b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
x :)) ([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) ParsedSource
ps Text
fileContents diag :: Diagnostic
diag@Diagnostic {Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
Range
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_range :: Range
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
    | 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. HasCallStack => [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
        L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports} = ParsedSource
ps

        locDic :: HashMap Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
locDic =
            (DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> HashMap Text (DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> HashMap
     Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a b. (a -> b) -> HashMap Text a -> HashMap Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
 -> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> (DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. DList a -> [a]
DL.toList) (HashMap Text (DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
 -> HashMap
      Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
-> HashMap Text (DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> HashMap
     Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$
            (DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> [(Text, DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
-> HashMap Text (DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. Semigroup a => a -> a -> a
(<>) ([(Text, DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
 -> HashMap
      Text (DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
-> [(Text, DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
-> HashMap Text (DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$
                (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> (Text, DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [(Text, DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map
                    ( \i :: GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i@(L SrcSpanAnnA
_ ImportDecl GhcPs
idecl) ->
                        ( String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ LocatedA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (LocatedA ModuleName -> ModuleName)
-> LocatedA ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
idecl
                        , GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> DList (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i
                        )
                    )
                    [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl 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
$
                [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList (Text
-> HashMap
     Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
"Prelude" HashMap Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
locDic)
        toModuleTarget Text
mName = NonEmpty (LImportDecl GhcPs) -> ModuleTarget
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> ModuleTarget
ExistingImp (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> ModuleTarget)
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Maybe ModuleTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> HashMap
     Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
mName HashMap Text (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
locDic
        parensed :: Bool
parensed =
            Text
"(" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.strip (Range -> Text -> Text
textInRange Range
_range Text
txt)
        -- > removeAllDuplicates [1, 1, 2, 3, 2] = [3]
        removeAllDuplicates :: [Text] -> [Text]
removeAllDuplicates = (NonEmpty Text -> Text) -> [NonEmpty Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head ([NonEmpty Text] -> [Text])
-> ([Text] -> [NonEmpty Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Text -> Bool) -> [NonEmpty Text] -> [NonEmpty Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1) (Int -> Bool) -> (NonEmpty Text -> Int) -> NonEmpty Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([NonEmpty Text] -> [NonEmpty Text])
-> ([Text] -> [NonEmpty Text]) -> [Text] -> [NonEmpty Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [NonEmpty Text]
forall (f :: * -> *) a. (Foldable f, Eq a) => f a -> [NonEmpty a]
NE.group ([Text] -> [NonEmpty Text])
-> ([Text] -> [Text]) -> [Text] -> [NonEmpty 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 a. [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 a. 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
modName
            , HidingMode
mode <-
                [ Bool -> ModuleName -> HidingMode
ToQualified Bool
parensed ModuleName
qual
                | ExistingImp NonEmpty (LImportDecl GhcPs)
imps <- [ModuleTarget
modTarget]
                {- HLINT ignore suggestImportDisambiguation "Use nubOrd" -}
                -- TODO: The use of nub here is slow and maybe wrong for UnhelpfulLocation
                -- nubOrd can't be used since SrcSpan is intentionally no Ord
                , L SrcSpanAnnA
_ ModuleName
qual <- [LocatedA ModuleName] -> [LocatedA ModuleName]
forall a. Eq a => [a] -> [a]
nub ([LocatedA ModuleName] -> [LocatedA ModuleName])
-> [LocatedA ModuleName] -> [LocatedA ModuleName]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> Maybe (LocatedA ModuleName))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [LocatedA ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
ImportDecl GhcPs -> Maybe (LocatedA ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs (ImportDecl GhcPs -> Maybe (LocatedA ModuleName))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Maybe (LocatedA ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc)
                    ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
 -> [LocatedA ModuleName])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [LocatedA ModuleName]
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
imps
                ]
                [HidingMode] -> [HidingMode] -> [HidingMode]
forall a. [a] -> [a] -> [a]
++ [Bool -> ModuleName -> HidingMode
ToQualified Bool
parensed ModuleName
modName
                    | (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> ImportDecl GhcPs -> Bool
occursUnqualified Text
symbol (ImportDecl GhcPs -> Bool)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc)
                        (ModuleTarget -> [LImportDecl GhcPs]
targetImports ModuleTarget
modTarget)
                    Bool -> Bool -> Bool
|| case ModuleTarget
modTarget of
                        ImplicitPrelude{} -> Bool
True
                        ModuleTarget
_                 -> Bool
False
                    ]
                [HidingMode] -> [HidingMode] -> [HidingMode]
forall a. [a] -> [a] -> [a]
++ [[ModuleTarget] -> HidingMode
HideOthers [ModuleTarget]
restImports | Bool -> Bool
not ([ModuleTarget] -> Bool
forall a. [a] -> 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]
++ case [(ModuleTarget, [ModuleTarget])]
targetsWithRestImports of
                    (ModuleTarget
m,[ModuleTarget]
ms):[(ModuleTarget, [ModuleTarget])]
_ | Bool
local ->
                        let mode :: HidingMode
mode = [ModuleTarget] -> HidingMode
HideOthers (ModuleTarget
mModuleTarget -> [ModuleTarget] -> [ModuleTarget]
forall a. a -> [a] -> [a]
:[ModuleTarget]
ms)
                        in [( 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
                            )]
                    [(ModuleTarget, [ModuleTarget])]
_ -> []

        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
<> String -> Text
T.pack (ModuleName -> String
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 (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
ImportDeclPkgQual GhcPs
XCImportDecl GhcPs
XRec GhcPs ModuleName
IsBootInterface
ImportDeclQualifiedStyle
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSafe :: forall a. ImportDecl a -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclExt :: XCImportDecl GhcPs
ideclName :: XRec GhcPs ModuleName
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImportList :: Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
..}
    | Maybe (LocatedA ModuleName) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (XRec GhcPs ModuleName)
Maybe (LocatedA 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...
#if MIN_VERSION_ghc(9,5,0)
        (Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe
  (ImportListInterpretation,
   GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
ideclImportList Maybe
  (ImportListInterpretation,
   GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ((ImportListInterpretation,
     GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> Bool)
-> Maybe Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ImportListInterpretation
isHiding, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcPs)]
ents) ->
            let occurs :: Bool
occurs = (GenLocated SrcSpanAnnA (IE GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text
symbol `symbolOccursIn`) (IE GhcPs -> Bool)
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (IE GhcPs)]
ents
            in (ImportListInterpretation
isHiding ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
occurs Bool -> Bool -> Bool
|| (ImportListInterpretation
isHiding ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
Exactly) Bool -> Bool -> Bool
&& Bool
occurs
        )
#else
        (ideclHiding <&> \(isHiding, L _ ents) ->
            let occurs = any ((symbol `symbolOccursIn`) . unLoc) ents
            in isHiding && not occurs || not isHiding && occurs
        )
#endif
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 -> [IdP GhcPs]
IE GhcPs -> [RdrName]
forall (p :: Pass). IE (GhcPass p) -> [IdP (GhcPass p)]
ieNames

targetModuleName :: ModuleTarget -> ModuleName
targetModuleName :: ModuleTarget -> ModuleName
targetModuleName ImplicitPrelude{} = String -> ModuleName
mkModuleName String
"Prelude"
targetModuleName (ExistingImp (L SrcSpanAnnA
_ ImportDecl{Bool
Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
ImportDeclPkgQual GhcPs
XCImportDecl GhcPs
XRec GhcPs ModuleName
IsBootInterface
ImportDeclQualifiedStyle
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSafe :: forall a. ImportDecl a -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclExt :: XCImportDecl GhcPs
ideclName :: XRec GhcPs ModuleName
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImportList :: Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
..} :| [LImportDecl GhcPs]
_)) =
    LocatedA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc XRec GhcPs ModuleName
LocatedA ModuleName
ideclName

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

suggestFixConstructorImport :: Diagnostic -> [(T.Text, TextEdit)]
suggestFixConstructorImport :: Diagnostic -> [(Text, TextEdit)]
suggestFixConstructorImport Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
    -- ‘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)
    --
    -- On 9.8+
    --
    -- In the import of ‘ModuleA’:
    -- an item called ‘Constructor’
    -- is exported, but it is a data constructor of
    -- ‘A’.
  | Just [Text
constructor, Text
typ] <-
    Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message
#if MIN_VERSION_ghc(9,7,0)
    "an item called ‘([^’]*)’ is exported, but it is a data constructor of ‘([^’]*)’"
#else
    Text
"‘([^’]*)’ is a data constructor of ‘([^’]*)’ To import it use"
#endif
  = 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 = []

suggestAddRecordFieldImport :: ExportsMap -> DynFlags -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]
suggestAddRecordFieldImport :: ExportsMap
-> DynFlags
-> ParsedSource
-> Text
-> Diagnostic
-> [(Text, CodeActionKind, TextEdit)]
suggestAddRecordFieldImport ExportsMap
exportsMap DynFlags
df ParsedSource
ps Text
fileContents Diagnostic {Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
Range
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_range :: Range
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
  | Just Text
fieldName <- Text -> Maybe Text
findMissingField Text
_message
  , Just (Range
range, Int
indent) <- ParsedSource -> Text -> Maybe (Range, Int)
newImportInsertRange ParsedSource
ps Text
fileContents
    = let qis :: QualifiedImportStyle
qis = DynFlags -> QualifiedImportStyle
qualifiedImportStyle DynFlags
df
          suggestions :: [ImportSuggestion]
suggestions = (ImportSuggestion -> ImportSuggestion -> Ordering)
-> [ImportSuggestion] -> [ImportSuggestion]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubSortBy ImportSuggestion -> ImportSuggestion -> Ordering
simpleCompareImportSuggestion (ExportsMap
-> (Maybe Text, NotInScope)
-> Maybe [Text]
-> QualifiedImportStyle
-> [ImportSuggestion]
constructNewImportSuggestions ExportsMap
exportsMap (Maybe Text
forall a. Maybe a
Nothing, Text -> NotInScope
NotInScopeThing Text
fieldName) Maybe [Text]
forall a. Maybe a
Nothing QualifiedImportStyle
qis)
      in (ImportSuggestion -> (Text, CodeActionKind, TextEdit))
-> [ImportSuggestion] -> [(Text, CodeActionKind, TextEdit)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ImportSuggestion Int
_ CodeActionKind
kind (NewImport -> Text
unNewImport -> Text
imp)) -> (Text
imp, CodeActionKind
kind, Range -> Text -> TextEdit
TextEdit Range
range (Text
imp 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
" "))) [ImportSuggestion]
suggestions
  | Bool
otherwise = []
    where
      findMissingField :: T.Text -> Maybe T.Text
      findMissingField :: Text -> Maybe Text
findMissingField Text
t =
        let
            hasfieldRegex :: Text
hasfieldRegex = Text
"((.+\\.)?HasField) \"(.+)\" ([^ ]+) ([^ ]+)"
            regex :: Text
regex = Text
"(No instance for|Could not deduce):? (\\(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hasfieldRegex Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\)|‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hasfieldRegex Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hasfieldRegex Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            match :: Maybe [Text]
match = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
"") ([Text] -> [Text]) -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
regex
        in case Maybe [Text]
match of
               Just [Text
_, Text
_, Text
_, Text
_, Text
fieldName, Text
_, Text
_] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fieldName
               Maybe [Text]
_                                  -> Maybe Text
forall a. Maybe a
Nothing

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

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

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

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

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

suggestInstanceConstraint :: DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestInstanceConstraint DynFlags
df (L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls}) Diagnostic {Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
Range
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_range :: Range
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..} Text
missingConstraint
  | Just GenLocated SrcSpanAnnA (HsType GhcPs)
instHead <- Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
instanceHead
  = [(Text -> Text
actionTitle Text
missingConstraint , String -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> String
T.unpack Text
missingConstraint) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
instHead)]
  | Bool
otherwise = []
    where
      instanceHead :: Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
instanceHead
        -- Suggests a constraint for an instance declaration with no existing constraints.
        -- • No instance for (Eq a) arising from a use of ‘==’
        --   Possible fix: add (Eq a) to the context of the instance declaration
        -- • In the expression: x == y
        --   In an equation for ‘==’: (Wrap x) == (Wrap y) = x == y
        --   In the instance declaration for ‘Eq (Wrap a)’
        | Just [Text
instanceDeclaration] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"In the instance declaration for ‘([^`]*)’"
        , Just LHsType GhcPs
instHead <- DynFlags -> String -> [LHsDecl GhcPs] -> Maybe (LHsType GhcPs)
forall p (p0 :: Pass).
(Outputable (HsType p), p ~ GhcPass p0) =>
DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p)
findInstanceHead DynFlags
df (Text -> String
T.unpack Text
instanceDeclaration) [LHsDecl GhcPs]
hsmodDecls
        = GenLocated SrcSpanAnnA (HsType GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> Maybe a
Just LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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]+)"
        , Just (L SrcSpanAnnA
_ (InstD XInstD GhcPs
_ (ClsInstD XClsInstD GhcPs
_ ClsInstDecl {cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = (LHsSigType GhcPs -> HsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs) -> HsSigType GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsSig{sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
hsib_body})})))
            <- Position
-> [LocatedAn AnnListItem (HsDecl GhcPs)]
-> Maybe (LocatedAn AnnListItem (HsDecl GhcPs))
forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (UInt -> UInt -> Position
Position (Text -> UInt
readPositionNumber Text
instanceLineStr) (Text -> UInt
readPositionNumber Text
constraintFirstCharStr)) [LHsDecl GhcPs]
[LocatedAn AnnListItem (HsDecl GhcPs)]
hsmodDecls
        = GenLocated SrcSpanAnnA (HsType GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> Maybe a
Just LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hsib_body
        | Bool
otherwise
        = Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. Maybe a
Nothing

      readPositionNumber :: T.Text -> UInt
      readPositionNumber :: Text -> UInt
readPositionNumber = Text -> String
T.unpack (Text -> String) -> (String -> 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
>>> forall a. Read a => String -> a
read @Integer (String -> Integer) -> (Integer -> UInt) -> String -> 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 :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls}) Diagnostic {Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message :: Text
_message, Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range :: Range
_range}
  | Just [Text
implicitT] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"Unbound implicit parameter \\(([^:]+::.+)\\) arising",
    Just (L SrcSpanAnnA
_ (ValD XValD GhcPs
_ FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L SrcSpanAnnN
_ RdrName
funId})) <- Position
-> [LocatedAn AnnListItem (HsDecl GhcPs)]
-> Maybe (LocatedAn AnnListItem (HsDecl GhcPs))
forall (t :: * -> *) a e.
Foldable t =>
Position
-> t (GenLocated (SrcSpanAnn' a) e)
-> Maybe (GenLocated (SrcSpanAnn' a) e)
findDeclContainingLoc (Range -> Position
_start Range
_range) [LHsDecl GhcPs]
[LocatedAn AnnListItem (HsDecl GhcPs)]
hsmodDecls,
    Just (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
_ HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = (LHsSigType GhcPs -> HsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs) -> HsSigType GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsSig {sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
hsib_body})})
      <- (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
== 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
<> String -> Text
T.pack (RdrName -> String
printRdrName RdrName
funId)
        , String -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> String
T.unpack Text
implicitT) LHsType GhcPs
hsib_body)]
  | Bool
otherwise = []

findTypeSignatureName :: T.Text -> Maybe T.Text
findTypeSignatureName :: Text -> Maybe Text
findTypeSignatureName Text
t = Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
"([^ ]+) :: " Maybe [Text] -> ([Text] -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe

-- | 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 :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls}) Diagnostic {Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
Range
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_range :: Range
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..} 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
  , Just (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
_ HsWC{hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = (LHsSigType GhcPs -> HsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs) -> HsSigType GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsSig {sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
sig})})
    <- (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 -> String
T.unpack Text
typeSignatureName ==) (String -> Bool)
-> (IdGhcP 'Parsed -> String) -> IdGhcP 'Parsed -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> SDoc -> String
showSDoc DynFlags
df (SDoc -> String)
-> (IdGhcP 'Parsed -> SDoc) -> IdGhcP 'Parsed -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdGhcP 'Parsed -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [LHsDecl GhcPs]
hsmodDecls
  , Text
title <- Text -> Text -> Text
actionTitle Text
missingConstraint Text
typeSignatureName
  = [(Text
title, String -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> String
T.unpack Text
missingConstraint) LHsType GhcPs
sig)]
  | Bool
otherwise
  = []
    where
      actionTitle :: T.Text -> T.Text -> T.Text
      actionTitle :: Text -> Text -> Text
actionTitle Text
constraint Text
typeSignatureName = Text
"Add `" 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)]
#if MIN_VERSION_ghc(9,9,0)
removeRedundantConstraints df (L _ HsModule {hsmodDecls}) Diagnostic{..}
#else
removeRedundantConstraints :: DynFlags -> ParsedSource -> Diagnostic -> [(Text, Rewrite)]
removeRedundantConstraints DynFlags
df (ParsedSource -> ParsedSource
forall ast. ExactPrint ast => ast -> ast
makeDeltaAst -> L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls}) Diagnostic{Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
Range
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_range :: Range
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
#endif
-- • 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
  , Just (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
_ HsWC{hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = (LHsSigType GhcPs -> HsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs) -> HsSigType GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsSig {sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
sig})})
    <- (Sig GhcPs -> Sig GhcPs) -> Maybe (Sig GhcPs) -> Maybe (Sig GhcPs)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(String -> Sig GhcPs -> Sig GhcPs
forall a. (Data a, ExactPrint a, HasCallStack) => String -> a -> a
traceAst String
"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] -> GenLocated SrcSpanAnnA (HsType GhcPs) -> Bool
forall {t :: * -> *} {a}.
(Foldable t, Outputable a) =>
DynFlags -> t Text -> a -> Bool
toRemove DynFlags
df [Text]
redundantConstraintList) LHsType GhcPs
sig
      = [([Text] -> Text -> Text
actionTitle [Text]
redundantConstraintList Text
typeSignatureName, Rewrite
rewrite)]
  | Bool
otherwise = []
    where
      toRemove :: DynFlags -> t Text -> a -> Bool
toRemove DynFlags
df t Text
list a
a = String -> Text
T.pack (DynFlags -> SDoc -> String
showSDoc DynFlags
df (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a)) Text -> t Text -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
list

      parseConstraints :: T.Text -> [T.Text]
      parseConstraints :: Text -> [Text]
parseConstraints Text
t = Text
t
        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
>>> HasCallStack => Text -> Text -> [Text]
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] -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m 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]
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 a. [a] -> 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
$sel:_message:Diagnostic :: Diagnostic -> Text
_message :: 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 -> (OccName -> Text) -> Maybe OccName -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OccName -> Text
occNameText (IdentInfo -> Maybe OccName
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
$
        OccEnv (HashSet IdentInfo) -> OccName -> Maybe (HashSet IdentInfo)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv (ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap ExportsMap
packageExportsMap) (Text -> OccName
mkVarOrDataOcc Text
methodName) =
    [[(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
      | [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] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName (HsModule GhcPs -> [LImportDecl GhcPs]
forall p. HsModule p -> [LImportDecl p]
hsmodImports (HsModule GhcPs -> [LImportDecl GhcPs])
-> (ParsedSource -> HsModule GhcPs)
-> ParsedSource
-> [LImportDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedSource -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (ParsedSource -> [LImportDecl GhcPs])
-> ParsedSource -> [LImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ ParsedSource
ps) (Text -> String
T.unpack Text
moduleText) =
        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
moduleText,
                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 String
 -> String -> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Rewrite)
-> (Maybe String, String)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Rewrite
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe String -> String -> LImportDecl GhcPs -> Rewrite
Maybe String
-> String -> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Rewrite
extendImport (ImportStyle -> (Maybe String, String)
unImportStyle ImportStyle
style) LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl 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
moduleText 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
moduleText)]
            | Bool
otherwise -> []
        where moduleText :: Text
moduleText = IdentInfo -> Text
moduleNameText IdentInfo
identInfo

suggestNewImport :: DynFlags -> ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]
suggestNewImport :: DynFlags
-> ExportsMap
-> ParsedSource
-> Text
-> Diagnostic
-> [(Text, CodeActionKind, TextEdit)]
suggestNewImport DynFlags
df ExportsMap
packageExportsMap ParsedSource
ps Text
fileContents Diagnostic{Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
Range
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
_range :: Range
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
..}
  | 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 (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
hsmodImports (String -> Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> (Text -> String)
-> Text
-> Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
        Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> Maybe (LocatedA ModuleName))
-> Maybe (LocatedA ModuleName)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
ImportDecl GhcPs -> Maybe (LocatedA ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs (ImportDecl GhcPs -> Maybe (LocatedA ModuleName))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Maybe (LocatedA ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc
        Maybe (LocatedA ModuleName)
-> (LocatedA ModuleName -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Text
T.pack (String -> Text)
-> (LocatedA ModuleName -> String) -> LocatedA ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString (ModuleName -> String)
-> (LocatedA ModuleName -> ModuleName)
-> LocatedA ModuleName
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc
  , -- tentative workaround for detecting qualification in GHC 9.4
    -- FIXME: We can delete this after dropping the support for GHC 9.4
    Maybe Text
qualGHC94 <-
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GhcVersion
ghcVersion GhcVersion -> GhcVersion -> Bool
forall a. Eq a => a -> a -> Bool
== GhcVersion
GHC94)
            Maybe () -> Maybe Text -> Maybe Text
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Maybe Text
extractQualifiedModuleNameFromMissingName (Range -> Text -> Text
extractTextInRange Range
_range Text
fileContents)
  , 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
#if MIN_VERSION_ghc(9,7,0)
    "Add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"
#else
    Text
"Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"
#endif
  = let qis :: QualifiedImportStyle
qis = DynFlags -> QualifiedImportStyle
qualifiedImportStyle DynFlags
df
        -- FIXME: we can use thingMissing once the support for GHC 9.4 is dropped.
        -- In what fllows, @missing@ is assumed to be qualified name.
        -- @thingMissing@ is already as desired with GHC != 9.4.
        -- In GHC 9.4, however, GHC drops a module qualifier from a qualified symbol.
        -- Thus we need to explicitly concatenate qualifier explicity in GHC 9.4.
        missing :: NotInScope
missing
            | GhcVersion
GHC94 <- GhcVersion
ghcVersion
            , Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text
qual Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
qual')
            , Just Text
q <- Maybe Text
qualGHC94 =
                Text -> NotInScope -> NotInScope
qualify Text
q NotInScope
thingMissing
            | Bool
otherwise = NotInScope
thingMissing
        suggestions :: [ImportSuggestion]
suggestions = (ImportSuggestion -> ImportSuggestion -> Ordering)
-> [ImportSuggestion] -> [ImportSuggestion]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubSortBy ImportSuggestion -> ImportSuggestion -> Ordering
simpleCompareImportSuggestion
          (ExportsMap
-> (Maybe Text, NotInScope)
-> Maybe [Text]
-> QualifiedImportStyle
-> [ImportSuggestion]
constructNewImportSuggestions ExportsMap
packageExportsMap (Maybe Text
qual Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
qual' Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
qualGHC94, NotInScope
missing) Maybe [Text]
extendImportSuggestions QualifiedImportStyle
qis) in
    (ImportSuggestion -> (Text, CodeActionKind, TextEdit))
-> [ImportSuggestion] -> [(Text, CodeActionKind, TextEdit)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ImportSuggestion Int
_ CodeActionKind
kind (NewImport -> Text
unNewImport -> Text
imp)) -> (Text
imp, CodeActionKind
kind, Range -> Text -> TextEdit
TextEdit Range
range (Text
imp 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
" "))) [ImportSuggestion]
suggestions
  where
    qualify :: Text -> NotInScope -> NotInScope
qualify Text
q (NotInScopeDataConstructor Text
d) = Text -> NotInScope
NotInScopeDataConstructor (Text
q Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d)
    qualify Text
q (NotInScopeTypeConstructorOrClass Text
d) = Text -> NotInScope
NotInScopeTypeConstructorOrClass (Text
q Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d)
    qualify Text
q (NotInScopeThing Text
d) = Text -> NotInScope
NotInScopeThing (Text
q Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d)

    L SrcSpan
_ HsModule {[LImportDecl GhcPs]
[LHsDecl GhcPs]
Maybe (XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
XCModule GhcPs
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodExt :: forall p. HsModule p -> XCModule p
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodImports :: [LImportDecl GhcPs]
hsmodExt :: XCModule GhcPs
hsmodName :: Maybe (XRec GhcPs ModuleName)
hsmodExports :: Maybe (XRec GhcPs [LIE GhcPs])
hsmodDecls :: [LHsDecl GhcPs]
..} = ParsedSource
ps
suggestNewImport DynFlags
_ ExportsMap
_ ParsedSource
_ Text
_ Diagnostic
_ = []

{- |
Extracts qualifier of the symbol from the missing symbol.
Input must be either a plain qualified variable or possibly-parenthesized qualified binary operator (though no strict checking is done for symbol part).
This is only needed to alleviate the issue #3473.

FIXME: We can delete this after dropping the support for GHC 9.4

>>> extractQualifiedModuleNameFromMissingName "P.lookup"
Just "P"

>>> extractQualifiedModuleNameFromMissingName "ΣP3_'.σlookup"
Just "\931P3_'"

>>> extractQualifiedModuleNameFromMissingName "ModuleA.Gre_ekσ.goodδ"
Just "ModuleA.Gre_ek\963"

>>> extractQualifiedModuleNameFromMissingName "(ModuleA.Gre_ekσ.+)"
Just "ModuleA.Gre_ek\963"

>>> extractQualifiedModuleNameFromMissingName "(ModuleA.Gre_ekσ..|.)"
Just "ModuleA.Gre_ek\963"

>>> extractQualifiedModuleNameFromMissingName "A.B.|."
Just "A.B"
-}
extractQualifiedModuleNameFromMissingName :: T.Text -> Maybe T.Text
extractQualifiedModuleNameFromMissingName :: Text -> Maybe Text
extractQualifiedModuleNameFromMissingName (Text -> Text
T.strip -> Text
missing)
    = String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> String
T.unpack Text
missing String -> RE Char String -> Maybe String
forall s a. [s] -> RE s a -> Maybe a
RE.=~ RE Char String
qualIdentP)
    where
        {-
        NOTE: Haskell 2010 allows /unicode/ upper & lower letters
        as a module name component; otoh, regex-tdfa only allows
        /ASCII/ letters to be matched with @[[:upper:]]@ and/or @[[:lower:]]@.
        Hence we use regex-applicative(-text) for finer-grained predicates.

        RULES (from [Section 10 of Haskell 2010 Report](https://www.haskell.org/onlinereport/haskell2010/haskellch10.html)):
            modid	→	{conid .} conid
            conid	→	large {small | large | digit | ' }
            small	→	ascSmall | uniSmall | _
            ascSmall	→	a | b | … | z
            uniSmall	→	any Unicode lowercase letter
            large	→	ascLarge | uniLarge
            ascLarge	→	A | B | … | Z
            uniLarge	→	any uppercase or titlecase Unicode letter
        -}

        qualIdentP :: RE Char String
qualIdentP = RE Char String
parensQualOpP RE Char String -> RE Char String -> RE Char String
forall a. RE Char a -> RE Char a -> RE Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE Char String
qualVarP
        parensQualOpP :: RE Char String
parensQualOpP = Char -> RE Char Char
forall s. Eq s => s -> RE s s
RE.sym Char
'(' RE Char Char -> RE Char String -> RE Char String
forall a b. RE Char a -> RE Char b -> RE Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RE Char String
modNameP RE Char String -> RE Char Char -> RE Char String
forall a b. RE Char a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> RE Char Char
forall s. Eq s => s -> RE s s
RE.sym Char
'.' RE Char String -> RE Char Char -> RE Char String
forall a b. RE Char a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char Char
forall s. RE s s
RE.anySym RE Char String -> RE Char String -> RE Char String
forall a b. RE Char a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char Char -> RE Char String
forall s a. RE s a -> RE s [a]
RE.few RE Char Char
forall s. RE s s
RE.anySym RE Char String -> RE Char Char -> RE Char String
forall a b. RE Char a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> RE Char Char
forall s. Eq s => s -> RE s s
RE.sym Char
')'
        qualVarP :: RE Char String
qualVarP = RE Char String
modNameP RE Char String -> RE Char Char -> RE Char String
forall a b. RE Char a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> RE Char Char
forall s. Eq s => s -> RE s s
RE.sym Char
'.' RE Char String -> RE Char String -> RE Char String
forall a b. RE Char a -> RE Char b -> RE Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE Char Char -> RE Char String
forall a. RE Char a -> RE Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
RE.some RE Char Char
forall s. RE s s
RE.anySym
        conIDP :: RE Char (String, String)
conIDP = RE Char String -> RE Char (String, String)
forall s a. RE s a -> RE s (a, [s])
RE.withMatched (RE Char String -> RE Char (String, String))
-> RE Char String -> RE Char (String, String)
forall a b. (a -> b) -> a -> b
$
            (Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
RE.psym Char -> Bool
isUpper
            RE Char Char -> RE Char String -> RE Char String
forall a b. RE Char a -> RE Char b -> RE Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RE Char Char -> RE Char String
forall a. RE Char a -> RE Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
RE.many
                ((Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
RE.psym ((Char -> Bool) -> RE Char Char) -> (Char -> Bool) -> RE Char Char
forall a b. (a -> b) -> a -> b
$ \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
'_' Bool -> Bool -> Bool
|| Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c)
        modNameP :: RE Char String
modNameP = ((NonEmpty (String, String), String) -> String)
-> RE Char (NonEmpty (String, String), String) -> RE Char String
forall a b. (a -> b) -> RE Char a -> RE Char b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty (String, String), String) -> String
forall a b. (a, b) -> b
snd (RE Char (NonEmpty (String, String), String) -> RE Char String)
-> RE Char (NonEmpty (String, String), String) -> RE Char String
forall a b. (a -> b) -> a -> b
$ RE Char (NonEmpty (String, String))
-> RE Char (NonEmpty (String, String), String)
forall s a. RE s a -> RE s (a, [s])
RE.withMatched (RE Char (NonEmpty (String, String))
 -> RE Char (NonEmpty (String, String), String))
-> RE Char (NonEmpty (String, String))
-> RE Char (NonEmpty (String, String), String)
forall a b. (a -> b) -> a -> b
$ RE Char (String, String)
conIDP RE Char (String, String)
-> RE Char Char -> RE Char (NonEmpty (String, String))
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`sepBy1` Char -> RE Char Char
forall s. Eq s => s -> RE s s
RE.sym Char
'.'


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

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

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

newtype NewImport = NewImport {NewImport -> Text
unNewImport :: T.Text}
  deriving (Int -> NewImport -> ShowS
[NewImport] -> ShowS
NewImport -> String
(Int -> NewImport -> ShowS)
-> (NewImport -> String)
-> ([NewImport] -> ShowS)
-> Show NewImport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewImport -> ShowS
showsPrec :: Int -> NewImport -> ShowS
$cshow :: NewImport -> String
show :: NewImport -> String
$cshowList :: [NewImport] -> ShowS
showList :: [NewImport] -> ShowS
Show, NewImport -> NewImport -> Bool
(NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> Bool) -> Eq NewImport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewImport -> NewImport -> Bool
== :: NewImport -> NewImport -> Bool
$c/= :: NewImport -> NewImport -> Bool
/= :: 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
$ccompare :: NewImport -> NewImport -> Ordering
compare :: NewImport -> NewImport -> Ordering
$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
>= :: NewImport -> NewImport -> Bool
$cmax :: NewImport -> NewImport -> NewImport
max :: NewImport -> NewImport -> NewImport
$cmin :: NewImport -> NewImport -> NewImport
min :: NewImport -> NewImport -> 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 ParsedSource
ps Text
fileContents
  |  Just ((Int
l, Int
c), Int
col) <- case [LImportDecl GhcPs]
hsmodImports of
      -- When there is no existing imports, we only cares about the line number, setting column and indent to zero.
      [] -> (\Int
line -> ((Int
line, Int
0), Int
0)) (Int -> ((Int, Int), Int)) -> Maybe Int -> Maybe ((Int, Int), Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedSource -> Text -> Maybe Int
findPositionNoImports ParsedSource
ps Text
fileContents
      [LImportDecl GhcPs]
_  -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> Maybe ((Int, Int), Int)
forall a t.
HasSrcSpan a =>
t -> (t -> a) -> Maybe ((Int, Int), Int)
findPositionFromImports [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
hsmodImports [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. HasCallStack => [a] -> a
last
  , 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
  where
    L SrcSpan
_ HsModule {[LImportDecl GhcPs]
[LHsDecl GhcPs]
Maybe (XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
XCModule GhcPs
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodExt :: forall p. HsModule p -> XCModule p
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodImports :: [LImportDecl GhcPs]
hsmodExt :: XCModule GhcPs
hsmodName :: Maybe (XRec GhcPs ModuleName)
hsmodExports :: Maybe (XRec GhcPs [LIE GhcPs])
hsmodDecls :: [LHsDecl GhcPs]
..} = ParsedSource
ps

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

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

    Int
lineOffset <- Maybe Int
whereKeywordLineOffset -- Calculate the gap before 'where' keyword.
#if MIN_VERSION_ghc(9,9,0)
    pure lineOffset
#else
    -- The last AST node before 'where' keyword. Might be module name or export list.
    let prevSrcSpan :: SrcSpan
prevSrcSpan = SrcSpan
-> (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> SrcSpan)
-> Maybe
     (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> SrcSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LocatedA ModuleName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LocatedA ModuleName
_hsmodName') GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Maybe (XRec GhcPs [LIE GhcPs])
Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
hsmodExports
    case SrcSpan
prevSrcSpan of
        UnhelpfulSpan UnhelpfulSpanReason
_ -> Maybe Int
forall a. Maybe a
Nothing
        (RealSrcSpan RealSrcSpan
prevSrcSpan' Maybe BufSpan
_) ->
            -- add them up produce the absolute location of 'where' keyword
            Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ RealSrcLoc -> Int
srcLocLine (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
prevSrcSpan') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lineOffset
#endif
  where
    L SrcSpan
_ HsModule {[LImportDecl GhcPs]
[LHsDecl GhcPs]
Maybe (XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
XCModule GhcPs
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodExt :: forall p. HsModule p -> XCModule p
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodExports :: Maybe (XRec GhcPs [LIE GhcPs])
hsmodExt :: XCModule GhcPs
hsmodName :: Maybe (XRec GhcPs ModuleName)
hsmodImports :: [LImportDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
..} = ParsedSource
ps

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

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

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

#if MIN_VERSION_ghc(9,9,0)
    anchorOpLine :: EpaLocation' a -> Int
    anchorOpLine EpaSpan{}                           = 0
    anchorOpLine (EpaDelta (SameLine _) _)           = 0
    anchorOpLine (EpaDelta (DifferentLine line _) _) = line
#else
    anchorOpLine :: AnchorOperation -> Int
    anchorOpLine :: AnchorOperation -> Int
anchorOpLine AnchorOperation
UnchangedAnchor                      = Int
0
    anchorOpLine (MovedAnchor (SameLine Int
_))           = Int
0
    anchorOpLine (MovedAnchor (DifferentLine Int
line Int
_)) = Int
line
#endif

findPositionFromImports :: HasSrcSpan a => t -> (t -> a) -> Maybe ((Int, Int), Int)
findPositionFromImports :: forall a t.
HasSrcSpan a =>
t -> (t -> a) -> Maybe ((Int, Int), Int)
findPositionFromImports t
hsField t -> a
f = case 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 = RealSrcLoc -> Int
srcLocCol (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Find the position one after the last file-header pragma
-- Defaults to zero if there are no pragmas in file
findNextPragmaPosition :: T.Text -> Int
findNextPragmaPosition :: Text -> Int
findNextPragmaPosition Text
contents = Int
lineNumber
  where
    lineNumber :: Int
lineNumber = Int -> Int
afterLangPragma (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, QualifiedImportStyle) -- ^ qualified name and style
  -> Bool -- ^ the symbol is to be imported or hidden
  -> NewImport
newImport :: Text
-> Maybe Text
-> Maybe (Text, QualifiedImportStyle)
-> Bool
-> NewImport
newImport Text
modName Maybe Text
mSymbol Maybe (Text, QualifiedImportStyle)
mQualNameStyle Bool
hiding = Text -> NewImport
NewImport Text
impStmt
  where
     symImp :: Text
symImp
            | Just Text
symbol <- Maybe Text
mSymbol
              , OccName
symOcc <- String -> OccName
mkVarOcc (String -> OccName) -> String -> OccName
forall a b. (a -> b) -> a -> b
$ Text -> String
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
<> Maybe QualifiedImportStyle -> Text
qualifiedModName ((Text, QualifiedImportStyle) -> QualifiedImportStyle
forall a b. (a, b) -> b
snd ((Text, QualifiedImportStyle) -> QualifiedImportStyle)
-> Maybe (Text, QualifiedImportStyle) -> Maybe QualifiedImportStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, QualifiedImportStyle)
mQualNameStyle)
         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
     mQual :: Maybe Text
mQual = (Text, QualifiedImportStyle) -> Text
forall a b. (a, b) -> a
fst ((Text, QualifiedImportStyle) -> Text)
-> Maybe (Text, QualifiedImportStyle) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, QualifiedImportStyle)
mQualNameStyle
     qualifiedModName :: Maybe QualifiedImportStyle -> Text
qualifiedModName Maybe QualifiedImportStyle
Nothing                       = Text
modName
     qualifiedModName (Just QualifiedImportStyle
QualifiedImportPrefix)  = Text
"qualified " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modName
     qualifiedModName (Just QualifiedImportStyle
QualifiedImportPostfix) = Text
modName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" qualified"


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

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

newImportAll :: T.Text -> NewImport
newImportAll :: Text -> NewImport
newImportAll Text
modName = Text
-> Maybe Text
-> Maybe (Text, QualifiedImportStyle)
-> Bool
-> NewImport
newImport Text
modName Maybe Text
forall a. Maybe a
Nothing Maybe (Text, QualifiedImportStyle)
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 -> String
(Int -> NotInScope -> ShowS)
-> (NotInScope -> String)
-> ([NotInScope] -> ShowS)
-> Show NotInScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotInScope -> ShowS
showsPrec :: Int -> NotInScope -> ShowS
$cshow :: NotInScope -> String
show :: NotInScope -> String
$cshowList :: [NotInScope] -> ShowS
showList :: [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] <-
#if MIN_VERSION_ghc(9,4,0)
    Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"the module ‘([^’]*)’ does not export"
      Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"nor ‘([^’]*)’ export"
#else
    matchRegexUnifySpaces x "Module ‘([^’]*)’ does not export"
      <|> matchRegexUnifySpaces x "nor ‘([^’]*)’ exports"
#endif
  = 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
    | 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 = 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
"`")
    | Maybe Bool
maybeIsTemplateFunction Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True = Range -> Text -> TextEdit
TextEdit Range
range (Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)
    | Bool
otherwise = Range -> Text -> TextEdit
TextEdit Range
range Text
name
  where
    maybeIsInfixFunction :: Maybe Bool
maybeIsInfixFunction = do
      Text
curr <- Range -> Text -> Text
textInRange Range
range (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 a. a -> Maybe a
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
    maybeIsTemplateFunction :: Maybe Bool
maybeIsTemplateFunction = 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 a. a -> Maybe a
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

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 = HasCallStack => Text -> Text -> [Text]
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
$sel:_start:Range :: Range -> Position
$sel:_end:Range :: Range -> Position
_start :: Position
_end :: 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
$ HasCallStack => Text -> Text -> [Text]
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 (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"\n" Text
text)

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

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

smallerRangesForBindingExport :: [LIE GhcPs] -> String -> [Range]
smallerRangesForBindingExport :: [LIE GhcPs] -> String -> [Range]
smallerRangesForBindingExport [LIE GhcPs]
lies String
b =
    (GenLocated SrcSpanAnnA (IE GhcPs) -> [Range])
-> [GenLocated SrcSpanAnnA (IE 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])
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> [SrcSpan])
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> [SrcSpan]
ranges') [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
lies
  where
    unqualify :: ShowS
unqualify = (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> (String, String)
forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOnEnd String
"."
    b' :: String
b' = ShowS
wrapOperatorInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
unqualify String
b
#if MIN_VERSION_ghc(9,9,0)
    ranges' (L _ (IEThingWith _ thing _  inners _))
#else
    ranges' :: GenLocated SrcSpanAnnA (IE GhcPs) -> [SrcSpan]
ranges' (L SrcSpanAnnA
_ (IEThingWith XIEThingWith GhcPs
_ XRec GhcPs (IEWrappedName GhcPs)
thing IEWildcard
_  [XRec GhcPs (IEWrappedName GhcPs)]
inners))
#endif
      | Text -> String
T.unpack (XRec GhcPs (IEWrappedName GhcPs) -> Text
forall a. Outputable a => a -> Text
printOutputable XRec GhcPs (IEWrappedName GhcPs)
thing) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b' = []
      | Bool
otherwise =
          [ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l' | L SrcSpanAnnA
l' IEWrappedName GhcPs
x <- [XRec GhcPs (IEWrappedName GhcPs)]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
inners, Text -> String
T.unpack (IEWrappedName GhcPs -> Text
forall a. Outputable a => a -> Text
printOutputable IEWrappedName GhcPs
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b']
    ranges' GenLocated SrcSpanAnnA (IE GhcPs)
_ = []

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

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

-- | Returns Just (all matches) for the first capture, or Nothing.
allMatchRegex :: T.Text -> T.Text -> Maybe [[T.Text]]
allMatchRegex :: Text -> Text -> Maybe [[Text]]
allMatchRegex Text
message Text
regex = Text
message 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


-- 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

-- | 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
    | Just [[Text]]
mods' <- Text -> Text -> Maybe [[Text]]
allMatchRegex Text
msg Text
"‘([^’]*)’"
    , Just [[Text]]
srcspans' <- Text -> Text -> Maybe [[Text]]
allMatchRegex Text
msg
    -- This regex has to be able to deal both with single-line srcpans like "(/path/to/File.hs:2:1-18)"
    -- as well as multi-line srcspans like "(/path/to/File.hs:(3,1)-(5,2))"
#if MIN_VERSION_ghc(9,7,0)
                          "\\(at ([^:]+:[^ ]+)\\)"
#else
                          Text
"\\(([^:]+:[^ ]+)\\)"
#endif
    , [Text]
mods <- [Text
mod | [Text
_,Text
mod] <- [[Text]]
mods']
    , [Text]
srcspans <- [Text
srcspan | [Text
_,Text
srcspan] <- [[Text]]
srcspans']
      -- check we have matching pairs like (Data.Map, (app/src.hs:1:2-18))
    , let result :: Maybe [(Text, Text)]
result = if [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
mods Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
srcspans then
                   [(Text, Text)] -> Maybe [(Text, Text)]
forall a. a -> Maybe a
Just ([Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
mods [Text]
srcspans) else Maybe [(Text, Text)]
forall a. Maybe a
Nothing
    = Maybe [(Text, Text)]
result
    | Bool
otherwise = 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
#if MIN_VERSION_ghc(9,7,0)
  let pat = T.pack "Add ‘([^’]*)’ to one of these import lists: *(‘.*\\))$"
#else
  let pat :: Text
pat = String -> Text
T.pack String
"Perhaps you want to add ‘([^’]*)’ to one of these import lists: *(‘.*\\))$"
#endif
  (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 a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
binding, [(Text, Text)]
imps)