haskell-language-server-2.10.0.0: plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where
import Control.Concurrent.Strict
import Control.DeepSeq
import Control.Lens ((^.))
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (runMaybeT)
import qualified Data.ByteString as BS
import Data.Hashable
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List as List
import qualified Data.List.NonEmpty as NE
import qualified Data.Maybe as Maybe
import Data.Proxy
import qualified Data.Text ()
import qualified Data.Text as T
import qualified Data.Text.Encoding as Encoding
import Data.Text.Utf16.Rope.Mixed as Rope
import Development.IDE as D
import Development.IDE.Core.FileStore (getVersionedTextDoc)
import Development.IDE.Core.PluginUtils
import Development.IDE.Core.Shake (restartShakeSession)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.Graph (Key,
alwaysRerun)
import Development.IDE.LSP.HoverDefinition (foundHover)
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
import Development.IDE.Types.Shake (toKey)
import qualified Distribution.CabalSpecVersion as Cabal
import qualified Distribution.Fields as Syntax
import Distribution.Package (Dependency)
import Distribution.PackageDescription (allBuildDepends,
depPkgName,
unPackageName)
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
import Distribution.Parsec.Error
import qualified Distribution.Parsec.Position as Syntax
import GHC.Generics
import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd
import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
import qualified Ide.Plugin.Cabal.Completion.Data as Data
import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections),
ParseCabalFields (..),
ParseCabalFile (..))
import qualified Ide.Plugin.Cabal.Completion.Types as Types
import Ide.Plugin.Cabal.Definition (gotoDefinition)
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
import Ide.Plugin.Cabal.Orphans ()
import Ide.Plugin.Cabal.Outline
import qualified Ide.Plugin.Cabal.Parse as Parse
import Ide.Plugin.Error
import Ide.Types
import qualified Language.LSP.Protocol.Lens as JL
import qualified Language.LSP.Protocol.Message as LSP
import Language.LSP.Protocol.Types
import qualified Language.LSP.VFS as VFS
import Text.Regex.TDFA
data Log
= LogModificationTime NormalizedFilePath FileVersion
| LogShake Shake.Log
| LogDocOpened Uri
| LogDocModified Uri
| LogDocSaved Uri
| LogDocClosed Uri
| LogFOI (HashMap NormalizedFilePath FileOfInterestStatus)
| LogCompletionContext Types.Context Position
| LogCompletions Types.Log
| LogCabalAdd CabalAdd.Log
deriving (Show)
instance Pretty Log where
pretty = \case
LogShake log' -> pretty log'
LogModificationTime nfp modTime ->
"Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime)
LogDocOpened uri ->
"Opened text document:" <+> pretty (getUri uri)
LogDocModified uri ->
"Modified text document:" <+> pretty (getUri uri)
LogDocSaved uri ->
"Saved text document:" <+> pretty (getUri uri)
LogDocClosed uri ->
"Closed text document:" <+> pretty (getUri uri)
LogFOI files ->
"Set files of interest to:" <+> viaShow files
LogCompletionContext context position ->
"Determined completion context:"
<+> pretty context
<+> "for cursor position:"
<+> pretty position
LogCompletions logs -> pretty logs
LogCabalAdd logs -> pretty logs
-- | Some actions with cabal files originate from haskell files.
-- This descriptor allows to hook into the diagnostics of haskell source files, and
-- allows us to provide code actions and commands that interact with `.cabal` files.
haskellInteractionDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
haskellInteractionDescriptor recorder plId =
(defaultPluginDescriptor plId "Provides the cabal-add code action in haskell files")
{ pluginHandlers =
mconcat
[ mkPluginHandler LSP.SMethod_TextDocumentCodeAction cabalAddCodeAction
]
, pluginCommands = [PluginCommand CabalAdd.cabalAddCommand "add a dependency to a cabal file" (CabalAdd.command cabalAddRecorder)]
, pluginRules = pure ()
, pluginNotificationHandlers = mempty
}
where
cabalAddRecorder = cmapWithPrio LogCabalAdd recorder
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor recorder plId =
(defaultCabalPluginDescriptor plId "Provides a variety of IDE features in cabal files")
{ pluginRules = cabalRules recorder plId
, pluginHandlers =
mconcat
[ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
, mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder
, mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
, mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition
, mkPluginHandler LSP.SMethod_TextDocumentHover hover
]
, pluginNotificationHandlers =
mconcat
[ mkPluginNotificationHandler LSP.SMethod_TextDocumentDidOpen $
\ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do
whenUriFile _uri $ \file -> do
log' Debug $ LogDocOpened _uri
restartCabalShakeSession (shakeExtras ide) vfs file "(opened)" $
addFileOfInterest recorder ide file Modified{firstOpen = True}
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $
\ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do
whenUriFile _uri $ \file -> do
log' Debug $ LogDocModified _uri
restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $
addFileOfInterest recorder ide file Modified{firstOpen = False}
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $
\ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
whenUriFile _uri $ \file -> do
log' Debug $ LogDocSaved _uri
restartCabalShakeSession (shakeExtras ide) vfs file "(saved)" $
addFileOfInterest recorder ide file OnDisk
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $
\ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
whenUriFile _uri $ \file -> do
log' Debug $ LogDocClosed _uri
restartCabalShakeSession (shakeExtras ide) vfs file "(closed)" $
deleteFileOfInterest recorder ide file
]
, pluginConfigDescriptor = defaultConfigDescriptor
{ configHasDiagnostics = True
}
}
where
log' = logWith recorder
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath'
{- | Helper function to restart the shake session, specifically for modifying .cabal files.
No special logic, just group up a bunch of functions you need for the base
Notification Handlers.
To make sure diagnostics are up to date, we need to tell shake that the file was touched and
needs to be re-parsed. That's what we do when we record the dirty key that our parsing
rule depends on.
Then we restart the shake session, so that changes to our virtual files are actually picked up.
-}
restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO ()
restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = do
restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do
keys <- actionBetweenSession
return (toKey GetModificationTime file:keys)
-- ----------------------------------------------------------------
-- Plugin Rules
-- ----------------------------------------------------------------
cabalRules :: Recorder (WithPriority Log) -> PluginId -> Rules ()
cabalRules recorder plId = do
-- Make sure we initialise the cabal files-of-interest.
ofInterestRules recorder
-- Rule to produce diagnostics for cabal files.
define (cmapWithPrio LogShake recorder) $ \ParseCabalFields file -> do
config <- getPluginConfigAction plId
if not (plcGlobalOn config && plcDiagnosticsOn config)
then pure ([], Nothing)
else do
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
-- we rerun this rule because this rule *depends* on GetModificationTime.
(t, mCabalSource) <- use_ GetFileContents file
log' Debug $ LogModificationTime file t
contents <- case mCabalSource of
Just sources ->
pure $ Encoding.encodeUtf8 $ Rope.toText sources
Nothing -> do
liftIO $ BS.readFile $ fromNormalizedFilePath file
case Parse.readCabalFields file contents of
Left _ ->
pure ([], Nothing)
Right fields ->
pure ([], Just fields)
define (cmapWithPrio LogShake recorder) $ \ParseCabalCommonSections file -> do
fields <- use_ ParseCabalFields file
let commonSections = Maybe.mapMaybe (\case
commonSection@(Syntax.Section (Syntax.Name _ "common") _ _) -> Just commonSection
_ -> Nothing)
fields
pure ([], Just commonSections)
define (cmapWithPrio LogShake recorder) $ \ParseCabalFile file -> do
config <- getPluginConfigAction plId
if not (plcGlobalOn config && plcDiagnosticsOn config)
then pure ([], Nothing)
else do
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
-- we rerun this rule because this rule *depends* on GetModificationTime.
(t, mCabalSource) <- use_ GetFileContents file
log' Debug $ LogModificationTime file t
contents <- case mCabalSource of
Just sources ->
pure $ Encoding.encodeUtf8 $ Rope.toText sources
Nothing -> do
liftIO $ BS.readFile $ fromNormalizedFilePath file
-- Instead of fully reparsing the sources to get a 'GenericPackageDescription',
-- we would much rather re-use the already parsed results of 'ParseCabalFields'.
-- Unfortunately, Cabal-syntax doesn't expose the function 'parseGenericPackageDescription''
-- which allows us to resume the parsing pipeline with '[Field Position]'.
(pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents
let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
case pm of
Left (_cabalVersion, pErrorNE) -> do
let regexUnknownCabalBefore310 :: T.Text
-- We don't support the cabal version, this should not be an error, as the
-- user did not do anything wrong. Instead we cast it to a warning
regexUnknownCabalBefore310 = "Unsupported cabal-version [0-9]+.[0-9]*"
regexUnknownCabalVersion :: T.Text
regexUnknownCabalVersion = "Unsupported cabal format version in cabal-version field: [0-9]+.[0-9]+"
unsupportedCabalHelpText = unlines
[ "The used `cabal-version` is not fully supported by this `HLS` binary."
, "Either the `cabal-version` is unknown, or too new for this executable."
, "This means that some functionality might not work as expected."
, "If you face any issues, try downgrading to a supported `cabal-version` or upgrading `HLS` if possible."
, ""
, "Supported versions are: " <>
List.intercalate ", "
(fmap Cabal.showCabalSpecVersion Data.supportedCabalVersions)
]
errorDiags =
NE.toList $
NE.map
( \pe@(PError pos text) ->
if any (text =~)
[ regexUnknownCabalBefore310
, regexUnknownCabalVersion
]
then Diagnostics.warningDiagnostic file (Syntax.PWarning Syntax.PWTOther pos $
unlines
[ text
, unsupportedCabalHelpText
])
else Diagnostics.errorDiagnostic file pe
)
pErrorNE
allDiags = errorDiags <> warningDiags
pure (allDiags, Nothing)
Right gpd -> do
pure (warningDiags, Just gpd)
action $ do
-- Run the cabal kick. This code always runs when 'shakeRestart' is run.
-- Must be careful to not impede the performance too much. Crucial to
-- a snappy IDE experience.
kick
where
log' = logWith recorder
{- | This is the kick function for the cabal plugin.
We run this action, whenever we shake session us run/restarted, which triggers
actions to produce diagnostics for cabal files.
It is paramount that this kick-function can be run quickly, since it is a blocking
function invocation.
-}
kick :: Action ()
kick = do
files <- HashMap.keys <$> getCabalFilesOfInterestUntracked
Shake.runWithSignal (Proxy @"kick/start/cabal") (Proxy @"kick/done/cabal") files Types.ParseCabalFile
-- ----------------------------------------------------------------
-- Code Actions
-- ----------------------------------------------------------------
licenseSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
licenseSuggestCodeAction ideState _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) = do
maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.suggestLicense" ideState getClientConfigAction
pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction maxCompls uri)
-- | CodeActions for correcting field names with typos in them.
--
-- Provides CodeActions that fix typos in both stanzas and top-level field names.
-- The suggestions are computed based on the completion context, where we "move" a fake cursor
-- to the end of the field name and trigger cabal file completions. The completions are then
-- suggested to the user.
--
-- TODO: Relying on completions here often does not produce the desired results, we should
-- use some sort of fuzzy matching in the future, see issue #4357.
fieldSuggestCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
mContents <- liftIO $ runAction "cabal-plugin.getUriContents" ide $ getUriContents $ toNormalizedUri uri
case (,) <$> mContents <*> uriToFilePath' uri of
Nothing -> pure $ InL []
Just (fileContents, path) -> do
-- We decide on `useWithStale` here, since `useWithStaleFast` often leads to the wrong completions being suggested.
-- In case it fails, we still will get some completion results instead of an error.
mFields <- liftIO $ runAction "cabal-plugin.fields" ide $ useWithStale ParseCabalFields $ toNormalizedFilePath path
case mFields of
Nothing ->
pure $ InL []
Just (cabalFields, _) -> do
let fields = Maybe.mapMaybe FieldSuggest.fieldErrorName diags
results <- forM fields (getSuggestion fileContents path cabalFields)
pure $ InL $ map InR $ concat results
where
getSuggestion fileContents fp cabalFields (fieldName,Diagnostic{ _range=_range@(Range (Position lineNr col) _) }) = do
let -- Compute where we would anticipate the cursor to be.
fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length fieldName))
lspPrefixInfo = Ghcide.getCompletionPrefixFromRope fakeLspCursorPosition fileContents
cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo
completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields
let completionTexts = fmap (^. JL.label) completions
pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
cabalAddCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction
let suggestions = take maxCompls $ concatMap CabalAdd.hiddenPackageSuggestion diags
case suggestions of
[] -> pure $ InL []
_ ->
case uriToFilePath uri of
Nothing -> pure $ InL []
Just haskellFilePath -> do
mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath
case mbCabalFile of
Nothing -> pure $ InL []
Just cabalFilePath -> do
verTxtDocId <- runActionE "cabalAdd.getVersionedTextDoc" state $
lift $ getVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath)
mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath
case mbGPD of
Nothing -> pure $ InL []
Just (gpd, _) -> do
actions <- liftIO $ CabalAdd.addDependencySuggestCodeAction plId verTxtDocId
suggestions
haskellFilePath cabalFilePath
gpd
pure $ InL $ fmap InR actions
-- | Handler for hover messages.
--
-- Provides a Handler for displaying message on hover.
-- If found that the filtered hover message is a dependency,
-- adds a Documentation link.
hover :: PluginMethodHandler IdeState LSP.Method_TextDocumentHover
hover ide _ msgParam = do
nfp <- getNormalizedFilePathE uri
cabalFields <- runActionE "cabal.cabal-hover" ide $ useE ParseCabalFields nfp
case CabalFields.findTextWord cursor cabalFields of
Nothing ->
pure $ InR Null
Just cursorText -> do
gpd <- runActionE "cabal.GPD" ide $ useE ParseCabalFile nfp
let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd
case filterVersion cursorText of
Nothing -> pure $ InR Null
Just txt ->
if txt `elem` depsNames
then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt])
else pure $ InR Null
where
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
uri = msgParam ^. JL.textDocument . JL.uri
dependencyName :: Dependency -> T.Text
dependencyName dep = T.pack $ unPackageName $ depPkgName dep
-- | Removes version requirements like
-- `==1.0.0.0`, `>= 2.1.1` that could be included in
-- hover message. Assumes that the dependency consists
-- of alphanums with dashes in between. Ends with an alphanum.
--
-- Examples:
-- >>> filterVersion "imp-deps>=2.1.1"
-- "imp-deps"
filterVersion :: T.Text -> Maybe T.Text
filterVersion msg = getMatch (msg =~ regex)
where
regex :: T.Text
regex = "([a-zA-Z0-9-]*[a-zA-Z0-9])"
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text
getMatch (_, _, _, [dependency]) = Just dependency
getMatch (_, _, _, _) = Nothing -- impossible case
documentationText :: T.Text -> T.Text
documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")"
-- ----------------------------------------------------------------
-- Cabal file of Interest rules and global variable
-- ----------------------------------------------------------------
{- | Cabal files that are currently open in the lsp-client.
Specific actions happen when these files are saved, closed or modified,
such as generating diagnostics, re-parsing, etc...
We need to store the open files to parse them again if we restart the shake session.
Restarting of the shake session happens whenever these files are modified.
-}
newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
instance Shake.IsIdeGlobal OfInterestCabalVar
data IsCabalFileOfInterest = IsCabalFileOfInterest
deriving (Eq, Show, Generic)
instance Hashable IsCabalFileOfInterest
instance NFData IsCabalFileOfInterest
type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult
data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus
deriving (Eq, Show, Generic)
instance Hashable CabalFileOfInterestResult
instance NFData CabalFileOfInterestResult
{- | The rule that initialises the files of interest state.
Needs to be run on start-up.
-}
ofInterestRules :: Recorder (WithPriority Log) -> Rules ()
ofInterestRules recorder = do
Shake.addIdeGlobal . OfInterestCabalVar =<< liftIO (newVar HashMap.empty)
Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalFileOfInterest f -> do
alwaysRerun
filesOfInterest <- getCabalFilesOfInterestUntracked
let foi = maybe NotCabalFOI IsCabalFOI $ f `HashMap.lookup` filesOfInterest
fp = summarize foi
res = (Just fp, Just foi)
return res
where
summarize NotCabalFOI = BS.singleton 0
summarize (IsCabalFOI OnDisk) = BS.singleton 1
summarize (IsCabalFOI (Modified False)) = BS.singleton 2
summarize (IsCabalFOI (Modified True)) = BS.singleton 3
getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
getCabalFilesOfInterestUntracked = do
OfInterestCabalVar var <- Shake.getIdeGlobalAction
liftIO $ readVar var
addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key]
addFileOfInterest recorder state f v = do
OfInterestCabalVar var <- Shake.getIdeGlobalState state
(prev, files) <- modifyVar var $ \dict -> do
let (prev, new) = HashMap.alterF (,Just v) f dict
pure (new, (prev, new))
if prev /= Just v
then do
log' Debug $ LogFOI files
return [toKey IsCabalFileOfInterest f]
else return []
where
log' = logWith recorder
deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO [Key]
deleteFileOfInterest recorder state f = do
OfInterestCabalVar var <- Shake.getIdeGlobalState state
files <- modifyVar' var $ HashMap.delete f
log' Debug $ LogFOI files
return [toKey IsFileOfInterest f]
where
log' = logWith recorder
-- ----------------------------------------------------------------
-- Completion
-- ----------------------------------------------------------------
completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion
completion recorder ide _ complParams = do
let TextDocumentIdentifier uri = complParams ^. JL.textDocument
position = complParams ^. JL.position
mContents <- liftIO $ runAction "cabal-plugin.getUriContents" ide $ getUriContents $ toNormalizedUri uri
case (,) <$> mContents <*> uriToFilePath' uri of
Just (cnts, path) -> do
-- We decide on `useWithStale` here, since `useWithStaleFast` often leads to the wrong completions being suggested.
-- In case it fails, we still will get some completion results instead of an error.
mFields <- liftIO $ runAction "cabal-plugin.fields" ide $ useWithStale ParseCabalFields $ toNormalizedFilePath path
case mFields of
Nothing ->
pure . InR $ InR Null
Just (fields, _) -> do
let lspPrefInfo = Ghcide.getCompletionPrefixFromRope position cnts
cabalPrefInfo = Completions.getCabalPrefixInfo path lspPrefInfo
let res = computeCompletionsAt recorder ide cabalPrefInfo path fields
liftIO $ fmap InL res
Nothing -> pure . InR $ InR Null
computeCompletionsAt :: Recorder (WithPriority Log) -> IdeState -> Types.CabalPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem]
computeCompletionsAt recorder ide prefInfo fp fields = do
runMaybeT (context fields) >>= \case
Nothing -> pure []
Just ctx -> do
logWith recorder Debug $ LogCompletionContext ctx pos
let completer = Completions.contextToCompleter ctx
let completerData = CompleterTypes.CompleterData
{ getLatestGPD = do
-- We decide on useWithStaleFast here, since we mostly care about the file's meta information,
-- thus, a quick response gives us the desired result most of the time.
-- The `withStale` option is very important here, since we often call this rule with invalid cabal files.
mGPD <- runAction "cabal-plugin.modulesCompleter.gpd" ide $ useWithStale ParseCabalFile $ toNormalizedFilePath fp
pure $ fmap fst mGPD
, getCabalCommonSections = runAction "cabal-plugin.commonSections" ide $ use ParseCabalCommonSections $ toNormalizedFilePath fp
, cabalPrefixInfo = prefInfo
, stanzaName =
case fst ctx of
Types.Stanza _ name -> name
_ -> Nothing
}
completions <- completer completerRecorder completerData
pure completions
where
pos = Types.completionCursorPosition prefInfo
context fields = Completions.getContext completerRecorder prefInfo fields
completerRecorder = cmapWithPrio LogCompletions recorder