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

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
#include "ghc-api-version.h"

-- | Go to the definition of a variable.
module Development.IDE.Plugin.CodeAction
    ( descriptor

    -- * For testing
    , matchRegExMultipleImports
    ) where

import Control.Monad (join, guard)
import Control.Monad.IO.Class
import Development.IDE.GHC.Compat
import Development.IDE.Core.Rules
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint
import Development.IDE.Plugin.CodeAction.ExactPrint
import Development.IDE.Plugin.CodeAction.PositionIndexed
import Development.IDE.Plugin.TypeLenses (suggestSignature)
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import qualified Data.HashMap.Strict as Map
import qualified Language.LSP.Server as LSP
import Language.LSP.VFS
import Language.LSP.Types
import qualified Data.Rope.UTF16 as Rope
import Data.Char
import Data.Maybe
import Data.List.Extra
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Text.Regex.TDFA (mrAfter, (=~), (=~~))
import Outputable (Outputable, ppr, showSDoc, showSDocUnsafe)
import Data.Function
import Control.Arrow ((>>>), second)
import Data.Functor
import Control.Applicative ((<|>))
import Safe (atMay)
import Bag (isEmptyBag)
import qualified Data.HashSet as Set
import Control.Concurrent.Extra (readVar)
import Development.IDE.GHC.Util (printRdrName, prettyPrint)
import Ide.PluginUtils (subRange)
import Ide.Types
import qualified Data.DList as DL
import Development.IDE.Spans.Common
import OccName
import qualified GHC.LanguageExtensions as Lang
import Control.Lens (alaf)
import Data.Monoid (Ap(..))
import TcRnTypes (TcGblEnv(..), ImportAvails(..))
import HscTypes (ImportedModsVal(..), importedByUser)
import RdrName (GlobalRdrElt(..), lookupGlobalRdrEnv)
import SrcLoc (realSrcSpanStart)
import Module (moduleEnvElts)
import qualified Data.Map as M
import qualified Data.Set as S

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId =
  (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
    { pluginRules :: Rules ()
pluginRules = Rules ()
forall a. Monoid a => a
mempty,
      pluginHandlers :: PluginHandlers IdeState
pluginHandlers = SClientMethod 'TextDocumentCodeAction
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentCodeAction
STextDocumentCodeAction PluginMethodHandler IdeState 'TextDocumentCodeAction
forall c.
IdeState
-> PluginId
-> CodeActionParams
-> LspM c (Either ResponseError (List (Command |? CodeAction)))
codeAction
    }

-- | Generate code actions.
codeAction
    :: IdeState
    -> PluginId
    -> CodeActionParams
    -> LSP.LspM c (Either ResponseError (List (Command |? CodeAction)))
codeAction :: IdeState
-> PluginId
-> CodeActionParams
-> LspM c (Either ResponseError (List (Command |? CodeAction)))
codeAction IdeState
state PluginId
_ (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ (TextDocumentIdentifier Uri
uri) Range
_range CodeActionContext{$sel:_diagnostics:CodeActionContext :: CodeActionContext -> List Diagnostic
_diagnostics=List [Diagnostic]
xs}) = do
  Maybe VirtualFile
contents <- NormalizedUri -> LspT c IO (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
LSP.getVirtualFile (NormalizedUri -> LspT c IO (Maybe VirtualFile))
-> NormalizedUri -> LspT c IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
  IO (Either ResponseError (List (Command |? CodeAction)))
-> LspM c (Either ResponseError (List (Command |? CodeAction)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ResponseError (List (Command |? CodeAction)))
 -> LspM c (Either ResponseError (List (Command |? CodeAction))))
-> IO (Either ResponseError (List (Command |? CodeAction)))
-> LspM c (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ do
    let text :: Maybe Text
text = Rope -> Text
Rope.toText (Rope -> Text) -> (VirtualFile -> Rope) -> VirtualFile -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VirtualFile -> Rope
_text :: VirtualFile -> Rope.Rope) (VirtualFile -> Text) -> Maybe VirtualFile -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe VirtualFile
contents
        mbFile :: Maybe NormalizedFilePath
mbFile = FilePath -> NormalizedFilePath
toNormalizedFilePath' (FilePath -> NormalizedFilePath)
-> Maybe FilePath -> Maybe NormalizedFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> Maybe FilePath
uriToFilePath Uri
uri
    [Diagnostic]
diag <- ((NormalizedFilePath, ShowDiagnostic, Diagnostic) -> Diagnostic)
-> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
-> [Diagnostic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(NormalizedFilePath
_, ShowDiagnostic
_, Diagnostic
d) -> Diagnostic
d) ([(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
 -> [Diagnostic])
-> ([(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
    -> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)])
-> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
-> [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NormalizedFilePath, ShowDiagnostic, Diagnostic) -> Bool)
-> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
-> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(NormalizedFilePath
p, ShowDiagnostic
_, Diagnostic
_) -> Maybe NormalizedFilePath
mbFile Maybe NormalizedFilePath -> Maybe NormalizedFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== NormalizedFilePath -> Maybe NormalizedFilePath
forall a. a -> Maybe a
Just NormalizedFilePath
p) ([(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
 -> [Diagnostic])
-> IO [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
-> IO [Diagnostic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdeState -> IO [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
getDiagnostics IdeState
state
    (IdeOptions
ideOptions, Maybe (Maybe ParsedModule) -> Maybe ParsedModule
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe ParsedModule
parsedModule, Maybe (Maybe HscEnvEq) -> Maybe HscEnvEq
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe HscEnvEq
env, Maybe (Maybe (Annotated ParsedSource))
-> Maybe (Annotated ParsedSource)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe (Annotated ParsedSource)
annotatedPS, Maybe (Maybe TcModuleResult) -> Maybe TcModuleResult
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe TcModuleResult
tcM, Maybe (Maybe HieAstResult) -> Maybe HieAstResult
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe HieAstResult
har) <- FilePath
-> IdeState
-> Action
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
      Maybe (Maybe (Annotated ParsedSource)),
      Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult))
-> IO
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
      Maybe (Maybe (Annotated ParsedSource)),
      Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult))
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"CodeAction" IdeState
state (Action
   (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
    Maybe (Maybe (Annotated ParsedSource)),
    Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult))
 -> IO
      (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
       Maybe (Maybe (Annotated ParsedSource)),
       Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
-> Action
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
      Maybe (Maybe (Annotated ParsedSource)),
      Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult))
-> IO
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
      Maybe (Maybe (Annotated ParsedSource)),
      Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult))
forall a b. (a -> b) -> a -> b
$
      (,,,,,) (IdeOptions
 -> Maybe (Maybe ParsedModule)
 -> Maybe (Maybe HscEnvEq)
 -> Maybe (Maybe (Annotated ParsedSource))
 -> Maybe (Maybe TcModuleResult)
 -> Maybe (Maybe HieAstResult)
 -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
     Maybe (Maybe (Annotated ParsedSource)),
     Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
-> Action IdeOptions
-> Action
     (Maybe (Maybe ParsedModule)
      -> Maybe (Maybe HscEnvEq)
      -> Maybe (Maybe (Annotated ParsedSource))
      -> Maybe (Maybe TcModuleResult)
      -> Maybe (Maybe HieAstResult)
      -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
          Maybe (Maybe (Annotated ParsedSource)),
          Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action IdeOptions
getIdeOptions
            Action
  (Maybe (Maybe ParsedModule)
   -> Maybe (Maybe HscEnvEq)
   -> Maybe (Maybe (Annotated ParsedSource))
   -> Maybe (Maybe TcModuleResult)
   -> Maybe (Maybe HieAstResult)
   -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
       Maybe (Maybe (Annotated ParsedSource)),
       Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
-> Action (Maybe (Maybe ParsedModule))
-> Action
     (Maybe (Maybe HscEnvEq)
      -> Maybe (Maybe (Annotated ParsedSource))
      -> Maybe (Maybe TcModuleResult)
      -> Maybe (Maybe HieAstResult)
      -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
          Maybe (Maybe (Annotated ParsedSource)),
          Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NormalizedFilePath -> Action (Maybe ParsedModule)
getParsedModule (NormalizedFilePath -> Action (Maybe ParsedModule))
-> Maybe NormalizedFilePath -> Action (Maybe (Maybe ParsedModule))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Maybe NormalizedFilePath
mbFile
            Action
  (Maybe (Maybe HscEnvEq)
   -> Maybe (Maybe (Annotated ParsedSource))
   -> Maybe (Maybe TcModuleResult)
   -> Maybe (Maybe HieAstResult)
   -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
       Maybe (Maybe (Annotated ParsedSource)),
       Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
-> Action (Maybe (Maybe HscEnvEq))
-> Action
     (Maybe (Maybe (Annotated ParsedSource))
      -> Maybe (Maybe TcModuleResult)
      -> Maybe (Maybe HieAstResult)
      -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
          Maybe (Maybe (Annotated ParsedSource)),
          Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GhcSession -> NormalizedFilePath -> Action (Maybe HscEnvEq)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSession
GhcSession (NormalizedFilePath -> Action (Maybe HscEnvEq))
-> Maybe NormalizedFilePath -> Action (Maybe (Maybe HscEnvEq))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Maybe NormalizedFilePath
mbFile
            Action
  (Maybe (Maybe (Annotated ParsedSource))
   -> Maybe (Maybe TcModuleResult)
   -> Maybe (Maybe HieAstResult)
   -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
       Maybe (Maybe (Annotated ParsedSource)),
       Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
-> Action (Maybe (Maybe (Annotated ParsedSource)))
-> Action
     (Maybe (Maybe TcModuleResult)
      -> Maybe (Maybe HieAstResult)
      -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
          Maybe (Maybe (Annotated ParsedSource)),
          Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GetAnnotatedParsedSource
-> NormalizedFilePath -> Action (Maybe (Annotated ParsedSource))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetAnnotatedParsedSource
GetAnnotatedParsedSource (NormalizedFilePath -> Action (Maybe (Annotated ParsedSource)))
-> Maybe NormalizedFilePath
-> Action (Maybe (Maybe (Annotated ParsedSource)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Maybe NormalizedFilePath
mbFile
            Action
  (Maybe (Maybe TcModuleResult)
   -> Maybe (Maybe HieAstResult)
   -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
       Maybe (Maybe (Annotated ParsedSource)),
       Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
-> Action (Maybe (Maybe TcModuleResult))
-> Action
     (Maybe (Maybe HieAstResult)
      -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
          Maybe (Maybe (Annotated ParsedSource)),
          Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeCheck -> NormalizedFilePath -> Action (Maybe TcModuleResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck (NormalizedFilePath -> Action (Maybe TcModuleResult))
-> Maybe NormalizedFilePath
-> Action (Maybe (Maybe TcModuleResult))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Maybe NormalizedFilePath
mbFile
            Action
  (Maybe (Maybe HieAstResult)
   -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
       Maybe (Maybe (Annotated ParsedSource)),
       Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult)))
-> Action (Maybe (Maybe HieAstResult))
-> Action
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
      Maybe (Maybe (Annotated ParsedSource)),
      Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GetHieAst -> NormalizedFilePath -> Action (Maybe HieAstResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetHieAst
GetHieAst (NormalizedFilePath -> Action (Maybe HieAstResult))
-> Maybe NormalizedFilePath -> Action (Maybe (Maybe HieAstResult))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Maybe NormalizedFilePath
mbFile
    -- This is quite expensive 0.6-0.7s on GHC
    ExportsMap
pkgExports   <- IO ExportsMap
-> (HscEnvEq -> IO ExportsMap) -> Maybe HscEnvEq -> IO ExportsMap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ExportsMap
forall a. Monoid a => a
mempty HscEnvEq -> IO ExportsMap
envPackageExports Maybe HscEnvEq
env
    ExportsMap
localExports <- Var ExportsMap -> IO ExportsMap
forall a. Var a -> IO a
readVar (ShakeExtras -> Var ExportsMap
exportsMap (ShakeExtras -> Var ExportsMap) -> ShakeExtras -> Var ExportsMap
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
state)
    let
      exportsMap :: ExportsMap
exportsMap = ExportsMap
localExports ExportsMap -> ExportsMap -> ExportsMap
forall a. Semigroup a => a -> a -> a
<> ExportsMap
pkgExports
      df :: Maybe DynFlags
df = ModSummary -> DynFlags
ms_hspp_opts (ModSummary -> DynFlags)
-> (ParsedModule -> ModSummary) -> ParsedModule -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary (ParsedModule -> DynFlags) -> Maybe ParsedModule -> Maybe DynFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ParsedModule
parsedModule
      actions :: [Command |? CodeAction]
actions =
        [ Text -> [Diagnostic] -> WorkspaceEdit -> Command |? CodeAction
mkCA Text
title  [Diagnostic
x] WorkspaceEdit
edit
        | Diagnostic
x <- [Diagnostic]
xs, (Text
title, [TextEdit]
tedit) <- ExportsMap
-> IdeOptions
-> Maybe ParsedModule
-> Maybe Text
-> Maybe DynFlags
-> Maybe (Annotated ParsedSource)
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Diagnostic
-> [(Text, [TextEdit])]
suggestAction ExportsMap
exportsMap IdeOptions
ideOptions Maybe ParsedModule
parsedModule Maybe Text
text Maybe DynFlags
df Maybe (Annotated ParsedSource)
annotatedPS Maybe TcModuleResult
tcM Maybe HieAstResult
har Diagnostic
x
        , let edit :: WorkspaceEdit
edit = Maybe WorkspaceEditMap
-> Maybe (List DocumentChange) -> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit) Maybe (List DocumentChange)
forall a. Maybe a
Nothing
        ]
      actions' :: [Command |? CodeAction]
actions' = Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> [Diagnostic]
-> Uri
-> [Command |? CodeAction]
caRemoveRedundantImports Maybe ParsedModule
parsedModule Maybe Text
text [Diagnostic]
diag [Diagnostic]
xs Uri
uri
               [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall a. Semigroup a => a -> a -> a
<> [Command |? CodeAction]
actions
               [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall a. Semigroup a => a -> a -> a
<> Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> [Diagnostic]
-> Uri
-> [Command |? CodeAction]
caRemoveInvalidExports Maybe ParsedModule
parsedModule Maybe Text
text [Diagnostic]
diag [Diagnostic]
xs Uri
uri
    Either ResponseError (List (Command |? CodeAction))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (List (Command |? CodeAction))
 -> IO (Either ResponseError (List (Command |? CodeAction))))
-> Either ResponseError (List (Command |? CodeAction))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. b -> Either a b
Right (List (Command |? CodeAction)
 -> Either ResponseError (List (Command |? CodeAction)))
-> List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> List (Command |? CodeAction)
forall a. [a] -> List a
List [Command |? CodeAction]
actions'

mkCA :: T.Text -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction)
mkCA :: Text -> [Diagnostic] -> WorkspaceEdit -> Command |? CodeAction
mkCA Text
title [Diagnostic]
diags WorkspaceEdit
edit =
  CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> CodeAction -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> CodeAction
CodeAction Text
title (CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix) (List Diagnostic -> Maybe (List Diagnostic)
forall a. a -> Maybe a
Just (List Diagnostic -> Maybe (List Diagnostic))
-> List Diagnostic -> Maybe (List Diagnostic)
forall a b. (a -> b) -> a -> b
$ [Diagnostic] -> List Diagnostic
forall a. [a] -> List a
List [Diagnostic]
diags) Maybe Bool
forall a. Maybe a
Nothing Maybe Reason
forall a. Maybe a
Nothing (WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit
edit) Maybe Command
forall a. Maybe a
Nothing

rewrite ::
    Maybe DynFlags ->
    Maybe (Annotated ParsedSource) ->
    (DynFlags -> ParsedSource -> [(T.Text, [Rewrite])]) ->
    [(T.Text, [TextEdit])]
rewrite :: Maybe DynFlags
-> Maybe (Annotated ParsedSource)
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
rewrite (Just DynFlags
df) (Just Annotated ParsedSource
ps) DynFlags -> ParsedSource -> [(Text, [Rewrite])]
f
    | Right [(Text, [TextEdit])]
edit <- (((Text, [Rewrite]) -> Either FilePath (Text, [TextEdit]))
-> [(Text, [Rewrite])] -> Either FilePath [(Text, [TextEdit])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((Text, [Rewrite]) -> Either FilePath (Text, [TextEdit]))
 -> [(Text, [Rewrite])] -> Either FilePath [(Text, [TextEdit])])
-> (([Rewrite] -> Either FilePath [TextEdit])
    -> (Text, [Rewrite]) -> Either FilePath (Text, [TextEdit]))
-> ([Rewrite] -> Either FilePath [TextEdit])
-> [(Text, [Rewrite])]
-> Either FilePath [(Text, [TextEdit])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Rewrite] -> Either FilePath [TextEdit])
-> (Text, [Rewrite]) -> Either FilePath (Text, [TextEdit])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
        ((Unwrapped (Ap (Either FilePath) [TextEdit])
 -> Ap (Either FilePath) [TextEdit])
-> ((Rewrite -> Ap (Either FilePath) [TextEdit])
    -> [Rewrite] -> Ap (Either FilePath) [TextEdit])
-> (Rewrite -> Unwrapped (Ap (Either FilePath) [TextEdit]))
-> [Rewrite]
-> Unwrapped (Ap (Either FilePath) [TextEdit])
forall (f :: * -> *) (g :: * -> *) s t.
(Functor f, Functor g, Rewrapping s t) =>
(Unwrapped s -> s)
-> (f t -> g s) -> f (Unwrapped t) -> g (Unwrapped s)
alaf Unwrapped (Ap (Either FilePath) [TextEdit])
-> Ap (Either FilePath) [TextEdit]
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Rewrite -> Ap (Either FilePath) [TextEdit])
-> [Rewrite] -> Ap (Either FilePath) [TextEdit]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (DynFlags -> Anns -> Rewrite -> Either FilePath [TextEdit]
rewriteToEdit DynFlags
df (Annotated ParsedSource -> Anns
forall ast. Annotated ast -> Anns
annsA Annotated ParsedSource
ps)))
        (DynFlags -> ParsedSource -> [(Text, [Rewrite])]
f DynFlags
df (ParsedSource -> [(Text, [Rewrite])])
-> ParsedSource -> [(Text, [Rewrite])]
forall a b. (a -> b) -> a -> b
$ Annotated ParsedSource -> ParsedSource
forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps) = [(Text, [TextEdit])]
edit
rewrite Maybe DynFlags
_ Maybe (Annotated ParsedSource)
_ DynFlags -> ParsedSource -> [(Text, [Rewrite])]
_ = []

suggestAction
  :: ExportsMap
  -> IdeOptions
  -> Maybe ParsedModule
  -> Maybe T.Text
  -> Maybe DynFlags
  -> Maybe (Annotated ParsedSource)
  -> Maybe TcModuleResult
  -> Maybe HieAstResult
  -> Diagnostic
  -> [(T.Text, [TextEdit])]
suggestAction :: ExportsMap
-> IdeOptions
-> Maybe ParsedModule
-> Maybe Text
-> Maybe DynFlags
-> Maybe (Annotated ParsedSource)
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Diagnostic
-> [(Text, [TextEdit])]
suggestAction ExportsMap
packageExports IdeOptions
ideOptions Maybe ParsedModule
parsedModule Maybe Text
text Maybe DynFlags
df Maybe (Annotated ParsedSource)
annSource Maybe TcModuleResult
tcM Maybe HieAstResult
har Diagnostic
diag =
    [[(Text, [TextEdit])]] -> [(Text, [TextEdit])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
   -- Order these suggestions by priority
    [ Bool -> Diagnostic -> [(Text, [TextEdit])]
suggestSignature Bool
True Diagnostic
diag
    , Maybe DynFlags
-> Maybe (Annotated ParsedSource)
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
rewrite Maybe DynFlags
df Maybe (Annotated ParsedSource)
annSource ((DynFlags -> ParsedSource -> [(Text, [Rewrite])])
 -> [(Text, [TextEdit])])
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
forall a b. (a -> b) -> a -> b
$ \DynFlags
_ ParsedSource
ps -> ExportsMap -> ParsedSource -> Diagnostic -> [(Text, [Rewrite])]
suggestExtendImport ExportsMap
packageExports ParsedSource
ps Diagnostic
diag
    , Maybe DynFlags
-> Maybe (Annotated ParsedSource)
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
rewrite Maybe DynFlags
df Maybe (Annotated ParsedSource)
annSource ((DynFlags -> ParsedSource -> [(Text, [Rewrite])])
 -> [(Text, [TextEdit])])
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ParsedSource
ps ->
        DynFlags
-> Maybe Text -> ParsedSource -> Diagnostic -> [(Text, [Rewrite])]
suggestImportDisambiguation DynFlags
df Maybe Text
text ParsedSource
ps Diagnostic
diag
    , Diagnostic -> [(Text, [TextEdit])]
suggestFillTypeWildcard Diagnostic
diag
    , Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestFixConstructorImport Maybe Text
text Diagnostic
diag
    , Diagnostic -> [(Text, [TextEdit])]
suggestModuleTypo Diagnostic
diag
    , Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestReplaceIdentifier Maybe Text
text Diagnostic
diag
    , Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
removeRedundantConstraints Maybe Text
text Diagnostic
diag
    , Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyContraints Maybe Text
text Diagnostic
diag
    , Maybe DynFlags
-> Maybe (Annotated ParsedSource)
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
rewrite Maybe DynFlags
df Maybe (Annotated ParsedSource)
annSource ((DynFlags -> ParsedSource -> [(Text, [Rewrite])])
 -> [(Text, [TextEdit])])
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ParsedSource
ps -> DynFlags -> ParsedSource -> Diagnostic -> [(Text, [Rewrite])]
suggestConstraint DynFlags
df ParsedSource
ps Diagnostic
diag
    , Maybe DynFlags
-> Maybe (Annotated ParsedSource)
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
rewrite Maybe DynFlags
df Maybe (Annotated ParsedSource)
annSource ((DynFlags -> ParsedSource -> [(Text, [Rewrite])])
 -> [(Text, [TextEdit])])
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
forall a b. (a -> b) -> a -> b
$ \DynFlags
_ ParsedSource
ps -> ParsedSource -> Diagnostic -> [(Text, [Rewrite])]
suggestImplicitParameter ParsedSource
ps Diagnostic
diag
    , Maybe DynFlags
-> Maybe (Annotated ParsedSource)
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
rewrite Maybe DynFlags
df Maybe (Annotated ParsedSource)
annSource ((DynFlags -> ParsedSource -> [(Text, [Rewrite])])
 -> [(Text, [TextEdit])])
-> (DynFlags -> ParsedSource -> [(Text, [Rewrite])])
-> [(Text, [TextEdit])]
forall a b. (a -> b) -> a -> b
$ \DynFlags
_ ParsedSource
ps -> ParsedSource
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Diagnostic
-> [(Text, [Rewrite])]
suggestHideShadow ParsedSource
ps Maybe TcModuleResult
tcM Maybe HieAstResult
har Diagnostic
diag
    ] [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ [[(Text, [TextEdit])]] -> [(Text, [TextEdit])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [  IdeOptions
-> ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestNewDefinition IdeOptions
ideOptions ParsedModule
pm Maybe Text
text Diagnostic
diag
    [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ ExportsMap -> ParsedModule -> Diagnostic -> [(Text, [TextEdit])]
suggestNewImport ExportsMap
packageExports ParsedModule
pm Diagnostic
diag
    [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDeleteUnusedBinding ParsedModule
pm Maybe Text
text Diagnostic
diag
    [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> ParsedModule -> Diagnostic -> [(Text, [TextEdit])]
suggestExportUnusedTopBinding Maybe Text
text ParsedModule
pm Diagnostic
diag
    [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDisableWarning ParsedModule
pm Maybe Text
text Diagnostic
diag
    | Just ParsedModule
pm <- [Maybe ParsedModule
parsedModule]
    ] [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++
    Diagnostic -> [(Text, [TextEdit])]
suggestFillHole Diagnostic
diag                   -- Lowest priority

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

findInstanceHead :: (Outputable (HsType p)) => DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p)
findInstanceHead :: DynFlags -> FilePath -> [LHsDecl p] -> Maybe (LHsType p)
findInstanceHead DynFlags
df FilePath
instanceHead [LHsDecl p]
decls =
  [LHsType p] -> Maybe (LHsType p)
forall a. [a] -> Maybe a
listToMaybe
    [ LHsType p
hsib_body
      | L SrcSpan
_ (InstD XInstD p
_ (ClsInstD XClsInstD p
_ ClsInstDecl {cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = HsIB {LHsType p
hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body :: LHsType p
hsib_body}})) <- [LHsDecl p]
decls,
        DynFlags -> SDoc -> FilePath
showSDoc DynFlags
df (LHsType p -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType p
hsib_body) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
instanceHead
    ]

findDeclContainingLoc :: Position -> [Located a] -> Maybe (Located a)
findDeclContainingLoc :: Position -> [Located a] -> Maybe (Located a)
findDeclContainingLoc Position
loc = (Located a -> Bool) -> [Located a] -> Maybe (Located a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L SrcSpan
l a
_) -> Position
loc Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l)

-- Single:
-- This binding for ‘mod’ shadows the existing binding
--   imported from ‘Prelude’ at haskell-language-server/ghcide/src/Development/IDE/Plugin/CodeAction.hs:10:8-40
--   (and originally defined in ‘GHC.Real’)typecheck(-Wname-shadowing)
-- Multi:
--This binding for ‘pack’ shadows the existing bindings
--  imported from ‘Data.ByteString’ at B.hs:6:1-22
--  imported from ‘Data.ByteString.Lazy’ at B.hs:8:1-27
--  imported from ‘Data.Text’ at B.hs:7:1-16
suggestHideShadow :: ParsedSource -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Rewrite])]
suggestHideShadow :: ParsedSource
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Diagnostic
-> [(Text, [Rewrite])]
suggestHideShadow pm :: ParsedSource
pm@(L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports}) Maybe TcModuleResult
mTcM Maybe HieAstResult
mHar Diagnostic {Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message :: Text
_message, Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range :: Range
_range}
  | Just [Text
identifier, Text
modName, Text
s] <-
      Text -> Text -> Maybe [Text]
matchRegexUnifySpaces
        Text
_message
        Text
"This binding for ‘([^`]+)’ shadows the existing binding imported from ‘([^`]+)’ at ([^ ]*)" =
    Text -> Text -> Text -> [(Text, [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, [Rewrite])]
result <- ((Text, [Rewrite]) -> (Text, [Rewrite]) -> Ordering)
-> [(Text, [Rewrite])] -> [(Text, [Rewrite])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> ((Text, [Rewrite]) -> Text)
-> (Text, [Rewrite])
-> (Text, [Rewrite])
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text, [Rewrite]) -> Text
forall a b. (a, b) -> a
fst) ([(Text, [Rewrite])] -> [(Text, [Rewrite])])
-> [(Text, [Rewrite])] -> [(Text, [Rewrite])]
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
mods [(Text, Text)]
-> ((Text, Text) -> [(Text, [Rewrite])]) -> [(Text, [Rewrite])]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> [(Text, [Rewrite])])
-> (Text, Text) -> [(Text, [Rewrite])]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Text -> Text -> Text -> [(Text, [Rewrite])]
suggests Text
identifier),
    (Text, [Rewrite])
hideAll <- (Text
"Hide " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from all occurence imports", [[Rewrite]] -> [Rewrite]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Rewrite]] -> [Rewrite]) -> [[Rewrite]] -> [Rewrite]
forall a b. (a -> b) -> a -> b
$ (Text, [Rewrite]) -> [Rewrite]
forall a b. (a, b) -> b
snd ((Text, [Rewrite]) -> [Rewrite])
-> [(Text, [Rewrite])] -> [[Rewrite]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [Rewrite])]
result) =
    [(Text, [Rewrite])]
result [(Text, [Rewrite])] -> [(Text, [Rewrite])] -> [(Text, [Rewrite])]
forall a. Semigroup a => a -> a -> a
<> [(Text, [Rewrite])
hideAll]
  | Bool
otherwise = []
  where
    suggests :: Text -> Text -> Text -> [(Text, [Rewrite])]
suggests Text
identifier Text
modName Text
s
      | Just TcModuleResult
tcM <- Maybe TcModuleResult
mTcM,
        Just HieAstResult
har <- Maybe HieAstResult
mHar,
        [RealSrcSpan
s'] <- [RealSrcSpan
x | (RealSrcSpan
x, FilePath
"") <- ReadS RealSrcSpan
readSrcSpan ReadS RealSrcSpan -> ReadS RealSrcSpan
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
s],
        TcModuleResult
-> HieAstResult -> FilePath -> FilePath -> SrcSpan -> Bool
isUnusedImportedId TcModuleResult
tcM HieAstResult
har (Text -> FilePath
T.unpack Text
identifier) (Text -> FilePath
T.unpack Text
modName) (RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
s'),
        Maybe (LImportDecl GhcPs)
mDecl <- [LImportDecl GhcPs] -> FilePath -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
hsmodImports (FilePath -> Maybe (LImportDecl GhcPs))
-> FilePath -> Maybe (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
modName,
        Text
title <- Text
"Hide " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modName =
        if Text
modName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Prelude" Bool -> Bool -> Bool
&& Maybe (LImportDecl GhcPs) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (LImportDecl GhcPs)
mDecl
          then [(Text
title, Maybe Rewrite -> [Rewrite]
forall a. Maybe a -> [a]
maybeToList (Maybe Rewrite -> [Rewrite]) -> Maybe Rewrite -> [Rewrite]
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsedSource -> Maybe Rewrite
hideImplicitPreludeSymbol (Text -> FilePath
T.unpack Text
identifier) ParsedSource
pm)]
          else Maybe (Text, [Rewrite]) -> [(Text, [Rewrite])]
forall a. Maybe a -> [a]
maybeToList (Maybe (Text, [Rewrite]) -> [(Text, [Rewrite])])
-> Maybe (Text, [Rewrite]) -> [(Text, [Rewrite])]
forall a b. (a -> b) -> a -> b
$ (Text
title,) ([Rewrite] -> (Text, [Rewrite]))
-> (LImportDecl GhcPs -> [Rewrite])
-> LImportDecl GhcPs
-> (Text, [Rewrite])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rewrite -> [Rewrite]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rewrite -> [Rewrite])
-> (LImportDecl GhcPs -> Rewrite) -> LImportDecl GhcPs -> [Rewrite]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> LImportDecl GhcPs -> Rewrite
hideSymbol (Text -> FilePath
T.unpack Text
identifier) (LImportDecl GhcPs -> (Text, [Rewrite]))
-> Maybe (LImportDecl GhcPs) -> Maybe (Text, [Rewrite])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LImportDecl GhcPs)
mDecl
      | Bool
otherwise = []

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

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

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

suggestDisableWarning :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestDisableWarning :: ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDisableWarning ParsedModule
pm Maybe Text
contents Diagnostic{Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    | Just (InR (Text -> Text -> Maybe Text
T.stripPrefix Text
"-W" -> Just Text
w)) <- Maybe (Int |? Text)
_code =
        (Text, [TextEdit]) -> [(Text, [TextEdit])]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( Text
"Disable \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" warnings"
            , [Range -> Text -> TextEdit
TextEdit (ParsedModule -> Maybe Text -> Range
endOfModuleHeader ParsedModule
pm Maybe Text
contents) (Text -> TextEdit) -> Text -> TextEdit
forall a b. (a -> b) -> a -> b
$ Text
"{-# OPTIONS_GHC -Wno-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" #-}\n"]
            )
    | Bool
otherwise = []

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

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

caRemoveRedundantImports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [Command |? CodeAction]
caRemoveRedundantImports :: Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> [Diagnostic]
-> Uri
-> [Command |? CodeAction]
caRemoveRedundantImports Maybe ParsedModule
m Maybe Text
contents [Diagnostic]
digs [Diagnostic]
ctxDigs Uri
uri
  | Just ParsedModule
pm <- Maybe ParsedModule
m,
    [(Diagnostic, (Text, [TextEdit]))]
r <- [[(Diagnostic, (Text, [TextEdit]))]]
-> [(Diagnostic, (Text, [TextEdit]))]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Diagnostic, (Text, [TextEdit]))]]
 -> [(Diagnostic, (Text, [TextEdit]))])
-> [[(Diagnostic, (Text, [TextEdit]))]]
-> [(Diagnostic, (Text, [TextEdit]))]
forall a b. (a -> b) -> a -> b
$ (Diagnostic -> [(Diagnostic, (Text, [TextEdit]))])
-> [Diagnostic] -> [[(Diagnostic, (Text, [TextEdit]))]]
forall a b. (a -> b) -> [a] -> [b]
map (\Diagnostic
d -> Diagnostic -> [Diagnostic]
forall a. a -> [a]
repeat Diagnostic
d [Diagnostic]
-> [(Text, [TextEdit])] -> [(Diagnostic, (Text, [TextEdit]))]
forall a b. [a] -> [b] -> [(a, b)]
`zip` ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestRemoveRedundantImport ParsedModule
pm Maybe Text
contents Diagnostic
d) [Diagnostic]
digs,
    [TextEdit]
allEdits <- [ TextEdit
e | (Diagnostic
_, (Text
_, [TextEdit]
edits)) <- [(Diagnostic, (Text, [TextEdit]))]
r, TextEdit
e <- [TextEdit]
edits],
    Command |? CodeAction
caRemoveAll <- [TextEdit] -> Command |? CodeAction
removeAll [TextEdit]
allEdits,
    [(Diagnostic, (Text, [TextEdit]))]
ctxEdits <- [ (Diagnostic, (Text, [TextEdit]))
x | x :: (Diagnostic, (Text, [TextEdit]))
x@(Diagnostic
d, (Text, [TextEdit])
_) <- [(Diagnostic, (Text, [TextEdit]))]
r, Diagnostic
d Diagnostic -> [Diagnostic] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Diagnostic]
ctxDigs],
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Diagnostic, (Text, [TextEdit]))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Diagnostic, (Text, [TextEdit]))]
ctxEdits,
    [Command |? CodeAction]
caRemoveCtx <- ((Diagnostic, (Text, [TextEdit])) -> Command |? CodeAction)
-> [(Diagnostic, (Text, [TextEdit]))] -> [Command |? CodeAction]
forall a b. (a -> b) -> [a] -> [b]
map (\(Diagnostic
d, (Text
title, [TextEdit]
tedit)) -> Text -> [TextEdit] -> Diagnostic -> Command |? CodeAction
removeSingle Text
title [TextEdit]
tedit Diagnostic
d) [(Diagnostic, (Text, [TextEdit]))]
ctxEdits
      = [Command |? CodeAction]
caRemoveCtx [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall a. [a] -> [a] -> [a]
++ [Command |? CodeAction
caRemoveAll]
  | Bool
otherwise = []
  where
    removeSingle :: Text -> [TextEdit] -> Diagnostic -> Command |? CodeAction
removeSingle Text
title [TextEdit]
tedit Diagnostic
diagnostic = Text -> [Diagnostic] -> WorkspaceEdit -> Command |? CodeAction
mkCA Text
title [Diagnostic
diagnostic] WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange) -> WorkspaceEdit
WorkspaceEdit{Maybe WorkspaceEditMap
Maybe (List DocumentChange)
forall a. Maybe a
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
..} where
        _changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit
        _documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
    removeAll :: [TextEdit] -> Command |? CodeAction
removeAll [TextEdit]
tedit = CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> CodeAction -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$ CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> CodeAction
CodeAction{Maybe Bool
Maybe WorkspaceEdit
Maybe Reason
Maybe CodeActionKind
Maybe Command
Maybe (List Diagnostic)
Text
forall a. Maybe a
$sel:_title:CodeAction :: Text
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_disabled:CodeAction :: Maybe Reason
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
_disabled :: forall a. Maybe a
_command :: forall a. Maybe a
_isPreferred :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_diagnostics :: forall a. Maybe a
_kind :: Maybe CodeActionKind
_title :: Text
..} where
        _changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit
        _title :: Text
_title = Text
"Remove all redundant imports"
        _kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
        _diagnostics :: Maybe a
_diagnostics = Maybe a
forall a. Maybe a
Nothing
        _documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
        _edit :: Maybe WorkspaceEdit
_edit = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange) -> WorkspaceEdit
WorkspaceEdit{Maybe WorkspaceEditMap
Maybe (List DocumentChange)
forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
..}
        _isPreferred :: Maybe a
_isPreferred = Maybe a
forall a. Maybe a
Nothing
        _command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
        _disabled :: Maybe a
_disabled = Maybe a
forall a. Maybe a
Nothing

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

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

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

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

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

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

      extractNameAndMatchesFromFunBind
        :: HsBind GhcPs
        -> Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])
      extractNameAndMatchesFromFunBind :: HsBind GhcPs
-> Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])
extractNameAndMatchesFromFunBind
        FunBind
          { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id=Located (IdP GhcPs)
lname
          , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches=MG {mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts=L SrcSpan
_ [LMatch GhcPs (LHsExpr GhcPs)]
matches}
          } = (Located RdrName, [LMatch GhcPs (LHsExpr GhcPs)])
-> Maybe (Located RdrName, [LMatch GhcPs (LHsExpr GhcPs)])
forall a. a -> Maybe a
Just (Located (IdP GhcPs)
Located RdrName
lname, [LMatch GhcPs (LHsExpr GhcPs)]
matches)
      extractNameAndMatchesFromFunBind HsBind GhcPs
_ = Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])
forall a. Maybe a
Nothing

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

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

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

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

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

      isSameName :: IdP GhcPs -> String -> Bool
      isSameName :: IdP GhcPs -> FilePath -> Bool
isSameName IdP GhcPs
x FilePath
name = SDoc -> FilePath
showSDocUnsafe (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdP GhcPs
RdrName
x) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
name

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

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

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

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

    parenthesizeIfNeeds :: Bool -> T.Text -> T.Text
    parenthesizeIfNeeds :: Bool -> Text -> Text
parenthesizeIfNeeds Bool
needsTypeKeyword Text
x
      | Text -> Char
T.head Text
x Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
opLetter = (if Bool
needsTypeKeyword then Text
"type " else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
")"
      | Bool
otherwise = Text
x

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

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

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

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

suggestAddTypeAnnotationToSatisfyContraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyContraints :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyContraints Maybe Text
sourceOpt Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
-- File.hs:52:41: warning:
--     * Defaulting the following constraint to type ‘Integer’
--        Num p0 arising from the literal ‘1’
--     * In the expression: 1
--       In an equation for ‘f’: f = 1
-- File.hs:52:41: warning:
--     * Defaulting the following constraints to type ‘[Char]’
--        (Show a0)
--          arising from a use of ‘traceShow’
--          at A.hs:228:7-25
--        (IsString a0)
--          arising from the literal ‘"debug"’
--          at A.hs:228:17-23
--     * In the expression: traceShow "debug" a
--       In an equation for ‘f’: f a = traceShow "debug" a
-- File.hs:52:41: warning:
--     * Defaulting the following constraints to type ‘[Char]’
--         (Show a0)
--          arising from a use of ‘traceShow’
--          at A.hs:255:28-43
--        (IsString a0)
--          arising from the literal ‘"test"’
--          at /Users/serhiip/workspace/ghcide/src/Development/IDE/Plugin/CodeAction.hs:255:38-43
--     * In the fourth argument of ‘seq’, namely ‘(traceShow "test")’
--       In the expression: seq "test" seq "test" (traceShow "test")
--       In an equation for ‘f’:
--          f = seq "test" seq "test" (traceShow "test")
    | Just [Text
ty, Text
lit] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
False Bool
False Bool
True Bool
False)
                        Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
False Bool
False Bool
False Bool
True)
                        Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
False Bool
False Bool
False Bool
False)
            = Text -> Text -> Text -> [(Text, [TextEdit])]
codeEdit Text
ty Text
lit (Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
makeAnnotatedLit Text
ty Text
lit)
    | Just Text
source <- Maybe Text
sourceOpt
    , Just [Text
ty, Text
lit] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
True Bool
True Bool
False Bool
False)
            = let lit' :: Text
lit' = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
makeAnnotatedLit Text
ty Text
lit;
                  tir :: Text
tir = Range -> Text -> Text
textInRange Range
_range Text
source
              in Text -> Text -> Text -> [(Text, [TextEdit])]
codeEdit Text
ty Text
lit (Text -> Text -> Text -> Text
T.replace Text
lit Text
lit' Text
tir)
    | Bool
otherwise = []
    where
      makeAnnotatedLit :: a -> a -> a
makeAnnotatedLit a
ty a
lit = a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lit a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" :: " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
ty a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
      pat :: Bool -> Bool -> Bool -> Bool -> Text
pat Bool
multiple Bool
at Bool
inArg Bool
inExpr = [Text] -> Text
T.concat [ Text
".*Defaulting the following constraint"
                                       , if Bool
multiple then Text
"s" else Text
""
                                       , Text
" to type ‘([^ ]+)’ "
                                       , Text
".*arising from the literal ‘(.+)’"
                                       , if Bool
inArg then Text
".+In the.+argument" else Text
""
                                       , if Bool
at then Text
".+at" else Text
""
                                       , if Bool
inExpr then Text
".+In the expression" else Text
""
                                       , Text
".+In the expression"
                                       ]
      codeEdit :: Text -> Text -> Text -> [(Text, [TextEdit])]
codeEdit Text
ty Text
lit Text
replacement =
        let title :: Text
title = Text
"Add type annotation ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ty Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’ to ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’"
            edits :: [TextEdit]
edits = [Range -> Text -> TextEdit
TextEdit Range
_range Text
replacement]
        in  [( Text
title, [TextEdit]
edits )]


suggestReplaceIdentifier :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestReplaceIdentifier :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestReplaceIdentifier Maybe Text
contents Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
-- File.hs:52:41: error:
--     * Variable not in scope:
--         suggestAcion :: Maybe T.Text -> Range -> Range
--     * Perhaps you meant ‘suggestAction’ (line 83)
-- File.hs:94:37: error:
--     Not in scope: ‘T.isPrfixOf’
--     Perhaps you meant one of these:
--       ‘T.isPrefixOf’ (imported from Data.Text),
--       ‘T.isInfixOf’ (imported from Data.Text),
--       ‘T.isSuffixOf’ (imported from Data.Text)
--     Module ‘Data.Text’ does not export ‘isPrfixOf’.
    | renameSuggestions :: [Text]
renameSuggestions@(Text
_:[Text]
_) <- Text -> [Text]
extractRenamableTerms Text
_message
        = [ (Text
"Replace with ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’", [Maybe Text -> Range -> Text -> TextEdit
mkRenameEdit Maybe Text
contents Range
_range Text
name]) | Text
name <- [Text]
renameSuggestions ]
    | Bool
otherwise = []

suggestNewDefinition :: IdeOptions -> ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestNewDefinition :: IdeOptions
-> ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestNewDefinition IdeOptions
ideOptions ParsedModule
parsedModule Maybe Text
contents Diagnostic{Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message, Range
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range}
--     * Variable not in scope:
--         suggestAcion :: Maybe T.Text -> Range -> Range
    | Just [Text
name, Text
typ] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
message Text
"Variable not in scope: ([^ ]+) :: ([^*•]+)"
    = IdeOptions
-> ParsedModule -> Range -> Text -> Text -> [(Text, [TextEdit])]
newDefinitionAction IdeOptions
ideOptions ParsedModule
parsedModule Range
_range Text
name Text
typ
    | Just [Text
name, Text
typ] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
message Text
"Found hole: _([^ ]+) :: ([^*•]+) Or perhaps"
    , [(Text
label, [TextEdit]
newDefinitionEdits)] <- IdeOptions
-> ParsedModule -> Range -> Text -> Text -> [(Text, [TextEdit])]
newDefinitionAction IdeOptions
ideOptions ParsedModule
parsedModule Range
_range Text
name Text
typ
    = [(Text
label, Maybe Text -> Range -> Text -> TextEdit
mkRenameEdit Maybe Text
contents Range
_range Text
name TextEdit -> [TextEdit] -> [TextEdit]
forall a. a -> [a] -> [a]
: [TextEdit]
newDefinitionEdits)]
    | Bool
otherwise = []
    where
      message :: Text
message = Text -> Text
unifySpaces Text
_message

newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> T.Text -> [(T.Text, [TextEdit])]
newDefinitionAction :: IdeOptions
-> ParsedModule -> Range -> Text -> Text -> [(Text, [TextEdit])]
newDefinitionAction IdeOptions{Bool
FilePath
[FilePath]
[Text]
Maybe FilePath
IO Bool
IO CheckParents
Action IdeGhcSession
ShakeOptions
IdePkgLocationOptions
IdeOTMemoryProfiling
IdeTesting
IdeDefer
IdeReportProgress
OptHaddockParse
ParsedSource -> IdePreprocessedSource
DynFlags -> DynFlags
optShakeOptions :: IdeOptions -> ShakeOptions
optCustomDynFlags :: IdeOptions -> DynFlags -> DynFlags
optHaddockParse :: IdeOptions -> OptHaddockParse
optCheckParents :: IdeOptions -> IO CheckParents
optCheckProject :: IdeOptions -> IO Bool
optDefer :: IdeOptions -> IdeDefer
optKeywords :: IdeOptions -> [Text]
optNewColonConvention :: IdeOptions -> Bool
optLanguageSyntax :: IdeOptions -> FilePath
optReportProgress :: IdeOptions -> IdeReportProgress
optTesting :: IdeOptions -> IdeTesting
optOTMemoryProfiling :: IdeOptions -> IdeOTMemoryProfiling
optShakeProfiling :: IdeOptions -> Maybe FilePath
optExtensions :: IdeOptions -> [FilePath]
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
optShakeOptions :: ShakeOptions
optCustomDynFlags :: DynFlags -> DynFlags
optHaddockParse :: OptHaddockParse
optCheckParents :: IO CheckParents
optCheckProject :: IO Bool
optDefer :: IdeDefer
optKeywords :: [Text]
optNewColonConvention :: Bool
optLanguageSyntax :: FilePath
optReportProgress :: IdeReportProgress
optTesting :: IdeTesting
optOTMemoryProfiling :: IdeOTMemoryProfiling
optShakeProfiling :: Maybe FilePath
optExtensions :: [FilePath]
optPkgLocationOpts :: IdePkgLocationOptions
optGhcSession :: Action IdeGhcSession
optPreprocessor :: ParsedSource -> IdePreprocessedSource
..} ParsedModule
parsedModule Range{Position
_start :: Position
_start :: Range -> Position
_start} Text
name Text
typ
    | Range Position
_ Position
lastLineP : [Range]
_ <-
      [ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
sp
      | (L l :: SrcSpan
l@(RealSrcSpan RealSrcSpan
sp) HsDecl GhcPs
_) <- [LHsDecl GhcPs]
hsmodDecls
      , Position
_start Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l]
    , Position
nextLineP <- Position :: Int -> Int -> Position
Position{ _line :: Int
_line = Position -> Int
_line Position
lastLineP Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, _character :: Int
_character = Int
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
" = error \"not implemented\""])]
        )]
    | Bool
otherwise = []
  where
    colon :: Text
colon = if Bool
optNewColonConvention then Text
" : " else Text
" :: "
    sig :: Text
sig = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
colon Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpace Text
typ
    ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls}} = ParsedModule
parsedModule


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

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

suggestModuleTypo :: Diagnostic -> [(T.Text, [TextEdit])]
suggestModuleTypo :: Diagnostic -> [(Text, [TextEdit])]
suggestModuleTypo Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
-- src/Development/IDE/Core/Compile.hs:58:1: error:
--     Could not find module ‘Data.Cha’
--     Perhaps you meant Data.Char (from base-4.12.0.0)
    | Text
"Could not find module" Text -> Text -> Bool
`T.isInfixOf` Text
_message
    , Text
"Perhaps you meant"     Text -> Text -> Bool
`T.isInfixOf` Text
_message = let
      findSuggestedModules :: Text -> [Text]
findSuggestedModules = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
2 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
      proposeModule :: Text -> (Text, [TextEdit])
proposeModule Text
mod = (Text
"replace with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod, [Range -> Text -> TextEdit
TextEdit Range
_range Text
mod])
      in (Text -> (Text, [TextEdit])) -> [Text] -> [(Text, [TextEdit])]
forall a b. (a -> b) -> [a] -> [b]
map Text -> (Text, [TextEdit])
proposeModule ([Text] -> [(Text, [TextEdit])]) -> [Text] -> [(Text, [TextEdit])]
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
$ Text -> [Text]
findSuggestedModules Text
_message
    | Bool
otherwise = []

suggestFillHole :: Diagnostic -> [(T.Text, [TextEdit])]
suggestFillHole :: Diagnostic -> [(Text, [TextEdit])]
suggestFillHole Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    | Just Text
holeName <- Text -> Maybe Text
extractHoleName Text
_message
    , ([Text]
holeFits, [Text]
refFits) <- [Text] -> ([Text], [Text])
processHoleSuggestions (Text -> [Text]
T.lines Text
_message)
    = (Text -> (Text, [TextEdit])) -> [Text] -> [(Text, [TextEdit])]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Bool -> Text -> (Text, [TextEdit])
proposeHoleFit Text
holeName Bool
False) [Text]
holeFits
    [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ (Text -> (Text, [TextEdit])) -> [Text] -> [(Text, [TextEdit])]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Bool -> Text -> (Text, [TextEdit])
proposeHoleFit Text
holeName Bool
True) [Text]
refFits
    | Bool
otherwise = []
    where
      extractHoleName :: Text -> Maybe Text
extractHoleName = ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
forall a. [a] -> a
head (Maybe [Text] -> Maybe Text)
-> (Text -> Maybe [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Maybe [Text]) -> Text -> Text -> Maybe [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
"Found hole: ([^ ]*)"
      proposeHoleFit :: Text -> Bool -> Text -> (Text, [TextEdit])
proposeHoleFit Text
holeName Bool
parenthise Text
name =
          ( Text
"replace " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
holeName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
          , [Range -> Text -> TextEdit
TextEdit Range
_range (Text -> TextEdit) -> Text -> TextEdit
forall a b. (a -> b) -> a -> b
$ if Bool
parenthise then Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
parens Text
name else Text
name])
      parens :: a -> a
parens a
x = a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"

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

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

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

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

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

suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, [Rewrite])]
suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(Text, [Rewrite])]
suggestExtendImport ExportsMap
exportsMap (L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports}) Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    | Just [Text
binding, Text
mod, Text
srcspan] <-
      Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message
      Text
"Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\).$"
    = [LImportDecl GhcPs] -> Text -> Text -> Text -> [(Text, [Rewrite])]
suggestions [LImportDecl GhcPs]
hsmodImports Text
binding Text
mod Text
srcspan
    | Just (Text
binding, [(Text, Text)]
mod_srcspan) <-
      Text -> Maybe (Text, [(Text, Text)])
matchRegExMultipleImports Text
_message
    = [(Text, Text)]
mod_srcspan [(Text, Text)]
-> ((Text, Text) -> [(Text, [Rewrite])]) -> [(Text, [Rewrite])]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> [(Text, [Rewrite])])
-> (Text, Text) -> [(Text, [Rewrite])]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([LImportDecl GhcPs] -> Text -> Text -> Text -> [(Text, [Rewrite])]
suggestions [LImportDecl GhcPs]
hsmodImports Text
binding)
    | Bool
otherwise = []
    where
        unImportStyle :: ImportStyle -> (Maybe FilePath, FilePath)
unImportStyle (ImportTopLevel Text
x) = (Maybe FilePath
forall a. Maybe a
Nothing, Text -> FilePath
T.unpack Text
x)
        unImportStyle (ImportViaParent Text
x Text
y) = (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
y, Text -> FilePath
T.unpack Text
x)
        suggestions :: [LImportDecl GhcPs] -> Text -> Text -> Text -> [(Text, [Rewrite])]
suggestions [LImportDecl GhcPs]
decls Text
binding Text
mod Text
srcspan
          |  Range
range <- case [ RealSrcSpan
x | (RealSrcSpan
x,FilePath
"") <- ReadS RealSrcSpan
readSrcSpan (Text -> FilePath
T.unpack Text
srcspan)] of
                [RealSrcSpan
s] -> let x :: Range
x = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
s
                   in Range
x{_end :: Position
_end = (Range -> Position
_end Range
x){_character :: Int
_character = Int -> Int
forall a. Enum a => a -> a
succ (Position -> Int
_character (Range -> Position
_end Range
x))}}
                [RealSrcSpan]
_ -> FilePath -> Range
forall a. HasCallStack => FilePath -> a
error FilePath
"bug in srcspan parser",
            Just LImportDecl GhcPs
decl <- [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs)
findImportDeclByRange [LImportDecl GhcPs]
decls Range
range,
            Just IdentInfo
ident <- Text -> Text -> Maybe IdentInfo
lookupExportMap Text
binding Text
mod
          = [ ( Text
"Add " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ImportStyle -> Text
renderImportStyle ImportStyle
importStyle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the import list of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod
              , [(Maybe FilePath -> FilePath -> LImportDecl GhcPs -> Rewrite)
-> (Maybe FilePath, FilePath) -> LImportDecl GhcPs -> Rewrite
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe FilePath -> FilePath -> LImportDecl GhcPs -> Rewrite
extendImport (ImportStyle -> (Maybe FilePath, FilePath)
unImportStyle ImportStyle
importStyle) LImportDecl GhcPs
decl]
              )
            | ImportStyle
importStyle <- NonEmpty ImportStyle -> [ImportStyle]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ImportStyle -> [ImportStyle])
-> NonEmpty ImportStyle -> [ImportStyle]
forall a b. (a -> b) -> a -> b
$ IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo
ident
            ]
          | Bool
otherwise = []
        lookupExportMap :: Text -> Text -> Maybe IdentInfo
lookupExportMap Text
binding Text
mod
          | Just HashSet IdentInfo
match <- Text
-> HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
binding (ExportsMap -> HashMap Text (HashSet IdentInfo)
getExportsMap ExportsMap
exportsMap)
          , [IdentInfo
ident] <- (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) (HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList HashSet IdentInfo
match)
           = 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 :: Text -> Text -> Maybe Text -> Bool -> Text -> IdentInfo
IdentInfo
                { name :: Text
name = Text
binding
                , rendered :: Text
rendered = Text
binding
                , parent :: Maybe Text
parent = Maybe Text
forall a. Maybe a
Nothing
                , isDatacon :: Bool
isDatacon = Bool
False
                , moduleNameText :: Text
moduleNameText = Text
mod}

data HidingMode
    = HideOthers [ModuleTarget]
    | ToQualified
        Bool
        -- ^ Parenthesised?
        ModuleName
    deriving (Int -> HidingMode -> ShowS
[HidingMode] -> ShowS
HidingMode -> FilePath
(Int -> HidingMode -> ShowS)
-> (HidingMode -> FilePath)
-> ([HidingMode] -> ShowS)
-> Show HidingMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HidingMode] -> ShowS
$cshowList :: [HidingMode] -> ShowS
show :: HidingMode -> FilePath
$cshow :: HidingMode -> FilePath
showsPrec :: Int -> HidingMode -> ShowS
$cshowsPrec :: Int -> HidingMode -> ShowS
Show)

data ModuleTarget
    = ExistingImp (NonEmpty (LImportDecl GhcPs))
    | ImplicitPrelude [LImportDecl GhcPs]
    deriving (Int -> ModuleTarget -> ShowS
[ModuleTarget] -> ShowS
ModuleTarget -> FilePath
(Int -> ModuleTarget -> ShowS)
-> (ModuleTarget -> FilePath)
-> ([ModuleTarget] -> ShowS)
-> Show ModuleTarget
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ModuleTarget] -> ShowS
$cshowList :: [ModuleTarget] -> ShowS
show :: ModuleTarget -> FilePath
$cshow :: ModuleTarget -> FilePath
showsPrec :: Int -> ModuleTarget -> ShowS
$cshowsPrec :: Int -> ModuleTarget -> ShowS
Show)

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

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

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

-- | Suggests disambiguation for ambiguous symbols.
suggestImportDisambiguation ::
    DynFlags ->
    Maybe T.Text ->
    ParsedSource ->
    Diagnostic ->
    [(T.Text, [Rewrite])]
suggestImportDisambiguation :: DynFlags
-> Maybe Text -> ParsedSource -> Diagnostic -> [(Text, [Rewrite])]
suggestImportDisambiguation DynFlags
df (Just Text
txt) ps :: ParsedSource
ps@(L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports}) diag :: Diagnostic
diag@Diagnostic {Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    | Just [Text
ambiguous] <-
        Text -> Text -> Maybe [Text]
matchRegexUnifySpaces
            Text
_message
            Text
"Ambiguous occurrence ‘([^’]+)’"
      , Just [Text]
modules <-
            ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
forall a. [a] -> a
last
                ([[Text]] -> [Text]) -> Maybe [[Text]] -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe [[Text]]
allMatchRegexUnifySpaces Text
_message Text
"imported from ‘([^’]+)’" =
        Text -> [Text] -> [(Text, [Rewrite])]
suggestions Text
ambiguous [Text]
modules
    | Bool
otherwise = []
    where
        locDic :: HashMap Text (NonEmpty (LImportDecl GhcPs))
locDic =
            (DList (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs))
-> HashMap Text (DList (LImportDecl GhcPs))
-> HashMap Text (NonEmpty (LImportDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([LImportDecl GhcPs] -> NonEmpty (LImportDecl GhcPs)
forall a. [a] -> NonEmpty a
NE.fromList ([LImportDecl GhcPs] -> NonEmpty (LImportDecl GhcPs))
-> (DList (LImportDecl GhcPs) -> [LImportDecl GhcPs])
-> DList (LImportDecl GhcPs)
-> NonEmpty (LImportDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall a. DList a -> [a]
DL.toList) (HashMap Text (DList (LImportDecl GhcPs))
 -> HashMap Text (NonEmpty (LImportDecl GhcPs)))
-> HashMap Text (DList (LImportDecl GhcPs))
-> HashMap Text (NonEmpty (LImportDecl GhcPs))
forall a b. (a -> b) -> a -> b
$
            (DList (LImportDecl GhcPs)
 -> DList (LImportDecl GhcPs) -> DList (LImportDecl GhcPs))
-> [(Text, DList (LImportDecl GhcPs))]
-> HashMap Text (DList (LImportDecl GhcPs))
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith DList (LImportDecl GhcPs)
-> DList (LImportDecl GhcPs) -> DList (LImportDecl GhcPs)
forall a. Semigroup a => a -> a -> a
(<>) ([(Text, DList (LImportDecl GhcPs))]
 -> HashMap Text (DList (LImportDecl GhcPs)))
-> [(Text, DList (LImportDecl GhcPs))]
-> HashMap Text (DList (LImportDecl GhcPs))
forall a b. (a -> b) -> a -> b
$
                (LImportDecl GhcPs -> (Text, DList (LImportDecl GhcPs)))
-> [LImportDecl GhcPs] -> [(Text, DList (LImportDecl GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map
                    ( \i :: LImportDecl GhcPs
i@(L SrcSpan
_ ImportDecl GhcPs
idecl) ->
                        ( FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
moduleNameString (ModuleName -> FilePath) -> ModuleName -> FilePath
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> SrcSpanLess (Located ModuleName))
-> Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
idecl
                        , LImportDecl GhcPs -> DList (LImportDecl GhcPs)
forall a. a -> DList a
DL.singleton LImportDecl GhcPs
i
                        )
                    )
                    [LImportDecl GhcPs]
hsmodImports
        toModuleTarget :: Text -> Maybe ModuleTarget
toModuleTarget Text
"Prelude"
            | DynFlags -> Bool
isPreludeImplicit DynFlags
df
             = ModuleTarget -> Maybe ModuleTarget
forall a. a -> Maybe a
Just (ModuleTarget -> Maybe ModuleTarget)
-> ModuleTarget -> Maybe ModuleTarget
forall a b. (a -> b) -> a -> b
$ [LImportDecl GhcPs] -> ModuleTarget
ImplicitPrelude ([LImportDecl GhcPs] -> ModuleTarget)
-> [LImportDecl GhcPs] -> ModuleTarget
forall a b. (a -> b) -> a -> b
$
                [LImportDecl GhcPs]
-> (NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs])
-> Maybe (NonEmpty (LImportDecl GhcPs))
-> [LImportDecl GhcPs]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall a. NonEmpty a -> [a]
NE.toList (Text
-> HashMap Text (NonEmpty (LImportDecl GhcPs))
-> Maybe (NonEmpty (LImportDecl GhcPs))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
"Prelude" HashMap Text (NonEmpty (LImportDecl GhcPs))
locDic)
        toModuleTarget Text
mName = NonEmpty (LImportDecl GhcPs) -> ModuleTarget
ExistingImp (NonEmpty (LImportDecl GhcPs) -> ModuleTarget)
-> Maybe (NonEmpty (LImportDecl GhcPs)) -> Maybe ModuleTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> HashMap Text (NonEmpty (LImportDecl GhcPs))
-> Maybe (NonEmpty (LImportDecl GhcPs))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
mName HashMap Text (NonEmpty (LImportDecl GhcPs))
locDic
        parensed :: Bool
parensed =
            Text
"(" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.strip (Range -> Text -> Text
textInRange Range
_range Text
txt)
        suggestions :: Text -> [Text] -> [(Text, [Rewrite])]
suggestions Text
symbol [Text]
mods
            | Just [ModuleTarget]
targets <- (Text -> Maybe ModuleTarget) -> [Text] -> Maybe [ModuleTarget]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Maybe ModuleTarget
toModuleTarget [Text]
mods =
                ((Text, [Rewrite]) -> Text)
-> [(Text, [Rewrite])] -> [(Text, [Rewrite])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, [Rewrite]) -> Text
forall a b. (a, b) -> a
fst
                [ ( HidingMode -> Text -> Text -> Text
renderUniquify HidingMode
mode Text
modNameText Text
symbol
                  , ParsedSource -> Diagnostic -> Text -> HidingMode -> [Rewrite]
disambiguateSymbol ParsedSource
ps Diagnostic
diag Text
symbol HidingMode
mode
                  )
                | (ModuleTarget
modTarget, [ModuleTarget]
restImports) <- [ModuleTarget] -> [(ModuleTarget, [ModuleTarget])]
forall a. [a] -> [(a, [a])]
oneAndOthers [ModuleTarget]
targets
                , let modName :: ModuleName
modName = ModuleTarget -> ModuleName
targetModuleName ModuleTarget
modTarget
                      modNameText :: Text
modNameText = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
moduleNameString ModuleName
modName
                , HidingMode
mode <-
                    [ModuleTarget] -> HidingMode
HideOthers [ModuleTarget]
restImports HidingMode -> [HidingMode] -> [HidingMode]
forall a. a -> [a] -> [a]
:
                    [ Bool -> ModuleName -> HidingMode
ToQualified Bool
parensed ModuleName
qual
                    | ExistingImp NonEmpty (LImportDecl GhcPs)
imps <- [ModuleTarget
modTarget]
                    , L SrcSpan
_ ModuleName
qual <- [Located ModuleName] -> [Located ModuleName]
forall a. Ord a => [a] -> [a]
nubOrd ([Located ModuleName] -> [Located ModuleName])
-> [Located ModuleName] -> [Located ModuleName]
forall a b. (a -> b) -> a -> b
$ (LImportDecl GhcPs -> Maybe (Located ModuleName))
-> [LImportDecl GhcPs] -> [Located ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs (ImportDecl GhcPs -> Maybe (Located ModuleName))
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> Maybe (Located ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
                        ([LImportDecl GhcPs] -> [Located ModuleName])
-> [LImportDecl GhcPs] -> [Located ModuleName]
forall a b. (a -> b) -> a -> b
$ NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcPs)
imps
                    ]
                    [HidingMode] -> [HidingMode] -> [HidingMode]
forall a. [a] -> [a] -> [a]
++ [Bool -> ModuleName -> HidingMode
ToQualified Bool
parensed ModuleName
modName
                        | (LImportDecl GhcPs -> Bool) -> [LImportDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> ImportDecl GhcPs -> Bool
occursUnqualified Text
symbol (ImportDecl GhcPs -> Bool)
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
                            (ModuleTarget -> [LImportDecl GhcPs]
targetImports ModuleTarget
modTarget)
                        Bool -> Bool -> Bool
|| case ModuleTarget
modTarget of
                            ImplicitPrelude{} -> Bool
True
                            ModuleTarget
_ -> Bool
False
                        ]
                ]
            | Bool
otherwise = []
        renderUniquify :: HidingMode -> Text -> Text -> Text
renderUniquify HideOthers {} Text
modName Text
symbol =
            Text
"Use " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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 =
            Text
"Replace with qualified: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (ModuleName -> FilePath
moduleNameString ModuleName
qual)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
symbol
suggestImportDisambiguation DynFlags
_ Maybe Text
_ ParsedSource
_ Diagnostic
_ = []

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

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

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

disambiguateSymbol ::
    ParsedSource ->
    Diagnostic ->
    T.Text ->
    HidingMode ->
    [Rewrite]
disambiguateSymbol :: ParsedSource -> Diagnostic -> Text -> HidingMode -> [Rewrite]
disambiguateSymbol ParsedSource
pm Diagnostic {Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..} (Text -> FilePath
T.unpack -> FilePath
symbol) = \case
    (HideOthers [ModuleTarget]
hiddens0) ->
        [ FilePath -> LImportDecl GhcPs -> Rewrite
hideSymbol FilePath
symbol LImportDecl GhcPs
idecl
        | ExistingImp NonEmpty (LImportDecl GhcPs)
idecls <- [ModuleTarget]
hiddens0
        , LImportDecl GhcPs
idecl <- NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcPs)
idecls
        ]
            [Rewrite] -> [Rewrite] -> [Rewrite]
forall a. [a] -> [a] -> [a]
++ [[Rewrite]] -> [Rewrite]
forall a. Monoid a => [a] -> a
mconcat
                [ if [LImportDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LImportDecl GhcPs]
imps
                    then Maybe Rewrite -> [Rewrite]
forall a. Maybe a -> [a]
maybeToList (Maybe Rewrite -> [Rewrite]) -> Maybe Rewrite -> [Rewrite]
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsedSource -> Maybe Rewrite
hideImplicitPreludeSymbol FilePath
symbol ParsedSource
pm
                    else FilePath -> LImportDecl GhcPs -> Rewrite
hideSymbol FilePath
symbol (LImportDecl GhcPs -> Rewrite) -> [LImportDecl GhcPs] -> [Rewrite]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LImportDecl GhcPs]
imps
                | ImplicitPrelude [LImportDecl GhcPs]
imps <- [ModuleTarget]
hiddens0
                ]
    (ToQualified Bool
parensed ModuleName
qualMod) ->
        let occSym :: OccName
occSym = FilePath -> OccName
mkVarOcc FilePath
symbol
            rdr :: RdrName
rdr = ModuleName -> OccName -> RdrName
Qual ModuleName
qualMod OccName
occSym
         in [ if Bool
parensed
                then SrcSpan
-> (DynFlags -> TransformT (Either FilePath) (LHsExpr GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either FilePath) (Located ast))
-> Rewrite
Rewrite (NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
"<dummy>" Range
_range) ((DynFlags -> TransformT (Either FilePath) (LHsExpr GhcPs))
 -> Rewrite)
-> (DynFlags -> TransformT (Either FilePath) (LHsExpr GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
                    DynFlags
-> FilePath -> TransformT (Either FilePath) (LHsExpr GhcPs)
forall ast.
ASTElement ast =>
DynFlags -> FilePath -> TransformT (Either FilePath) (Located ast)
liftParseAST @(HsExpr GhcPs) DynFlags
df (FilePath -> TransformT (Either FilePath) (LHsExpr GhcPs))
-> FilePath -> TransformT (Either FilePath) (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
                    HsExpr GhcPs -> FilePath
forall a. Outputable a => a -> FilePath
prettyPrint (HsExpr GhcPs -> FilePath) -> HsExpr GhcPs -> FilePath
forall a b. (a -> b) -> a -> b
$
                        XVar GhcPs -> Located (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar @GhcPs NoExtField
XVar GhcPs
noExtField (Located (IdP GhcPs) -> HsExpr GhcPs)
-> Located (IdP GhcPs) -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$
                            SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L (FastString -> SrcSpan
UnhelpfulSpan FastString
"") RdrName
rdr
                else SrcSpan
-> (DynFlags -> TransformT (Either FilePath) (Located RdrName))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either FilePath) (Located ast))
-> Rewrite
Rewrite (NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
"<dummy>" Range
_range) ((DynFlags -> TransformT (Either FilePath) (Located RdrName))
 -> Rewrite)
-> (DynFlags -> TransformT (Either FilePath) (Located RdrName))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
                    DynFlags
-> FilePath -> TransformT (Either FilePath) (Located RdrName)
forall ast.
ASTElement ast =>
DynFlags -> FilePath -> TransformT (Either FilePath) (Located ast)
liftParseAST @RdrName DynFlags
df (FilePath -> TransformT (Either FilePath) (Located RdrName))
-> FilePath -> TransformT (Either FilePath) (Located RdrName)
forall a b. (a -> b) -> a -> b
$
                    Located RdrName -> FilePath
forall a. Outputable a => a -> FilePath
prettyPrint (Located RdrName -> FilePath) -> Located RdrName -> FilePath
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L (FastString -> SrcSpan
UnhelpfulSpan FastString
"") RdrName
rdr
            ]

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

suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestFixConstructorImport :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestFixConstructorImport Maybe Text
_ Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
    -- ‘Success’ is a data constructor of ‘Result’
    -- To import it use
    -- import Data.Aeson.Types( Result( Success ) )
    -- or
    -- import Data.Aeson.Types( Result(..) ) (lsp-ui)
  | Just [Text
constructor, Text
typ] <-
    Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message
    Text
"‘([^’]*)’ is a data constructor of ‘([^’]*)’ To import it use"
  = let fixedImport :: Text
fixedImport = Text
typ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    in [(Text
"Fix import of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fixedImport, [Range -> Text -> TextEdit
TextEdit Range
_range Text
fixedImport])]
  | Bool
otherwise = []
-- | Suggests a constraint for a declaration for which a constraint is missing.
suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, [Rewrite])]
suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(Text, [Rewrite])]
suggestConstraint DynFlags
df ParsedSource
parsedModule diag :: Diagnostic
diag@Diagnostic {Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
  | Just Text
missingConstraint <- Text -> Maybe Text
findMissingConstraint Text
_message
  = let codeAction :: Diagnostic -> Text -> [(Text, Rewrite)]
codeAction = if Text
_message Text -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (FilePath
"the type signature for:" :: String)
                        then DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestFunctionConstraint DynFlags
df ParsedSource
parsedModule
                        else DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestInstanceConstraint DynFlags
df ParsedSource
parsedModule
     in ((Text, Rewrite) -> (Text, [Rewrite]))
-> [(Text, Rewrite)] -> [(Text, [Rewrite])]
forall a b. (a -> b) -> [a] -> [b]
map ((Rewrite -> [Rewrite]) -> (Text, Rewrite) -> (Text, [Rewrite])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Rewrite -> [Rewrite] -> [Rewrite]
forall a. a -> [a] -> [a]
:[])) ([(Text, Rewrite)] -> [(Text, [Rewrite])])
-> [(Text, Rewrite)] -> [(Text, [Rewrite])]
forall a b. (a -> b) -> a -> b
$ Diagnostic -> Text -> [(Text, Rewrite)]
codeAction Diagnostic
diag Text
missingConstraint
  | Bool
otherwise = []
    where
      findMissingConstraint :: T.Text -> Maybe T.Text
      findMissingConstraint :: Text -> Maybe Text
findMissingConstraint Text
t =
        let regex :: Text
regex = Text
"(No instance for|Could not deduce) \\((.+)\\) arising from" -- a use of / a do statement
            regexImplicitParams :: Text
regexImplicitParams = Text
"Could not deduce: (\\?.+) arising from a use of"
            match :: Maybe [Text]
match = Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
regex
            matchImplicitParams :: Maybe [Text]
matchImplicitParams = Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
regexImplicitParams
        in Maybe [Text]
match Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Text]
matchImplicitParams Maybe [Text] -> ([Text] -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Text] -> Text
forall a. [a] -> a
last

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

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

      readPositionNumber :: T.Text -> Int
      readPositionNumber :: Text -> Int
readPositionNumber = Text -> FilePath
T.unpack (Text -> FilePath) -> (FilePath -> Int) -> Text -> Int
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FilePath -> Int
forall a. Read a => FilePath -> a
read

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

suggestImplicitParameter ::
  ParsedSource ->
  Diagnostic ->
  [(T.Text, [Rewrite])]
suggestImplicitParameter :: ParsedSource -> Diagnostic -> [(Text, [Rewrite])]
suggestImplicitParameter (L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls}) Diagnostic {Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message, Range
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range}
  | Just [Text
implicitT] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"Unbound implicit parameter \\(([^:]+::.+)\\) arising",
    Just (L SrcSpan
_ (ValD XValD GhcPs
_ FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = L SrcSpan
_ IdP GhcPs
funId})) <- Position -> [LHsDecl GhcPs] -> Maybe (LHsDecl GhcPs)
forall a. Position -> [Located a] -> Maybe (Located a)
findDeclContainingLoc (Range -> Position
_start Range
_range) [LHsDecl GhcPs]
hsmodDecls,
    Just (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
_ HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB {LHsType GhcPs
hsib_body :: LHsType GhcPs
hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body}}) <- (IdP GhcPs -> Bool) -> [LHsDecl GhcPs] -> Maybe (Sig GhcPs)
forall p. (IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDecl (RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== IdP GhcPs
RdrName
funId) [LHsDecl GhcPs]
hsmodDecls
    =
      [( Text
"Add " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
implicitT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the context of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (RdrName -> FilePath
printRdrName IdP GhcPs
RdrName
funId)
        , [FilePath -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> FilePath
T.unpack Text
implicitT) LHsType GhcPs
hsib_body])]
  | Bool
otherwise = []

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

findTypeSignatureLine :: T.Text -> T.Text -> Int
findTypeSignatureLine :: Text -> Text -> Int
findTypeSignatureLine Text
contents Text
typeSignatureName =
  Text -> Text -> [Text]
T.splitOn (Text
typeSignatureName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: ") Text
contents [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
forall a. [a] -> a
head Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text]
T.lines [Text] -> ([Text] -> Int) -> Int
forall a b. a -> (a -> b) -> b
& [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

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

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

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

-- | Suggests the removal of a redundant constraint for a type signature.
removeRedundantConstraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
removeRedundantConstraints :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
removeRedundantConstraints Maybe Text
mContents Diagnostic{Maybe Text
Maybe DiagnosticSeverity
Maybe (Int |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe (Int |? Text)
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int |? Text)
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
-- • Redundant constraint: Eq a
-- • In the type signature for:
--      foo :: forall a. Eq a => a -> a
-- • Redundant constraints: (Monoid a, Show a)
-- • In the type signature for:
--      foo :: forall a. (Num a, Monoid a, Eq a, Show a) => a -> Bool
  | Just Text
contents <- Maybe Text
mContents
  -- Account for both "Redundant constraint" and "Redundant constraints".
  , Bool
True <- Text
"Redundant constraint" Text -> Text -> Bool
`T.isInfixOf` Text
_message
  , Just Text
typeSignatureName <- Text -> Maybe Text
findTypeSignatureName Text
_message
  , Just [Text]
redundantConstraintList <- Text -> Maybe [Text]
findRedundantConstraints Text
_message
  , Just Text
constraints <- Text -> Text -> Maybe Text
findConstraints Text
contents Text
typeSignatureName
  = let constraintList :: [Text]
constraintList = Text -> [Text]
parseConstraints Text
constraints
        newConstraints :: Text
newConstraints = [Text] -> [Text] -> Text
buildNewConstraints [Text]
constraintList [Text]
redundantConstraintList
        typeSignatureLine :: Int
typeSignatureLine = Text -> Text -> Int
findTypeSignatureLine Text
contents Text
typeSignatureName
        typeSignatureFirstChar :: Int
typeSignatureFirstChar = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text
typeSignatureName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: "
        startOfConstraint :: Position
startOfConstraint = Int -> Int -> Position
Position Int
typeSignatureLine Int
typeSignatureFirstChar
        endOfConstraint :: Position
endOfConstraint = Int -> Int -> Position
Position Int
typeSignatureLine (Int -> Position) -> Int -> Position
forall a b. (a -> b) -> a -> b
$
          Int
typeSignatureFirstChar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length (Text
constraints Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => ")
        range :: Range
range = Position -> Position -> Range
Range Position
startOfConstraint Position
endOfConstraint
     in [([Text] -> Text -> Text
actionTitle [Text]
redundantConstraintList Text
typeSignatureName, [Range -> Text -> TextEdit
TextEdit Range
range Text
newConstraints])]
  | Bool
otherwise = []
    where
      parseConstraints :: T.Text -> [T.Text]
      parseConstraints :: Text -> [Text]
parseConstraints Text
t = Text
t
        Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text
T.strip (Text -> Text) -> (Text -> [Text]) -> Text -> [Text]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Text
stripConstraintsParens (Text -> Text) -> (Text -> [Text]) -> Text -> [Text]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Text -> [Text]
T.splitOn Text
",")
        [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
T.strip

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

      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
        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
forall a. [a] -> a
head
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
T.strip
        Text -> (Text -> Maybe [Text]) -> Maybe [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Maybe [Text]
`matchRegexUnifySpaces` Text
"Redundant constraints?: (.+)")
        Maybe [Text] -> ([Text] -> [Text]) -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> (Text -> [Text]) -> [Text] -> [Text]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> [Text]
parseConstraints)

      -- If the type signature is not formatted as expected (arbitrary number of spaces,
      -- line feeds...), just fail.
      findConstraints :: T.Text -> T.Text -> Maybe T.Text
      findConstraints :: Text -> Text -> Maybe Text
findConstraints Text
contents Text
typeSignatureName = do
        Text
constraints <- Text
contents
          Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Text -> Text -> [Text]
T.splitOn (Text
typeSignatureName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: ")
          [Text] -> ([Text] -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
& ([Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`atMay` Int
1)
          Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> [Text]
T.splitOn Text
" => " (Text -> [Text]) -> ([Text] -> Maybe Text) -> Text -> Maybe Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`atMay` Int
0))
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Bool
`T.isInfixOf` Text
constraints Bool -> Bool -> Bool
|| Text -> Text
T.strip Text
constraints Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
constraints
        Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
constraints

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

      formatConstraintsWithArrow :: [T.Text] -> T.Text
      formatConstraintsWithArrow :: [Text] -> Text
formatConstraintsWithArrow [] = Text
""
      formatConstraintsWithArrow [Text]
cs = [Text]
cs [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
formatConstraints Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => ")

      buildNewConstraints :: [T.Text] -> [T.Text] -> T.Text
      buildNewConstraints :: [Text] -> [Text] -> Text
buildNewConstraints [Text]
constraintList [Text]
redundantConstraintList =
        [Text] -> Text
formatConstraintsWithArrow ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
constraintList [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
redundantConstraintList

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

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

suggestNewImport :: ExportsMap -> ParsedModule -> Diagnostic -> [(T.Text, [TextEdit])]
suggestNewImport :: ExportsMap -> ParsedModule -> Diagnostic -> [(Text, [TextEdit])]
suggestNewImport ExportsMap
packageExportsMap ParsedModule {pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule {[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (Located [LIE GhcPs])
Maybe LHsDocString
Maybe (Located WarningTxt)
Maybe (Located ModuleName)
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodName :: Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
..}} Diagnostic{Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message}
  | Text
msg <- Text -> Text
unifySpaces Text
_message
  , Just NotInScope
thingMissing <- Text -> Maybe NotInScope
extractNotInScopeName Text
msg
  , Maybe Text
qual <- Text -> Maybe Text
extractQualifiedModuleName Text
msg
  , Just Int
insertLine <- case [LImportDecl GhcPs]
hsmodImports of
        [] -> case SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc) -> SrcSpan -> SrcLoc
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc ([LHsDecl GhcPs] -> LHsDecl GhcPs
forall a. [a] -> a
head [LHsDecl GhcPs]
hsmodDecls) of
          RealSrcLoc RealSrcLoc
s -> 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 RealSrcLoc
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          SrcLoc
_ -> Maybe Int
forall a. Maybe a
Nothing
        [LImportDecl GhcPs]
_ -> case SrcSpan -> SrcLoc
srcSpanEnd (SrcSpan -> SrcLoc) -> SrcSpan -> SrcLoc
forall a b. (a -> b) -> a -> b
$ LImportDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc ([LImportDecl GhcPs] -> LImportDecl GhcPs
forall a. [a] -> a
last [LImportDecl GhcPs]
hsmodImports) of
          RealSrcLoc RealSrcLoc
s -> 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 RealSrcLoc
s
          SrcLoc
_ -> Maybe Int
forall a. Maybe a
Nothing
  , Position
insertPos <- Int -> Int -> Position
Position Int
insertLine Int
0
  , Maybe [Text]
extendImportSuggestions <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
msg
    Text
"Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"
  = [(Text
imp, [Range -> Text -> TextEdit
TextEdit (Position -> Position -> Range
Range Position
insertPos Position
insertPos) (Text
imp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")])
    | Text
imp <- [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ExportsMap -> (Maybe Text, NotInScope) -> Maybe [Text] -> [Text]
constructNewImportSuggestions ExportsMap
packageExportsMap (Maybe Text
qual, NotInScope
thingMissing) Maybe [Text]
extendImportSuggestions
    ]
suggestNewImport ExportsMap
_ ParsedModule
_ Diagnostic
_ = []

constructNewImportSuggestions
  :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [T.Text]
constructNewImportSuggestions :: ExportsMap -> (Maybe Text, NotInScope) -> Maybe [Text] -> [Text]
constructNewImportSuggestions ExportsMap
exportsMap (Maybe Text
qual, NotInScope
thingMissing) Maybe [Text]
notTheseModules = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd
  [ Text
suggestion
  | Just Text
name <- [Text -> Text -> Maybe Text
T.stripPrefix (Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") Maybe Text
qual) (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ NotInScope -> Text
notInScope NotInScope
thingMissing]
  , IdentInfo
identInfo <- [IdentInfo]
-> (HashSet IdentInfo -> [IdentInfo])
-> Maybe (HashSet IdentInfo)
-> [IdentInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList (Maybe (HashSet IdentInfo) -> [IdentInfo])
-> Maybe (HashSet IdentInfo) -> [IdentInfo]
forall a b. (a -> b) -> a -> b
$ Text
-> HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
name (ExportsMap -> HashMap Text (HashSet IdentInfo)
getExportsMap ExportsMap
exportsMap)
  , NotInScope -> IdentInfo -> Bool
canUseIdent NotInScope
thingMissing IdentInfo
identInfo
  , IdentInfo -> Text
moduleNameText IdentInfo
identInfo Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
notTheseModules
  , Text
suggestion <- IdentInfo -> [Text]
renderNewImport IdentInfo
identInfo
  ]
 where
  renderNewImport :: IdentInfo -> [T.Text]
  renderNewImport :: IdentInfo -> [Text]
renderNewImport IdentInfo
identInfo
    | Just Text
q <- Maybe Text
qual
    , Text
asQ <- if Text
q Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
m then Text
"" else Text
" as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q
    = [Text
"import qualified " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
asQ]
    | Bool
otherwise
    = [Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" 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
")"
      | 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] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
      [Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
m ]
    where
        m :: Text
m = IdentInfo -> Text
moduleNameText IdentInfo
identInfo

canUseIdent :: NotInScope -> IdentInfo -> Bool
canUseIdent :: NotInScope -> IdentInfo -> Bool
canUseIdent NotInScopeDataConstructor{} = IdentInfo -> Bool
isDatacon
canUseIdent NotInScope
_                           = Bool -> IdentInfo -> Bool
forall a b. a -> b -> a
const Bool
True

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

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

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

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

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


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

extractWildCardTypeSignature :: T.Text -> T.Text
extractWildCardTypeSignature :: Text -> Text
extractWildCardTypeSignature =
  -- inferring when parens are actually needed around the type signature would
  -- require understanding both the precedence of the context of the _ and of
  -- the signature itself. Inserting them unconditionally is ugly but safe.
  (Text
"(" Text -> Text -> Text
`T.append`) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
`T.append` Text
")") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'’') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'‘') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'‘') (Text -> Text) -> (Text -> Text) -> 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
. Text -> Text -> (Text, Text)
T.breakOnEnd Text
"standing for "

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

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

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

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

-- | Returns the ranges for a binding in an import declaration
rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range]
rangesForBindingImport :: ImportDecl GhcPs -> FilePath -> [Range]
rangesForBindingImport ImportDecl{ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding = Just (Bool
False, L SrcSpan
_ [LIE GhcPs]
lies)} FilePath
b =
    (LIE GhcPs -> [Range]) -> [LIE GhcPs] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SrcSpan -> Maybe Range) -> [SrcSpan] -> [Range]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SrcSpan -> Maybe Range
srcSpanToRange ([SrcSpan] -> [Range])
-> (LIE GhcPs -> [SrcSpan]) -> LIE GhcPs -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> LIE GhcPs -> [SrcSpan]
rangesForBinding' FilePath
b') [LIE GhcPs]
lies
  where
    b' :: FilePath
b' = ShowS
modifyBinding FilePath
b
rangesForBindingImport ImportDecl GhcPs
_ FilePath
_ = []

modifyBinding :: String -> String
modifyBinding :: ShowS
modifyBinding = ShowS
wrapOperatorInParens ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unqualify
  where
    wrapOperatorInParens :: ShowS
wrapOperatorInParens FilePath
x = if Char -> Bool
isAlpha (FilePath -> Char
forall a. [a] -> a
head FilePath
x) then FilePath
x else FilePath
"(" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
x FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
")"
    unqualify :: ShowS
unqualify FilePath
x = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath) -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> (FilePath, FilePath)
forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOnEnd FilePath
"." FilePath
x

smallerRangesForBindingExport :: [LIE GhcPs] -> String -> [Range]
smallerRangesForBindingExport :: [LIE GhcPs] -> FilePath -> [Range]
smallerRangesForBindingExport [LIE GhcPs]
lies FilePath
b =
    (LIE GhcPs -> [Range]) -> [LIE GhcPs] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SrcSpan -> Maybe Range) -> [SrcSpan] -> [Range]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SrcSpan -> Maybe Range
srcSpanToRange ([SrcSpan] -> [Range])
-> (LIE GhcPs -> [SrcSpan]) -> LIE GhcPs -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> [SrcSpan]
ranges') [LIE GhcPs]
lies
  where
    b' :: FilePath
b' = ShowS
modifyBinding FilePath
b
    ranges' :: LIE GhcPs -> [SrcSpan]
ranges' (L SrcSpan
_ (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
thing IEWildcard
_  [LIEWrappedName (IdP GhcPs)]
inners [Located (FieldLbl (IdP GhcPs))]
labels))
      | SDoc -> FilePath
showSDocUnsafe (LIEWrappedName RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
thing) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b' = []
      | Bool
otherwise =
          [ SrcSpan
l' | L SrcSpan
l' IEWrappedName RdrName
x <- [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
inners, SDoc -> FilePath
showSDocUnsafe (IEWrappedName RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IEWrappedName RdrName
x) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b'] [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++
          [ SrcSpan
l' | L SrcSpan
l' FieldLbl RdrName
x <- [Located (FieldLbl (IdP GhcPs))]
[GenLocated SrcSpan (FieldLbl RdrName)]
labels, SDoc -> FilePath
showSDocUnsafe (FieldLbl RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLbl RdrName
x) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b']
    ranges' LIE GhcPs
_ = []

rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]
rangesForBinding' :: FilePath -> LIE GhcPs -> [SrcSpan]
rangesForBinding' FilePath
b (L SrcSpan
l x :: IE GhcPs
x@IEVar{}) | SDoc -> FilePath
showSDocUnsafe (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
x) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b = [SrcSpan
l]
rangesForBinding' FilePath
b (L SrcSpan
l x :: IE GhcPs
x@IEThingAbs{}) | SDoc -> FilePath
showSDocUnsafe (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
x) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b = [SrcSpan
l]
rangesForBinding' FilePath
b (L SrcSpan
l (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
x)) | SDoc -> FilePath
showSDocUnsafe (LIEWrappedName RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b = [SrcSpan
l]
rangesForBinding' FilePath
b (L SrcSpan
l (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
thing IEWildcard
_  [LIEWrappedName (IdP GhcPs)]
inners [Located (FieldLbl (IdP GhcPs))]
labels))
    | SDoc -> FilePath
showSDocUnsafe (LIEWrappedName RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
thing) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b = [SrcSpan
l]
    | Bool
otherwise =
        [ SrcSpan
l' | L SrcSpan
l' IEWrappedName RdrName
x <- [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
inners, SDoc -> FilePath
showSDocUnsafe (IEWrappedName RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IEWrappedName RdrName
x) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b] [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++
        [ SrcSpan
l' | L SrcSpan
l' FieldLbl RdrName
x <- [Located (FieldLbl (IdP GhcPs))]
[GenLocated SrcSpan (FieldLbl RdrName)]
labels, SDoc -> FilePath
showSDocUnsafe (FieldLbl RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLbl RdrName
x) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b]
rangesForBinding' FilePath
_ LIE GhcPs
_ = []

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

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

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

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


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

-- functions to help parse multiple import suggestions

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

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

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

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

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

    | ImportViaParent T.Text T.Text
      -- ^ Import an export (first parameter) through its parent (second
      -- parameter).
      --
      -- import M (P(?))
      --
      -- @P@ and @?@ can be a data type and a constructor, a class and a method,
      -- a class and an associated type/data family, etc.
  deriving Int -> ImportStyle -> ShowS
[ImportStyle] -> ShowS
ImportStyle -> FilePath
(Int -> ImportStyle -> ShowS)
-> (ImportStyle -> FilePath)
-> ([ImportStyle] -> ShowS)
-> Show ImportStyle
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ImportStyle] -> ShowS
$cshowList :: [ImportStyle] -> ShowS
show :: ImportStyle -> FilePath
$cshow :: ImportStyle -> FilePath
showsPrec :: Int -> ImportStyle -> ShowS
$cshowsPrec :: Int -> ImportStyle -> ShowS
Show

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

renderImportStyle :: ImportStyle -> T.Text
renderImportStyle :: ImportStyle -> Text
renderImportStyle (ImportTopLevel Text
x) = Text
x
renderImportStyle (ImportViaParent Text
x Text
p) = Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Find the first non-blank line before the first of (module name / imports / declarations).
-- Useful for inserting pragmas.
endOfModuleHeader :: ParsedModule -> Maybe T.Text -> Range
endOfModuleHeader :: ParsedModule -> Maybe Text -> Range
endOfModuleHeader ParsedModule
pm Maybe Text
contents =
    let mod :: SrcSpanLess ParsedSource
mod = ParsedSource -> SrcSpanLess ParsedSource
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ParsedSource -> SrcSpanLess ParsedSource)
-> ParsedSource -> SrcSpanLess ParsedSource
forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm
        modNameLoc :: Maybe SrcSpan
modNameLoc = Located ModuleName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located ModuleName -> SrcSpan)
-> Maybe (Located ModuleName) -> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsModule GhcPs -> Maybe (Located ModuleName)
forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodName HsModule GhcPs
SrcSpanLess ParsedSource
mod
        firstImportLoc :: Maybe SrcSpan
firstImportLoc = LImportDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LImportDecl GhcPs -> SrcSpan)
-> Maybe (LImportDecl GhcPs) -> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs)
forall a. [a] -> Maybe a
listToMaybe (HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports HsModule GhcPs
SrcSpanLess ParsedSource
mod)
        firstDeclLoc :: Maybe SrcSpan
firstDeclLoc = LHsDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LHsDecl GhcPs -> SrcSpan)
-> Maybe (LHsDecl GhcPs) -> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs] -> Maybe (LHsDecl GhcPs)
forall a. [a] -> Maybe a
listToMaybe (HsModule GhcPs -> [LHsDecl GhcPs]
forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls HsModule GhcPs
SrcSpanLess ParsedSource
mod)
        line :: Int
line = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
firstNonBlankBefore (Int -> Maybe Int) -> (Range -> Int) -> Range -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int
_line (Position -> Int) -> (Range -> Position) -> Range -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Position
_start (Range -> Maybe Int) -> Maybe Range -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SrcSpan -> Maybe Range
srcSpanToRange (SrcSpan -> Maybe Range) -> Maybe SrcSpan -> Maybe Range
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
            Maybe SrcSpan
modNameLoc Maybe SrcSpan -> Maybe SrcSpan -> Maybe SrcSpan
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SrcSpan
firstImportLoc Maybe SrcSpan -> Maybe SrcSpan -> Maybe SrcSpan
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SrcSpan
firstDeclLoc
        firstNonBlankBefore :: Int -> Maybe Int
firstNonBlankBefore Int
n = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> (Text -> Maybe Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> Maybe Int) -> (Text -> [Text]) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
n ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> Int) -> Maybe Text -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
contents
        loc :: Position
loc = Int -> Int -> Position
Position Int
line Int
0
     in Position -> Position -> Range
Range Position
loc Position
loc