Implement filepath completion closing opened apostrophes

Implement tests for functionality
Refactor completion text representation into a type that can:
* carry information on suffix to be added on completion
* carry separate text to be displayed in suggestion box,
* and text to be inserted on completion action

Author: VeryMilkyJoe

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

@@ -9,42 +9,40 @@
 {-# 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
 import           Control.DeepSeq
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
-import qualified Data.ByteString                        as BS
+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.NonEmpty                     as NE
-import qualified Data.Text                              as T
-import qualified Data.Text.Encoding                     as Encoding
-import qualified Data.Text.Utf16.Rope                   as Rope
+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           Distribution.Simple.PackageDescription (readGenericPackageDescription)
-import           Distribution.Verbosity                 (silent)
+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           Ide.Plugin.Cabal.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 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.Types
-import qualified Language.LSP.Server                    as LSP
+import qualified Language.LSP.Server             as LSP
 import           Language.LSP.Types
-import qualified Language.LSP.Types                     as J
-import qualified Language.LSP.Types                     as LSP
-import qualified Language.LSP.Types.Lens                as JL
-import           Language.LSP.VFS                       (VirtualFile)
-import qualified Language.LSP.VFS                       as VFS
+import qualified Language.LSP.Types              as J
+import qualified Language.LSP.Types              as LSP
+import qualified Language.LSP.Types.Lens         as JL
+import           Language.LSP.VFS                (VirtualFile)
+import qualified Language.LSP.VFS                as VFS
+
 data Log
   = LogModificationTime NormalizedFilePath FileVersion
   | LogShake Shake.Log
@@ -53,12 +51,12 @@ data Log
   | LogDocSaved Uri
   | LogDocClosed Uri
   | LogFOI (HashMap NormalizedFilePath FileOfInterestStatus)
-  deriving Show
+  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)
@@ -71,56 +69,56 @@ instance Pretty Log where
     LogFOI files ->
       "Set files of interest to:" <+> viaShow files
 
-
 descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
-descriptor recorder plId = (defaultCabalPluginDescriptor plId)
-  { pluginRules = cabalRules recorder
-  , pluginHandlers = mkPluginHandler STextDocumentCodeAction licenseSuggestCodeAction
-                      <> mkPluginHandler J.STextDocumentCompletion completion
-  , pluginNotificationHandlers = mconcat
-  [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $
-      \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do
-      whenUriFile _uri $ \file -> do
-        log' Debug $ LogDocOpened _uri
-        addFileOfInterest recorder ide file Modified{firstOpen=True}
-        restartCabalShakeSession (shakeExtras ide) vfs file "(opened)"
-
-  , mkPluginNotificationHandler LSP.STextDocumentDidChange $
-      \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do
-      whenUriFile _uri $ \file -> do
-        log' Debug $ LogDocModified _uri
-        addFileOfInterest recorder ide file Modified{firstOpen=False}
-        restartCabalShakeSession (shakeExtras ide) vfs file "(changed)"
-
-  , mkPluginNotificationHandler LSP.STextDocumentDidSave $
-      \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
-      whenUriFile _uri $ \file -> do
-        log' Debug $ LogDocSaved _uri
-        addFileOfInterest recorder ide file OnDisk
-        restartCabalShakeSession (shakeExtras ide) vfs file "(saved)"
-
-  , mkPluginNotificationHandler LSP.STextDocumentDidClose $
-      \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
-      whenUriFile _uri $ \file -> do
-        log' Debug $ LogDocClosed _uri
-        deleteFileOfInterest recorder ide file
-        restartCabalShakeSession (shakeExtras ide) vfs file "(closed)"
-  ]
-  }
-  where
-    log' = logWith recorder
-
-    whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
-    whenUriFile uri act = whenJust (LSP.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.
+descriptor recorder plId =
+  (defaultCabalPluginDescriptor plId)
+    { pluginRules = cabalRules recorder
+    , pluginHandlers =
+        mkPluginHandler STextDocumentCodeAction licenseSuggestCodeAction
+          <> mkPluginHandler J.STextDocumentCompletion completion
+    , pluginNotificationHandlers =
+        mconcat
+          [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $
+              \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do
+                whenUriFile _uri $ \file -> do
+                  log' Debug $ LogDocOpened _uri
+                  addFileOfInterest recorder ide file Modified{firstOpen = True}
+                  restartCabalShakeSession (shakeExtras ide) vfs file "(opened)"
+          , mkPluginNotificationHandler LSP.STextDocumentDidChange $
+              \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do
+                whenUriFile _uri $ \file -> do
+                  log' Debug $ LogDocModified _uri
+                  addFileOfInterest recorder ide file Modified{firstOpen = False}
+                  restartCabalShakeSession (shakeExtras ide) vfs file "(changed)"
+          , mkPluginNotificationHandler LSP.STextDocumentDidSave $
+              \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
+                whenUriFile _uri $ \file -> do
+                  log' Debug $ LogDocSaved _uri
+                  addFileOfInterest recorder ide file OnDisk
+                  restartCabalShakeSession (shakeExtras ide) vfs file "(saved)"
+          , mkPluginNotificationHandler LSP.STextDocumentDidClose $
+              \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
+                whenUriFile _uri $ \file -> do
+                  log' Debug $ LogDocClosed _uri
+                  deleteFileOfInterest recorder ide file
+                  restartCabalShakeSession (shakeExtras ide) vfs file "(closed)"
+          ]
+    }
+ where
+  log' = logWith recorder
+
+  whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
+  whenUriFile uri act = whenJust (LSP.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 ()
 restartCabalShakeSession shakeExtras vfs file actionMsg = do
   join $ atomically $ Shake.recordDirtyKeys shakeExtras GetModificationTime [file]
@@ -131,9 +129,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 = ()
 
@@ -168,15 +166,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
-
--- | 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.
+ 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
@@ -186,84 +185,86 @@ kick = do
 -- Code Actions
 -- ----------------------------------------------------------------
 
-licenseSuggestCodeAction
-  :: IdeState
-  -> PluginId
-  -> CodeActionParams
-  -> LSP.LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))
-licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) =
+licenseSuggestCodeAction ::
+  IdeState ->
+  PluginId ->
+  CodeActionParams ->
+  LSP.LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))
+licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics = List diags}) =
   pure $ Right $ List $ diags >>= (fmap InR . (LicenseSuggest.licenseErrorAction 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
@@ -279,22 +280,17 @@ completion _ide _ complParams = do
       pref <- VFS.getCompletionPrefix position cnts
       liftIO $ result pref path cnts
     _ -> return $ J.List []
-  where
-    result :: Maybe VFS.PosPrefixInfo -> FilePath -> VirtualFile -> IO (J.List CompletionItem)
-    result Nothing _ _ = pure $ J.List []
-    result (Just pfix) fp cnts
-      | Just ctx <- context  = do
+ where
+  result :: Maybe VFS.PosPrefixInfo -> FilePath -> VirtualFile -> IO (J.List CompletionItem)
+  result Nothing _ _ = pure $ J.List []
+  result (Just prefix) _fp cnts
+    | Just ctx <- context = do
         let completer = contextToCompleter "" ctx
-        completions <- completer filePathPfix
+        completions <- completer completionContext
         -- genPkgDesc <- readGenericPackageDescription silent fp
-        pure $ J.List $ makeCompletionItems editRange completions
-      | otherwise = pure $ J.List []
-      where
-        (Position linePos charPos) = VFS.cursorPos pfix
-        context = getContext (Position linePos charPos) (Rope.lines $ cnts ^. VFS.file_text)
-        filePathPfix = getFilePathCursorPrefix pfix
-        editRange =
-          Range
-            (Position linePos (fromIntegral charPos - fromIntegral (T.length filePathPfix)))
-            (Position linePos charPos)
-
+        pure $ J.List $ makeCompletionItems completions
+    | otherwise = pure $ J.List []
+   where
+    (Position linePos charPos) = VFS.cursorPos prefix
+    context = getContext (Position linePos charPos) (Rope.lines $ cnts ^. VFS.file_text)
+    completionContext = getFilePathCompletionContext prefix