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

    -- * For haskell-language-server

    , codeAction
    , codeLens
    , rulePackageExports
    , commandHandler

    -- * For testing

    , blockCommandId
    , typeSignatureCommandId
    , matchRegExMultipleImports
    ) where

import Control.Monad (join, guard)
import Development.IDE.Plugin
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.LSP.Server
import Development.IDE.Plugin.CodeAction.PositionIndexed
import Development.IDE.Plugin.CodeAction.RuleTypes
import Development.IDE.Plugin.CodeAction.Rules
import Development.IDE.Types.Exports
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import Development.Shake (Rules)
import qualified Data.HashMap.Strict as Map
import qualified Language.Haskell.LSP.Core as LSP
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Types
import qualified Data.Rope.UTF16 as Rope
import Data.Aeson.Types (toJSON, fromJSON, Value(..), Result(..))
import Data.Char
import Data.Maybe
import Data.List.Extra
import qualified Data.Text as T
import Text.Regex.TDFA (mrAfter, (=~), (=~~))
import Outputable (ppr, 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 (threadDelay, readVar)

plugin :: Plugin c
plugin :: Plugin c
plugin = Rules ()
-> (LspFuncs c
    -> IdeState
    -> TextDocumentIdentifier
    -> Range
    -> CodeActionContext
    -> IO (Either ResponseError [CAResult]))
-> Plugin c
forall c.
Rules ()
-> (LspFuncs c
    -> IdeState
    -> TextDocumentIdentifier
    -> Range
    -> CodeActionContext
    -> IO (Either ResponseError [CAResult]))
-> Plugin c
codeActionPluginWithRules Rules ()
rules LspFuncs c
-> IdeState
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either ResponseError [CAResult])
forall c.
LspFuncs c
-> IdeState
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either ResponseError [CAResult])
codeAction Plugin c -> Plugin c -> Plugin c
forall a. Semigroup a => a -> a -> a
<> Rules () -> PartialHandlers c -> Plugin c
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
forall a. Monoid a => a
mempty PartialHandlers c
forall c. PartialHandlers c
setHandlersCodeLens

rules :: Rules ()
rules :: Rules ()
rules = Rules ()
rulePackageExports

-- | a command that blocks forever. Used for testing

blockCommandId :: T.Text
blockCommandId :: Text
blockCommandId = Text
"ghcide.command.block"

typeSignatureCommandId :: T.Text
typeSignatureCommandId :: Text
typeSignatureCommandId = Text
"typesignature.add"

-- | Generate code actions.

codeAction
    :: LSP.LspFuncs c
    -> IdeState
    -> TextDocumentIdentifier
    -> Range
    -> CodeActionContext
    -> IO (Either ResponseError [CAResult])
codeAction :: LspFuncs c
-> IdeState
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either ResponseError [CAResult])
codeAction LspFuncs c
lsp IdeState
state (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) <- FilePath
-> IdeState
-> Action
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq))
-> IO
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq))
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"CodeAction" IdeState
state (Action
   (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq))
 -> IO
      (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq)))
-> Action
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq))
-> IO
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq))
forall a b. (a -> b) -> a -> b
$
      (,,) (IdeOptions
 -> Maybe (Maybe ParsedModule)
 -> Maybe (Maybe HscEnvEq)
 -> (IdeOptions, Maybe (Maybe ParsedModule),
     Maybe (Maybe HscEnvEq)))
-> Action IdeOptions
-> Action
     (Maybe (Maybe ParsedModule)
      -> Maybe (Maybe HscEnvEq)
      -> (IdeOptions, Maybe (Maybe ParsedModule),
          Maybe (Maybe HscEnvEq)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action IdeOptions
getIdeOptions
            Action
  (Maybe (Maybe ParsedModule)
   -> Maybe (Maybe HscEnvEq)
   -> (IdeOptions, Maybe (Maybe ParsedModule),
       Maybe (Maybe HscEnvEq)))
-> Action (Maybe (Maybe ParsedModule))
-> Action
     (Maybe (Maybe HscEnvEq)
      -> (IdeOptions, Maybe (Maybe ParsedModule),
          Maybe (Maybe HscEnvEq)))
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)
   -> (IdeOptions, Maybe (Maybe ParsedModule),
       Maybe (Maybe HscEnvEq)))
-> Action (Maybe (Maybe HscEnvEq))
-> Action
     (IdeOptions, Maybe (Maybe ParsedModule), Maybe (Maybe HscEnvEq))
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
    -- 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
    Either ResponseError [CAResult]
-> IO (Either ResponseError [CAResult])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError [CAResult]
 -> IO (Either ResponseError [CAResult]))
-> ([CAResult] -> Either ResponseError [CAResult])
-> [CAResult]
-> IO (Either ResponseError [CAResult])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CAResult] -> Either ResponseError [CAResult]
forall a b. b -> Either a b
Right ([CAResult] -> IO (Either ResponseError [CAResult]))
-> [CAResult] -> IO (Either ResponseError [CAResult])
forall a b. (a -> b) -> a -> b
$
        [ 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
x]) (WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit
edit) Maybe Command
forall a. Maybe a
Nothing
        | 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
        ] [CAResult] -> [CAResult] -> [CAResult]
forall a. Semigroup a => a -> a -> a
<> Maybe ParsedModule
-> Maybe Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [CAResult]
caRemoveRedundantImports Maybe ParsedModule
parsedModule Maybe Text
text [Diagnostic]
diag [Diagnostic]
xs Uri
uri

-- | Generate code lenses.

codeLens
    :: LSP.LspFuncs c
    -> IdeState
    -> CodeLensParams
    -> IO (Either ResponseError (List CodeLens))
codeLens :: LspFuncs c
-> IdeState
-> CodeLensParams
-> IO (Either ResponseError (List CodeLens))
codeLens LspFuncs c
_lsp IdeState
ideState CodeLensParams{$sel:_textDocument:CodeLensParams :: CodeLensParams -> TextDocumentIdentifier
_textDocument=TextDocumentIdentifier Uri
uri} = do
    Text
commandId <- Text -> IO Text
makeLspCommandId Text
"typesignature.add"
    ([CodeLens] -> Either ResponseError (List CodeLens))
-> IO [CodeLens] -> IO (Either ResponseError (List CodeLens))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (List CodeLens -> Either ResponseError (List CodeLens)
forall a b. b -> Either a b
Right (List CodeLens -> Either ResponseError (List CodeLens))
-> ([CodeLens] -> List CodeLens)
-> [CodeLens]
-> Either ResponseError (List CodeLens)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CodeLens] -> List CodeLens
forall a. [a] -> List a
List) (IO [CodeLens] -> IO (Either ResponseError (List CodeLens)))
-> IO [CodeLens] -> IO (Either ResponseError (List CodeLens))
forall a b. (a -> b) -> a -> b
$ case Uri -> Maybe FilePath
uriToFilePath' Uri
uri of
      Just (FilePath -> NormalizedFilePath
toNormalizedFilePath' -> NormalizedFilePath
filePath) -> do
        Maybe TcModuleResult
_ <- FilePath
-> IdeState
-> Action (Maybe TcModuleResult)
-> IO (Maybe TcModuleResult)
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"codeLens" IdeState
ideState (TypeCheck -> NormalizedFilePath -> Action (Maybe TcModuleResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck NormalizedFilePath
filePath)
        [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
diag <- IdeState -> IO [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
getDiagnostics IdeState
ideState
        [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
hDiag <- IdeState -> IO [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
getHiddenDiagnostics IdeState
ideState
        [CodeLens] -> IO [CodeLens]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          [ Range -> Maybe Command -> Maybe Value -> CodeLens
CodeLens Range
_range (Command -> Maybe Command
forall a. a -> Maybe a
Just (Text -> Text -> Maybe (List Value) -> Command
Command Text
title Text
commandId (List Value -> Maybe (List Value)
forall a. a -> Maybe a
Just (List Value -> Maybe (List Value))
-> List Value -> Maybe (List Value)
forall a b. (a -> b) -> a -> b
$ [Value] -> List Value
forall a. [a] -> List a
List [WorkspaceEdit -> Value
forall a. ToJSON a => a -> Value
toJSON WorkspaceEdit
edit]))) Maybe Value
forall a. Maybe a
Nothing
          | (NormalizedFilePath
dFile, ShowDiagnostic
_, dDiag :: Diagnostic
dDiag@Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range}) <- [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
diag [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
-> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
-> [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
forall a. [a] -> [a] -> [a]
++ [(NormalizedFilePath, ShowDiagnostic, Diagnostic)]
hDiag
          , NormalizedFilePath
dFile NormalizedFilePath -> NormalizedFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== NormalizedFilePath
filePath
          , (Text
title, [TextEdit]
tedit) <- Bool -> Diagnostic -> [(Text, [TextEdit])]
suggestSignature Bool
False Diagnostic
dDiag
          , 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
          ]
      Maybe FilePath
Nothing -> [CodeLens] -> IO [CodeLens]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Execute the "typesignature.add" command.

commandHandler
    :: LSP.LspFuncs c
    -> IdeState
    -> ExecuteCommandParams
    -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
commandHandler :: LspFuncs c
-> IdeState
-> ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
commandHandler LspFuncs c
lsp IdeState
_ideState ExecuteCommandParams{Maybe ProgressToken
Maybe (List Value)
Text
$sel:_command:ExecuteCommandParams :: ExecuteCommandParams -> Text
$sel:_arguments:ExecuteCommandParams :: ExecuteCommandParams -> Maybe (List Value)
$sel:_workDoneToken:ExecuteCommandParams :: ExecuteCommandParams -> Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken
_arguments :: Maybe (List Value)
_command :: Text
..}
    -- _command is prefixed with a process ID, because certain clients

    -- have a global command registry, and all commands must be

    -- unique. And there can be more than one ghcide instance running

    -- at a time against the same client.

    | Text -> Text -> Bool
T.isSuffixOf Text
blockCommandId Text
_command
    = do
        LspFuncs c -> SendFunc
forall c. LspFuncs c -> SendFunc
LSP.sendFunc LspFuncs c
lsp SendFunc -> SendFunc
forall a b. (a -> b) -> a -> b
$ CustomServerNotification -> FromServerMessage
NotCustomServer (CustomServerNotification -> FromServerMessage)
-> CustomServerNotification -> FromServerMessage
forall a b. (a -> b) -> a -> b
$
            Text -> ServerMethod -> Value -> CustomServerNotification
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" (Text -> ServerMethod
CustomServerMethod Text
"ghcide/blocking/command") Value
Null
        Int -> IO ()
threadDelay Int
forall a. Bounded a => a
maxBound
        (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
Null, Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. Maybe a
Nothing)
    | Text -> Text -> Bool
T.isSuffixOf Text
typeSignatureCommandId Text
_command
    , Just (List [Value
edit]) <- Maybe (List Value)
_arguments
    , Success WorkspaceEdit
wedit <- Value -> Result WorkspaceEdit
forall a. FromJSON a => Value -> Result a
fromJSON Value
edit
    = (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
Null, (ServerMethod, ApplyWorkspaceEditParams)
-> Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. a -> Maybe a
Just (ServerMethod
WorkspaceApplyEdit, WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
wedit))
    | Bool
otherwise
    = (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
Null, Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. Maybe a
Nothing)

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
    , ExportsMap -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestExtendImport ExportsMap
packageExports Maybe Text
text 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
    [  ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestConstraint ParsedModule
pm Maybe Text
text Diagnostic
diag
    [(Text, [TextEdit])]
-> [(Text, [TextEdit])] -> [(Text, [TextEdit])]
forall a. [a] -> [a] -> [a]
++ 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
    | 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



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
$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
..}
--     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]
rangesForBinding 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' <- PositionIndexedString -> [Range] -> [Range]
extendAllToIncludeCommaIfPossible (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 = 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 :: Maybe (List Diagnostic)
_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
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
$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
$sel:_documentChanges:WorkspaceEdit :: Maybe (List TextDocumentEdit)
_documentChanges :: forall a. Maybe a
_changes :: Maybe WorkspaceEditMap
..}
        _command :: Maybe a
_command = 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
_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
        _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

suggestDeleteUnusedBinding :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestDeleteUnusedBinding :: ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestDeleteUnusedBinding
  ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls :: [LHsDecl GhcPs]
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)

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)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE 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)
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
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:_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)
$sel:_range:Diagnostic :: Diagnostic -> Range
..}
-- 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

    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

    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 -> Text
pat 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 -> Text
pat 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 -> Text
pat Bool
True Bool
True 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 -> Text
pat Bool
multiple Bool
at Bool
inThe = [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
inThe then Text
".+In the.+argument" else Text
""
                                       , if Bool
at then Text
".+at" 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
Int
FilePath
[FilePath]
[Text]
Maybe FilePath
CheckParents
Action IdeGhcSession
IdePkgLocationOptions
IdeOTMemoryProfiling
IdeTesting
IdeDefer
IdeReportProgress
OptHaddockParse
ParsedSource -> IdePreprocessedSource
DynFlags -> DynFlags
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
optShakeFiles :: IdeOptions -> Maybe FilePath
optThreads :: IdeOptions -> Int
optExtensions :: IdeOptions -> [FilePath]
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
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
optShakeFiles :: Maybe FilePath
optThreads :: Int
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 -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestExtendImport :: ExportsMap -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestExtendImport ExportsMap
exportsMap 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)
..}
    | 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 ‘([^’]*)’ *\\((.*)\\).$"
    , Just Text
c <- Maybe Text
contents
    = Text -> Text -> Text -> Text -> [(Text, [TextEdit])]
suggestions Text
c Text
binding Text
mod Text
srcspan
    | Just (Text
binding, [(Text, Text)]
mod_srcspan) <-
      Text -> Maybe (Text, [(Text, Text)])
matchRegExMultipleImports Text
_message
    , Just Text
c <- Maybe Text
contents
    = [(Text, Text)]
mod_srcspan [(Text, Text)]
-> ((Text, Text) -> [(Text, [TextEdit])]) -> [(Text, [TextEdit])]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(Text
x, Text
y) -> Text -> Text -> Text -> Text -> [(Text, [TextEdit])]
suggestions Text
c Text
binding Text
x Text
y)
    | Bool
otherwise = []
    where
        suggestions :: Text -> Text -> Text -> Text -> [(Text, [TextEdit])]
suggestions Text
c 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",
            Text
importLine <- Range -> Text -> Text
textInRange Range
range Text
c,
            Just IdentInfo
ident <- Text -> Text -> Maybe IdentInfo
lookupExportMap Text
binding Text
mod,
            Just Text
result <- IdentInfo -> Text -> Maybe Text
addBindingToImportList IdentInfo
ident Text
importLine
            = [(Text
"Add " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IdentInfo -> Text
renderIdentInfo IdentInfo
ident 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, [Range -> Text -> TextEdit
TextEdit Range
range Text
result])]
          | 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}

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 = []

suggestSignature :: Bool -> Diagnostic -> [(T.Text, [TextEdit])]
suggestSignature :: Bool -> Diagnostic -> [(Text, [TextEdit])]
suggestSignature Bool
isQuickFix Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=_range :: Range
_range@Range{Position
_end :: Position
_start :: Position
_start :: Range -> Position
_end :: Range -> Position
..},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)
..}
    | Text
_message Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~
      (Text
"(Top-level binding|Polymorphic local binding|Pattern synonym) with no type signature" :: T.Text) = let
      signature :: Text
signature      = Text -> Text
removeInitialForAll
                     (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (\Char
x -> Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'*' Bool -> Bool -> Bool
&& Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'•')
                     (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
unifySpaces (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
last ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"type signature: " (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
filterNewlines Text
_message
      startOfLine :: Position
startOfLine    = Int -> Int -> Position
Position (Position -> Int
_line Position
_start) Int
startCharacter
      beforeLine :: Range
beforeLine     = Position -> Position -> Range
Range Position
startOfLine Position
startOfLine
      title :: Text
title          = if Bool
isQuickFix then Text
"add signature: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
signature else Text
signature
      action :: TextEdit
action         = Range -> Text -> TextEdit
TextEdit Range
beforeLine (Text -> TextEdit) -> Text -> TextEdit
forall a b. (a -> b) -> a -> b
$ Text
signature Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
startCharacter Text
" "
      in [(Text
title, [TextEdit
action])]
    where removeInitialForAll :: T.Text -> T.Text
          removeInitialForAll :: Text -> Text
removeInitialForAll (Text -> Text -> (Text, Text)
T.breakOnEnd Text
" :: " -> (Text
nm, Text
ty))
              | Text
"forall" Text -> Text -> Bool
`T.isPrefixOf` Text
ty = Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
2 ((Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text -> Text -> (Text, Text)
T.breakOn Text
"." Text
ty))
              | Bool
otherwise                  = Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ty
          startCharacter :: Int
startCharacter
            | Text
"Polymorphic local binding" Text -> Text -> Bool
`T.isPrefixOf` Text
_message
            = Position -> Int
_character Position
_start
            | Bool
otherwise
            = Int
0

suggestSignature Bool
_ Diagnostic
_ = []

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

suggestConstraint :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestConstraint :: ParsedModule -> Maybe Text -> Diagnostic -> [(Text, [TextEdit])]
suggestConstraint ParsedModule
parsedModule Maybe Text
mContents 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:_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)
$sel:_range:Diagnostic :: Diagnostic -> Range
..}
  | Just Text
contents <- Maybe Text
mContents
  , Just Text
missingConstraint <- Text -> Maybe Text
findMissingConstraint Text
_message
  = let codeAction :: Diagnostic -> Text -> [(Text, [TextEdit])]
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 ParsedModule -> Diagnostic -> Text -> [(Text, [TextEdit])]
suggestFunctionConstraint ParsedModule
parsedModule
                        else Text -> Diagnostic -> Text -> [(Text, [TextEdit])]
suggestInstanceConstraint Text
contents
     in Diagnostic -> Text -> [(Text, [TextEdit])]
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"
         in Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
t Text
regex 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

normalizeConstraints :: T.Text -> T.Text -> T.Text
normalizeConstraints :: Text -> Text -> Text
normalizeConstraints Text
existingConstraints Text
constraint =
  let constraintsInit :: Text
constraintsInit = if Text
"(" Text -> Text -> Bool
`T.isPrefixOf` Text
existingConstraints
                           then Int -> Text -> Text
T.dropEnd Int
1 Text
existingConstraints
                           else Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
existingConstraints
   in Text
constraintsInit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constraint Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

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

suggestInstanceConstraint :: T.Text -> Diagnostic -> T.Text -> [(T.Text, [TextEdit])]
suggestInstanceConstraint :: Text -> Diagnostic -> Text -> [(Text, [TextEdit])]
suggestInstanceConstraint Text
contents 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:_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)
$sel:_range:Diagnostic :: Diagnostic -> Range
..} Text
missingConstraint
-- 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 ‘([^`]*)’"
  = let instanceLine :: Int
instanceLine = Text
contents
          Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Text -> Text -> [Text]
T.splitOn (Text
"instance " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
instanceDeclaration)
          [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
        startOfConstraint :: Position
startOfConstraint = Int -> Int -> Position
Position Int
instanceLine (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath
"instance " :: String))
        range :: Range
range = Position -> Position -> Range
Range Position
startOfConstraint Position
startOfConstraint
        newConstraint :: Text
newConstraint = Text
missingConstraint Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => "
     in [(Text -> Text
actionTitle Text
missingConstraint, [Range -> Text -> TextEdit
TextEdit Range
range Text
newConstraint])]

-- 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]+)"
  = let existingConstraints :: Text
existingConstraints = Text -> Text
findExistingConstraints Text
_message
        newConstraints :: Text
newConstraints = Text -> Text -> Text
normalizeConstraints Text
existingConstraints Text
missingConstraint
        instanceLine :: Int
instanceLine = Text -> Int
readPositionNumber Text
instanceLineStr
        constraintFirstChar :: Int
constraintFirstChar = Text -> Int
readPositionNumber Text
constraintFirstCharStr
        startOfConstraint :: Position
startOfConstraint = Int -> Int -> Position
Position Int
instanceLine Int
constraintFirstChar
        endOfConstraint :: Position
endOfConstraint = Int -> Int -> Position
Position Int
instanceLine (Int -> Position) -> Int -> Position
forall a b. (a -> b) -> a -> b
$
          Int
constraintFirstChar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
existingConstraints
        range :: Range
range = Position -> Position -> Range
Range Position
startOfConstraint Position
endOfConstraint
     in [(Text -> Text
actionTitle Text
missingConstraint, [Range -> Text -> TextEdit
TextEdit Range
range Text
newConstraints])]
  | Bool
otherwise = []
    where
      findExistingConstraints :: T.Text -> T.Text
      findExistingConstraints :: Text -> Text
findExistingConstraints Text
t =
        Text -> Text -> Text -> Text
T.replace Text
"from the context: " Text
"" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
t [Text] -> Int -> Text
forall a. [a] -> Int -> a
!! Int
1

      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 (FilePath -> Int) -> (Int -> Int) -> FilePath -> Int
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Int -> Int
forall a. Enum a => a -> a
pred

      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"

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 :: ParsedModule -> Diagnostic -> T.Text -> [(T.Text, [TextEdit])]
suggestFunctionConstraint :: ParsedModule -> Diagnostic -> Text -> [(Text, [TextEdit])]
suggestFunctionConstraint 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}} 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:_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)
$sel:_range:Diagnostic :: Diagnostic -> Range
..} 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
  = let mExistingConstraints :: Maybe Text
mExistingConstraints = Text -> Maybe Text
findExistingConstraints Text
_message
        newConstraint :: Text
newConstraint = Text -> Maybe Text -> Text
buildNewConstraints Text
missingConstraint Maybe Text
mExistingConstraints
     in case Text -> Maybe Range
findRangeOfContextForFunctionNamed Text
typeSignatureName of
       Just Range
range -> [(Text -> Text -> Text
actionTitle Text
missingConstraint Text
typeSignatureName, [Range -> Text -> TextEdit
TextEdit Range
range Text
newConstraint])]
       Maybe Range
Nothing -> []
  | Bool
otherwise = []
    where
      findRangeOfContextForFunctionNamed :: T.Text -> Maybe Range
      findRangeOfContextForFunctionNamed :: Text -> Maybe Range
findRangeOfContextForFunctionNamed Text
typeSignatureName = do
          LHsType GhcPs
locatedType <- [LHsType GhcPs] -> Maybe (LHsType GhcPs)
forall a. [a] -> Maybe a
listToMaybe
              [ LHsType GhcPs
locatedType
              | L SrcSpan
_ (SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
identifiers (HsWC XHsWC GhcPs (LHsSigType GhcPs)
_ (HsIB XHsIB GhcPs (LHsType GhcPs)
_ LHsType GhcPs
locatedType)))) <- [LHsDecl GhcPs]
hsmodDecls
              , (RdrName -> Bool) -> [RdrName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (IdP GhcPs -> FilePath -> Bool
`isSameName` Text -> FilePath
T.unpack Text
typeSignatureName) ([RdrName] -> Bool) -> [RdrName] -> Bool
forall a b. (a -> b) -> a -> b
$ (Located RdrName -> RdrName) -> [Located RdrName] -> [RdrName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP GhcPs)]
[Located RdrName]
identifiers
              ]
          SrcSpan -> Maybe Range
srcSpanToRange (SrcSpan -> Maybe Range) -> SrcSpan -> Maybe Range
forall a b. (a -> b) -> a -> b
$ case LHsType GhcPs -> (LHsContext GhcPs, LHsType GhcPs)
forall pass. LHsType pass -> (LHsContext pass, LHsType pass)
splitLHsQualTy LHsType GhcPs
locatedType of
            (L SrcSpan
contextSrcSpan [LHsType GhcPs]
_ , LHsType GhcPs
_) ->
              if SrcSpan -> Bool
isGoodSrcSpan SrcSpan
contextSrcSpan
                then SrcSpan
contextSrcSpan -- The type signature has explicit context

                else -- No explicit context, return SrcSpan at the start of type sig where we can write context

                     let start :: SrcLoc
start = SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc) -> SrcSpan -> SrcLoc
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsType GhcPs
locatedType in SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
start SrcLoc
start

      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

      findExistingConstraints :: T.Text -> Maybe T.Text
      findExistingConstraints :: Text -> Maybe Text
findExistingConstraints Text
message =
        if Text
message Text -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (FilePath
"from the context:" :: String)
           then ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
T.strip (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. [a] -> a
head) (Maybe [Text] -> Maybe Text) -> Maybe [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
message Text
"\\. ([^=]+)"
           else Maybe Text
forall a. Maybe a
Nothing

      buildNewConstraints :: T.Text -> Maybe T.Text -> T.Text
      buildNewConstraints :: Text -> Maybe Text -> Text
buildNewConstraints Text
constraint Maybe Text
mExistingConstraints =
        case Maybe Text
mExistingConstraints of
          Just Text
existingConstraints -> Text -> Text -> Text
normalizeConstraints Text
existingConstraints Text
constraint
          Maybe Text
Nothing -> Text
constraint Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => "

      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:_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)
$sel:_range:Diagnostic :: Diagnostic -> Range
..}
-- • 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])
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
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 -> 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
<> IdentInfo -> Text
renderIdentInfo IdentInfo
identInfo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      ,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

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

    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

rangesForBinding ImportDecl GhcPs
_ FilePath
_ = []

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
_ = []

-- | Extends an import list with a new binding.

--   Assumes an import statement of the form:

--       import (qualified) A (..) ..

--   Places the new binding first, preserving whitespace.

--   Copes with multi-line import lists

addBindingToImportList :: IdentInfo -> T.Text -> Maybe T.Text
addBindingToImportList :: IdentInfo -> Text -> Maybe Text
addBindingToImportList IdentInfo {parent :: IdentInfo -> Maybe Text
parent = Maybe Text
_parent, Bool
Text
isDatacon :: Bool
rendered :: Text
name :: Text
isDatacon :: IdentInfo -> Bool
rendered :: IdentInfo -> Text
name :: IdentInfo -> Text
..} Text
importLine =
  case Text -> Text -> (Text, Text)
T.breakOn Text
"(" Text
importLine of
    (Text
pre, Text -> Maybe (Char, Text)
T.uncons -> Just (Char
_, Text
rest)) ->
      case Maybe Text
_parent of
        -- the binding is not a constructor, add it to the head of import list

        Maybe Text
Nothing -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
pre, Text
"(", Text
rendered, Text -> Text
addCommaIfNeeds Text
rest]
        Just Text
parent -> case Text -> Text -> (Text, Text)
T.breakOn Text
parent Text
rest of
          -- the binding is a constructor, and current import list contains its parent

          -- `rest'` could be 1. `,...)`

          --               or 2. `(),...)`

          --               or 3. `(ConsA),...)`

          --               or 4. `)`

          (Text
leading, Text -> Text -> Maybe Text
T.stripPrefix Text
parent -> Just Text
rest') -> case Text -> Maybe (Char, Text)
T.uncons (Text -> Text
T.stripStart Text
rest') of
            -- case 1: no children and parentheses, e.g. `import A(Foo,...)` --> `import A(Foo(Cons), ...)`

            Just (Char
',', Text
rest'') -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
pre, Text
"(", Text
leading, Text
parent, Text
"(", Text
rendered, Text
")", Text -> Text
addCommaIfNeeds Text
rest'']
            -- case 2: no children but parentheses, e.g. `import A(Foo(),...)` --> `import A(Foo(Cons), ...)`

            Just (Char
'(', Text -> Maybe (Char, Text)
T.uncons -> Just (Char
')', Text
rest'')) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
pre, Text
"(", Text
leading, Text
parent, Text
"(", Text
rendered, Text
")", Text
rest'']
            -- case 3: children with parentheses, e.g. `import A(Foo(ConsA),...)` --> `import A(Foo(Cons, ConsA), ...)`

            Just (Char
'(', Text -> Text -> (Text, Text)
T.breakOn Text
")" -> (Text
children, Text
rest''))
              | Bool -> Bool
not (Text -> Bool
T.null Text
children),
                -- ignore A(Foo({-...-}), ...)

                Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"{-" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.stripStart Text
children
              -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
pre, Text
"(", Text
leading, Text
parent, Text
"(", Text
rendered, Text
", ", Text
children, Text
rest'']
            -- case 4: no trailing, e.g. `import A(..., Foo)` --> `import A(..., Foo(Cons))`

            Just (Char
')', Text
_) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
pre, Text
"(", Text
leading, Text
parent, Text
"(", Text
rendered, Text
")", Text
rest']
            Maybe (Char, Text)
_ -> Maybe Text
forall a. Maybe a
Nothing
          -- current import list does not contain the parent, e.g. `import A(...)` --> `import A(Foo(Cons), ...)`

          (Text, Text)
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
pre, Text
"(", Text
parent, Text
"(", Text
rendered, Text
")", Text -> Text
addCommaIfNeeds Text
rest]
    (Text, Text)
_ -> Maybe Text
forall a. Maybe a
Nothing
  where
    addCommaIfNeeds :: Text -> Text
addCommaIfNeeds Text
r = case Text -> Maybe (Char, Text)
T.uncons (Text -> Text
T.stripStart Text
r) of
      Just (Char
')', Text
_) -> Text
r
      Maybe (Char, Text)
_ -> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r

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

setHandlersCodeLens :: PartialHandlers c
setHandlersCodeLens :: PartialHandlers c
setHandlersCodeLens = (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c)
-> (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x -> Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x{
    codeLensHandler :: Maybe (Handler CodeLensRequest)
LSP.codeLensHandler =
        (ResponseMessage (List CodeLens) -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> CodeLensParams
    -> IO (Either ResponseError (List CodeLens)))
-> Maybe (Handler CodeLensRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage (List CodeLens) -> FromServerMessage
RspCodeLens LspFuncs c
-> IdeState
-> CodeLensParams
-> IO (Either ResponseError (List CodeLens))
forall c.
LspFuncs c
-> IdeState
-> CodeLensParams
-> IO (Either ResponseError (List CodeLens))
codeLens,
    executeCommandHandler :: Maybe (Handler ExecuteCommandRequest)
LSP.executeCommandHandler =
        (ResponseMessage Value -> FromServerMessage)
-> (RequestMessage
      ServerMethod
      ApplyWorkspaceEditParams
      ApplyWorkspaceEditResponseBody
    -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> ExecuteCommandParams
    -> IO
         (Either ResponseError Value,
          Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> Maybe (Handler ExecuteCommandRequest)
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withResponseAndRequest
            ResponseMessage Value -> FromServerMessage
RspExecuteCommand
            RequestMessage
  ServerMethod
  ApplyWorkspaceEditParams
  ApplyWorkspaceEditResponseBody
-> FromServerMessage
ReqApplyWorkspaceEdit
            LspFuncs c
-> IdeState
-> ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall c.
LspFuncs c
-> IdeState
-> ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
commandHandler
    }

filterNewlines :: T.Text -> T.Text
filterNewlines :: Text -> Text
filterNewlines = [Text] -> Text
T.concat  ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

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)

renderIdentInfo :: IdentInfo -> T.Text
renderIdentInfo :: IdentInfo -> Text
renderIdentInfo IdentInfo {Maybe Text
parent :: Maybe Text
parent :: IdentInfo -> Maybe Text
parent, Text
rendered :: Text
rendered :: IdentInfo -> Text
rendered}
  | Just Text
p <- Maybe Text
parent = Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rendered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  | Bool
otherwise        = Text
rendered