{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ViewPatterns          #-}

-- | Provides code actions to add missing pragmas (whenever GHC suggests to)
module Ide.Plugin.Pragmas
  ( suggestPragmaDescriptor
  , completionDescriptor
  , suggestDisableWarningDescriptor
  -- For testing
  , validPragmas
  , AppearWhere(..)
  ) where

import           Control.Lens                             hiding (List)
import           Control.Monad.IO.Class                   (MonadIO (liftIO))
import           Control.Monad.Trans.Class                (lift)
import           Data.Char                                (isAlphaNum)
import           Data.List.Extra                          (nubOrdOn)
import qualified Data.Map                                 as M
import           Data.Maybe                               (mapMaybe)
import qualified Data.Text                                as T
import           Development.IDE                          hiding (line)
import           Development.IDE.Core.Compile             (sourceParser,
                                                           sourceTypecheck)
import           Development.IDE.Core.PluginUtils
import           Development.IDE.GHC.Compat
import           Development.IDE.Plugin.Completions       (ghcideCompletionsPluginPriority)
import           Development.IDE.Plugin.Completions.Logic (getCompletionPrefix)
import           Development.IDE.Plugin.Completions.Types (PosPrefixInfo (..))
import qualified Development.IDE.Spans.Pragmas            as Pragmas
import           Ide.Plugin.Error
import           Ide.Types
import qualified Language.LSP.Protocol.Lens               as L
import qualified Language.LSP.Protocol.Message            as LSP
import qualified Language.LSP.Protocol.Types              as LSP
import qualified Text.Fuzzy                               as Fuzzy

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

suggestPragmaDescriptor :: PluginId -> PluginDescriptor IdeState
suggestPragmaDescriptor :: PluginId -> PluginDescriptor IdeState
suggestPragmaDescriptor PluginId
plId = (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
"Provides a code action to add missing LANGUAGE pragmas")
  { pluginHandlers = mkPluginHandler LSP.SMethod_TextDocumentCodeAction suggestPragmaProvider
  , pluginPriority = defaultPluginPriority + 1000
  }

completionDescriptor :: PluginId -> PluginDescriptor IdeState
completionDescriptor :: PluginId -> PluginDescriptor IdeState
completionDescriptor PluginId
plId = (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
"Provides completion of LANGAUGE pragmas")
  { pluginHandlers = mkPluginHandler LSP.SMethod_TextDocumentCompletion completion
  , pluginPriority = ghcideCompletionsPluginPriority + 1
  }

suggestDisableWarningDescriptor :: PluginId -> PluginDescriptor IdeState
suggestDisableWarningDescriptor :: PluginId -> PluginDescriptor IdeState
suggestDisableWarningDescriptor PluginId
plId = (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
"Provides a code action to disable warnings")
  { pluginHandlers = mkPluginHandler LSP.SMethod_TextDocumentCodeAction suggestDisableWarningProvider
    -- #3636 Suggestions to disable warnings should appear last.
  , pluginPriority = 0
  }

-- ---------------------------------------------------------------------
-- | Title and pragma
type PragmaEdit = (T.Text, Pragma)

data Pragma = LangExt T.Text | OptGHC T.Text
  deriving (Int -> Pragma -> ShowS
[Pragma] -> ShowS
Pragma -> String
(Int -> Pragma -> ShowS)
-> (Pragma -> String) -> ([Pragma] -> ShowS) -> Show Pragma
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pragma -> ShowS
showsPrec :: Int -> Pragma -> ShowS
$cshow :: Pragma -> String
show :: Pragma -> String
$cshowList :: [Pragma] -> ShowS
showList :: [Pragma] -> ShowS
Show, Pragma -> Pragma -> Bool
(Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool) -> Eq Pragma
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pragma -> Pragma -> Bool
== :: Pragma -> Pragma -> Bool
$c/= :: Pragma -> Pragma -> Bool
/= :: Pragma -> Pragma -> Bool
Eq, Eq Pragma
Eq Pragma =>
(Pragma -> Pragma -> Ordering)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Pragma)
-> (Pragma -> Pragma -> Pragma)
-> Ord Pragma
Pragma -> Pragma -> Bool
Pragma -> Pragma -> Ordering
Pragma -> Pragma -> Pragma
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pragma -> Pragma -> Ordering
compare :: Pragma -> Pragma -> Ordering
$c< :: Pragma -> Pragma -> Bool
< :: Pragma -> Pragma -> Bool
$c<= :: Pragma -> Pragma -> Bool
<= :: Pragma -> Pragma -> Bool
$c> :: Pragma -> Pragma -> Bool
> :: Pragma -> Pragma -> Bool
$c>= :: Pragma -> Pragma -> Bool
>= :: Pragma -> Pragma -> Bool
$cmax :: Pragma -> Pragma -> Pragma
max :: Pragma -> Pragma -> Pragma
$cmin :: Pragma -> Pragma -> Pragma
min :: Pragma -> Pragma -> Pragma
Ord)

suggestPragmaProvider :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
suggestPragmaProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
suggestPragmaProvider = (Maybe DynFlags -> Diagnostic -> [PragmaEdit])
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
mkCodeActionProvider Maybe DynFlags -> Diagnostic -> [PragmaEdit]
suggest

suggestDisableWarningProvider :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
suggestDisableWarningProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
suggestDisableWarningProvider = (Maybe DynFlags -> Diagnostic -> [PragmaEdit])
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
mkCodeActionProvider ((Maybe DynFlags -> Diagnostic -> [PragmaEdit])
 -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction)
-> (Maybe DynFlags -> Diagnostic -> [PragmaEdit])
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
forall a b. (a -> b) -> a -> b
$ (Diagnostic -> [PragmaEdit])
-> Maybe DynFlags -> Diagnostic -> [PragmaEdit]
forall a b. a -> b -> a
const Diagnostic -> [PragmaEdit]
suggestDisableWarning

mkCodeActionProvider :: (Maybe DynFlags -> Diagnostic -> [PragmaEdit]) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
mkCodeActionProvider :: (Maybe DynFlags -> Diagnostic -> [PragmaEdit])
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
mkCodeActionProvider Maybe DynFlags -> Diagnostic -> [PragmaEdit]
mkSuggest IdeState
state PluginId
_plId
  (LSP.CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ LSP.TextDocumentIdentifier{ $sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri = Uri
uri } Range
_ (LSP.CodeActionContext [Diagnostic]
diags Maybe [CodeActionKind]
_monly Maybe CodeActionTriggerKind
_)) = do
    NormalizedFilePath
normalizedFilePath <- Uri -> ExceptT PluginError (HandlerM Config) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
    -- ghc session to get some dynflags even if module isn't parsed
    (HscEnvEq -> HscEnv
hscEnv -> HscEnv -> DynFlags
hsc_dflags -> DynFlags
sessionDynFlags, PositionMapping
_) <-
      String
-> IdeState
-> ExceptT PluginError Action (HscEnvEq, PositionMapping)
-> ExceptT
     PluginError (HandlerM Config) (HscEnvEq, PositionMapping)
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"Pragmas.GhcSession" IdeState
state (ExceptT PluginError Action (HscEnvEq, PositionMapping)
 -> ExceptT
      PluginError (HandlerM Config) (HscEnvEq, PositionMapping))
-> ExceptT PluginError Action (HscEnvEq, PositionMapping)
-> ExceptT
     PluginError (HandlerM Config) (HscEnvEq, PositionMapping)
forall a b. (a -> b) -> a -> b
$ GhcSession
-> NormalizedFilePath
-> ExceptT PluginError Action (HscEnvEq, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE GhcSession
GhcSession NormalizedFilePath
normalizedFilePath
    (UTCTime
_, Maybe Text
fileContents) <- IO (UTCTime, Maybe Text)
-> ExceptT PluginError (HandlerM Config) (UTCTime, Maybe Text)
forall a. IO a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (UTCTime, Maybe Text)
 -> ExceptT PluginError (HandlerM Config) (UTCTime, Maybe Text))
-> IO (UTCTime, Maybe Text)
-> ExceptT PluginError (HandlerM Config) (UTCTime, Maybe Text)
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action (UTCTime, Maybe Text)
-> IO (UTCTime, Maybe Text)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"Pragmas.GetFileContents" IdeState
state (Action (UTCTime, Maybe Text) -> IO (UTCTime, Maybe Text))
-> Action (UTCTime, Maybe Text) -> IO (UTCTime, Maybe Text)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Action (UTCTime, Maybe Text)
getFileContents NormalizedFilePath
normalizedFilePath
    Maybe ParsedModule
parsedModule <- IO (Maybe ParsedModule)
-> ExceptT PluginError (HandlerM Config) (Maybe ParsedModule)
forall a. IO a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ParsedModule)
 -> ExceptT PluginError (HandlerM Config) (Maybe ParsedModule))
-> IO (Maybe ParsedModule)
-> ExceptT PluginError (HandlerM Config) (Maybe ParsedModule)
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action (Maybe ParsedModule)
-> IO (Maybe ParsedModule)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"Pragmas.GetParsedModule" IdeState
state (Action (Maybe ParsedModule) -> IO (Maybe ParsedModule))
-> Action (Maybe ParsedModule) -> IO (Maybe ParsedModule)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Action (Maybe ParsedModule)
getParsedModule NormalizedFilePath
normalizedFilePath
    let parsedModuleDynFlags :: Maybe DynFlags
parsedModuleDynFlags = ModSummary -> DynFlags
ms_hspp_opts (ModSummary -> DynFlags)
-> (ParsedModule -> ModSummary) -> ParsedModule -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary (ParsedModule -> DynFlags) -> Maybe ParsedModule -> Maybe DynFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ParsedModule
parsedModule
        nextPragmaInfo :: NextPragmaInfo
nextPragmaInfo = DynFlags -> Maybe Text -> NextPragmaInfo
Pragmas.getNextPragmaInfo DynFlags
sessionDynFlags Maybe Text
fileContents
        pedits :: [PragmaEdit]
pedits = (PragmaEdit -> Pragma) -> [PragmaEdit] -> [PragmaEdit]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn PragmaEdit -> Pragma
forall a b. (a, b) -> b
snd ([PragmaEdit] -> [PragmaEdit]) -> [PragmaEdit] -> [PragmaEdit]
forall a b. (a -> b) -> a -> b
$ (Diagnostic -> [PragmaEdit]) -> [Diagnostic] -> [PragmaEdit]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe DynFlags -> Diagnostic -> [PragmaEdit]
mkSuggest Maybe DynFlags
parsedModuleDynFlags) [Diagnostic]
diags
    ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure  (([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (HandlerM Config) ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
LSP.InL ([Command |? CodeAction] -> [Command |? CodeAction] |? Null)
-> [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. (a -> b) -> a -> b
$ Uri -> NextPragmaInfo -> PragmaEdit -> Command |? CodeAction
pragmaEditToAction Uri
uri NextPragmaInfo
nextPragmaInfo (PragmaEdit -> Command |? CodeAction)
-> [PragmaEdit] -> [Command |? CodeAction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PragmaEdit]
pedits



-- | Add a Pragma to the given URI at the top of the file.
-- It is assumed that the pragma name is a valid pragma,
-- thus, not validated.
pragmaEditToAction :: Uri -> Pragmas.NextPragmaInfo -> PragmaEdit -> (LSP.Command LSP.|? LSP.CodeAction)
pragmaEditToAction :: Uri -> NextPragmaInfo -> PragmaEdit -> Command |? CodeAction
pragmaEditToAction Uri
uri Pragmas.NextPragmaInfo{ Int
nextPragmaLine :: Int
$sel:nextPragmaLine:NextPragmaInfo :: NextPragmaInfo -> Int
nextPragmaLine, Maybe LineSplitTextEdits
lineSplitTextEdits :: Maybe LineSplitTextEdits
$sel:lineSplitTextEdits:NextPragmaInfo :: NextPragmaInfo -> Maybe LineSplitTextEdits
lineSplitTextEdits } (Text
title, Pragma
p) =
  CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
LSP.InR (CodeAction -> Command |? CodeAction)
-> CodeAction -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe CodeActionKind
-> Maybe [Diagnostic]
-> Maybe Bool
-> Maybe CodeActionDisabled
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
LSP.CodeAction Text
title (CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
LSP.CodeActionKind_QuickFix) ([Diagnostic] -> Maybe [Diagnostic]
forall a. a -> Maybe a
Just []) Maybe Bool
forall a. Maybe a
Nothing Maybe CodeActionDisabled
forall a. Maybe a
Nothing (WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit
edit) Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing
  where
    render :: Pragma -> Text
render (OptGHC Text
x)  = Text
"{-# OPTIONS_GHC -Wno-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" #-}\n"
    render (LangExt Text
x) = Text
"{-# LANGUAGE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" #-}\n"
    pragmaInsertPosition :: Position
pragmaInsertPosition = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nextPragmaLine) UInt
0
    pragmaInsertRange :: Range
pragmaInsertRange = Position -> Position -> Range
Range Position
pragmaInsertPosition Position
pragmaInsertPosition
    -- workaround the fact that for some reason lsp-test applies text
    -- edits in reverse order than lsp (tried in both coc.nvim and vscode)
    textEdits :: [TextEdit]
textEdits =
      if | Just (Pragmas.LineSplitTextEdits TextEdit
insertTextEdit TextEdit
deleteTextEdit) <- Maybe LineSplitTextEdits
lineSplitTextEdits
         , let LSP.TextEdit{ Range
_range :: Range
$sel:_range:TextEdit :: TextEdit -> Range
_range, Text
_newText :: Text
$sel:_newText:TextEdit :: TextEdit -> Text
_newText } = TextEdit
insertTextEdit ->
             [Range -> Text -> TextEdit
LSP.TextEdit Range
_range (Pragma -> Text
render Pragma
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
_newText), TextEdit
deleteTextEdit]
         | Bool
otherwise -> [Range -> Text -> TextEdit
LSP.TextEdit Range
pragmaInsertRange (Pragma -> Text
render Pragma
p)]

    edit :: WorkspaceEdit
edit =
      Maybe (Map Uri [TextEdit])
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
LSP.WorkspaceEdit
        (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit]))
-> Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a b. (a -> b) -> a -> b
$ Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
M.singleton Uri
uri [TextEdit]
textEdits)
        Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing
        Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing

suggest :: Maybe DynFlags -> Diagnostic -> [PragmaEdit]
suggest :: Maybe DynFlags -> Diagnostic -> [PragmaEdit]
suggest Maybe DynFlags
dflags Diagnostic
diag =
  Maybe DynFlags -> Diagnostic -> [PragmaEdit]
suggestAddPragma Maybe DynFlags
dflags Diagnostic
diag

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

suggestDisableWarning :: Diagnostic -> [PragmaEdit]
suggestDisableWarning :: Diagnostic -> [PragmaEdit]
suggestDisableWarning Diagnostic {Maybe (Int32 |? Text)
_code :: Maybe (Int32 |? Text)
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
_code}
  | Just (LSP.InR (Text -> Text -> Maybe Text
T.stripPrefix Text
"-W" -> Just Text
w)) <- Maybe (Int32 |? Text)
_code
  , Text
w Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
warningBlacklist =
    PragmaEdit -> [PragmaEdit]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"Disable \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" warnings", Text -> Pragma
OptGHC Text
w)
  | Bool
otherwise = []

-- Don't suggest disabling type errors as a solution to all type errors
warningBlacklist :: [T.Text]
warningBlacklist :: [Text]
warningBlacklist = [Text
"deferred-type-errors"]

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

-- | Offer to add a missing Language Pragma to the top of a file.
-- Pragmas are defined by a curated list of known pragmas, see 'possiblePragmas'.
suggestAddPragma :: Maybe DynFlags -> Diagnostic -> [PragmaEdit]
suggestAddPragma :: Maybe DynFlags -> Diagnostic -> [PragmaEdit]
suggestAddPragma Maybe DynFlags
mDynflags Diagnostic {Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message, Maybe Text
_source :: Maybe Text
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
_source}
    | Maybe Text
_source Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sourceTypecheck Bool -> Bool -> Bool
|| Maybe Text
_source Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sourceParser = Text -> [PragmaEdit]
genPragma Text
_message
  where
    genPragma :: Text -> [PragmaEdit]
genPragma Text
target =
      [(Text
"Add \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"", Text -> Pragma
LangExt Text
r) | Text
r <- Text -> [Text]
findPragma Text
target, Text
r Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
disabled]
    disabled :: [Text]
disabled
      | Just DynFlags
dynFlags <- Maybe DynFlags
mDynflags =
        -- GHC does not export 'OnOff', so we have to view it as string
        (OnOff Extension -> Maybe Text) -> [OnOff Extension] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Text -> Maybe Text
T.stripPrefix Text
"Off " (Text -> Maybe Text)
-> (OnOff Extension -> Text) -> OnOff Extension -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnOff Extension -> Text
forall a. Outputable a => a -> Text
printOutputable) (DynFlags -> [OnOff Extension]
extensions DynFlags
dynFlags)
      | Bool
otherwise =
        -- When the module failed to parse, we don't have access to its
        -- dynFlags. In that case, simply don't disable any pragmas.
        []
suggestAddPragma Maybe DynFlags
_ Diagnostic
_ = []

-- | Find all Pragmas are an infix of the search term.
findPragma :: T.Text -> [T.Text]
findPragma :: Text -> [Text]
findPragma Text
str = (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
check [Text]
possiblePragmas
  where
    check :: Text -> [Text]
check Text
p = [Text
p | Text -> Text -> Bool
T.isInfixOf Text
p Text
str]

    -- We exclude the Strict extension as it causes many false positives, see
    -- the discussion at https://github.com/haskell/ghcide/pull/638
    --
    -- We don't include the No- variants, as GHC never suggests disabling an
    -- extension in an error message.
    possiblePragmas :: [T.Text]
    possiblePragmas :: [Text]
possiblePragmas =
       [ Text
name
       | FlagSpec{flagSpecName :: forall flag. FlagSpec flag -> String
flagSpecName = String -> Text
T.pack -> Text
name} <- [FlagSpec Extension]
xFlags
       , Text
"Strict" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name
       ]

-- | All language pragmas, including the No- variants
allPragmas :: [T.Text]
allPragmas :: [Text]
allPragmas =
  [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Text
name, Text
"No" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name]
    | FlagSpec{flagSpecName :: forall flag. FlagSpec flag -> String
flagSpecName = String -> Text
T.pack -> Text
name} <- [FlagSpec Extension]
xFlags
    ]
  [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
  -- These pragmas are not part of xFlags as they are not reversable
  -- by prepending "No".
  [ -- Safe Haskell
    Text
"Unsafe"
  , Text
"Trustworthy"
  , Text
"Safe"

    -- Language Version Extensions
  , Text
"Haskell98"
  , Text
"Haskell2010"
  , Text
"GHC2021"
  ]

-- ---------------------------------------------------------------------
flags :: [T.Text]
flags :: [Text]
flags = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ Bool -> [String]
flagsForCompletion Bool
False

completion :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion
completion :: PluginMethodHandler IdeState 'Method_TextDocumentCompletion
completion IdeState
_ide PluginId
_ MessageParams 'Method_TextDocumentCompletion
complParams = do
    let (LSP.TextDocumentIdentifier Uri
uri) = MessageParams 'Method_TextDocumentCompletion
CompletionParams
complParams CompletionParams
-> Getting
     TextDocumentIdentifier CompletionParams TextDocumentIdentifier
-> TextDocumentIdentifier
forall s a. s -> Getting a s a -> a
^. Getting
  TextDocumentIdentifier CompletionParams TextDocumentIdentifier
forall s a. HasTextDocument s a => Lens' s a
Lens' CompletionParams TextDocumentIdentifier
L.textDocument
        position :: Position
position@(Position UInt
ln UInt
col) = MessageParams 'Method_TextDocumentCompletion
CompletionParams
complParams CompletionParams
-> Getting Position CompletionParams Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position CompletionParams Position
forall s a. HasPosition s a => Lens' s a
Lens' CompletionParams Position
L.position
    Maybe VirtualFile
contents <- HandlerM Config (Maybe VirtualFile)
-> ExceptT PluginError (HandlerM Config) (Maybe VirtualFile)
forall (m :: * -> *) a. Monad m => m a -> ExceptT PluginError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HandlerM Config (Maybe VirtualFile)
 -> ExceptT PluginError (HandlerM Config) (Maybe VirtualFile))
-> HandlerM Config (Maybe VirtualFile)
-> ExceptT PluginError (HandlerM Config) (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ NormalizedUri -> HandlerM Config (Maybe VirtualFile)
forall config. NormalizedUri -> HandlerM config (Maybe VirtualFile)
pluginGetVirtualFile (NormalizedUri -> HandlerM Config (Maybe VirtualFile))
-> NormalizedUri -> HandlerM Config (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
    ([CompletionItem] -> [CompletionItem] |? (CompletionList |? Null))
-> ExceptT PluginError (HandlerM Config) [CompletionItem]
-> ExceptT
     PluginError
     (HandlerM Config)
     ([CompletionItem] |? (CompletionList |? Null))
forall a b.
(a -> b)
-> ExceptT PluginError (HandlerM Config) a
-> ExceptT PluginError (HandlerM Config) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CompletionItem] -> [CompletionItem] |? (CompletionList |? Null)
forall a b. a -> a |? b
LSP.InL (ExceptT PluginError (HandlerM Config) [CompletionItem]
 -> ExceptT
      PluginError
      (HandlerM Config)
      ([CompletionItem] |? (CompletionList |? Null)))
-> ExceptT PluginError (HandlerM Config) [CompletionItem]
-> ExceptT
     PluginError
     (HandlerM Config)
     ([CompletionItem] |? (CompletionList |? Null))
forall a b. (a -> b) -> a -> b
$ case (Maybe VirtualFile
contents, Uri -> Maybe String
uriToFilePath' Uri
uri) of
        (Just VirtualFile
cnts, Just String
_path) ->
            [CompletionItem]
-> ExceptT PluginError (HandlerM Config) [CompletionItem]
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CompletionItem]
 -> ExceptT PluginError (HandlerM Config) [CompletionItem])
-> [CompletionItem]
-> ExceptT PluginError (HandlerM Config) [CompletionItem]
forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> [CompletionItem]
result (PosPrefixInfo -> [CompletionItem])
-> PosPrefixInfo -> [CompletionItem]
forall a b. (a -> b) -> a -> b
$ Position -> VirtualFile -> PosPrefixInfo
getCompletionPrefix Position
position VirtualFile
cnts
            where
                result :: PosPrefixInfo -> [CompletionItem]
result PosPrefixInfo
pfix
                    | Text
"{-# language" Text -> Text -> Bool
`T.isPrefixOf` Text
line
                    = (Text -> CompletionItem) -> [Text] -> [CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
map Text -> CompletionItem
mkLanguagePragmaCompl ([Text] -> [CompletionItem]) -> [Text] -> [CompletionItem]
forall a b. (a -> b) -> a -> b
$
                        Text -> [Text] -> [Text]
forall s. TextualMonoid s => s -> [s] -> [s]
Fuzzy.simpleFilter Text
word [Text]
allPragmas
                    | Text
"{-# options_ghc" Text -> Text -> Bool
`T.isPrefixOf` Text
line
                    = let optionPrefix :: Text
optionPrefix = PosPrefixInfo -> Text
getGhcOptionPrefix PosPrefixInfo
pfix
                          prefixLength :: UInt
prefixLength = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
optionPrefix
                          prefixRange :: Range
prefixRange = Position -> Position -> Range
LSP.Range (UInt -> UInt -> Position
Position UInt
ln (UInt
col UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
prefixLength)) Position
position
                      in (Text -> CompletionItem) -> [Text] -> [CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
map (Range -> Text -> CompletionItem
mkGhcOptionCompl Range
prefixRange) ([Text] -> [CompletionItem]) -> [Text] -> [CompletionItem]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall s. TextualMonoid s => s -> [s] -> [s]
Fuzzy.simpleFilter Text
optionPrefix [Text]
flags
                    | Text
"{-#" Text -> Text -> Bool
`T.isPrefixOf` Text
line
                    = [ Text -> Text -> Text -> CompletionItem
mkPragmaCompl (Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix) Text
b Text
c
                      | (Text
a, Text
b, Text
c, AppearWhere
w) <- [(Text, Text, Text, AppearWhere)]
validPragmas, AppearWhere
w AppearWhere -> AppearWhere -> Bool
forall a. Eq a => a -> a -> Bool
== AppearWhere
NewLine
                      ]
                    | -- Do not suggest any pragmas under any of these conditions:
                      -- 1. Current line is an import
                      -- 2. There is a module name right before the current word.
                      --    Something like `Text.la` shouldn't suggest adding the
                      --    'LANGUAGE' pragma.
                      -- 3. The user has not typed anything yet.
                      Text
"import" Text -> Text -> Bool
`T.isPrefixOf` Text
line Bool -> Bool -> Bool
|| Bool -> Bool
not (Text -> Bool
T.null Text
module_) Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
word
                    = []
                    | Bool
otherwise
                    = [ Text -> Text -> Text -> CompletionItem
mkPragmaCompl (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pragmaTemplate Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix) Text
matcher Text
detail
                      | (Text
pragmaTemplate, Text
matcher, Text
detail, AppearWhere
appearWhere) <- [(Text, Text, Text, AppearWhere)]
validPragmas
                      , case AppearWhere
appearWhere of
                            -- Only suggest a pragma that needs its own line if the whole line
                            -- fuzzily matches the pragma
                            AppearWhere
NewLine   -> Text -> Text -> Bool
forall s. TextualMonoid s => s -> s -> Bool
Fuzzy.test Text
line Text
matcher
                            -- Only suggest a pragma that appears in the middle of a line when
                            -- the current word is not the only thing in the line and the
                            -- current word fuzzily matches the pragma
                            AppearWhere
CanInline -> Text
line Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
word Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall s. TextualMonoid s => s -> s -> Bool
Fuzzy.test Text
word Text
matcher
                      ]
                    where
                        line :: Text
line = Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> Text
fullLine PosPrefixInfo
pfix
                        module_ :: Text
module_ = PosPrefixInfo -> Text
prefixScope PosPrefixInfo
pfix
                        word :: Text
word = PosPrefixInfo -> Text
prefixText PosPrefixInfo
pfix
                        -- Not completely correct, may fail if more than one "{-#" exists.
                        -- We can ignore it since it rarely happens.
                        prefix :: Text
prefix
                            | Text
"{-# "  Text -> Text -> Bool
`T.isInfixOf` Text
line = Text
""
                            | Text
"{-#"   Text -> Text -> Bool
`T.isInfixOf` Text
line = Text
" "
                            | Bool
otherwise                 = Text
"{-# "
                        suffix :: Text
suffix
                            | Text
" #-}" Text -> Text -> Bool
`T.isSuffixOf` Text
line = Text
""
                            | Text
"#-}"  Text -> Text -> Bool
`T.isSuffixOf` Text
line = Text
" "
                            | Text
"-}"   Text -> Text -> Bool
`T.isSuffixOf` Text
line = Text
" #"
                            | Text
"}"    Text -> Text -> Bool
`T.isSuffixOf` Text
line = Text
" #-"
                            | Bool
otherwise                 = Text
" #-}"
        (Maybe VirtualFile, Maybe String)
_ -> [CompletionItem]
-> ExceptT PluginError (HandlerM Config) [CompletionItem]
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. Monad m => a -> m a
return []

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

-- | Pragma where exist
data AppearWhere =
  NewLine
  -- ^Must be on a new line
  | CanInline
  -- ^Can appear in the line
  deriving (Int -> AppearWhere -> ShowS
[AppearWhere] -> ShowS
AppearWhere -> String
(Int -> AppearWhere -> ShowS)
-> (AppearWhere -> String)
-> ([AppearWhere] -> ShowS)
-> Show AppearWhere
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AppearWhere -> ShowS
showsPrec :: Int -> AppearWhere -> ShowS
$cshow :: AppearWhere -> String
show :: AppearWhere -> String
$cshowList :: [AppearWhere] -> ShowS
showList :: [AppearWhere] -> ShowS
Show, AppearWhere -> AppearWhere -> Bool
(AppearWhere -> AppearWhere -> Bool)
-> (AppearWhere -> AppearWhere -> Bool) -> Eq AppearWhere
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AppearWhere -> AppearWhere -> Bool
== :: AppearWhere -> AppearWhere -> Bool
$c/= :: AppearWhere -> AppearWhere -> Bool
/= :: AppearWhere -> AppearWhere -> Bool
Eq)

validPragmas :: [(T.Text, T.Text, T.Text, AppearWhere)]
validPragmas :: [(Text, Text, Text, AppearWhere)]
validPragmas =
  [ (Text
"LANGUAGE ${1:extension}"        , Text
"LANGUAGE"         , Text
"{-# LANGUAGE #-}"         ,   AppearWhere
NewLine)
  , (Text
"OPTIONS_GHC -${1:option}"       , Text
"OPTIONS_GHC"      , Text
"{-# OPTIONS_GHC #-}"      ,   AppearWhere
NewLine)
  , (Text
"INLINE ${1:function}"           , Text
"INLINE"           , Text
"{-# INLINE #-}"           ,   AppearWhere
NewLine)
  , (Text
"NOINLINE ${1:function}"         , Text
"NOINLINE"         , Text
"{-# NOINLINE #-}"         ,   AppearWhere
NewLine)
  , (Text
"INLINABLE ${1:function}"        , Text
"INLINABLE"        , Text
"{-# INLINABLE #-}"        ,   AppearWhere
NewLine)
  , (Text
"WARNING ${1:message}"           , Text
"WARNING"          , Text
"{-# WARNING #-}"          , AppearWhere
CanInline)
  , (Text
"DEPRECATED ${1:message}"        , Text
"DEPRECATED"       , Text
"{-# DEPRECATED  #-}"      , AppearWhere
CanInline)
  , (Text
"ANN ${1:annotation}"            , Text
"ANN"              , Text
"{-# ANN #-}"              ,   AppearWhere
NewLine)
  , (Text
"RULES"                          , Text
"RULES"            , Text
"{-# RULES #-}"            ,   AppearWhere
NewLine)
  , (Text
"SPECIALIZE ${1:function}"       , Text
"SPECIALIZE"       , Text
"{-# SPECIALIZE #-}"       ,   AppearWhere
NewLine)
  , (Text
"SPECIALIZE INLINE ${1:function}", Text
"SPECIALIZE INLINE", Text
"{-# SPECIALIZE INLINE #-}",   AppearWhere
NewLine)
  , (Text
"SPECIALISE ${1:function}"       , Text
"SPECIALISE"       , Text
"{-# SPECIALISE #-}"       ,   AppearWhere
NewLine)
  , (Text
"SPECIALISE INLINE ${1:function}", Text
"SPECIALISE INLINE", Text
"{-# SPECIALISE INLINE #-}",   AppearWhere
NewLine)
  , (Text
"MINIMAL ${1:functions}"         , Text
"MINIMAL"          , Text
"{-# MINIMAL #-}"          , AppearWhere
CanInline)
  , (Text
"UNPACK"                         , Text
"UNPACK"           , Text
"{-# UNPACK #-}"           , AppearWhere
CanInline)
  , (Text
"NOUNPACK"                       , Text
"NOUNPACK"         , Text
"{-# NOUNPACK #-}"         , AppearWhere
CanInline)
  , (Text
"COMPLETE ${1:function}"         , Text
"COMPLETE"         , Text
"{-# COMPLETE #-}"         ,   AppearWhere
NewLine)
  , (Text
"OVERLAPPING"                    , Text
"OVERLAPPING"      , Text
"{-# OVERLAPPING #-}"      , AppearWhere
CanInline)
  , (Text
"OVERLAPPABLE"                   , Text
"OVERLAPPABLE"     , Text
"{-# OVERLAPPABLE #-}"     , AppearWhere
CanInline)
  , (Text
"OVERLAPS"                       , Text
"OVERLAPS"         , Text
"{-# OVERLAPS #-}"         , AppearWhere
CanInline)
  , (Text
"INCOHERENT"                     , Text
"INCOHERENT"       , Text
"{-# INCOHERENT #-}"       , AppearWhere
CanInline)
  ]

mkPragmaCompl :: T.Text -> T.Text -> T.Text -> LSP.CompletionItem
mkPragmaCompl :: Text -> Text -> Text -> CompletionItem
mkPragmaCompl Text
insertText Text
label Text
detail =
  Text
-> Maybe CompletionItemLabelDetails
-> Maybe CompletionItemKind
-> Maybe [CompletionItemTag]
-> Maybe Text
-> Maybe (Text |? MarkupContent)
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe InsertTextMode
-> Maybe (TextEdit |? InsertReplaceEdit)
-> Maybe Text
-> Maybe [TextEdit]
-> Maybe [Text]
-> Maybe Command
-> Maybe Value
-> CompletionItem
LSP.CompletionItem Text
label Maybe CompletionItemLabelDetails
forall a. Maybe a
Nothing (CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
LSP.CompletionItemKind_Keyword) Maybe [CompletionItemTag]
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
detail)
    Maybe (Text |? MarkupContent)
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
insertText) (InsertTextFormat -> Maybe InsertTextFormat
forall a. a -> Maybe a
Just InsertTextFormat
LSP.InsertTextFormat_Snippet)
    Maybe InsertTextMode
forall a. Maybe a
Nothing Maybe (TextEdit |? InsertReplaceEdit)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe [TextEdit]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing

mkLanguagePragmaCompl :: T.Text -> LSP.CompletionItem
mkLanguagePragmaCompl :: Text -> CompletionItem
mkLanguagePragmaCompl Text
label =
  Text
-> Maybe CompletionItemLabelDetails
-> Maybe CompletionItemKind
-> Maybe [CompletionItemTag]
-> Maybe Text
-> Maybe (Text |? MarkupContent)
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe InsertTextMode
-> Maybe (TextEdit |? InsertReplaceEdit)
-> Maybe Text
-> Maybe [TextEdit]
-> Maybe [Text]
-> Maybe Command
-> Maybe Value
-> CompletionItem
LSP.CompletionItem Text
label Maybe CompletionItemLabelDetails
forall a. Maybe a
Nothing (CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
LSP.CompletionItemKind_Keyword) Maybe [CompletionItemTag]
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
    Maybe (Text |? MarkupContent)
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe InsertTextFormat
forall a. Maybe a
Nothing
    Maybe InsertTextMode
forall a. Maybe a
Nothing Maybe (TextEdit |? InsertReplaceEdit)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe [TextEdit]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing

mkGhcOptionCompl :: Range -> T.Text -> LSP.CompletionItem
mkGhcOptionCompl :: Range -> Text -> CompletionItem
mkGhcOptionCompl Range
editRange Text
completedFlag =
  Text
-> Maybe CompletionItemLabelDetails
-> Maybe CompletionItemKind
-> Maybe [CompletionItemTag]
-> Maybe Text
-> Maybe (Text |? MarkupContent)
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe InsertTextMode
-> Maybe (TextEdit |? InsertReplaceEdit)
-> Maybe Text
-> Maybe [TextEdit]
-> Maybe [Text]
-> Maybe Command
-> Maybe Value
-> CompletionItem
LSP.CompletionItem Text
completedFlag Maybe CompletionItemLabelDetails
forall a. Maybe a
Nothing (CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
LSP.CompletionItemKind_Keyword) Maybe [CompletionItemTag]
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
    Maybe (Text |? MarkupContent)
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe InsertTextFormat
forall a. Maybe a
Nothing
    Maybe InsertTextMode
forall a. Maybe a
Nothing ((TextEdit |? InsertReplaceEdit)
-> Maybe (TextEdit |? InsertReplaceEdit)
forall a. a -> Maybe a
Just TextEdit |? InsertReplaceEdit
forall {b}. TextEdit |? b
insertCompleteFlag) Maybe Text
forall a. Maybe a
Nothing Maybe [TextEdit]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing
  where
    insertCompleteFlag :: TextEdit |? b
insertCompleteFlag = TextEdit -> TextEdit |? b
forall a b. a -> a |? b
LSP.InL (TextEdit -> TextEdit |? b) -> TextEdit -> TextEdit |? b
forall a b. (a -> b) -> a -> b
$ Range -> Text -> TextEdit
LSP.TextEdit Range
editRange Text
completedFlag

-- The prefix extraction logic of getCompletionPrefix
-- doesn't consider '-' part of prefix which breaks completion
-- of flags like "-ddump-xyz". For OPTIONS_GHC completion we need the whole thing
-- to be considered completion prefix, but `prefixText posPrefixInfo` would return"xyz" in this case
getGhcOptionPrefix :: PosPrefixInfo -> T.Text
getGhcOptionPrefix :: PosPrefixInfo -> Text
getGhcOptionPrefix PosPrefixInfo {cursorPos :: PosPrefixInfo -> Position
cursorPos = Position UInt
_ UInt
col, Text
fullLine :: PosPrefixInfo -> Text
fullLine :: Text
fullLine}=
  (Char -> Bool) -> Text -> Text
T.takeWhileEnd Char -> Bool
isGhcOptionChar Text
beforePos
  where
    beforePos :: Text
beforePos = Int -> Text -> Text
T.take (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
col) Text
fullLine

    -- Is this character contained in some GHC flag? Based on:
    -- >>> nub . sort . concat $ GHC.Driver.Session.flagsForCompletion False
    -- "#-.01234589=ABCDEFGHIJKLMNOPQRSTUVWX_abcdefghijklmnopqrstuvwxyz"
    isGhcOptionChar :: Char -> Bool
    isGhcOptionChar :: Char -> Bool
isGhcOptionChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"#-.=_" :: String)