Add completion support for cabal files

Currently supports:
* completions for keywords, sensitive to stanzas
* value completions for constant values, licenses, files and directories

Author: Jana Chadt

plugins/hls-cabal-plugin/hls-cabal-plugin.cabal

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

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

@@ -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
@@ -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
@@ -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)
@@ -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
@@ -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
@@ -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 = ()
 
@@ -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
 
@@ -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
@@ -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