-- Copyright (c) 2019 The DAML Authors. All rights reserved.

-- SPDX-License-Identifier: Apache-2.0


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

-- | Go to the definition of a variable.

module Development.IDE.Plugin.CodeAction
    ( descriptor

    -- * For testing

    , matchRegExMultipleImports
    ) where

import Control.Monad (join, guard)
import Development.IDE.GHC.Compat
import Development.IDE.Core.Rules
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint
import Development.IDE.Plugin.CodeAction.ExactPrint
import Development.IDE.Plugin.CodeAction.PositionIndexed
import Development.IDE.Plugin.CodeAction.RuleTypes
import Development.IDE.Plugin.CodeAction.Rules
import Development.IDE.Plugin.TypeLenses (suggestSignature)
import Development.IDE.Types.Exports
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import qualified Data.HashMap.Strict as Map
import qualified Language.Haskell.LSP.Core as LSP
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Types
import qualified Data.Rope.UTF16 as Rope
import Data.Char
import Data.Maybe
import Data.List.Extra
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Text.Regex.TDFA (mrAfter, (=~), (=~~))
import Outputable (Outputable, ppr, showSDoc, showSDocUnsafe)
import Data.Function
import Control.Arrow ((>>>))
import Data.Functor
import Control.Applicative ((<|>))
import Safe (atMay)
import Bag (isEmptyBag)
import qualified Data.HashSet as Set
import Control.Concurrent.Extra (readVar)
import Development.IDE.GHC.Util (printRdrName)
import Ide.PluginUtils (subRange)
import Ide.Types

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 ()
rulePackageExports,
      pluginCodeActionProvider :: Maybe (CodeActionProvider IdeState)
pluginCodeActionProvider = CodeActionProvider IdeState -> Maybe (CodeActionProvider IdeState)
forall a. a -> Maybe a
Just CodeActionProvider IdeState
forall c.
LspFuncs c
-> IdeState
-> PluginId
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either ResponseError (List CAResult))
codeAction
    }

-- | Generate code actions.

codeAction
    :: LSP.LspFuncs c
    -> IdeState
    -> PluginId
    -> TextDocumentIdentifier
    -> Range
    -> CodeActionContext
    -> IO (Either ResponseError (List CAResult))
codeAction :: LspFuncs c
-> IdeState
-> PluginId
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either ResponseError (List CAResult))
codeAction LspFuncs c
lsp IdeState
state PluginId
_ (TextDocumentIdentifier Uri
uri) Range
_range CodeActionContext{$sel:_diagnostics:CodeActionContext :: CodeActionContext -> List Diagnostic
_diagnostics=List [Diagnostic]
xs} = do
    Maybe VirtualFile
contents <- LspFuncs c -> NormalizedUri -> IO (Maybe VirtualFile)
forall c. LspFuncs c -> NormalizedUri -> IO (Maybe VirtualFile)
LSP.getVirtualFileFunc LspFuncs c
lsp (NormalizedUri -> IO (Maybe VirtualFile))
-> NormalizedUri -> IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
    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) <- FilePath
-> IdeState
-> Action
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
      Maybe (Maybe (Annotated ParsedSource)))
-> IO
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
      Maybe (Maybe (Annotated ParsedSource)))
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)))
 -> IO
      (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
       Maybe (Maybe (Annotated ParsedSource))))
-> Action
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
      Maybe (Maybe (Annotated ParsedSource)))
-> IO
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
      Maybe (Maybe (Annotated ParsedSource)))
forall a b. (a -> b) -> a -> b
$
      (,,,) (IdeOptions
 -> Maybe (Maybe ParsedModule)
 -> Maybe (Maybe HscEnvEq)
 -> Maybe (Maybe (Annotated ParsedSource))
 -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
     Maybe (Maybe (Annotated ParsedSource))))
-> Action IdeOptions
-> Action
     (Maybe (Maybe ParsedModule)
      -> Maybe (Maybe HscEnvEq)
      -> Maybe (Maybe (Annotated ParsedSource))
      -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
          Maybe (Maybe (Annotated ParsedSource))))
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))
   -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
       Maybe (Maybe (Annotated ParsedSource))))
-> Action (Maybe (Maybe ParsedModule))
-> Action
     (Maybe (Maybe HscEnvEq)
      -> Maybe (Maybe (Annotated ParsedSource))
      -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
          Maybe (Maybe (Annotated ParsedSource))))
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))
   -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
       Maybe (Maybe (Annotated ParsedSource))))
-> Action (Maybe (Maybe HscEnvEq))
-> Action
     (Maybe (Maybe (Annotated ParsedSource))
      -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
          Maybe (Maybe (Annotated ParsedSource))))
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))
   -> (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
       Maybe (Maybe (Annotated ParsedSource))))
-> Action (Maybe (Maybe (Annotated ParsedSource)))
-> Action
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq),
      Maybe (Maybe (Annotated ParsedSource)))
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
    -- This is quite expensive 0.6-0.7s on GHC

    Maybe ExportsMap
pkgExports <- FilePath
-> IdeState -> Action (Maybe ExportsMap) -> IO (Maybe ExportsMap)
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"CodeAction:PackageExports" IdeState
state (Action (Maybe ExportsMap) -> IO (Maybe ExportsMap))
-> Action (Maybe ExportsMap) -> IO (Maybe ExportsMap)
forall a b. (a -> b) -> a -> b
$ (PackageExports -> Action ExportsMap
forall k v. IdeRule k v => k -> Action v
useNoFile_ (PackageExports -> Action ExportsMap)
-> (HscEnvEq -> PackageExports) -> HscEnvEq -> Action ExportsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnvEq -> PackageExports
PackageExports) (HscEnvEq -> Action ExportsMap)
-> Maybe HscEnvEq -> Action (Maybe ExportsMap)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` 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 -> Maybe ExportsMap -> ExportsMap
forall a. a -> Maybe a -> a
fromMaybe ExportsMap
forall a. Monoid a => a
mempty Maybe 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 :: [CAResult]
actions =
        [ Text -> [Diagnostic] -> WorkspaceEdit -> CAResult
mkCA Text
title  [Diagnostic
x] WorkspaceEdit
edit
        | Diagnostic
x <- [Diagnostic]
xs, (Text
title, [TextEdit]
tedit) <- ExportsMap
-> IdeOptions
-> Maybe ParsedModule
-> Maybe Text
-> Diagnostic
-> [(Text, [TextEdit])]
suggestAction ExportsMap
exportsMap IdeOptions
ideOptions Maybe ParsedModule
parsedModule Maybe Text
text Diagnostic
x
        , let edit :: WorkspaceEdit
edit = Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> 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 TextDocumentEdit)
forall a. Maybe a
Nothing
        ]
      actions' :: [CAResult]
actions' =
          [Text -> [Diagnostic] -> WorkspaceEdit -> CAResult
mkCA Text
title [Diagnostic
x] WorkspaceEdit
edit
          | Diagnostic
x <- [Diagnostic]
xs
          , Just Annotated ParsedSource
ps <- [Maybe (Annotated ParsedSource)
annotatedPS]
          , Just DynFlags
dynflags <- [Maybe DynFlags
df]
          , (Text
title, Rewrite
graft) <- ExportsMap
-> DynFlags
-> Annotated ParsedSource
-> Diagnostic
-> [(Text, Rewrite)]
suggestExactAction ExportsMap
exportsMap DynFlags
dynflags Annotated ParsedSource
ps Diagnostic
x
          , Right WorkspaceEdit
edit <-
                [ -- either (Left . traceShow) Right $

                 DynFlags -> Uri -> Anns -> Rewrite -> Either FilePath WorkspaceEdit
rewriteToEdit DynFlags
dynflags Uri
uri (Annotated ParsedSource -> Anns
forall ast. Annotated ast -> Anns
annsA Annotated ParsedSource
ps) Rewrite
graft
                 ]
          ]
      actions'' :: [CAResult]
actions'' = Maybe ParsedModule
-> Maybe Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [CAResult]
caRemoveRedundantImports Maybe ParsedModule
parsedModule Maybe Text
text [Diagnostic]
diag [Diagnostic]
xs Uri
uri
               [CAResult] -> [CAResult] -> [CAResult]
forall a. Semigroup a => a -> a -> a
<> [CAResult]
actions
               [CAResult] -> [CAResult] -> [CAResult]
forall a. Semigroup a => a -> a -> a
<> [CAResult]
actions'
               [CAResult] -> [CAResult] -> [CAResult]
forall a. Semigroup a => a -> a -> a
<> Maybe ParsedModule
-> Maybe Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [CAResult]
caRemoveInvalidExports Maybe ParsedModule
parsedModule Maybe Text
text [Diagnostic]
diag [Diagnostic]
xs Uri
uri
    Either ResponseError (List CAResult)
-> IO (Either ResponseError (List CAResult))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (List CAResult)
 -> IO (Either ResponseError (List CAResult)))
-> Either ResponseError (List CAResult)
-> IO (Either ResponseError (List CAResult))
forall a b. (a -> b) -> a -> b
$ List CAResult -> Either ResponseError (List CAResult)
forall a b. b -> Either a b
Right (List CAResult -> Either ResponseError (List CAResult))
-> List CAResult -> Either ResponseError (List CAResult)
forall a b. (a -> b) -> a -> b
$ [CAResult] -> List CAResult
forall a. [a] -> List a
List [CAResult]
actions''

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

suggestExactAction ::
  ExportsMap ->
  DynFlags ->
  Annotated ParsedSource ->
  Diagnostic ->
  [(T.Text, Rewrite)]
suggestExactAction :: ExportsMap
-> DynFlags
-> Annotated ParsedSource
-> Diagnostic
-> [(Text, Rewrite)]
suggestExactAction ExportsMap
exportsMap DynFlags
df Annotated ParsedSource
ps Diagnostic
x =
  [[(Text, Rewrite)]] -> [(Text, Rewrite)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ DynFlags -> ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestConstraint DynFlags
df (Annotated ParsedSource -> ParsedSource
forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps) Diagnostic
x
    , ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestImplicitParameter (Annotated ParsedSource -> ParsedSource
forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps) Diagnostic
x
    , ExportsMap -> ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestExtendImport ExportsMap
exportsMap (Annotated ParsedSource -> ParsedSource
forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps) Diagnostic
x
    ]

suggestAction
  :: ExportsMap
  -> IdeOptions
  -> Maybe ParsedModule
  -> Maybe T.Text
  -> Diagnostic
  -> [(T.Text, [TextEdit])]
suggestAction :: ExportsMap
-> IdeOptions
-> Maybe ParsedModule
-> Maybe Text
-> Diagnostic
-> [(Text, [TextEdit])]
suggestAction ExportsMap
packageExports IdeOptions
ideOptions Maybe ParsedModule
parsedModule Maybe Text
text Diagnostic
diag = [[(Text, [TextEdit])]] -> [(Text, [TextEdit])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
   -- Order these suggestions by priority

    [ Bool -> Diagnostic -> [(Text, [TextEdit])]
suggestSignature Bool
True Diagnostic
diag
    , Diagnostic -> [(Text, [TextEdit])]
suggestFillTypeWildcard Diagnostic
diag
    , Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestFixConstructorImport Maybe Text
text Diagnostic
diag
    , Diagnostic -> [(Text, [TextEdit])]
suggestModuleTypo Diagnostic
diag
    , Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestReplaceIdentifier Maybe Text
text Diagnostic
diag
    , Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
removeRedundantConstraints Maybe Text
text Diagnostic
diag
    , Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyContraints Maybe Text
text Diagnostic
diag
    ] [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ [[(Text, [TextEdit])]] -> [(Text, [TextEdit])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [  IdeOptions
-> ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestNewDefinition IdeOptions
ideOptions ParsedModule
pm Maybe Text
text Diagnostic
diag
    [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ ExportsMap -> ParsedModule -> Diagnostic -> [(Text, [TextEdit])]
suggestNewImport ExportsMap
packageExports ParsedModule
pm Diagnostic
diag
    [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDeleteUnusedBinding ParsedModule
pm Maybe Text
text Diagnostic
diag
    [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> ParsedModule -> Diagnostic -> [(Text, [TextEdit])]
suggestExportUnusedTopBinding Maybe Text
text ParsedModule
pm Diagnostic
diag
    [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDisableWarning ParsedModule
pm Maybe Text
text Diagnostic
diag
    | Just ParsedModule
pm <- [Maybe ParsedModule
parsedModule]
    ] [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++
    Diagnostic -> [(Text, [TextEdit])]
suggestFillHole Diagnostic
diag                   -- Lowest priority


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

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

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

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

suggestRemoveRedundantImport :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestRemoveRedundantImport :: ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestRemoveRedundantImport ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_  HsModule{[LImportDecl GhcPs]
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports}} Maybe Text
contents Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
--     The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant

    | Just [Text
_, Text
bindings] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"
    , Just (L SrcSpan
_ ImportDecl GhcPs
impDecl) <- (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(L SrcSpan
l ImportDecl GhcPs
_) -> SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
l Maybe Range -> Maybe Range -> Bool
forall a. Eq a => a -> a -> Bool
== Range -> Maybe Range
forall a. a -> Maybe a
Just Range
_range ) [LImportDecl GhcPs]
hsmodImports
    , Just Text
c <- Maybe Text
contents
    , [[Range]]
ranges <- (Text -> [Range]) -> [Text] -> [[Range]]
forall a b. (a -> b) -> [a] -> [b]
map (ImportDecl GhcPs -> FilePath -> [Range]
rangesForBindingImport ImportDecl GhcPs
impDecl (FilePath -> [Range]) -> (Text -> FilePath) -> Text -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) (Text -> Text -> [Text]
T.splitOn Text
", " Text
bindings)
    , [Range]
ranges' <- Bool -> PositionIndexedString -> [Range] -> [Range]
extendAllToIncludeCommaIfPossible Bool
False (FilePath -> PositionIndexedString
indexedByPosition (FilePath -> PositionIndexedString)
-> FilePath -> PositionIndexedString
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
c) ([[Range]] -> [Range]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Range]]
ranges)
    , Bool -> Bool
not ([Range] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Range]
ranges')
    = [( Text
"Remove " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bindings Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from import" , [ Range -> Text -> TextEdit
TextEdit Range
r Text
"" | Range
r <- [Range]
ranges' ] )]

-- File.hs:16:1: warning:

--     The import of `Data.List' is redundant

--       except perhaps to import instances from `Data.List'

--     To import instances alone, use: import Data.List()

    | Text
_message Text -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (FilePath
"The( qualified)? import of [^ ]* is redundant" :: String)
        = [(Text
"Remove import", [Range -> Text -> TextEdit
TextEdit (Maybe Text -> Range -> Range
extendToWholeLineIfPossible Maybe Text
contents Range
_range) Text
""])]
    | Bool
otherwise = []

caRemoveRedundantImports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [CAResult]
caRemoveRedundantImports :: Maybe ParsedModule
-> Maybe Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [CAResult]
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],
    CAResult
caRemoveAll <- [TextEdit] -> CAResult
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,
    [CAResult]
caRemoveCtx <- ((Diagnostic, (Text, [TextEdit])) -> CAResult)
-> [(Diagnostic, (Text, [TextEdit]))] -> [CAResult]
forall a b. (a -> b) -> [a] -> [b]
map (\(Diagnostic
d, (Text
title, [TextEdit]
tedit)) -> Text -> [TextEdit] -> Diagnostic -> CAResult
removeSingle Text
title [TextEdit]
tedit Diagnostic
d) [(Diagnostic, (Text, [TextEdit]))]
ctxEdits
      = [CAResult]
caRemoveCtx [CAResult] -> [CAResult] -> [CAResult]
forall a. [a] -> [a] -> [a]
++ [CAResult
caRemoveAll]
  | Bool
otherwise = []
  where
    removeSingle :: Text -> [TextEdit] -> Diagnostic -> CAResult
removeSingle Text
title [TextEdit]
tedit Diagnostic
diagnostic = Text -> [Diagnostic] -> WorkspaceEdit -> CAResult
mkCA Text
title [Diagnostic
diagnostic] WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit{Maybe WorkspaceEditMap
Maybe (List TextDocumentEdit)
forall a. Maybe a
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List TextDocumentEdit)
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
..} where
        _changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit
        _documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
    removeAll :: [TextEdit] -> CAResult
removeAll [TextEdit]
tedit = CodeAction -> CAResult
CACodeAction CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe WorkspaceEdit
-> Maybe Command
-> CodeAction
CodeAction {Maybe CodeActionKind
Maybe WorkspaceEdit
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:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
_command :: 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 TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit{Maybe WorkspaceEditMap
Maybe (List TextDocumentEdit)
forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List TextDocumentEdit)
..}
        _command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing

caRemoveInvalidExports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [CAResult]
caRemoveInvalidExports :: Maybe ParsedModule
-> Maybe Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [CAResult]
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,
    [CAResult]
caRemoveCtx <- ((Text, Diagnostic, [Range]) -> Maybe CAResult)
-> [(Text, Diagnostic, [Range])] -> [CAResult]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Diagnostic, [Range]) -> Maybe CAResult
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 CAResult
caRemoveAll <- [Range] -> Maybe CAResult
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
      = [CAResult]
caRemoveCtx [CAResult] -> [CAResult] -> [CAResult]
forall a. [a] -> [a] -> [a]
++ [CAResult
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 CAResult
removeSingle (Text
_, Diagnostic
_, []) = Maybe CAResult
forall a. Maybe a
Nothing
    removeSingle (Text
title, Diagnostic
diagnostic, [Range]
ranges) = CAResult -> Maybe CAResult
forall a. a -> Maybe a
Just (CAResult -> Maybe CAResult) -> CAResult -> Maybe CAResult
forall a b. (a -> b) -> a -> b
$ CodeAction -> CAResult
CACodeAction CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe WorkspaceEdit
-> Maybe Command
-> CodeAction
CodeAction{Maybe CodeActionKind
Maybe WorkspaceEdit
Maybe Command
Maybe (List Diagnostic)
Text
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:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
..} where
        tedit :: [TextEdit]
tedit = (Range -> [TextEdit]) -> [Range] -> [TextEdit]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Range
r -> [Range -> Text -> TextEdit
TextEdit Range
r Text
""]) ([Range] -> [TextEdit]) -> [Range] -> [TextEdit]
forall a b. (a -> b) -> a -> b
$ [Range] -> [Range]
forall a. Ord a => [a] -> [a]
nubOrd [Range]
ranges
        _changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit
        _title :: Text
_title = Text
title
        _kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
        _diagnostics :: Maybe (List Diagnostic)
_diagnostics = List Diagnostic -> Maybe (List Diagnostic)
forall a. a -> Maybe a
Just (List Diagnostic -> Maybe (List Diagnostic))
-> List Diagnostic -> Maybe (List Diagnostic)
forall a b. (a -> b) -> a -> b
$ [Diagnostic] -> List Diagnostic
forall a. [a] -> List a
List [Diagnostic
diagnostic]
        _documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
        _edit :: Maybe WorkspaceEdit
_edit = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit{Maybe WorkspaceEditMap
Maybe (List TextDocumentEdit)
forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List TextDocumentEdit)
..}
        _command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
    removeAll :: [Range] -> Maybe CAResult
removeAll [] = Maybe CAResult
forall a. Maybe a
Nothing
    removeAll [Range]
ranges = CAResult -> Maybe CAResult
forall a. a -> Maybe a
Just (CAResult -> Maybe CAResult) -> CAResult -> Maybe CAResult
forall a b. (a -> b) -> a -> b
$ CodeAction -> CAResult
CACodeAction CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe WorkspaceEdit
-> Maybe Command
-> CodeAction
CodeAction {Maybe CodeActionKind
Maybe WorkspaceEdit
Maybe Command
Maybe (List Diagnostic)
Text
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:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
..} where
        tedit :: [TextEdit]
tedit = (Range -> [TextEdit]) -> [Range] -> [TextEdit]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Range
r -> [Range -> Text -> TextEdit
TextEdit Range
r Text
""]) [Range]
ranges
        _changes :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri (List TextEdit -> WorkspaceEditMap)
-> List TextEdit -> WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
tedit
        _title :: Text
_title = Text
"Remove all redundant exports"
        _kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
        _diagnostics :: Maybe a
_diagnostics = Maybe a
forall a. Maybe a
Nothing
        _documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
        _edit :: Maybe WorkspaceEdit
_edit = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit{Maybe WorkspaceEditMap
Maybe (List TextDocumentEdit)
forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List TextDocumentEdit)
..}
        _command :: Maybe a
_command = 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 NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
  | 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 NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
-- Foo.hs:4:1: warning: [-Wunused-binds] Defined but not used: ‘f’

    | Just [Text
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
".*Defined but not used: ‘([^ ]+)’"
    , Just PositionIndexedString
indexedContent <- FilePath -> PositionIndexedString
indexedByPosition (FilePath -> PositionIndexedString)
-> (Text -> FilePath) -> Text -> PositionIndexedString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> PositionIndexedString)
-> Maybe Text -> Maybe PositionIndexedString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
contents
      = let edits :: [TextEdit]
edits = (Range -> Text -> TextEdit) -> Text -> Range -> TextEdit
forall a b c. (a -> b -> c) -> b -> a -> c
flip Range -> Text -> TextEdit
TextEdit Text
"" (Range -> TextEdit) -> [Range] -> [TextEdit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionIndexedString -> FilePath -> [Range]
relatedRanges PositionIndexedString
indexedContent (Text -> FilePath
T.unpack Text
name)
        in ([(Text
"Delete ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’", [TextEdit]
edits) | Bool -> Bool
not ([TextEdit] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TextEdit]
edits)])
    | Bool
otherwise = []
    where
      relatedRanges :: PositionIndexedString -> FilePath -> [Range]
relatedRanges PositionIndexedString
indexedContent FilePath
name =
        (LHsDecl GhcPs -> [Range]) -> [LHsDecl GhcPs] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PositionIndexedString -> FilePath -> LHsDecl GhcPs -> [Range]
findRelatedSpans PositionIndexedString
indexedContent FilePath
name) [LHsDecl GhcPs]
hsmodDecls
      toRange :: RealSrcSpan -> Range
toRange = RealSrcSpan -> Range
realSrcSpanToRange
      extendForSpaces :: PositionIndexedString -> Range -> Range
extendForSpaces = PositionIndexedString -> Range -> Range
extendToIncludePreviousNewlineIfPossible

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

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

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

          Just (RealSrcSpan RealSrcSpan
span, Bool
False) -> Range -> [Range]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range -> [Range]) -> Range -> [Range]
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
toRange RealSrcSpan
span -- a, b :: Int, a is unused

          Maybe (SrcSpan, Bool)
_ -> []

      -- Second of the tuple means there is only one match

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

      -- for where clause

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

      findRelatedSpanForHsBind
        :: PositionIndexedString
        -> String
        -> [LSig GhcPs]
        -> LHsBind GhcPs
        -> [Range]
      findRelatedSpanForHsBind :: PositionIndexedString
-> FilePath -> [LSig GhcPs] -> LHsBind GhcPs -> [Range]
findRelatedSpanForHsBind
        PositionIndexedString
indexedContent
        FilePath
name
        [LSig GhcPs]
lsigs
        (L (RealSrcSpan RealSrcSpan
l) (HsBind GhcPs
-> Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])
extractNameAndMatchesFromFunBind -> Just (Located (IdP GhcPs)
lname, [LMatch GhcPs (LHsExpr GhcPs)]
matches))) =
        if SrcSpan -> Bool
isTheBinding (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (IdP GhcPs)
Located RdrName
lname)
        then
          let findSig :: LSig GhcPs -> [Range]
findSig (L (RealSrcSpan RealSrcSpan
l) Sig GhcPs
sig) = PositionIndexedString
-> FilePath -> RealSrcSpan -> Sig GhcPs -> [Range]
findRelatedSigSpan PositionIndexedString
indexedContent FilePath
name RealSrcSpan
l Sig GhcPs
sig
              findSig LSig GhcPs
_ = []
          in [PositionIndexedString -> Range -> Range
extendForSpaces PositionIndexedString
indexedContent (Range -> Range) -> Range -> Range
forall a b. (a -> b) -> a -> b
$ 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 NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
-- Foo.hs:4:1: warning: [-Wunused-top-binds] Defined but not used: ‘f’

-- Foo.hs:5:1: warning: [-Wunused-top-binds] Defined but not used: type constructor or class ‘F’

-- Foo.hs:6:1: warning: [-Wunused-top-binds] Defined but not used: data constructor ‘Bar’

  | Just Text
source <- Maybe Text
srcOpt
  , Just [Text
name] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
".*Defined but not used: ‘([^ ]+)’"
                   Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
".*Defined but not used: type constructor or class ‘([^ ]+)’"
                   Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
".*Defined but not used: data constructor ‘([^ ]+)’"
  , Just (ExportsAs
exportType, Located RdrName
_) <- ((ExportsAs, Located RdrName) -> Bool)
-> [(ExportsAs, Located RdrName)]
-> Maybe (ExportsAs, Located RdrName)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Range -> Located (IdP GhcPs) -> Bool
matchWithDiagnostic Range
_range (Located RdrName -> Bool)
-> ((ExportsAs, Located RdrName) -> Located RdrName)
-> (ExportsAs, Located RdrName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExportsAs, Located RdrName) -> Located RdrName
forall a b. (a, b) -> b
snd)
                            ([(ExportsAs, Located RdrName)]
 -> Maybe (ExportsAs, Located RdrName))
-> ([LHsDecl GhcPs] -> [(ExportsAs, Located RdrName)])
-> [LHsDecl GhcPs]
-> Maybe (ExportsAs, Located RdrName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsDecl GhcPs -> Maybe (ExportsAs, Located RdrName))
-> [LHsDecl GhcPs] -> [(ExportsAs, Located RdrName)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                                (\(L SrcSpan
l HsDecl GhcPs
b) -> if Bool -> (Range -> Bool) -> Maybe Range -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Range -> Bool
isTopLevel (Maybe Range -> Bool) -> Maybe Range -> Bool
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
l
                                                then HsDecl GhcPs -> Maybe (ExportsAs, Located (IdP GhcPs))
forall p. HsDecl p -> Maybe (ExportsAs, Located (IdP p))
exportsAs HsDecl GhcPs
b else Maybe (ExportsAs, Located RdrName)
forall a. Maybe a
Nothing)
                            ([LHsDecl GhcPs] -> Maybe (ExportsAs, Located RdrName))
-> [LHsDecl GhcPs] -> Maybe (ExportsAs, Located RdrName)
forall a b. (a -> b) -> a -> b
$ [LHsDecl GhcPs]
hsmodDecls
  , Just Position
pos <- (Range -> Position) -> Maybe Range -> Maybe Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_end (Maybe Range -> Maybe Position)
-> (Located [LIE GhcPs] -> Maybe Range)
-> Located [LIE GhcPs]
-> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [LIE GhcPs] -> Maybe Range
forall a. Located a -> Maybe Range
getLocatedRange (Located [LIE GhcPs] -> Maybe Position)
-> Maybe (Located [LIE GhcPs]) -> Maybe Position
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Located [LIE GhcPs])
hsmodExports
  , Just Bool
needComma <- Text -> Located [LIE GhcPs] -> Bool
needsComma Text
source (Located [LIE GhcPs] -> Bool)
-> Maybe (Located [LIE GhcPs]) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Located [LIE GhcPs])
hsmodExports
  , let exportName :: Text
exportName = (if Bool
needComma then Text
"," else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExportsAs -> Text -> Text
printExport ExportsAs
exportType Text
name
        insertPos :: Position
insertPos = Position
pos {_character :: Int
_character = Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Position -> Int
_character Position
pos}
  = [(Text
"Export ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’", [Range -> Text -> TextEdit
TextEdit (Position -> Position -> Range
Range Position
insertPos Position
insertPos) Text
exportName])]
  | Bool
otherwise = []
  where
    -- we get the last export and the closing bracket and check for comma in that range

    needsComma :: T.Text -> Located [LIE GhcPs] -> Bool
    needsComma :: Text -> Located [LIE GhcPs] -> Bool
needsComma Text
_ (L SrcSpan
_ []) = Bool
False
    needsComma Text
source (L (RealSrcSpan RealSrcSpan
l) [LIE GhcPs]
exports) =
      let closeParan :: Position
closeParan = Range -> Position
_end (Range -> Position) -> Range -> Position
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
l
          lastExport :: Maybe Position
lastExport = (Range -> Position) -> Maybe Range -> Maybe Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Position
_end (Maybe Range -> Maybe Position)
-> (LIE GhcPs -> Maybe Range) -> LIE GhcPs -> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> Maybe Range
forall a. Located a -> Maybe Range
getLocatedRange (LIE GhcPs -> Maybe Position) -> LIE GhcPs -> Maybe Position
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs] -> LIE GhcPs
forall a. [a] -> a
last [LIE GhcPs]
exports
      in case Maybe Position
lastExport of
        Just Position
lastExport -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
T.isInfixOf Text
"," (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Range -> Text -> Text
textInRange (Position -> Position -> Range
Range Position
lastExport Position
closeParan) Text
source
        Maybe Position
_ -> Bool
False
    needsComma Text
_ Located [LIE GhcPs]
_ = Bool
False

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

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

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

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

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

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

suggestAddTypeAnnotationToSatisfyContraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyContraints :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestAddTypeAnnotationToSatisfyContraints Maybe Text
sourceOpt Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
-- File.hs:52:41: warning:

--     * Defaulting the following constraint to type ‘Integer’

--        Num p0 arising from the literal ‘1’

--     * In the expression: 1

--       In an equation for ‘f’: f = 1

-- File.hs:52:41: warning:

--     * Defaulting the following constraints to type ‘[Char]’

--        (Show a0)

--          arising from a use of ‘traceShow’

--          at A.hs:228:7-25

--        (IsString a0)

--          arising from the literal ‘"debug"’

--          at A.hs:228:17-23

--     * In the expression: traceShow "debug" a

--       In an equation for ‘f’: f a = traceShow "debug" a

-- File.hs:52:41: warning:

--     * Defaulting the following constraints to type ‘[Char]’

--         (Show a0)

--          arising from a use of ‘traceShow’

--          at A.hs:255:28-43

--        (IsString a0)

--          arising from the literal ‘"test"’

--          at /Users/serhiip/workspace/ghcide/src/Development/IDE/Plugin/CodeAction.hs:255:38-43

--     * In the fourth argument of ‘seq’, namely ‘(traceShow "test")’

--       In the expression: seq "test" seq "test" (traceShow "test")

--       In an equation for ‘f’:

--          f = seq "test" seq "test" (traceShow "test")

    | Just [Text
ty, Text
lit] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
False Bool
False Bool
True Bool
False)
                        Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
False Bool
False Bool
False Bool
True)
                        Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message (Bool -> Bool -> Bool -> Bool -> Text
pat Bool
False Bool
False Bool
False Bool
False)
            = Text -> Text -> Text -> [(Text, [TextEdit])]
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 NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
-- File.hs:52:41: error:

--     * Variable not in scope:

--         suggestAcion :: Maybe T.Text -> Range -> Range

--     * Perhaps you meant ‘suggestAction’ (line 83)

-- File.hs:94:37: error:

--     Not in scope: ‘T.isPrfixOf’

--     Perhaps you meant one of these:

--       ‘T.isPrefixOf’ (imported from Data.Text),

--       ‘T.isInfixOf’ (imported from Data.Text),

--       ‘T.isSuffixOf’ (imported from Data.Text)

--     Module ‘Data.Text’ does not export ‘isPrfixOf’.

    | renameSuggestions :: [Text]
renameSuggestions@(Text
_:[Text]
_) <- Text -> [Text]
extractRenamableTerms Text
_message
        = [ (Text
"Replace with ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’", [Maybe Text -> Range -> Text -> TextEdit
mkRenameEdit Maybe Text
contents Range
_range Text
name]) | Text
name <- [Text]
renameSuggestions ]
    | Bool
otherwise = []

suggestNewDefinition :: IdeOptions -> ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestNewDefinition :: IdeOptions
-> ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestNewDefinition IdeOptions
ideOptions ParsedModule
parsedModule Maybe Text
contents Diagnostic{Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message, Range
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range}
--     * Variable not in scope:

--         suggestAcion :: Maybe T.Text -> Range -> Range

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

newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> T.Text -> [(T.Text, [TextEdit])]
newDefinitionAction :: IdeOptions
-> ParsedModule -> Range -> Text -> Text -> [(Text, [TextEdit])]
newDefinitionAction IdeOptions{Bool
FilePath
[FilePath]
[Text]
Maybe FilePath
CheckParents
Action IdeGhcSession
ShakeOptions
IdePkgLocationOptions
IdeOTMemoryProfiling
IdeTesting
IdeDefer
IdeReportProgress
OptHaddockParse
ParsedSource -> IdePreprocessedSource
DynFlags -> DynFlags
optShakeOptions :: IdeOptions -> ShakeOptions
optCustomDynFlags :: IdeOptions -> DynFlags -> DynFlags
optHaddockParse :: IdeOptions -> OptHaddockParse
optCheckParents :: IdeOptions -> CheckParents
optCheckProject :: IdeOptions -> Bool
optDefer :: IdeOptions -> IdeDefer
optKeywords :: IdeOptions -> [Text]
optNewColonConvention :: IdeOptions -> Bool
optLanguageSyntax :: IdeOptions -> FilePath
optReportProgress :: IdeOptions -> IdeReportProgress
optTesting :: IdeOptions -> IdeTesting
optOTMemoryProfiling :: IdeOptions -> IdeOTMemoryProfiling
optShakeProfiling :: IdeOptions -> Maybe FilePath
optExtensions :: IdeOptions -> [FilePath]
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
optShakeOptions :: ShakeOptions
optCustomDynFlags :: DynFlags -> DynFlags
optHaddockParse :: OptHaddockParse
optCheckParents :: CheckParents
optCheckProject :: 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 NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
-- Foo.hs:3:8: error:

--     * Found type wildcard `_' standing for `p -> p1 -> p'


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

suggestModuleTypo :: Diagnostic -> [(T.Text, [TextEdit])]
suggestModuleTypo :: Diagnostic -> [(Text, [TextEdit])]
suggestModuleTypo Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
-- src/Development/IDE/Core/Compile.hs:58:1: error:

--     Could not find module ‘Data.Cha’

--     Perhaps you meant Data.Char (from base-4.12.0.0)

    | Text
"Could not find module" Text -> Text -> Bool
`T.isInfixOf` Text
_message
    , Text
"Perhaps you meant"     Text -> Text -> Bool
`T.isInfixOf` Text
_message = let
      findSuggestedModules :: Text -> [Text]
findSuggestedModules = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
2 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
      proposeModule :: Text -> (Text, [TextEdit])
proposeModule Text
mod = (Text
"replace with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod, [Range -> Text -> TextEdit
TextEdit Range
_range Text
mod])
      in (Text -> (Text, [TextEdit])) -> [Text] -> [(Text, [TextEdit])]
forall a b. (a -> b) -> [a] -> [b]
map Text -> (Text, [TextEdit])
proposeModule ([Text] -> [(Text, [TextEdit])]) -> [Text] -> [(Text, [TextEdit])]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
findSuggestedModules Text
_message
    | Bool
otherwise = []

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

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

      Valid hole fits include def
      Valid refinement hole fits include
        fromMaybe (_ :: LSP.Handlers) (_ :: Maybe LSP.Handlers)
        fromJust (_ :: Maybe LSP.Handlers)
        haskell-lsp-types-0.22.0.0:Language.Haskell.LSP.Types.Window.$sel:_value:ProgressParams (_ :: ProgressParams
                                                                                                        LSP.Handlers)
        T.foldl (_ :: LSP.Handlers -> Char -> LSP.Handlers)
                (_ :: LSP.Handlers)
                (_ :: T.Text)
        T.foldl' (_ :: LSP.Handlers -> Char -> LSP.Handlers)
                 (_ :: LSP.Handlers)
                 (_ :: T.Text)
-}
  where
    t :: Text -> Text
t = Text -> Text
forall a. a -> a
id @T.Text
    holeSuggestions :: [Text]
holeSuggestions = do
      -- get the text indented under Valid hole fits

      [Text]
validHolesSection <-
        (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy (Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
" *Valid (hole fits|substitutions) include") [Text]
mm
      -- the Valid hole fits line can contain a hole fit

      Text
holeFitLine <-
        (Text -> Text) -> [Text] -> [Text]
forall a. (a -> a) -> [a] -> [a]
mapHead
            (MatchResult Text -> Text
forall a. MatchResult a -> a
mrAfter (MatchResult Text -> Text)
-> (Text -> MatchResult Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> MatchResult Text
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
" *Valid (hole fits|substitutions) include"))
            [Text]
validHolesSection
      let holeFit :: Text
holeFit = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Text
holeFitLine
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
holeFit)
      Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return Text
holeFit
    refSuggestions :: [Text]
refSuggestions = do -- @[]

      -- get the text indented under Valid refinement hole fits

      [Text]
refinementSection <-
        (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy (Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
" *Valid refinement hole fits include") [Text]
mm
      -- get the text for each hole fit

      [Text]
holeFitLines <- [Text] -> [[Text]]
getIndentedGroups ([Text] -> [Text]
forall a. [a] -> [a]
tail [Text]
refinementSection)
      let holeFit :: Text
holeFit = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
holeFitLines
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
holeFit Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
"Some refinement hole fits suppressed"
      Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return Text
holeFit

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

-- > getIndentedGroups [" H1", "  l1", "  l2", " H2", "  l3"] = [[" H1,", "  l1", "  l2"], [" H2", "  l3"]]

getIndentedGroups :: [T.Text] -> [[T.Text]]
getIndentedGroups :: [Text] -> [[Text]]
getIndentedGroups [] = []
getIndentedGroups ll :: [Text]
ll@(Text
l:[Text]
_) = (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Int
indentation Text
l) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
indentation) [Text]
ll
-- |

-- > getIndentedGroupsBy (" H" `isPrefixOf`) [" H1", "  l1", "  l2", " H2", "  l3"] = [[" H1", "  l1", "  l2"], [" H2", "  l3"]]

getIndentedGroupsBy :: (T.Text -> Bool) -> [T.Text] -> [[T.Text]]
getIndentedGroupsBy :: (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy Text -> Bool
pred [Text]
inp = case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not(Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Text -> Bool
pred) [Text]
inp of
    (Text
l:[Text]
ll) -> case (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Text
l' -> Text -> Int
indentation Text
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
indentation Text
l') [Text]
ll of
        ([Text]
indented, [Text]
rest) -> (Text
lText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
indented) [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy Text -> Bool
pred [Text]
rest
    [Text]
_ -> []

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

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

            -- fallback to using GHC suggestion even though it is not always correct

          | Bool
otherwise
          = IdentInfo -> Maybe IdentInfo
forall a. a -> Maybe a
Just IdentInfo :: Text -> Text -> Maybe Text -> Bool -> 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}

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

suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestFixConstructorImport :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestFixConstructorImport Maybe Text
_ Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe Text
Maybe NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
    -- ‘Success’ is a data constructor of ‘Result’

    -- To import it use

    -- import Data.Aeson.Types( Result( Success ) )

    -- or

    -- import Data.Aeson.Types( Result(..) ) (lsp-ui)

  | Just [Text
constructor, Text
typ] <-
    Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message
    Text
"‘([^’]*)’ is a data constructor of ‘([^’]*)’ To import it use"
  = let fixedImport :: Text
fixedImport = Text
typ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constructor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    in [(Text
"Fix import of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fixedImport, [Range -> Text -> TextEdit
TextEdit Range
_range Text
fixedImport])]
  | Bool
otherwise = []
-- | Suggests a constraint for a declaration for which a constraint is missing.

suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]
suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(Text, Rewrite)]
suggestConstraint DynFlags
df ParsedSource
parsedModule diag :: Diagnostic
diag@Diagnostic {Maybe Text
Maybe NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
  | Just Text
missingConstraint <- Text -> Maybe Text
findMissingConstraint Text
_message
  = let codeAction :: Diagnostic -> Text -> [(Text, Rewrite)]
codeAction = if Text
_message Text -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (FilePath
"the type signature for:" :: String)
                        then DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestFunctionConstraint DynFlags
df ParsedSource
parsedModule
                        else DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestInstanceConstraint DynFlags
df ParsedSource
parsedModule
     in Diagnostic -> Text -> [(Text, Rewrite)]
codeAction Diagnostic
diag Text
missingConstraint
  | Bool
otherwise = []
    where
      findMissingConstraint :: T.Text -> Maybe T.Text
      findMissingConstraint :: Text -> Maybe Text
findMissingConstraint Text
t =
        let regex :: Text
regex = Text
"(No instance for|Could not deduce) \\((.+)\\) arising from" -- a use of / a do statement

            regexImplicitParams :: Text
regexImplicitParams = Text
"Could not deduce: (\\?.+) arising from a use of"
            match :: Maybe [Text]
match = Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
regex
            matchImplicitParams :: Maybe [Text]
matchImplicitParams = Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
regexImplicitParams
        in Maybe [Text]
match Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Text]
matchImplicitParams Maybe [Text] -> ([Text] -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Text] -> Text
forall a. [a] -> a
last

-- | Suggests a constraint for an instance declaration for which a constraint is missing.

suggestInstanceConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)]

suggestInstanceConstraint :: DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestInstanceConstraint DynFlags
df (L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls}) Diagnostic {Maybe Text
Maybe NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..} Text
missingConstraint
  | Just LHsType GhcPs
instHead <- Maybe (LHsType GhcPs)
instanceHead
  = [(Text -> Text
actionTitle Text
missingConstraint , FilePath -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> FilePath
T.unpack Text
missingConstraint) LHsType GhcPs
instHead)]
  | Bool
otherwise = []
    where
      instanceHead :: Maybe (LHsType GhcPs)
instanceHead
        -- Suggests a constraint for an instance declaration with no existing constraints.

        -- • No instance for (Eq a) arising from a use of ‘==’

        --   Possible fix: add (Eq a) to the context of the instance declaration

        -- • In the expression: x == y

        --   In an equation for ‘==’: (Wrap x) == (Wrap y) = x == y

        --   In the instance declaration for ‘Eq (Wrap a)’

        | Just [Text
instanceDeclaration] <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"In the instance declaration for ‘([^`]*)’"
        , Just LHsType GhcPs
instHead <- DynFlags -> FilePath -> [LHsDecl GhcPs] -> Maybe (LHsType GhcPs)
forall p.
Outputable (HsType p) =>
DynFlags -> FilePath -> [LHsDecl p] -> Maybe (LHsType p)
findInstanceHead DynFlags
df (Text -> FilePath
T.unpack Text
instanceDeclaration) [LHsDecl GhcPs]
hsmodDecls
        = LHsType GhcPs -> Maybe (LHsType GhcPs)
forall a. a -> Maybe a
Just LHsType GhcPs
instHead
        -- Suggests a constraint for an instance declaration with one or more existing constraints.

        -- • Could not deduce (Eq b) arising from a use of ‘==’

        --   from the context: Eq a

        --     bound by the instance declaration at /path/to/Main.hs:7:10-32

        --   Possible fix: add (Eq b) to the context of the instance declaration

        -- • In the second argument of ‘(&&)’, namely ‘x' == y'’

        --   In the expression: x == y && x' == y'

        --   In an equation for ‘==’:

        --       (Pair x x') == (Pair y y') = x == y && x' == y'

        | Just [Text
instanceLineStr, Text
constraintFirstCharStr]
            <- Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
_message Text
"bound by the instance declaration at .+:([0-9]+):([0-9]+)"
        , Just (L SrcSpan
_ (InstD XInstD GhcPs
_ (ClsInstD XClsInstD GhcPs
_ ClsInstDecl {cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = HsIB{LHsType GhcPs
hsib_body :: LHsType GhcPs
hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body}})))
            <- Position -> [LHsDecl GhcPs] -> Maybe (LHsDecl GhcPs)
forall a. Position -> [Located a] -> Maybe (Located a)
findDeclContainingLoc (Int -> Int -> Position
Position (Text -> Int
readPositionNumber Text
instanceLineStr) (Text -> Int
readPositionNumber Text
constraintFirstCharStr)) [LHsDecl GhcPs]
hsmodDecls
        = LHsType GhcPs -> Maybe (LHsType GhcPs)
forall a. a -> Maybe a
Just LHsType GhcPs
hsib_body
        | Bool
otherwise
        = Maybe (LHsType GhcPs)
forall a. Maybe a
Nothing

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

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

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

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

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

-- | Suggests a constraint for a type signature with any number of existing constraints.

suggestFunctionConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)]

suggestFunctionConstraint :: DynFlags -> ParsedSource -> Diagnostic -> Text -> [(Text, Rewrite)]
suggestFunctionConstraint DynFlags
df (L SrcSpan
_ HsModule {[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls}) Diagnostic {Maybe Text
Maybe NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..} Text
missingConstraint
-- • No instance for (Eq a) arising from a use of ‘==’

--   Possible fix:

--     add (Eq a) to the context of

--       the type signature for:

--         eq :: forall a. a -> a -> Bool

-- • In the expression: x == y

--   In an equation for ‘eq’: eq x y = x == y


-- • Could not deduce (Eq b) arising from a use of ‘==’

--   from the context: Eq a

--     bound by the type signature for:

--                eq :: forall a b. Eq a => Pair a b -> Pair a b -> Bool

--     at Main.hs:5:1-42

--   Possible fix:

--     add (Eq b) to the context of

--       the type signature for:

--         eq :: forall a b. Eq a => Pair a b -> Pair a b -> Bool

-- • In the second argument of ‘(&&)’, namely ‘y == y'’

--   In the expression: x == x' && y == y'

--   In an equation for ‘eq’:

--       eq (Pair x y) (Pair x' y') = x == x' && y == y'

  | Just Text
typeSignatureName <- Text -> Maybe Text
findTypeSignatureName Text
_message
  , Just (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
_ HsWC{hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB {hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcPs
sig}})
    <- (IdP GhcPs -> Bool) -> [LHsDecl GhcPs] -> Maybe (Sig GhcPs)
forall p. (IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
findSigOfDecl ((Text -> FilePath
T.unpack Text
typeSignatureName FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==) (FilePath -> Bool) -> (RdrName -> FilePath) -> RdrName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> SDoc -> FilePath
showSDoc DynFlags
df (SDoc -> FilePath) -> (RdrName -> SDoc) -> RdrName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [LHsDecl GhcPs]
hsmodDecls
  , Text
title <- Text -> Text -> Text
actionTitle Text
missingConstraint Text
typeSignatureName
  = [(Text
title, FilePath -> LHsType GhcPs -> Rewrite
appendConstraint (Text -> FilePath
T.unpack Text
missingConstraint) LHsType GhcPs
sig)]
  | Bool
otherwise
  = []
    where
      actionTitle :: T.Text -> T.Text -> T.Text
      actionTitle :: Text -> Text -> Text
actionTitle Text
constraint Text
typeSignatureName = Text
"Add `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constraint
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` to the context of the type signature for `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeSignatureName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

-- | Suggests the removal of a redundant constraint for a type signature.

removeRedundantConstraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
removeRedundantConstraints :: Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
removeRedundantConstraints Maybe Text
mContents Diagnostic{Maybe Text
Maybe NumberOrString
Maybe DiagnosticSeverity
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
_tags :: Maybe (List DiagnosticTag)
_message :: Text
_source :: Maybe Text
_code :: Maybe NumberOrString
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Diagnostic -> Maybe NumberOrString
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
..}
-- • Redundant constraint: Eq a

-- • In the type signature for:

--      foo :: forall a. Eq a => a -> a

-- • Redundant constraints: (Monoid a, Show a)

-- • In the type signature for:

--      foo :: forall a. (Num a, Monoid a, Eq a, Show a) => a -> Bool

  | Just Text
contents <- Maybe Text
mContents
  -- Account for both "Redundant constraint" and "Redundant constraints".

  , Bool
True <- Text
"Redundant constraint" Text -> Text -> Bool
`T.isInfixOf` Text
_message
  , Just Text
typeSignatureName <- Text -> Maybe Text
findTypeSignatureName Text
_message
  , Just [Text]
redundantConstraintList <- Text -> Maybe [Text]
findRedundantConstraints Text
_message
  , Just Text
constraints <- Text -> Text -> Maybe Text
findConstraints Text
contents Text
typeSignatureName
  = let constraintList :: [Text]
constraintList = Text -> [Text]
parseConstraints Text
constraints
        newConstraints :: Text
newConstraints = [Text] -> [Text] -> Text
buildNewConstraints [Text]
constraintList [Text]
redundantConstraintList
        typeSignatureLine :: Int
typeSignatureLine = Text -> Text -> Int
findTypeSignatureLine Text
contents Text
typeSignatureName
        typeSignatureFirstChar :: Int
typeSignatureFirstChar = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text
typeSignatureName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: "
        startOfConstraint :: Position
startOfConstraint = Int -> Int -> Position
Position Int
typeSignatureLine Int
typeSignatureFirstChar
        endOfConstraint :: Position
endOfConstraint = Int -> Int -> Position
Position Int
typeSignatureLine (Int -> Position) -> Int -> Position
forall a b. (a -> b) -> a -> b
$
          Int
typeSignatureFirstChar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length (Text
constraints Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => ")
        range :: Range
range = Position -> Position -> Range
Range Position
startOfConstraint Position
endOfConstraint
     in [([Text] -> Text -> Text
actionTitle [Text]
redundantConstraintList Text
typeSignatureName, [Range -> Text -> TextEdit
TextEdit Range
range Text
newConstraints])]
  | Bool
otherwise = []
    where
      parseConstraints :: T.Text -> [T.Text]
      parseConstraints :: Text -> [Text]
parseConstraints Text
t = Text
t
        Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text
T.strip (Text -> Text) -> (Text -> [Text]) -> Text -> [Text]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Text
stripConstraintsParens (Text -> Text) -> (Text -> [Text]) -> Text -> [Text]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Text -> [Text]
T.splitOn Text
",")
        [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
T.strip

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

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

      -- If the type signature is not formatted as expected (arbitrary number of spaces,

      -- line feeds...), just fail.

      findConstraints :: T.Text -> T.Text -> Maybe T.Text
      findConstraints :: Text -> Text -> Maybe Text
findConstraints Text
contents Text
typeSignatureName = do
        Text
constraints <- Text
contents
          Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Text -> Text -> [Text]
T.splitOn (Text
typeSignatureName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: ")
          [Text] -> ([Text] -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
& ([Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`atMay` Int
1)
          Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> [Text]
T.splitOn Text
" => " (Text -> [Text]) -> ([Text] -> Maybe Text) -> Text -> Maybe Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`atMay` Int
0))
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Bool
`T.isInfixOf` Text
constraints Bool -> Bool -> Bool
|| Text -> Text
T.strip Text
constraints Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
constraints
        Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
constraints

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

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

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

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

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


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

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

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

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

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

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

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

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



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

extractWildCardTypeSignature :: T.Text -> T.Text
extractWildCardTypeSignature :: Text -> Text
extractWildCardTypeSignature =
  -- inferring when parens are actually needed around the type signature would

  -- require understanding both the precedence of the context of the _ and of

  -- the signature itself. Inserting them unconditionally is ugly but safe.

  (Text
"(" Text -> Text -> Text
`T.append`) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
`T.append` Text
")") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'’') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'‘') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'‘') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> (Text, Text)
T.breakOnEnd Text
"standing for "

extractRenamableTerms :: T.Text -> [T.Text]
extractRenamableTerms :: Text -> [Text]
extractRenamableTerms Text
msg
  -- Account for both "Variable not in scope" and "Not in scope"

  | Text
"ot in scope:" Text -> Text -> Bool
`T.isInfixOf` Text
msg = Text -> [Text]
extractSuggestions Text
msg
  | Bool
otherwise = []
  where
    extractSuggestions :: Text -> [Text]
extractSuggestions = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
getEnclosed
                       ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
singleSuggestions
                       ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isKnownSymbol
                       ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
    singleSuggestions :: Text -> [Text]
singleSuggestions = Text -> Text -> [Text]
T.splitOn Text
"), " -- Each suggestion is comma delimited

    isKnownSymbol :: Text -> Bool
isKnownSymbol Text
t = Text
" (imported from" Text -> Text -> Bool
`T.isInfixOf` Text
t Bool -> Bool -> Bool
|| Text
" (line " Text -> Text -> Bool
`T.isInfixOf` Text
t
    getEnclosed :: Text -> Text
getEnclosed = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'‘')
                (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'’')
                (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropAround (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'‘' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'’')

-- | If a range takes up a whole line (it begins at the start of the line and there's only whitespace

-- between the end of the range and the next newline), extend the range to take up the whole line.

extendToWholeLineIfPossible :: Maybe T.Text -> Range -> Range
extendToWholeLineIfPossible :: Maybe Text -> Range -> Range
extendToWholeLineIfPossible Maybe Text
contents range :: Range
range@Range{Position
_end :: Position
_start :: Position
_start :: Range -> Position
_end :: Range -> Position
..} =
    let newlineAfter :: Bool
newlineAfter = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Text -> Bool
T.isPrefixOf Text
"\n" (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (\Char
x -> Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Text -> (Text, Text)
splitTextAtPosition Position
_end) Maybe Text
contents
        extend :: Bool
extend = Bool
newlineAfter Bool -> Bool -> Bool
&& Position -> Int
_character Position
_start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -- takes up an entire line, so remove the whole line

    in if Bool
extend then Position -> Position -> Range
Range Position
_start (Int -> Int -> Position
Position (Position -> Int
_line Position
_end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0) else Range
range

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

-- | Returns [start .. end[

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

-- | Returns the ranges for a binding in an import declaration

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

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

smallerRangesForBindingExport :: [LIE GhcPs] -> String -> [Range]
smallerRangesForBindingExport :: [LIE GhcPs] -> FilePath -> [Range]
smallerRangesForBindingExport [LIE GhcPs]
lies FilePath
b =
    (LIE GhcPs -> [Range]) -> [LIE GhcPs] -> [Range]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SrcSpan -> Maybe Range) -> [SrcSpan] -> [Range]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SrcSpan -> Maybe Range
srcSpanToRange ([SrcSpan] -> [Range])
-> (LIE GhcPs -> [SrcSpan]) -> LIE GhcPs -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> [SrcSpan]
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
_ = []

-- | 'matchRegex' combined with 'unifySpaces'

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

-- | Returns Just (the submatches) for the first capture, or Nothing.

matchRegex :: T.Text -> T.Text -> Maybe [T.Text]
matchRegex :: Text -> Text -> Maybe [Text]
matchRegex Text
message Text
regex = case Text
message Text -> Text -> Maybe (Text, Text, Text, [Text])
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
regex of
    Just (Text
_ :: T.Text, Text
_ :: T.Text, Text
_ :: T.Text, [Text]
bindings) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
bindings
    Maybe (Text, Text, Text, [Text])
Nothing -> Maybe [Text]
forall a. Maybe a
Nothing
unifySpaces :: T.Text -> T.Text
unifySpaces :: Text -> Text
unifySpaces    = [Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words

-- functions to help parse multiple import suggestions


-- | Returns the first match if found

regexSingleMatch :: T.Text -> T.Text -> Maybe T.Text
regexSingleMatch :: Text -> Text -> Maybe Text
regexSingleMatch Text
msg Text
regex = case Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
msg Text
regex of
    Just (Text
h:[Text]
_) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
h
    Maybe [Text]
_ -> Maybe Text
forall a. Maybe a
Nothing

-- | Parses tuples like (‘Data.Map’, (app/ModuleB.hs:2:1-18)) and

-- | return (Data.Map, app/ModuleB.hs:2:1-18)

regExPair :: (T.Text, T.Text) -> Maybe (T.Text, T.Text)
regExPair :: (Text, Text) -> Maybe (Text, Text)
regExPair (Text
modname, Text
srcpair) = do
  Text
x <- Text -> Text -> Maybe Text
regexSingleMatch Text
modname Text
"‘([^’]*)’"
  Text
y <- Text -> Text -> Maybe Text
regexSingleMatch Text
srcpair Text
"\\((.*)\\)"
  (Text, Text) -> Maybe (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Text
y)

-- | Process a list of (module_name, filename:src_span) values

-- | Eg. [(Data.Map, app/ModuleB.hs:2:1-18), (Data.HashMap.Strict, app/ModuleB.hs:3:1-29)]

regExImports :: T.Text -> Maybe [(T.Text, T.Text)]
regExImports :: Text -> Maybe [(Text, Text)]
regExImports Text
msg = Maybe [(Text, Text)]
result
  where
    parts :: [Text]
parts = Text -> [Text]
T.words Text
msg
    isPrefix :: Text -> Bool
isPrefix = Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
T.isPrefixOf Text
"("
    ([Text]
mod, [Text]
srcspan) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Text -> Bool
isPrefix  [Text]
parts
    -- check we have matching pairs like (Data.Map, (app/src.hs:1:2-18))

    result :: Maybe [(Text, Text)]
result = if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
mod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
srcspan then
               (Text, Text) -> Maybe (Text, Text)
regExPair ((Text, Text) -> Maybe (Text, Text))
-> [(Text, Text)] -> Maybe [(Text, Text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
mod [Text]
srcspan
             else Maybe [(Text, Text)]
forall a. Maybe a
Nothing

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

-- | Possible import styles for an 'IdentInfo'.

--

-- The first 'Text' parameter corresponds to the 'rendered' field of the

-- 'IdentInfo'.

data ImportStyle
    = ImportTopLevel T.Text
      -- ^ Import a top-level export from a module, e.g., a function, a type, a

      -- class.

      --

      -- > import M (?)

      --

      -- Some exports that have a parent, like a type-class method or an

      -- associated type/data family, can still be imported as a top-level

      -- import.

      --

      -- Note that this is not the case for constructors, they must always be

      -- imported as part of their parent data type.


    | ImportViaParent T.Text T.Text
      -- ^ Import an export (first parameter) through its parent (second

      -- parameter).

      --

      -- import M (P(?))

      --

      -- @P@ and @?@ can be a data type and a constructor, a class and a method,

      -- a class and an associated type/data family, etc.

  deriving Int -> ImportStyle -> ShowS
[ImportStyle] -> ShowS
ImportStyle -> FilePath
(Int -> ImportStyle -> ShowS)
-> (ImportStyle -> FilePath)
-> ([ImportStyle] -> ShowS)
-> Show ImportStyle
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ImportStyle] -> ShowS
$cshowList :: [ImportStyle] -> ShowS
show :: ImportStyle -> FilePath
$cshow :: ImportStyle -> FilePath
showsPrec :: Int -> ImportStyle -> ShowS
$cshowsPrec :: Int -> ImportStyle -> ShowS
Show

importStyles :: IdentInfo -> NonEmpty ImportStyle
importStyles :: IdentInfo -> NonEmpty ImportStyle
importStyles IdentInfo {Maybe Text
parent :: Maybe Text
parent :: IdentInfo -> Maybe Text
parent, Text
rendered :: Text
rendered :: IdentInfo -> Text
rendered, Bool
isDatacon :: Bool
isDatacon :: IdentInfo -> Bool
isDatacon}
  | Just Text
p <- Maybe Text
parent
    -- Constructors always have to be imported via their parent data type, but

    -- methods and associated type/data families can also be imported as

    -- top-level exports.

  = Text -> Text -> ImportStyle
ImportViaParent Text
rendered Text
p ImportStyle -> [ImportStyle] -> NonEmpty ImportStyle
forall a. a -> [a] -> NonEmpty a
:| [Text -> ImportStyle
ImportTopLevel Text
rendered | Bool -> Bool
not Bool
isDatacon]
  | Bool
otherwise
  = Text -> ImportStyle
ImportTopLevel Text
rendered ImportStyle -> [ImportStyle] -> NonEmpty ImportStyle
forall a. a -> [a] -> NonEmpty a
:| []

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

-- | Find the first non-blank line before the first of (module name / imports / declarations).

-- Useful for inserting pragmas.

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