Skip to content

Commit

Permalink
Add completion support for cabal files
Browse files Browse the repository at this point in the history 
Currently supports:
* completions for keywords, sensitive to stanzas
* value completions for constant values, licenses, files and directories
  • Loading branch information
@VeryMilkyJoe
Jana Chadt authored and VeryMilkyJoe committed Jun 19, 2023
1 parent a918c02 commit 0027a1c
Show file tree
Hide file tree
Showing 10 changed files with 1,299 additions and 190 deletions.
6 changes: 6 additions & 0 deletions plugins/hls-cabal-plugin/hls-cabal-plugin.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@ library
exposed-modules:
Ide.Plugin.Cabal
Ide.Plugin.Cabal.Diagnostics
Ide.Plugin.Cabal.Completions
Ide.Plugin.Cabal.LicenseSuggest
Ide.Plugin.Cabal.Parse

Expand All @@ -45,8 +46,10 @@ library
-- This is a lot of work for almost zero benefit, so we just allow more versions here
-- and we eventually completely drop support for building HLS with stack.
, Cabal ^>=3.2 || ^>=3.4 || ^>=3.6 || ^>= 3.8 || ^>= 3.10
, containers
, deepseq
, directory
, filepath
, extra >=1.7.4
, ghcide == 2.1.0.0
, hashable
Expand All @@ -57,6 +60,7 @@ library
, regex-tdfa ^>=1.3.1
, stm
, text
, text-rope
, unordered-containers >=0.2.10.0
, containers
hs-source-dirs: src
Expand All @@ -71,11 +75,13 @@ test-suite tests
build-depends:
, base
, bytestring
, directory
, filepath
, ghcide
, hls-cabal-plugin
, hls-test-utils == 2.1.0.0
, lens
, lsp
, lsp-types
, tasty-hunit
, text
Expand Down
167 changes: 105 additions & 62 deletions plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

module Ide.Plugin.Cabal (descriptor, Log(..)) where
module Ide.Plugin.Cabal (descriptor, Log (..)) where

import Control.Concurrent.STM
import Control.Concurrent.Strict
Expand All @@ -22,21 +22,23 @@ import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List.NonEmpty as NE
import qualified Data.Text.Encoding as Encoding
import qualified Data.Text.Utf16.Rope as Rope
import Data.Typeable
import Development.IDE as D
import Development.IDE.Core.Shake (restartShakeSession)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.Graph (alwaysRerun)
import Distribution.Compat.Lens ((^.))
import GHC.Generics
import qualified Ide.Plugin.Cabal.Completions as Completions
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
import qualified Ide.Plugin.Cabal.Parse as Parse
import Ide.Plugin.Config (Config)
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.Protocol.Types as LSP
import Language.LSP.Server (LspM)
import Language.LSP.Server (LspM, getVirtualFile)
import qualified Language.LSP.VFS as VFS

data Log
Expand All @@ -47,12 +49,14 @@ data Log
| LogDocSaved Uri
| LogDocClosed Uri
| LogFOI (HashMap NormalizedFilePath FileOfInterestStatus)
deriving Show
| LogCompletionContext Completions.Context Position
| LogCompletions Completions.Log
deriving (Show)

instance Pretty Log where
pretty = \case
LogShake log' -> pretty log'
LogModificationTime nfp modTime ->
LogModificationTime nfp modTime ->
"Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime)
LogDocOpened uri ->
"Opened text document:" <+> pretty (getUri uri)
Expand All @@ -64,12 +68,18 @@ instance Pretty Log where
"Closed text document:" <+> pretty (getUri uri)
LogFOI files ->
"Set files of interest to:" <+> viaShow files

LogCompletionContext context position->
"Determined completion context:" <+> viaShow context
<+> "for cursor position:" <+> viaShow position
LogCompletions logs -> pretty logs

descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor recorder plId = (defaultCabalPluginDescriptor plId)
{ pluginRules = cabalRules recorder
, pluginHandlers = mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
, pluginHandlers = mconcat
[ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
, mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder
]
, pluginNotificationHandlers = mconcat
[ mkPluginNotificationHandler LSP.SMethod_TextDocumentDidOpen $
\ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do
Expand Down Expand Up @@ -104,7 +114,7 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId)
log' = logWith recorder

whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath'
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
Expand All @@ -124,9 +134,9 @@ restartCabalShakeSession shakeExtras vfs file actionMsg = do
-- ----------------------------------------------------------------

data ParseCabal = ParseCabal
deriving (Eq, Show, Typeable, Generic)
deriving (Eq, Show, Typeable, Generic)
instance Hashable ParseCabal
instance NFData ParseCabal
instance NFData ParseCabal

type instance RuleResult ParseCabal = ()

Expand All @@ -141,7 +151,8 @@ cabalRules recorder = do
(t, mCabalSource) <- use_ GetFileContents file
log' Debug $ LogModificationTime file t
contents <- case mCabalSource of
Just sources -> pure $ Encoding.encodeUtf8 sources
Just sources ->
pure $ Encoding.encodeUtf8 sources
Nothing -> do
liftIO $ BS.readFile $ fromNormalizedFilePath file

Expand All @@ -160,15 +171,16 @@ cabalRules recorder = do
-- Must be careful to not impede the performance too much. Crucial to
-- a snappy IDE experience.
kick
where
log' = logWith recorder
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.
{- | 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
Expand All @@ -190,69 +202,100 @@ licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri)
-- 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.
{- | 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, Typeable, Generic)
deriving (Eq, Show, Typeable, Generic)
instance Hashable IsCabalFileOfInterest
instance NFData IsCabalFileOfInterest
instance NFData IsCabalFileOfInterest

type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult

data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus
deriving (Eq, Show, Typeable, Generic)
instance Hashable CabalFileOfInterestResult
instance NFData CabalFileOfInterestResult
instance NFData CabalFileOfInterestResult

-- | The rule that initialises the files of interest state.
--
-- Needs to be run on start-up.
{- | 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
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
OfInterestCabalVar var <- Shake.getIdeGlobalAction
liftIO $ readVar var

addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
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))
when (prev /= Just v) $ do
join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]
log' Debug $ LogFOI files
where
log' = logWith recorder
OfInterestCabalVar var <- Shake.getIdeGlobalState state
(prev, files) <- modifyVar var $ \dict -> do
let (prev, new) = HashMap.alterF (,Just v) f dict
pure (new, (prev, new))
when (prev /= Just v) $ do
join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]
log' Debug $ LogFOI files
where
log' = logWith recorder

deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO ()
deleteFileOfInterest recorder state f = do
OfInterestCabalVar var <- Shake.getIdeGlobalState state
files <- modifyVar' var $ HashMap.delete f
join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]
log' Debug $ LogFOI files
where
log' = logWith recorder
OfInterestCabalVar var <- Shake.getIdeGlobalState state
files <- modifyVar' var $ HashMap.delete f
join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]
log' Debug $ LogFOI files
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
contents <- getVirtualFile $ toNormalizedUri uri
fmap (Right . InL) $ case (contents, uriToFilePath' uri) of
(Just cnts, Just path) -> do
pref <- VFS.getCompletionPrefix position cnts
liftIO $ result pref path cnts
_ -> return []
where
result :: Maybe VFS.PosPrefixInfo -> FilePath -> VFS.VirtualFile -> IO [CompletionItem]
result Nothing _ _ = pure []
result (Just prefix) fp cnts
| Just ctx <- context = do
logWith recorder Debug $ LogCompletionContext ctx pos
let completer = Completions.contextToCompleter ctx
completions <- completer (cmapWithPrio LogCompletions recorder) completionContext
pure $ Completions.mkCompletionItems completions
| otherwise = pure []
where
pos = VFS.cursorPos prefix
context = Completions.getContext completionContext (Rope.lines $ cnts ^. VFS.file_text)
completionContext = Completions.getCabalCompletionContext fp prefix
Loading

0 comments on commit 0027a1c

Please sign in to comment.