{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
#include "ghc-api-version.h"
module Development.IDE.Plugin.CodeAction
( descriptor
, matchRegExMultipleImports
) where
import Bag (isEmptyBag)
import Control.Applicative ((<|>))
import Control.Arrow (second,
(>>>))
import Control.Concurrent.Extra (readVar)
import Control.Monad (guard, join)
import Control.Monad.IO.Class
import Data.Char
import qualified Data.DList as DL
import Data.Function
import Data.Functor
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import Data.List.Extra
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Rope.UTF16 as Rope
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Tuple.Extra (fst3)
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Rules
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint
import Development.IDE.GHC.Util (prettyPrint,
printRdrName,
unsafePrintSDoc)
import Development.IDE.Plugin.CodeAction.Args
import Development.IDE.Plugin.CodeAction.ExactPrint
import Development.IDE.Plugin.CodeAction.PositionIndexed
import Development.IDE.Plugin.TypeLenses (GetGlobalBindingTypeSigs (GetGlobalBindingTypeSigs),
suggestSignature)
import Development.IDE.Spans.Common
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import qualified GHC.LanguageExtensions as Lang
import HscTypes (ImportedModsVal (..),
importedByUser)
import Ide.PluginUtils (subRange)
import Ide.Types
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import Language.LSP.VFS
import Module (moduleEnvElts)
import OccName
import Outputable (Outputable,
ppr,
showSDoc,
showSDocUnsafe)
import RdrName (GlobalRdrElt (..),
lookupGlobalRdrEnv)
import Safe (atMay)
import SrcLoc (realSrcSpanEnd,
realSrcSpanStart)
import TcRnTypes (ImportAvails (..),
TcGblEnv (..))
import Text.Regex.TDFA (mrAfter,
(=~), (=~~))
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
}
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, Maybe (Maybe Bindings) -> Maybe Bindings
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe Bindings
bindings, Maybe (Maybe GlobalBindingTypeSigsResult)
-> Maybe GlobalBindingTypeSigsResult
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe GlobalBindingTypeSigsResult
gblSigs) <- FilePath
-> IdeState
-> Action
(IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult))
-> IO
(IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult))
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),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult))
-> IO
(IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
-> Action
(IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult))
-> IO
(IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult))
forall a b. (a -> b) -> a -> b
$
(,,,,,,,) (IdeOptions
-> Maybe (Maybe ParsedModule)
-> Maybe (Maybe HscEnvEq)
-> Maybe (Maybe (Annotated ParsedSource))
-> Maybe (Maybe TcModuleResult)
-> Maybe (Maybe HieAstResult)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
-> Action IdeOptions
-> Action
(Maybe (Maybe ParsedModule)
-> Maybe (Maybe HscEnvEq)
-> Maybe (Maybe (Annotated ParsedSource))
-> Maybe (Maybe TcModuleResult)
-> Maybe (Maybe HieAstResult)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
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)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
-> Action (Maybe (Maybe ParsedModule))
-> Action
(Maybe (Maybe HscEnvEq)
-> Maybe (Maybe (Annotated ParsedSource))
-> Maybe (Maybe TcModuleResult)
-> Maybe (Maybe HieAstResult)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
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)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
-> Action (Maybe (Maybe HscEnvEq))
-> Action
(Maybe (Maybe (Annotated ParsedSource))
-> Maybe (Maybe TcModuleResult)
-> Maybe (Maybe HieAstResult)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
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)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
-> Action (Maybe (Maybe (Annotated ParsedSource)))
-> Action
(Maybe (Maybe TcModuleResult)
-> Maybe (Maybe HieAstResult)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
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)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
-> Action (Maybe (Maybe TcModuleResult))
-> Action
(Maybe (Maybe HieAstResult)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
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)
-> Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
-> Action (Maybe (Maybe HieAstResult))
-> Action
(Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
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
Action
(Maybe (Maybe Bindings)
-> Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
-> Action (Maybe (Maybe Bindings))
-> Action
(Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GetBindings -> NormalizedFilePath -> Action (Maybe Bindings)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetBindings
GetBindings (NormalizedFilePath -> Action (Maybe Bindings))
-> Maybe NormalizedFilePath -> Action (Maybe (Maybe Bindings))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Maybe NormalizedFilePath
mbFile
Action
(Maybe (Maybe GlobalBindingTypeSigsResult)
-> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult)))
-> Action (Maybe (Maybe GlobalBindingTypeSigsResult))
-> Action
(IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
Maybe (Maybe (Annotated ParsedSource)),
Maybe (Maybe TcModuleResult), Maybe (Maybe HieAstResult),
Maybe (Maybe Bindings), Maybe (Maybe GlobalBindingTypeSigsResult))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GetGlobalBindingTypeSigs
-> NormalizedFilePath -> Action (Maybe GlobalBindingTypeSigsResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetGlobalBindingTypeSigs
GetGlobalBindingTypeSigs (NormalizedFilePath -> Action (Maybe GlobalBindingTypeSigsResult))
-> Maybe NormalizedFilePath
-> Action (Maybe (Maybe GlobalBindingTypeSigsResult))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Maybe NormalizedFilePath
mbFile
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
-> Maybe CodeActionKind
-> Maybe Bool
-> [Diagnostic]
-> WorkspaceEdit
-> Command |? CodeAction
mkCA Text
title Maybe CodeActionKind
kind Maybe Bool
isPreferred [Diagnostic
x] WorkspaceEdit
edit
| Diagnostic
x <- [Diagnostic]
xs, (Text
title, Maybe CodeActionKind
kind, Maybe Bool
isPreferred, [TextEdit]
tedit) <- CodeActionArgs -> GhcideCodeActions
suggestAction (CodeActionArgs -> GhcideCodeActions)
-> CodeActionArgs -> GhcideCodeActions
forall a b. (a -> b) -> a -> b
$ ExportsMap
-> IdeOptions
-> Maybe ParsedModule
-> Maybe Text
-> Maybe DynFlags
-> Maybe (Annotated ParsedSource)
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Maybe Bindings
-> Maybe GlobalBindingTypeSigsResult
-> Diagnostic
-> CodeActionArgs
CodeActionArgs ExportsMap
exportsMap IdeOptions
ideOptions Maybe ParsedModule
parsedModule Maybe Text
text Maybe DynFlags
df Maybe (Annotated ParsedSource)
annotatedPS Maybe TcModuleResult
tcM Maybe HieAstResult
har Maybe Bindings
bindings Maybe GlobalBindingTypeSigsResult
gblSigs Diagnostic
x
, let edit :: WorkspaceEdit
edit = Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> 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 Maybe ChangeAnnotationMap
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 -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction)
mkCA :: Text
-> Maybe CodeActionKind
-> Maybe Bool
-> [Diagnostic]
-> WorkspaceEdit
-> Command |? CodeAction
mkCA Text
title Maybe CodeActionKind
kind Maybe Bool
isPreferred [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
-> Maybe Value
-> CodeAction
CodeAction Text
title Maybe CodeActionKind
kind (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
isPreferred 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 Maybe Value
forall a. Maybe a
Nothing
suggestAction :: CodeActionArgs -> GhcideCodeActions
suggestAction :: CodeActionArgs -> GhcideCodeActions
suggestAction CodeActionArgs
caa =
[GhcideCodeActions] -> GhcideCodeActions
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ (Maybe GlobalBindingTypeSigsResult
-> Maybe TcModuleResult
-> Maybe Bindings
-> Diagnostic
-> [(Text, [TextEdit])])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap ((Maybe GlobalBindingTypeSigsResult
-> Maybe TcModuleResult
-> Maybe Bindings
-> Diagnostic
-> [(Text, [TextEdit])])
-> GhcideCodeActions)
-> (Maybe GlobalBindingTypeSigsResult
-> Maybe TcModuleResult
-> Maybe Bindings
-> Diagnostic
-> [(Text, [TextEdit])])
-> GhcideCodeActions
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe GlobalBindingTypeSigsResult
-> Maybe TcModuleResult
-> Maybe Bindings
-> Diagnostic
-> [(Text, [TextEdit])]
suggestSignature Bool
True
, (ExportsMap
-> ParsedSource -> Diagnostic -> [(Text, CodeActionKind, Rewrite)])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap ExportsMap
-> ParsedSource -> Diagnostic -> [(Text, CodeActionKind, Rewrite)]
suggestExtendImport
, (DynFlags
-> Maybe Text
-> ParsedSource
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap DynFlags
-> Maybe Text
-> ParsedSource
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])]
suggestImportDisambiguation
, (ExportsMap
-> ParsedSource
-> Diagnostic
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap ExportsMap
-> ParsedSource
-> Diagnostic
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
suggestNewOrExtendImportForClassMethod
, (Diagnostic -> [(Text, TextEdit)]) -> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap Diagnostic -> [(Text, TextEdit)]
suggestFillTypeWildcard
, (Diagnostic -> [(Text, TextEdit)]) -> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap Diagnostic -> [(Text, TextEdit)]
suggestFixConstructorImport
, (Diagnostic -> [(Text, TextEdit)]) -> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap Diagnostic -> [(Text, TextEdit)]
suggestModuleTypo
, (Maybe Text -> Diagnostic -> [(Text, [TextEdit])])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestReplaceIdentifier
, (Maybe Text -> Diagnostic -> [(Text, TextEdit)])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap Maybe Text -> Diagnostic -> [(Text, TextEdit)]
removeRedundantConstraints
, (Maybe Text -> Diagnostic -> [(Text, [TextEdit])])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyContraints
, (DynFlags -> ParsedSource -> Diagnostic -> [(Text, Rewrite)])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap DynFlags -> ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestConstraint
, (ParsedSource -> Diagnostic -> [(Text, Rewrite)])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestImplicitParameter
, (ParsedSource
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap ParsedSource
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])]
suggestHideShadow
, (IdeOptions
-> ParsedModule
-> Maybe Text
-> Diagnostic
-> [(Text, [TextEdit])])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap IdeOptions
-> ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestNewDefinition
, (ExportsMap
-> ParsedSource
-> Diagnostic
-> [(Text, CodeActionKind, TextEdit)])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap ExportsMap
-> ParsedSource -> Diagnostic -> [(Text, CodeActionKind, TextEdit)]
suggestNewImport
, (ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDeleteUnusedBinding
, (Maybe Text -> ParsedModule -> Diagnostic -> [(Text, TextEdit)])
-> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap Maybe Text -> ParsedModule -> Diagnostic -> [(Text, TextEdit)]
suggestExportUnusedTopBinding
, (Diagnostic -> [(Text, TextEdit)]) -> GhcideCodeActions
forall a. ToCodeAction a => a -> GhcideCodeActions
wrap Diagnostic -> [(Text, TextEdit)]
suggestFillHole
]
where
wrap :: ToCodeAction a => a -> GhcideCodeActions
wrap :: a -> GhcideCodeActions
wrap = CodeActionArgs -> a -> GhcideCodeActions
forall a.
ToCodeAction a =>
CodeActionArgs -> a -> GhcideCodeActions
toCodeAction CodeActionArgs
caa
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)
suggestHideShadow :: ParsedSource -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])]
suggestHideShadow :: ParsedSource
-> Maybe TcModuleResult
-> Maybe HieAstResult
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])]
suggestHideShadow ps :: ParsedSource
ps@(L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports}) Maybe TcModuleResult
mTcM Maybe HieAstResult
mHar Diagnostic {Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message :: Text
_message, Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range :: Range
_range}
| Just [Text
identifier, Text
modName, Text
s] <-
Text -> Text -> Maybe [Text]
matchRegexUnifySpaces
Text
_message
Text
"This binding for ‘([^`]+)’ shadows the existing binding imported from ‘([^`]+)’ at ([^ ]*)" =
Text -> Text -> Text -> [(Text, [Either TextEdit Rewrite])]
suggests Text
identifier Text
modName Text
s
| Just [Text
identifier] <-
Text -> Text -> Maybe [Text]
matchRegexUnifySpaces
Text
_message
Text
"This binding for ‘([^`]+)’ shadows the existing bindings",
Just [[Text]]
matched <- Text -> Text -> Maybe [[Text]]
allMatchRegexUnifySpaces Text
_message Text
"imported from ‘([^’]+)’ at ([^ ]*)",
[(Text, Text)]
mods <- [(Text
modName, Text
s) | [Text
_, Text
modName, Text
s] <- [[Text]]
matched],
[(Text, [Either TextEdit Rewrite])]
result <- ((Text, [Either TextEdit Rewrite])
-> (Text, [Either TextEdit Rewrite]) -> Ordering)
-> [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> ((Text, [Either TextEdit Rewrite]) -> Text)
-> (Text, [Either TextEdit Rewrite])
-> (Text, [Either TextEdit Rewrite])
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text, [Either TextEdit Rewrite]) -> Text
forall a b. (a, b) -> a
fst) ([(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])])
-> [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
mods [(Text, Text)]
-> ((Text, Text) -> [(Text, [Either TextEdit Rewrite])])
-> [(Text, [Either TextEdit Rewrite])]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> [(Text, [Either TextEdit Rewrite])])
-> (Text, Text) -> [(Text, [Either TextEdit Rewrite])]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Text -> Text -> Text -> [(Text, [Either TextEdit Rewrite])]
suggests Text
identifier),
(Text, [Either TextEdit Rewrite])
hideAll <- (Text
"Hide " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from all occurence imports", [[Either TextEdit Rewrite]] -> [Either TextEdit Rewrite]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either TextEdit Rewrite]] -> [Either TextEdit Rewrite])
-> [[Either TextEdit Rewrite]] -> [Either TextEdit Rewrite]
forall a b. (a -> b) -> a -> b
$ (Text, [Either TextEdit Rewrite]) -> [Either TextEdit Rewrite]
forall a b. (a, b) -> b
snd ((Text, [Either TextEdit Rewrite]) -> [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])]
-> [[Either TextEdit Rewrite]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [Either TextEdit Rewrite])]
result) =
[(Text, [Either TextEdit Rewrite])]
result [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
forall a. Semigroup a => a -> a -> a
<> [(Text, [Either TextEdit Rewrite])
hideAll]
| Bool
otherwise = []
where
suggests :: Text -> Text -> Text -> [(Text, [Either TextEdit Rewrite])]
suggests Text
identifier Text
modName Text
s
| Just TcModuleResult
tcM <- Maybe TcModuleResult
mTcM,
Just HieAstResult
har <- Maybe HieAstResult
mHar,
[RealSrcSpan
s'] <- [RealSrcSpan
x | (RealSrcSpan
x, FilePath
"") <- ReadS RealSrcSpan
readSrcSpan ReadS RealSrcSpan -> ReadS RealSrcSpan
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
s],
TcModuleResult
-> HieAstResult -> FilePath -> FilePath -> SrcSpan -> Bool
isUnusedImportedId TcModuleResult
tcM HieAstResult
har (Text -> FilePath
T.unpack Text
identifier) (Text -> FilePath
T.unpack Text
modName) (RealSrcSpan -> 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 Maybe (Text, [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])]
forall a. Maybe a -> [a]
maybeToList (Maybe (Text, [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])])
-> Maybe (Text, [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])]
forall a b. (a -> b) -> a -> b
$ (\(Text
_, TextEdit
te) -> (Text
title, [TextEdit -> Either TextEdit Rewrite
forall a b. a -> Either a b
Left TextEdit
te])) ((Text, TextEdit) -> (Text, [Either TextEdit Rewrite]))
-> Maybe (Text, TextEdit)
-> Maybe (Text, [Either TextEdit Rewrite])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewImport -> ParsedSource -> Maybe (Text, TextEdit)
newImportToEdit (Text -> NewImport
hideImplicitPreludeSymbol Text
identifier) ParsedSource
ps
else Maybe (Text, [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])]
forall a. Maybe a -> [a]
maybeToList (Maybe (Text, [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])])
-> Maybe (Text, [Either TextEdit Rewrite])
-> [(Text, [Either TextEdit Rewrite])]
forall a b. (a -> b) -> a -> b
$ (Text
title,) ([Either TextEdit Rewrite] -> (Text, [Either TextEdit Rewrite]))
-> (LImportDecl GhcPs -> [Either TextEdit Rewrite])
-> LImportDecl GhcPs
-> (Text, [Either TextEdit Rewrite])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TextEdit Rewrite -> [Either TextEdit Rewrite]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TextEdit Rewrite -> [Either TextEdit Rewrite])
-> (LImportDecl GhcPs -> Either TextEdit Rewrite)
-> LImportDecl GhcPs
-> [Either TextEdit Rewrite]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rewrite -> Either TextEdit Rewrite
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rewrite -> Either TextEdit Rewrite)
-> (LImportDecl GhcPs -> Rewrite)
-> LImportDecl GhcPs
-> Either TextEdit Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> LImportDecl GhcPs -> Rewrite
hideSymbol (Text -> FilePath
T.unpack Text
identifier) (LImportDecl GhcPs -> (Text, [Either TextEdit Rewrite]))
-> Maybe (LImportDecl GhcPs)
-> Maybe (Text, [Either TextEdit Rewrite])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LImportDecl GhcPs)
mDecl
| Bool
otherwise = []
findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName :: [LImportDecl GhcPs] -> FilePath -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
decls FilePath
modName = ((LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs))
-> [LImportDecl GhcPs]
-> (LImportDecl GhcPs -> Bool)
-> Maybe (LImportDecl GhcPs)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find [LImportDecl GhcPs]
decls ((LImportDecl GhcPs -> Bool) -> Maybe (LImportDecl GhcPs))
-> (LImportDecl GhcPs -> Bool) -> Maybe (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ \case
(L SrcSpan
_ ImportDecl {Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
SourceText
Located ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> Bool
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: Bool
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..}) -> FilePath
modName FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName -> FilePath
moduleNameString (Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
ideclName)
LImportDecl GhcPs
_ -> FilePath -> Bool
forall a. HasCallStack => FilePath -> a
error FilePath
"impossible"
isTheSameLine :: SrcSpan -> SrcSpan -> Bool
isTheSameLine :: SrcSpan -> SrcSpan -> Bool
isTheSameLine SrcSpan
s1 SrcSpan
s2
| Just Int
sl1 <- SrcSpan -> Maybe Int
getStartLine SrcSpan
s1,
Just Int
sl2 <- SrcSpan -> Maybe Int
getStartLine SrcSpan
s2 =
Int
sl1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl2
| Bool
otherwise = Bool
False
where
getStartLine :: SrcSpan -> Maybe Int
getStartLine SrcSpan
x = RealSrcLoc -> Int
srcLocLine (RealSrcLoc -> Int)
-> (RealSrcSpan -> RealSrcLoc) -> RealSrcSpan -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> RealSrcLoc
realSrcSpanStart (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe RealSrcSpan
realSpan SrcSpan
x
isUnusedImportedId :: TcModuleResult -> HieAstResult -> String -> String -> SrcSpan -> Bool
isUnusedImportedId :: TcModuleResult
-> HieAstResult -> FilePath -> FilePath -> SrcSpan -> Bool
isUnusedImportedId
TcModuleResult {tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTypechecked = TcGblEnv {tcg_imports :: TcGblEnv -> ImportAvails
tcg_imports = ImportAvails {ImportedMods
imp_mods :: ImportAvails -> ImportedMods
imp_mods :: ImportedMods
imp_mods}}}
HAR {RefMap a
refMap :: ()
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
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
$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
$sel:_message:Diagnostic :: Diagnostic -> Text
..}
| 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' ] )]
| 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
forall a. [TextEdit] -> a |? CodeAction
removeAll [TextEdit]
allEdits,
[(Diagnostic, (Text, [TextEdit]))]
ctxEdits <- [ (Diagnostic, (Text, [TextEdit]))
x | x :: (Diagnostic, (Text, [TextEdit]))
x@(Diagnostic
d, (Text, [TextEdit])
_) <- [(Diagnostic, (Text, [TextEdit]))]
r, Diagnostic
d Diagnostic -> [Diagnostic] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Diagnostic]
ctxDigs],
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Diagnostic, (Text, [TextEdit]))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Diagnostic, (Text, [TextEdit]))]
ctxEdits,
[Command |? CodeAction]
caRemoveCtx <- ((Diagnostic, (Text, [TextEdit])) -> Command |? CodeAction)
-> [(Diagnostic, (Text, [TextEdit]))] -> [Command |? CodeAction]
forall a b. (a -> b) -> [a] -> [b]
map (\(Diagnostic
d, (Text
title, [TextEdit]
tedit)) -> Text -> [TextEdit] -> Diagnostic -> Command |? CodeAction
removeSingle Text
title [TextEdit]
tedit Diagnostic
d) [(Diagnostic, (Text, [TextEdit]))]
ctxEdits
= [Command |? CodeAction]
caRemoveCtx [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall a. [a] -> [a] -> [a]
++ [Command |? CodeAction
caRemoveAll]
| Bool
otherwise = []
where
removeSingle :: Text -> [TextEdit] -> Diagnostic -> Command |? CodeAction
removeSingle Text
title [TextEdit]
tedit Diagnostic
diagnostic = Text
-> Maybe CodeActionKind
-> Maybe Bool
-> [Diagnostic]
-> WorkspaceEdit
-> Command |? CodeAction
mkCA Text
title (CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix) Maybe Bool
forall a. Maybe a
Nothing [Diagnostic
diagnostic] WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit{Maybe ChangeAnnotationMap
Maybe WorkspaceEditMap
Maybe (List DocumentChange)
forall a. Maybe a
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations :: forall a. Maybe a
_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
_changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing
removeAll :: [TextEdit] -> a |? CodeAction
removeAll [TextEdit]
tedit = CodeAction -> a |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> a |? CodeAction) -> CodeAction -> a |? CodeAction
forall a b. (a -> b) -> a -> b
$ CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction{Maybe Bool
Maybe Value
Maybe WorkspaceEdit
Maybe Reason
Maybe CodeActionKind
Maybe Command
Maybe (List Diagnostic)
Text
forall a. Maybe a
$sel:_title:CodeAction :: Text
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_disabled:CodeAction :: Maybe Reason
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
$sel:_xdata:CodeAction :: Maybe Value
_xdata :: forall a. Maybe a
_disabled :: forall a. Maybe a
_command :: forall a. Maybe a
_isPreferred :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_diagnostics :: forall a. Maybe a
_kind :: Maybe CodeActionKind
_title :: Text
..} where
_changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit
_title :: Text
_title = Text
"Remove all redundant imports"
_kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
_diagnostics :: Maybe a
_diagnostics = Maybe a
forall a. Maybe a
Nothing
_documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
_edit :: Maybe WorkspaceEdit
_edit = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit{Maybe ChangeAnnotationMap
Maybe WorkspaceEditMap
Maybe (List DocumentChange)
forall a. Maybe a
_changeAnnotations :: forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
..}
_isPreferred :: Maybe a
_isPreferred = Maybe a
forall a. Maybe a
Nothing
_command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
_disabled :: Maybe a
_disabled = Maybe a
forall a. Maybe a
Nothing
_xdata :: Maybe a
_xdata = Maybe a
forall a. Maybe a
Nothing
_changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing
caRemoveInvalidExports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [Command |? CodeAction]
caRemoveInvalidExports :: Maybe ParsedModule
-> Maybe Text
-> [Diagnostic]
-> [Diagnostic]
-> Uri
-> [Command |? CodeAction]
caRemoveInvalidExports Maybe ParsedModule
m Maybe Text
contents [Diagnostic]
digs [Diagnostic]
ctxDigs Uri
uri
| Just ParsedModule
pm <- Maybe ParsedModule
m,
Just Text
txt <- Maybe Text
contents,
PositionIndexedString
txt' <- FilePath -> PositionIndexedString
indexedByPosition (FilePath -> PositionIndexedString)
-> FilePath -> PositionIndexedString
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
txt,
[(Text, Diagnostic, [Range])]
r <- (Diagnostic -> Maybe (Text, Diagnostic, [Range]))
-> [Diagnostic] -> [(Text, Diagnostic, [Range])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ParsedModule -> Diagnostic -> Maybe (Text, Diagnostic, [Range])
groupDiag ParsedModule
pm) [Diagnostic]
digs,
[(Text, Diagnostic, [Range])]
r' <- ((Text, Diagnostic, [Range]) -> (Text, Diagnostic, [Range]))
-> [(Text, Diagnostic, [Range])] -> [(Text, Diagnostic, [Range])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
t,Diagnostic
d,[Range]
rs) -> (Text
t,Diagnostic
d,PositionIndexedString -> [Range] -> [Range]
extend PositionIndexedString
txt' [Range]
rs)) [(Text, Diagnostic, [Range])]
r,
[Command |? CodeAction]
caRemoveCtx <- ((Text, Diagnostic, [Range]) -> Maybe (Command |? CodeAction))
-> [(Text, Diagnostic, [Range])] -> [Command |? CodeAction]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Diagnostic, [Range]) -> Maybe (Command |? CodeAction)
forall a. (Text, Diagnostic, [Range]) -> Maybe (a |? 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)
forall a. [Range] -> Maybe (a |? 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 (a |? CodeAction)
removeSingle (Text
_, Diagnostic
_, []) = Maybe (a |? CodeAction)
forall a. Maybe a
Nothing
removeSingle (Text
title, Diagnostic
diagnostic, [Range]
ranges) = (a |? CodeAction) -> Maybe (a |? CodeAction)
forall a. a -> Maybe a
Just ((a |? CodeAction) -> Maybe (a |? CodeAction))
-> (a |? CodeAction) -> Maybe (a |? CodeAction)
forall a b. (a -> b) -> a -> b
$ CodeAction -> a |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> a |? CodeAction) -> CodeAction -> a |? CodeAction
forall a b. (a -> b) -> a -> b
$ CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction{Maybe Bool
Maybe Value
Maybe WorkspaceEdit
Maybe Reason
Maybe CodeActionKind
Maybe Command
Maybe (List Diagnostic)
Text
forall a. Maybe a
_xdata :: forall a. Maybe a
_disabled :: forall a. Maybe a
_isPreferred :: forall a. Maybe a
_command :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_diagnostics :: Maybe (List Diagnostic)
_kind :: Maybe CodeActionKind
_title :: Text
$sel:_title:CodeAction :: Text
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_disabled:CodeAction :: Maybe Reason
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
$sel:_xdata:CodeAction :: Maybe Value
..} where
tedit :: [TextEdit]
tedit = (Range -> [TextEdit]) -> [Range] -> [TextEdit]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Range
r -> [Range -> Text -> TextEdit
TextEdit Range
r Text
""]) ([Range] -> [TextEdit]) -> [Range] -> [TextEdit]
forall a b. (a -> b) -> a -> b
$ [Range] -> [Range]
forall a. Ord a => [a] -> [a]
nubOrd [Range]
ranges
_changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit
_title :: Text
_title = Text
title
_kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
_diagnostics :: Maybe (List Diagnostic)
_diagnostics = List Diagnostic -> Maybe (List Diagnostic)
forall a. a -> Maybe a
Just (List Diagnostic -> Maybe (List Diagnostic))
-> List Diagnostic -> Maybe (List Diagnostic)
forall a b. (a -> b) -> a -> b
$ [Diagnostic] -> List Diagnostic
forall a. [a] -> List a
List [Diagnostic
diagnostic]
_documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
_edit :: Maybe WorkspaceEdit
_edit = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit{Maybe ChangeAnnotationMap
Maybe WorkspaceEditMap
Maybe (List DocumentChange)
forall a. Maybe a
_changeAnnotations :: forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
..}
_command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
_isPreferred :: Maybe a
_isPreferred = Maybe a
forall a. Maybe a
Nothing
_disabled :: Maybe a
_disabled = Maybe a
forall a. Maybe a
Nothing
_xdata :: Maybe a
_xdata = Maybe a
forall a. Maybe a
Nothing
_changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing
removeAll :: [Range] -> Maybe (a |? CodeAction)
removeAll [] = Maybe (a |? CodeAction)
forall a. Maybe a
Nothing
removeAll [Range]
ranges = (a |? CodeAction) -> Maybe (a |? CodeAction)
forall a. a -> Maybe a
Just ((a |? CodeAction) -> Maybe (a |? CodeAction))
-> (a |? CodeAction) -> Maybe (a |? CodeAction)
forall a b. (a -> b) -> a -> b
$ CodeAction -> a |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> a |? CodeAction) -> CodeAction -> a |? CodeAction
forall a b. (a -> b) -> a -> b
$ CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction{Maybe Bool
Maybe Value
Maybe WorkspaceEdit
Maybe Reason
Maybe CodeActionKind
Maybe Command
Maybe (List Diagnostic)
Text
forall a. Maybe a
_xdata :: forall a. Maybe a
_disabled :: forall a. Maybe a
_isPreferred :: forall a. Maybe a
_command :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_diagnostics :: forall a. Maybe a
_kind :: Maybe CodeActionKind
_title :: Text
$sel:_title:CodeAction :: Text
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_disabled:CodeAction :: Maybe Reason
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
$sel:_xdata:CodeAction :: Maybe Value
..} where
tedit :: [TextEdit]
tedit = (Range -> [TextEdit]) -> [Range] -> [TextEdit]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Range
r -> [Range -> Text -> TextEdit
TextEdit Range
r Text
""]) [Range]
ranges
_changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit
_title :: Text
_title = Text
"Remove all redundant exports"
_kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
_diagnostics :: Maybe a
_diagnostics = Maybe a
forall a. Maybe a
Nothing
_documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
_edit :: Maybe WorkspaceEdit
_edit = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit{Maybe ChangeAnnotationMap
Maybe WorkspaceEditMap
Maybe (List DocumentChange)
forall a. Maybe a
_changeAnnotations :: forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
..}
_command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
_isPreferred :: Maybe a
_isPreferred = Maybe a
forall a. Maybe a
Nothing
_disabled :: Maybe a
_disabled = Maybe a
forall a. Maybe a
Nothing
_xdata :: Maybe a
_xdata = Maybe a
forall a. Maybe a
Nothing
_changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing
suggestRemoveRedundantExport :: ParsedModule -> Diagnostic -> Maybe (T.Text, [Range])
suggestRemoveRedundantExport :: ParsedModule -> Diagnostic -> Maybe (Text, [Range])
suggestRemoveRedundantExport ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (Located [LIE GhcPs])
Maybe LHsDocString
Maybe (Located WarningTxt)
Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodName :: Maybe (Located ModuleName)
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
..}} Diagnostic{Maybe Text
Maybe DiagnosticSeverity
Maybe (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
..}
| 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
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
Maybe (SrcSpan, Bool)
_ -> []
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
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
..}
| 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
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
..}
| 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])]
forall a.
(Semigroup a, IsString a) =>
a -> a -> Text -> [(a, [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])]
forall a.
(Semigroup a, IsString a) =>
a -> a -> Text -> [(a, [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 :: a -> a -> Text -> [(a, [TextEdit])]
codeEdit a
ty a
lit Text
replacement =
let title :: a
title = a
"Add type annotation ‘" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
ty a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"’ to ‘" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lit a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"’"
edits :: [TextEdit]
edits = [Range -> Text -> TextEdit
TextEdit Range
_range Text
replacement]
in [( a
title, [TextEdit]
edits )]
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
..}
| 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}
| 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
ProgressReportingStyle
IdeOTMemoryProfiling
IdeTesting
IdeDefer
IdeReportProgress
OptHaddockParse
ParsedSource -> IdePreprocessedSource
DynFlags -> DynFlags
forall a. Typeable a => a -> Bool
optProgressStyle :: IdeOptions -> ProgressReportingStyle
optSkipProgress :: IdeOptions -> forall a. Typeable a => a -> Bool
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
optProgressStyle :: ProgressReportingStyle
optSkipProgress :: forall a. Typeable a => a -> Bool
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
..}
| 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
..}
| 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)
where
t :: Text -> Text
t = Text -> Text
forall a. a -> a
id @T.Text
holeSuggestions :: [Text]
holeSuggestions = do
[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
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)
return Text
holeFit
refSuggestions :: [Text]
refSuggestions = do
[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
[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"
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 :: [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 :: (T.Text -> Bool) -> [T.Text] -> [[T.Text]]
getIndentedGroupsBy :: (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy Text -> Bool
pred [Text]
inp = case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not(Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Text -> Bool
pred) [Text]
inp of
(Text
l:[Text]
ll) -> case (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Text
l' -> Text -> Int
indentation Text
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
indentation Text
l') [Text]
ll of
([Text]
indented, [Text]
rest) -> (Text
lText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
indented) [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy Text -> Bool
pred [Text]
rest
[Text]
_ -> []
indentation :: T.Text -> Int
indentation :: Text -> Int
indentation = Text -> Int
T.length (Text -> Int) -> (Text -> Text) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace
suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)]
suggestExtendImport :: ExportsMap
-> ParsedSource -> Diagnostic -> [(Text, CodeActionKind, Rewrite)]
suggestExtendImport ExportsMap
exportsMap (L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports}) Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe DiagnosticSeverity
Maybe (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, CodeActionKind, Rewrite)]
suggestions [LImportDecl GhcPs]
hsmodImports Text
binding Text
mod Text
srcspan
| Just (Text
binding, [(Text, Text)]
mod_srcspan) <-
Text -> Maybe (Text, [(Text, Text)])
matchRegExMultipleImports Text
_message
= [(Text, Text)]
mod_srcspan [(Text, Text)]
-> ((Text, Text) -> [(Text, CodeActionKind, Rewrite)])
-> [(Text, CodeActionKind, Rewrite)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> [(Text, CodeActionKind, Rewrite)])
-> (Text, Text) -> [(Text, CodeActionKind, Rewrite)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([LImportDecl GhcPs]
-> Text -> Text -> Text -> [(Text, CodeActionKind, Rewrite)]
suggestions [LImportDecl GhcPs]
hsmodImports Text
binding)
| Bool
otherwise = []
where
suggestions :: [LImportDecl GhcPs]
-> Text -> Text -> Text -> [(Text, CodeActionKind, Rewrite)]
suggestions [LImportDecl GhcPs]
decls Text
binding Text
mod Text
srcspan
| Range
range <- case [ RealSrcSpan
x | (RealSrcSpan
x,FilePath
"") <- ReadS RealSrcSpan
readSrcSpan (Text -> FilePath
T.unpack Text
srcspan)] of
[RealSrcSpan
s] -> let x :: Range
x = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
s
in Range
x{_end :: Position
_end = (Range -> Position
_end Range
x){_character :: 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
, Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"extend" ImportStyle
importStyle
, (Maybe FilePath -> FilePath -> LImportDecl GhcPs -> Rewrite)
-> (Maybe FilePath, FilePath) -> LImportDecl GhcPs -> Rewrite
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe FilePath -> FilePath -> LImportDecl GhcPs -> Rewrite
extendImport (ImportStyle -> (Maybe FilePath, FilePath)
unImportStyle ImportStyle
importStyle) LImportDecl GhcPs
decl
)
| ImportStyle
importStyle <- NonEmpty ImportStyle -> [ImportStyle]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ImportStyle -> [ImportStyle])
-> NonEmpty ImportStyle -> [ImportStyle]
forall a b. (a -> b) -> a -> b
$ IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo
ident
]
| Bool
otherwise = []
lookupExportMap :: Text -> Text -> Maybe IdentInfo
lookupExportMap Text
binding Text
mod
| Just HashSet IdentInfo
match <- Text
-> HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
binding (ExportsMap -> HashMap Text (HashSet IdentInfo)
getExportsMap ExportsMap
exportsMap)
, [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
| 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
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
suggestImportDisambiguation ::
DynFlags ->
Maybe T.Text ->
ParsedSource ->
Diagnostic ->
[(T.Text, [Either TextEdit Rewrite])]
suggestImportDisambiguation :: DynFlags
-> Maybe Text
-> ParsedSource
-> Diagnostic
-> [(Text, [Either TextEdit Rewrite])]
suggestImportDisambiguation DynFlags
df (Just Text
txt) ps :: ParsedSource
ps@(L SrcSpan
_ HsModule {[LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports}) 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, [Either TextEdit 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)
removeAllDuplicates :: [Text] -> [Text]
removeAllDuplicates = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
forall a. [a] -> a
head ([[Text]] -> [Text]) -> ([Text] -> [[Text]]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Bool) -> [[Text]] -> [[Text]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1) (Int -> Bool) -> ([Text] -> Int) -> [Text] -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Text]] -> [[Text]])
-> ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [[Text]]
forall a. Eq a => [a] -> [[a]]
group ([Text] -> [[Text]]) -> ([Text] -> [Text]) -> [Text] -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort
hasDuplicate :: [a] -> Bool
hasDuplicate [a]
xs = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
xs)
suggestions :: Text -> [Text] -> [(Text, [Either TextEdit Rewrite])]
suggestions Text
symbol [Text]
mods
| [Text] -> Bool
forall a. Ord a => [a] -> Bool
hasDuplicate [Text]
mods = case (Text -> Maybe ModuleTarget) -> [Text] -> Maybe [ModuleTarget]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Maybe ModuleTarget
toModuleTarget ([Text] -> [Text]
removeAllDuplicates [Text]
mods) of
Just [ModuleTarget]
targets -> Text
-> [(ModuleTarget, [ModuleTarget])]
-> [(Text, [Either TextEdit Rewrite])]
suggestionsImpl Text
symbol ((ModuleTarget -> (ModuleTarget, [ModuleTarget]))
-> [ModuleTarget] -> [(ModuleTarget, [ModuleTarget])]
forall a b. (a -> b) -> [a] -> [b]
map (, []) [ModuleTarget]
targets)
Maybe [ModuleTarget]
Nothing -> []
| Bool
otherwise = case (Text -> Maybe ModuleTarget) -> [Text] -> Maybe [ModuleTarget]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Maybe ModuleTarget
toModuleTarget [Text]
mods of
Just [ModuleTarget]
targets -> Text
-> [(ModuleTarget, [ModuleTarget])]
-> [(Text, [Either TextEdit Rewrite])]
suggestionsImpl Text
symbol ([ModuleTarget] -> [(ModuleTarget, [ModuleTarget])]
forall a. [a] -> [(a, [a])]
oneAndOthers [ModuleTarget]
targets)
Maybe [ModuleTarget]
Nothing -> []
suggestionsImpl :: Text
-> [(ModuleTarget, [ModuleTarget])]
-> [(Text, [Either TextEdit Rewrite])]
suggestionsImpl Text
symbol [(ModuleTarget, [ModuleTarget])]
targetsWithRestImports =
((Text, [Either TextEdit Rewrite]) -> Text)
-> [(Text, [Either TextEdit Rewrite])]
-> [(Text, [Either TextEdit Rewrite])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, [Either TextEdit Rewrite]) -> Text
forall a b. (a, b) -> a
fst
[ ( HidingMode -> Text -> Text -> Text
renderUniquify HidingMode
mode Text
modNameText Text
symbol
, ParsedSource
-> Diagnostic -> Text -> HidingMode -> [Either TextEdit Rewrite]
disambiguateSymbol ParsedSource
ps Diagnostic
diag Text
symbol HidingMode
mode
)
| (ModuleTarget
modTarget, [ModuleTarget]
restImports) <- [(ModuleTarget, [ModuleTarget])]
targetsWithRestImports
, let modName :: ModuleName
modName = ModuleTarget -> ModuleName
targetModuleName ModuleTarget
modTarget
modNameText :: Text
modNameText = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
moduleNameString ModuleName
modName
, HidingMode
mode <-
[ Bool -> ModuleName -> HidingMode
ToQualified Bool
parensed ModuleName
qual
| ExistingImp NonEmpty (LImportDecl GhcPs)
imps <- [ModuleTarget
modTarget]
, 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
]
[HidingMode] -> [HidingMode] -> [HidingMode]
forall a. [a] -> [a] -> [a]
++ [[ModuleTarget] -> HidingMode
HideOthers [ModuleTarget]
restImports | Bool -> Bool
not ([ModuleTarget] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleTarget]
restImports)]
]
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
/=
(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 ->
[Either TextEdit Rewrite]
disambiguateSymbol :: ParsedSource
-> Diagnostic -> Text -> HidingMode -> [Either TextEdit 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) ->
[ Rewrite -> Either TextEdit Rewrite
forall a b. b -> Either a b
Right (Rewrite -> Either TextEdit Rewrite)
-> Rewrite -> Either TextEdit Rewrite
forall a b. (a -> b) -> a -> b
$ FilePath -> LImportDecl GhcPs -> Rewrite
hideSymbol FilePath
symbol LImportDecl GhcPs
idecl
| ExistingImp NonEmpty (LImportDecl GhcPs)
idecls <- [ModuleTarget]
hiddens0
, LImportDecl GhcPs
idecl <- NonEmpty (LImportDecl GhcPs) -> [LImportDecl GhcPs]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LImportDecl GhcPs)
idecls
]
[Either TextEdit Rewrite]
-> [Either TextEdit Rewrite] -> [Either TextEdit Rewrite]
forall a. [a] -> [a] -> [a]
++ [[Either TextEdit Rewrite]] -> [Either TextEdit Rewrite]
forall a. Monoid a => [a] -> a
mconcat
[ if [LImportDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LImportDecl GhcPs]
imps
then Maybe (Either TextEdit Rewrite) -> [Either TextEdit Rewrite]
forall a. Maybe a -> [a]
maybeToList (Maybe (Either TextEdit Rewrite) -> [Either TextEdit Rewrite])
-> Maybe (Either TextEdit Rewrite) -> [Either TextEdit Rewrite]
forall a b. (a -> b) -> a -> b
$ TextEdit -> Either TextEdit Rewrite
forall a b. a -> Either a b
Left (TextEdit -> Either TextEdit Rewrite)
-> ((Text, TextEdit) -> TextEdit)
-> (Text, TextEdit)
-> Either TextEdit Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, TextEdit) -> TextEdit
forall a b. (a, b) -> b
snd ((Text, TextEdit) -> Either TextEdit Rewrite)
-> Maybe (Text, TextEdit) -> Maybe (Either TextEdit Rewrite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewImport -> ParsedSource -> Maybe (Text, TextEdit)
newImportToEdit (Text -> NewImport
hideImplicitPreludeSymbol (Text -> NewImport) -> Text -> NewImport
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
symbol) ParsedSource
pm
else Rewrite -> Either TextEdit Rewrite
forall a b. b -> Either a b
Right (Rewrite -> Either TextEdit Rewrite)
-> (LImportDecl GhcPs -> Rewrite)
-> LImportDecl GhcPs
-> Either TextEdit Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> LImportDecl GhcPs -> Rewrite
hideSymbol FilePath
symbol (LImportDecl GhcPs -> Either TextEdit Rewrite)
-> [LImportDecl GhcPs] -> [Either TextEdit Rewrite]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LImportDecl GhcPs]
imps
| ImplicitPrelude [LImportDecl GhcPs]
imps <- [ModuleTarget]
hiddens0
]
(ToQualified Bool
parensed ModuleName
qualMod) ->
let occSym :: OccName
occSym = FilePath -> OccName
mkVarOcc FilePath
symbol
rdr :: RdrName
rdr = ModuleName -> OccName -> RdrName
Qual ModuleName
qualMod OccName
occSym
in Rewrite -> Either TextEdit Rewrite
forall a b. b -> Either a b
Right (Rewrite -> Either TextEdit Rewrite)
-> [Rewrite] -> [Either TextEdit Rewrite]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ if Bool
parensed
then SrcSpan
-> (DynFlags -> TransformT (Either FilePath) (LHsExpr GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either FilePath) (Located ast))
-> Rewrite
Rewrite (NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
"<dummy>" Range
_range) ((DynFlags -> TransformT (Either FilePath) (LHsExpr GhcPs))
-> Rewrite)
-> (DynFlags -> TransformT (Either FilePath) (LHsExpr GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
DynFlags
-> FilePath -> TransformT (Either FilePath) (LHsExpr GhcPs)
forall ast.
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 :: Diagnostic -> [(T.Text, TextEdit)]
suggestFixConstructorImport :: Diagnostic -> [(Text, TextEdit)]
suggestFixConstructorImport 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
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 = []
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 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"
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
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
| 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
| 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
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
| 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
"`"
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
..}
| Just Text
contents <- Maybe Text
mContents
, 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)
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
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
"`"
suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])]
suggestNewOrExtendImportForClassMethod :: ExportsMap
-> ParsedSource
-> Diagnostic
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
suggestNewOrExtendImportForClassMethod ExportsMap
packageExportsMap ParsedSource
ps Diagnostic {Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message}
| Just [Text
methodName, Text
className] <-
Text -> Text -> Maybe [Text]
matchRegexUnifySpaces
Text
_message
Text
"‘([^’]*)’ is not a \\(visible\\) method of class ‘([^’]*)’",
[IdentInfo]
idents <-
[IdentInfo]
-> (HashSet IdentInfo -> [IdentInfo])
-> Maybe (HashSet IdentInfo)
-> [IdentInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList (HashSet IdentInfo -> [IdentInfo])
-> (HashSet IdentInfo -> HashSet IdentInfo)
-> HashSet IdentInfo
-> [IdentInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdentInfo -> Bool) -> HashSet IdentInfo -> HashSet IdentInfo
forall a. (a -> Bool) -> HashSet a -> HashSet a
Set.filter (\IdentInfo
x -> IdentInfo -> Maybe Text
parent IdentInfo
x Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
className)) (Maybe (HashSet IdentInfo) -> [IdentInfo])
-> Maybe (HashSet IdentInfo) -> [IdentInfo]
forall a b. (a -> b) -> a -> b
$
Text
-> HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
methodName (HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo))
-> HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ExportsMap -> HashMap Text (HashSet IdentInfo)
getExportsMap ExportsMap
packageExportsMap =
[[(Text, CodeActionKind, [Either TextEdit Rewrite])]]
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
forall a. Monoid a => [a] -> a
mconcat ([[(Text, CodeActionKind, [Either TextEdit Rewrite])]]
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])])
-> [[(Text, CodeActionKind, [Either TextEdit Rewrite])]]
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
forall a b. (a -> b) -> a -> b
$ IdentInfo -> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
suggest (IdentInfo -> [(Text, CodeActionKind, [Either TextEdit Rewrite])])
-> [IdentInfo]
-> [[(Text, CodeActionKind, [Either TextEdit Rewrite])]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IdentInfo]
idents
| Bool
otherwise = []
where
suggest :: IdentInfo -> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
suggest identInfo :: IdentInfo
identInfo@IdentInfo {Text
moduleNameText :: Text
moduleNameText :: IdentInfo -> Text
moduleNameText}
| [ImportStyle]
importStyle <- NonEmpty ImportStyle -> [ImportStyle]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ImportStyle -> [ImportStyle])
-> NonEmpty ImportStyle -> [ImportStyle]
forall a b. (a -> b) -> a -> b
$ IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo
identInfo,
Maybe (LImportDecl GhcPs)
mImportDecl <- [LImportDecl GhcPs] -> FilePath -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName (HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports (HsModule GhcPs -> [LImportDecl GhcPs])
-> HsModule GhcPs -> [LImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ ParsedSource -> SrcSpanLess ParsedSource
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ParsedSource
ps) (Text -> FilePath
T.unpack Text
moduleNameText) =
case Maybe (LImportDecl GhcPs)
mImportDecl of
Just LImportDecl GhcPs
decl ->
[ ( Text
"Add " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ImportStyle -> Text
renderImportStyle ImportStyle
style Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the import list of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
moduleNameText,
Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"extend" ImportStyle
style,
[Rewrite -> Either TextEdit Rewrite
forall a b. b -> Either a b
Right (Rewrite -> Either TextEdit Rewrite)
-> Rewrite -> Either TextEdit Rewrite
forall a b. (a -> b) -> a -> b
$ (Maybe FilePath -> FilePath -> LImportDecl GhcPs -> Rewrite)
-> (Maybe FilePath, FilePath) -> LImportDecl GhcPs -> Rewrite
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe FilePath -> FilePath -> LImportDecl GhcPs -> Rewrite
extendImport (ImportStyle -> (Maybe FilePath, FilePath)
unImportStyle ImportStyle
style) LImportDecl GhcPs
decl]
)
| ImportStyle
style <- [ImportStyle]
importStyle
]
Maybe (LImportDecl GhcPs)
_
| Just (Range
range, Int
indent) <- ParsedSource -> Maybe (Range, Int)
newImportInsertRange ParsedSource
ps
->
(\(CodeActionKind
kind, NewImport -> Text
unNewImport -> Text
x) -> (Text
x, CodeActionKind
kind, [TextEdit -> Either TextEdit Rewrite
forall a b. a -> Either a b
Left (TextEdit -> Either TextEdit Rewrite)
-> TextEdit -> Either TextEdit Rewrite
forall a b. (a -> b) -> a -> b
$ Range -> Text -> TextEdit
TextEdit Range
range (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
indent Text
" ")])) ((CodeActionKind, NewImport)
-> (Text, CodeActionKind, [Either TextEdit Rewrite]))
-> [(CodeActionKind, NewImport)]
-> [(Text, CodeActionKind, [Either TextEdit Rewrite])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[ (Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"new" ImportStyle
style, Text -> Text -> Bool -> NewImport
newUnqualImport Text
moduleNameText Text
rendered Bool
False)
| ImportStyle
style <- [ImportStyle]
importStyle,
let rendered :: Text
rendered = ImportStyle -> Text
renderImportStyle ImportStyle
style
]
[(CodeActionKind, NewImport)]
-> [(CodeActionKind, NewImport)] -> [(CodeActionKind, NewImport)]
forall a. Semigroup a => a -> a -> a
<> [(Text -> CodeActionKind
quickFixImportKind Text
"new.all", Text -> NewImport
newImportAll Text
moduleNameText)]
| Bool
otherwise -> []
suggestNewImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]
suggestNewImport :: ExportsMap
-> ParsedSource -> Diagnostic -> [(Text, CodeActionKind, TextEdit)]
suggestNewImport ExportsMap
packageExportsMap ps :: ParsedSource
ps@(L SrcSpan
_ HsModule {[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (Located [LIE GhcPs])
Maybe LHsDocString
Maybe (Located WarningTxt)
Maybe (Located ModuleName)
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodName :: Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
..}) Diagnostic{Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message}
| Text
msg <- Text -> Text
unifySpaces Text
_message
, Just NotInScope
thingMissing <- Text -> Maybe NotInScope
extractNotInScopeName Text
msg
, Maybe Text
qual <- Text -> Maybe Text
extractQualifiedModuleName Text
msg
, Maybe Text
qual' <-
Text -> Maybe Text
extractDoesNotExportModuleName Text
msg
Maybe Text
-> (Text -> Maybe (LImportDecl GhcPs)) -> Maybe (LImportDecl GhcPs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([LImportDecl GhcPs] -> FilePath -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName [LImportDecl GhcPs]
hsmodImports (FilePath -> Maybe (LImportDecl GhcPs))
-> (Text -> FilePath) -> Text -> Maybe (LImportDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)
Maybe (LImportDecl GhcPs)
-> (LImportDecl GhcPs -> Maybe (Located ModuleName))
-> Maybe (Located ModuleName)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs (ImportDecl GhcPs -> Maybe (Located ModuleName))
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> Maybe (Located ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
Maybe (Located ModuleName)
-> (Located ModuleName -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FilePath -> Text
T.pack (FilePath -> Text)
-> (Located ModuleName -> FilePath) -> Located ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
moduleNameString (ModuleName -> FilePath)
-> (Located ModuleName -> ModuleName)
-> Located ModuleName
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
, Just (Range
range, Int
indent) <- ParsedSource -> Maybe (Range, Int)
newImportInsertRange ParsedSource
ps
, Maybe [Text]
extendImportSuggestions <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
msg
Text
"Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"
= ((Text, CodeActionKind, TextEdit) -> Text)
-> [(Text, CodeActionKind, TextEdit)]
-> [(Text, CodeActionKind, TextEdit)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, CodeActionKind, TextEdit) -> Text
forall a b c. (a, b, c) -> a
fst3 [(Text
imp, CodeActionKind
kind, Range -> Text -> TextEdit
TextEdit Range
range (Text
imp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
indent Text
" "))
| (CodeActionKind
kind, NewImport -> Text
unNewImport -> Text
imp) <- ExportsMap
-> (Maybe Text, NotInScope)
-> Maybe [Text]
-> [(CodeActionKind, NewImport)]
constructNewImportSuggestions ExportsMap
packageExportsMap (Maybe Text
qual Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
qual', NotInScope
thingMissing) Maybe [Text]
extendImportSuggestions
]
suggestNewImport ExportsMap
_ ParsedSource
_ Diagnostic
_ = []
constructNewImportSuggestions
:: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [(CodeActionKind, NewImport)]
constructNewImportSuggestions :: ExportsMap
-> (Maybe Text, NotInScope)
-> Maybe [Text]
-> [(CodeActionKind, NewImport)]
constructNewImportSuggestions ExportsMap
exportsMap (Maybe Text
qual, NotInScope
thingMissing) Maybe [Text]
notTheseModules = ((CodeActionKind, NewImport) -> NewImport)
-> [(CodeActionKind, NewImport)] -> [(CodeActionKind, NewImport)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (CodeActionKind, NewImport) -> NewImport
forall a b. (a, b) -> b
snd
[ (CodeActionKind, NewImport)
suggestion
| Just Text
name <- [Text -> Text -> Maybe Text
T.stripPrefix (Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") Maybe Text
qual) (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ NotInScope -> Text
notInScope NotInScope
thingMissing]
, IdentInfo
identInfo <- [IdentInfo]
-> (HashSet IdentInfo -> [IdentInfo])
-> Maybe (HashSet IdentInfo)
-> [IdentInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList (Maybe (HashSet IdentInfo) -> [IdentInfo])
-> Maybe (HashSet IdentInfo) -> [IdentInfo]
forall a b. (a -> b) -> a -> b
$ Text
-> HashMap Text (HashSet IdentInfo) -> Maybe (HashSet IdentInfo)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
name (ExportsMap -> HashMap Text (HashSet IdentInfo)
getExportsMap ExportsMap
exportsMap)
, NotInScope -> IdentInfo -> Bool
canUseIdent NotInScope
thingMissing IdentInfo
identInfo
, IdentInfo -> Text
moduleNameText IdentInfo
identInfo Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
notTheseModules
, (CodeActionKind, NewImport)
suggestion <- IdentInfo -> [(CodeActionKind, NewImport)]
renderNewImport IdentInfo
identInfo
]
where
renderNewImport :: IdentInfo -> [(CodeActionKind, NewImport)]
renderNewImport :: IdentInfo -> [(CodeActionKind, NewImport)]
renderNewImport IdentInfo
identInfo
| Just Text
q <- Maybe Text
qual
= [(Text -> CodeActionKind
quickFixImportKind Text
"new.qualified", Text -> Text -> NewImport
newQualImport Text
m Text
q)]
| Bool
otherwise
= [(Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
"new" ImportStyle
importStyle, Text -> Text -> Bool -> NewImport
newUnqualImport Text
m (ImportStyle -> Text
renderImportStyle ImportStyle
importStyle) Bool
False)
| ImportStyle
importStyle <- NonEmpty ImportStyle -> [ImportStyle]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ImportStyle -> [ImportStyle])
-> NonEmpty ImportStyle -> [ImportStyle]
forall a b. (a -> b) -> a -> b
$ IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo
identInfo] [(CodeActionKind, NewImport)]
-> [(CodeActionKind, NewImport)] -> [(CodeActionKind, NewImport)]
forall a. [a] -> [a] -> [a]
++
[(Text -> CodeActionKind
quickFixImportKind Text
"new.all", Text -> NewImport
newImportAll Text
m)]
where
m :: Text
m = IdentInfo -> Text
moduleNameText IdentInfo
identInfo
newtype NewImport = NewImport {NewImport -> Text
unNewImport :: T.Text}
deriving (Int -> NewImport -> ShowS
[NewImport] -> ShowS
NewImport -> FilePath
(Int -> NewImport -> ShowS)
-> (NewImport -> FilePath)
-> ([NewImport] -> ShowS)
-> Show NewImport
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewImport] -> ShowS
$cshowList :: [NewImport] -> ShowS
show :: NewImport -> FilePath
$cshow :: NewImport -> FilePath
showsPrec :: Int -> NewImport -> ShowS
$cshowsPrec :: Int -> NewImport -> ShowS
Show, NewImport -> NewImport -> Bool
(NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> Bool) -> Eq NewImport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewImport -> NewImport -> Bool
$c/= :: NewImport -> NewImport -> Bool
== :: NewImport -> NewImport -> Bool
$c== :: NewImport -> NewImport -> Bool
Eq, Eq NewImport
Eq NewImport
-> (NewImport -> NewImport -> Ordering)
-> (NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> Bool)
-> (NewImport -> NewImport -> NewImport)
-> (NewImport -> NewImport -> NewImport)
-> Ord NewImport
NewImport -> NewImport -> Bool
NewImport -> NewImport -> Ordering
NewImport -> NewImport -> NewImport
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NewImport -> NewImport -> NewImport
$cmin :: NewImport -> NewImport -> NewImport
max :: NewImport -> NewImport -> NewImport
$cmax :: NewImport -> NewImport -> NewImport
>= :: NewImport -> NewImport -> Bool
$c>= :: NewImport -> NewImport -> Bool
> :: NewImport -> NewImport -> Bool
$c> :: NewImport -> NewImport -> Bool
<= :: NewImport -> NewImport -> Bool
$c<= :: NewImport -> NewImport -> Bool
< :: NewImport -> NewImport -> Bool
$c< :: NewImport -> NewImport -> Bool
compare :: NewImport -> NewImport -> Ordering
$ccompare :: NewImport -> NewImport -> Ordering
$cp1Ord :: Eq NewImport
Ord)
newImportToEdit :: NewImport -> ParsedSource -> Maybe (T.Text, TextEdit)
newImportToEdit :: NewImport -> ParsedSource -> Maybe (Text, TextEdit)
newImportToEdit (NewImport -> Text
unNewImport -> Text
imp) ParsedSource
ps
| Just (Range
range, Int
indent) <- ParsedSource -> Maybe (Range, Int)
newImportInsertRange ParsedSource
ps
= (Text, TextEdit) -> Maybe (Text, TextEdit)
forall a. a -> Maybe a
Just (Text
imp, Range -> Text -> TextEdit
TextEdit Range
range (Text
imp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
indent Text
" "))
| Bool
otherwise = Maybe (Text, TextEdit)
forall a. Maybe a
Nothing
newImportInsertRange :: ParsedSource -> Maybe (Range, Int)
newImportInsertRange :: ParsedSource -> Maybe (Range, Int)
newImportInsertRange (L SrcSpan
_ HsModule {[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (Located [LIE GhcPs])
Maybe LHsDocString
Maybe (Located WarningTxt)
Maybe (Located ModuleName)
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodName :: Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
..})
| Just ((Int -> Int -> Position) -> (Int, Int) -> Position
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Position
Position -> Position
insertPos, Int
col) <- case [LImportDecl GhcPs]
hsmodImports of
[] -> case LHsDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc ([LHsDecl GhcPs] -> LHsDecl GhcPs
forall a. [a] -> a
head [LHsDecl GhcPs]
hsmodDecls) of
RealSrcSpan RealSrcSpan
s -> let col :: Int
col = RealSrcLoc -> Int
srcLocCol (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
in ((Int, Int), Int) -> Maybe ((Int, Int), Int)
forall a. a -> Maybe a
Just ((RealSrcLoc -> Int
srcLocLine (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
col), Int
col)
SrcSpan
_ -> Maybe ((Int, Int), Int)
forall a. Maybe a
Nothing
[LImportDecl GhcPs]
_ -> case LImportDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc ([LImportDecl GhcPs] -> LImportDecl GhcPs
forall a. [a] -> a
last [LImportDecl GhcPs]
hsmodImports) of
RealSrcSpan RealSrcSpan
s -> let col :: Int
col = RealSrcLoc -> Int
srcLocCol (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
in ((Int, Int), Int) -> Maybe ((Int, Int), Int)
forall a. a -> Maybe a
Just ((RealSrcLoc -> Int
srcLocLine (RealSrcLoc -> Int) -> RealSrcLoc -> Int
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
s,Int
col), Int
col)
SrcSpan
_ -> Maybe ((Int, Int), Int)
forall a. Maybe a
Nothing
= (Range, Int) -> Maybe (Range, Int)
forall a. a -> Maybe a
Just (Position -> Position -> Range
Range Position
insertPos Position
insertPos, Int
col)
| Bool
otherwise = Maybe (Range, Int)
forall a. Maybe a
Nothing
newImport
:: T.Text
-> Maybe T.Text
-> Maybe T.Text
-> Bool
-> NewImport
newImport :: Text -> Maybe Text -> Maybe Text -> Bool -> NewImport
newImport Text
modName Maybe Text
mSymbol Maybe Text
mQual Bool
hiding = Text -> NewImport
NewImport Text
impStmt
where
symImp :: Text
symImp
| Just Text
symbol <- Maybe Text
mSymbol
, OccName
symOcc <- FilePath -> OccName
mkVarOcc (FilePath -> OccName) -> FilePath -> OccName
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
symbol =
Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (SDoc -> FilePath
unsafePrintSDoc (OccName -> SDoc -> SDoc
parenSymOcc OccName
symOcc (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
symOcc)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
| Bool
otherwise = Text
""
impStmt :: Text
impStmt =
Text
"import "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a b. a -> b -> a
const Text
"qualified ") Maybe Text
mQual
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modName
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
hiding then Text
" hiding" else Text
"")
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
symImp
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
qual -> if Text
modName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
qual then Text
"" else Text
" as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qual) Maybe Text
mQual
newQualImport :: T.Text -> T.Text -> NewImport
newQualImport :: Text -> Text -> NewImport
newQualImport Text
modName Text
qual = Text -> Maybe Text -> Maybe Text -> Bool -> NewImport
newImport Text
modName Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
qual) Bool
False
newUnqualImport :: T.Text -> T.Text -> Bool -> NewImport
newUnqualImport :: Text -> Text -> Bool -> NewImport
newUnqualImport Text
modName Text
symbol = Text -> Maybe Text -> Maybe Text -> Bool -> NewImport
newImport Text
modName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
symbol) Maybe Text
forall a. Maybe a
Nothing
newImportAll :: T.Text -> NewImport
newImportAll :: Text -> NewImport
newImportAll Text
modName = Text -> Maybe Text -> Maybe Text -> Bool -> NewImport
newImport Text
modName Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Bool
False
hideImplicitPreludeSymbol :: T.Text -> NewImport
hideImplicitPreludeSymbol :: Text -> NewImport
hideImplicitPreludeSymbol Text
symbol = Text -> Text -> Bool -> NewImport
newUnqualImport Text
"Prelude" Text
symbol Bool
True
canUseIdent :: NotInScope -> IdentInfo -> Bool
canUseIdent :: NotInScope -> IdentInfo -> Bool
canUseIdent NotInScopeDataConstructor{} = IdentInfo -> Bool
isDatacon
canUseIdent 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
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
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
extractDoesNotExportModuleName :: T.Text -> Maybe T.Text
Text
x
| Just [Text
m] <-
Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"Module ‘([^’]*)’ does not export"
Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
x Text
"nor ‘([^’]*)’ exports"
= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
m
| Bool
otherwise
= Maybe Text
forall a. Maybe a
Nothing
mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit
mkRenameEdit :: Maybe Text -> Range -> Text -> TextEdit
mkRenameEdit Maybe Text
contents Range
range Text
name =
if Maybe Bool
maybeIsInfixFunction Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
then Range -> Text -> TextEdit
TextEdit Range
range (Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`")
else Range -> Text -> TextEdit
TextEdit Range
range Text
name
where
maybeIsInfixFunction :: Maybe Bool
maybeIsInfixFunction = do
Text
curr <- Range -> Text -> Text
textInRange Range
range (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
contents
pure $ Text
"`" Text -> Text -> Bool
`T.isPrefixOf` Text
curr Bool -> Bool -> Bool
&& Text
"`" Text -> Text -> Bool
`T.isSuffixOf` Text
curr
extractWildCardTypeSignature :: T.Text -> T.Text
=
(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]
Text
msg
| 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
"), "
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
'’')
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
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)
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)
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]
forall pass l.
OutputableBndr (IdP pass) =>
GenLocated l (IE pass) -> [SrcSpan]
ranges') [LIE GhcPs]
lies
where
b' :: FilePath
b' = ShowS
modifyBinding FilePath
b
ranges' :: GenLocated l (IE pass) -> [SrcSpan]
ranges' (L l
_ (IEThingWith XIEThingWith pass
_ LIEWrappedName (IdP pass)
thing IEWildcard
_ [LIEWrappedName (IdP pass)]
inners [Located (FieldLbl (IdP pass))]
labels))
| SDoc -> FilePath
showSDocUnsafe (LIEWrappedName (IdP pass) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIEWrappedName (IdP pass)
thing) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b' = []
| Bool
otherwise =
[ SrcSpan
l' | L SrcSpan
l' IEWrappedName (IdP pass)
x <- [LIEWrappedName (IdP pass)]
inners, SDoc -> FilePath
showSDocUnsafe (IEWrappedName (IdP pass) -> SDoc
forall a. Outputable a => a -> SDoc
ppr IEWrappedName (IdP pass)
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 (IdP pass)
x <- [Located (FieldLbl (IdP pass))]
labels, SDoc -> FilePath
showSDocUnsafe (FieldLbl (IdP pass) -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLbl (IdP pass)
x) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b']
ranges' GenLocated l (IE pass)
_ = []
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
_ = []
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)
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)
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
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
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
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
"\\((.*)\\)"
return (Text
x, Text
y)
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
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
return (Text
binding, [(Text, Text)]
imps)
data ImportStyle
= ImportTopLevel T.Text
| ImportViaParent T.Text T.Text
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
= 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 p :: Text
p@(Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'(', Text
_))) = Text
"type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
renderImportStyle (ImportViaParent Text
x Text
p) = Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
unImportStyle :: ImportStyle -> (Maybe String, String)
unImportStyle :: ImportStyle -> (Maybe FilePath, FilePath)
unImportStyle (ImportTopLevel Text
x) = (Maybe FilePath
forall a. Maybe a
Nothing, Text -> FilePath
T.unpack Text
x)
unImportStyle (ImportViaParent Text
x Text
y) = (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
y, Text -> FilePath
T.unpack Text
x)
quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind
quickFixImportKind' :: Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
x (ImportTopLevel Text
_) = Text -> CodeActionKind
CodeActionUnknown (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".list.topLevel"
quickFixImportKind' Text
x (ImportViaParent Text
_ Text
_) = Text -> CodeActionKind
CodeActionUnknown (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".list.withParent"
quickFixImportKind :: T.Text -> CodeActionKind
quickFixImportKind :: Text -> CodeActionKind
quickFixImportKind Text
x = Text -> CodeActionKind
CodeActionUnknown (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x