diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index e86c9f3108d..b9aae6d7107 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/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.0.0.0 , hashable @@ -57,6 +60,7 @@ library , regex-tdfa ^>=1.3.1 , stm , text + , text-rope , unordered-containers >=0.2.10.0 hs-source-dirs: src @@ -71,11 +75,14 @@ test-suite tests build-depends: , base , bytestring + , directory , filepath , ghcide , hls-cabal-plugin , hls-test-utils == 2.0.0.0 , lens + , lsp , lsp-types , tasty-hunit , text + diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 913cb37ed62..7e042d27544 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/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,20 +22,25 @@ 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 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 Ide.Plugin.Config (Config) import Ide.Types -import Language.LSP.Server (LspM) +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 data Log @@ -46,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) @@ -64,55 +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 - , 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] @@ -123,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 = () @@ -140,7 +146,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 @@ -159,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 @@ -177,81 +185,111 @@ kick = do -- Code Actions -- ---------------------------------------------------------------- -licenseSuggestCodeAction - :: IdeState - -> PluginId - -> CodeActionParams - -> 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 +-- ---------------------------------------------------------------- + +completion :: PluginMethodHandler IdeState 'J.TextDocumentCompletion +completion _ide _ complParams = do + let (J.TextDocumentIdentifier uri) = complParams ^. JL.textDocument + position = complParams ^. JL.position + contents <- LSP.getVirtualFile $ toNormalizedUri uri + fmap (Right . J.InL) $ case (contents, uriToFilePath' uri) of + (Just cnts, Just path) -> 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 prefix) fp cnts + | Just ctx <- context = do + let completer = contextToCompleter ctx + completions <- completer completionContext + 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 = getCabalCompletionContext fp prefix diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs new file mode 100644 index 00000000000..5f1063b601f --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs @@ -0,0 +1,641 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Ide.Plugin.Cabal.Completions where + +import Control.Exception (try) +import Control.Exception.Extra (evaluate) +import Control.Monad (filterM, forM) +import qualified Data.List as List +import qualified Data.List.Extra as Extra +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe) +import qualified Data.Text as T +import Development.IDE as D +import Distribution.CabalSpecVersion (CabalSpecVersion (CabalSpecV2_2), + showCabalSpecVersion) +import Distribution.Compat.Lens ((^.)) +import Ide.Plugin.Cabal.LicenseSuggest (licenseNames) +import qualified Language.LSP.Types as Compls (CompletionItem (..)) +import qualified Language.LSP.Types as J +import qualified Language.LSP.Types.Lens as JL +import qualified Language.LSP.VFS as VFS +import System.Directory (doesDirectoryExist, + doesFileExist, listDirectory) +import qualified System.FilePath as FP +import qualified System.FilePath.Posix as Posix +import qualified Text.Fuzzy.Parallel as Fuzzy +import Debug.Trace (traceShowM) + +{- | Takes information needed to build possible completion items +and returns the list of possible completion items +-} +type Completer = CabalCompletionContext -> IO [CabalCompletionItem] + +-- | Contains information needed for a completion action +data CabalCompletionItem = CabalCompletionItem + { itemInsert :: T.Text + -- ^ actual text to be written into the document + , itemDisplay :: Maybe T.Text + -- ^ text displayed when completion options are shown + , itemRange :: Range + -- ^ range where completion is to be inserted + } + deriving (Eq, Show, Read) + +{- | The context a cursor can be in within a cabal file, + we can be in stanzas or the top level, + and additionally we can be in a context where we have already + written a keyword but no value for it yet +-} +type Context = (NestingContext, KeyWordContext) + +-- | Context inside a cabal file, used to decide which keywords to suggest +data NestingContext + = -- | Top level context in a cabal file such as 'author' + TopLevel + | -- | Nested context in a cabal file, such as 'library', + -- which has nested keywords, specific to the stanza + Stanza StanzaName + deriving (Eq, Show, Read) + +{- | Keyword context in cabal file + used to decide whether to suggest values or keywords +-} +data KeyWordContext + = -- | Key word context, where a keyword + -- occurs right before the current position, + -- with no value associated to it + KeyWord KeyWordName + | -- | Keyword context where no keyword occurs + -- right before the current position + None + deriving (Eq, Show, Read) + +type KeyWordName = T.Text +type StanzaName = T.Text + +{- | Information about the current completion status + + Example: @"dir1/fi@ having been written to the file + would correspond to: + + @ + completionPrefix = "dir1/fi" + completionSuffix = Just "\\"" + ... + @ +-} +data CabalCompletionContext = CabalCompletionContext + { completionPrefix :: T.Text + -- ^ text prefix to complete + , completionSuffix :: Maybe T.Text + -- ^ possible wrapping text, to write after + -- the filepath has been completed + , completionRange :: Range + -- ^ range where completion is to be inserted + , completionCabalFileDir :: FilePath + -- ^ filepath of the handled file + } + deriving (Eq, Show, Read) + +-- ---------------------------------------------------------------- +-- Public API for Completions +-- ---------------------------------------------------------------- + +{- | Takes information about the completion status within the file + and finds the correct completer to be applied +-} +contextToCompleter :: Context -> Completer +-- if we are in the top level of the cabal file and not in a keyword context, +-- we can write any top level keywords or a stanza declaration +contextToCompleter (TopLevel, None) = + constantCompleter $ + Map.keys (cabalVersionKeyword <> cabalKeywords) ++ Map.keys stanzaKeywordMap +-- if we are in a keyword context in the top level, +-- we look up that keyword in the top level context and can complete its possible values +contextToCompleter (TopLevel, KeyWord kw) = + case Map.lookup kw (cabalVersionKeyword <> cabalKeywords) of + Nothing -> noopCompleter + Just l -> l +-- if we are in a stanza and not in a keyword context, +-- we can write any of the stanza's keywords or a stanza declaration +contextToCompleter (Stanza s, None) = + case Map.lookup s stanzaKeywordMap of + Nothing -> noopCompleter + Just l -> constantCompleter $ Map.keys l ++ Map.keys stanzaKeywordMap +-- if we are in a stanza's keyword's context we can complete possible values of that keyword +contextToCompleter (Stanza s, KeyWord kw) = + case Map.lookup s stanzaKeywordMap of + Nothing -> noopCompleter + Just m -> case Map.lookup kw m of + Nothing -> noopCompleter + Just l -> l + +{- | Takes information about the current cursor position, + the handled cabal file and a set of possible keywords + and creates completion suggestions that fit the current input + from the given list +-} +makeCompletionItems :: [CabalCompletionItem] -> [J.CompletionItem] +makeCompletionItems l = map buildCompletion l + +{- | Takes a position and a list of lines (representing a file) + and returns the context of the current position + can return Nothing if an error occurs + TODO: first line can only have cabal-version: keyword +-} +getContext :: Position -> [T.Text] -> Maybe Context +getContext pos ls = + case lvlContext of + TopLevel -> do + kwContext <- getKeyWordContext pos ls (cabalVersionKeyword <> cabalKeywords) + pure (TopLevel, kwContext) + Stanza s -> + case Map.lookup s stanzaKeywordMap of + Nothing -> do + pure (Stanza s, None) + Just m -> do + kwContext <- getKeyWordContext pos ls m + pure (Stanza s, kwContext) + where + lvlContext = + if pos ^. JL.character == 0 + then TopLevel + else currentLevel (previousLines pos ls) + +-- ---------------------------------------------------------------- +-- Helper Functions +-- ---------------------------------------------------------------- + +{- | Takes a position, a list of lines (representing a file) + and a map of keywords and returns a keyword context if the + previously written keyword matches one in the map +-} +getKeyWordContext :: Position -> [T.Text] -> Map KeyWordName a -> Maybe KeyWordContext +getKeyWordContext pos ls keywords = do + case lastNonEmptyLineM of + Nothing -> Just None + Just lastLine' -> do + let (whiteSpaces, lastLine) = T.span (== ' ') lastLine' + let keywordIndentation = T.length whiteSpaces + let cursorIndentation = fromIntegral (pos ^. JL.character) + -- in order to be in a keyword context the cursor needs + -- to be indented more than the keyword + if cursorIndentation > keywordIndentation + then -- if the last thing written was a keyword without a value + case List.find (`T.isPrefixOf` lastLine) (Map.keys keywords) of + Nothing -> Just None + Just kw -> Just $ KeyWord kw + else Just None + where + currentLineM = ls Extra.!? (fromIntegral $ pos ^. JL.line) + lastNonEmptyLineM :: Maybe T.Text + lastNonEmptyLineM = do + cur' <- currentLineM + let cur = stripPartiallyWritten $ T.take (fromIntegral $ pos ^. JL.character) cur' + List.find (not . T.null . T.stripEnd) + $ cur : previousLines pos ls + +{- | Parse the given set of lines (starting before current cursor position + up to the start of the file) to find the nearest stanza declaration, + if none is found we are in the top level context. +-} +currentLevel :: [T.Text] -> NestingContext +currentLevel [] = TopLevel +currentLevel (cur : xs) + | Just s <- stanza = Stanza s + | otherwise = currentLevel xs + where + stanza = List.find (`T.isPrefixOf` cur) (Map.keys stanzaKeywordMap) + +{- | Returns a CabalCompletionItem with the given starting position + and text to be inserted, + where the displayed text is the same as the inserted text. +-} +makeSimpleCabalCompletionItem :: Range -> T.Text -> CabalCompletionItem +makeSimpleCabalCompletionItem r txt = CabalCompletionItem txt Nothing r + +{- | Returns a CabalCompletionItem with the given starting position, + text to be inserted and text to be displayed in the completion suggestion +-} +makeCabalCompletionItem :: Range -> T.Text -> T.Text -> CabalCompletionItem +makeCabalCompletionItem r insertTxt displayTxt = + CabalCompletionItem insertTxt (Just displayTxt) r + +{- | Get all lines before the given cursor position in the given file + and reverse their order to traverse backwards starting from the current position +-} +previousLines :: Position -> [T.Text] -> [T.Text] +previousLines pos ls = reverse $ take (fromIntegral currentLine) ls + where + currentLine = pos ^. JL.line + + +{- | Takes a line of text and removes the last partially written word. +-} +stripPartiallyWritten :: T.Text -> T.Text +stripPartiallyWritten = T.dropWhileEnd (\y -> (y /= ' ') && (y /= ':')) + +{- | Takes information about the current file's file path, + the current cursor position in the file + and its contents; and builds a CabalCompletionItem + with the prefix up to that cursor position, + checks whether a suffix needs to be completed, + and calculates the range in the document in which to complete +-} +getCabalCompletionContext :: FilePath -> VFS.PosPrefixInfo -> CabalCompletionContext +getCabalCompletionContext dir prefixInfo = + CabalCompletionContext + { completionPrefix = filepathPrefix + , completionSuffix = Just suffix + , completionRange = Range completionStart completionEnd + , completionCabalFileDir = dir + } + where + completionEnd = VFS.cursorPos prefixInfo + completionStart = + Position + (_line completionEnd) + (_character completionEnd - (fromIntegral $ T.length filepathPrefix)) + (beforeCursorText, afterCursorText) = T.splitAt cursorColumn $ VFS.fullLine prefixInfo + filepathPrefix = T.takeWhileEnd (not . (`elem` stopConditionChars)) beforeCursorText + suffix = + if apostropheOrSpaceSeparator == '\"' && even (T.count "\"" afterCursorText) + then "\"" + else "" + apostropheOrSpaceSeparator = + if odd $ T.count "\"" beforeCursorText + then '\"' + else ' ' + cursorColumn = fromIntegral $ VFS.cursorPos prefixInfo ^. JL.character + -- if the filepath is inside apostrophes, we parse until the apostrophe, + -- otherwise we parse until a space occurs + stopConditionChars = apostropheOrSpaceSeparator : [',', ':'] + +buildCompletion :: CabalCompletionItem -> J.CompletionItem +buildCompletion completionItem = + J.CompletionItem + { Compls._label = toDisplay + , Compls._kind = Just J.CiKeyword + , Compls._tags = Nothing + , Compls._detail = Nothing + , Compls._documentation = Nothing + , Compls._deprecated = Nothing + , Compls._preselect = Nothing + , Compls._sortText = Nothing + , Compls._filterText = Nothing + , Compls._insertText = Nothing + , Compls._insertTextFormat = Nothing + , Compls._insertTextMode = Nothing + , Compls._textEdit = Just $ J.CompletionEditText (J.TextEdit (itemRange completionItem) $ itemInsert completionItem) + , Compls._additionalTextEdits = Nothing + , Compls._commitCharacters = Nothing + , Compls._command = Nothing + , Compls._xdata = Nothing + } + where + toDisplay = fromMaybe (itemInsert completionItem) (itemDisplay completionItem) + +-- ---------------------------------------------------------------- +-- Completer API +-- ---------------------------------------------------------------- + +{- | Completer to be used when no completion suggestions + are implemented for the field +-} +noopCompleter :: Completer +noopCompleter _ = pure [] + +{- | Completer to be used when a simple set of values + can be completed for a field +-} +constantCompleter :: [T.Text] -> Completer +constantCompleter completions ctxInfo = do + let scored = Fuzzy.simpleFilter 1000 10 (completionPrefix ctxInfo) completions + let range = completionRange ctxInfo + pure $ map (makeSimpleCabalCompletionItem range . Fuzzy.original) scored + +{- | Completer to be used when a file path can be + completed for a field, takes the file path of the directory to start from, + completes file paths as well as directories +-} +filePathCompleter :: Completer +filePathCompleter ctx = do + let suffix = fromMaybe "" $ completionSuffix ctx + complInfo = pathCompletionInfoFromCompletionContext ctx + toMatch = fromMaybe (partialFileName complInfo) $ T.stripPrefix "./" $ partialFileName complInfo + filePathCompletions <- listFileCompletions complInfo + traceShowM ("match string:", toMatch) + traceShowM ("completions:", filePathCompletions) + let scored = Fuzzy.simpleFilter 1000 10 toMatch (map T.pack filePathCompletions) + traceShowM ("scored:", scored) + forM + scored + ( \compl' -> do + let compl = Fuzzy.original compl' + fullFilePath <- makeFullFilePath suffix compl complInfo + pure $ makeCabalCompletionItem (completionRange ctx) fullFilePath fullFilePath + ) + where + -- Takes a suffix, a completed path and a pathCompletionInfo and + -- generates the whole filepath including the already written prefix + -- and the suffix in case the completed path is a filepath + makeFullFilePath :: T.Text -> T.Text -> PathCompletionInfo -> IO T.Text + makeFullFilePath suffix' completion' complInfo = do + let fullPath' = partialFileDir complInfo Posix. T.unpack completion' + isFilePath <- doesFileExist fullPath' + let fullPath = if isFilePath then fullPath' ++ T.unpack suffix' else fullPath' + pure $ T.pack fullPath + +{- | Completer to be used when a directory can be completed for the field, + takes the file path of the directory to start from, + only completes directories +-} +directoryCompleter :: Completer +directoryCompleter ctx = do + let complInfo = pathCompletionInfoFromCompletionContext ctx + directoryCompletions <- listDirectoryCompletions complInfo + let scored = Fuzzy.simpleFilter 1000 10 (partialFileName complInfo) (map T.pack directoryCompletions) + forM + scored + ( \compl' -> do + let compl = Fuzzy.original compl' + fullDirPath <- makeFullDirPath compl complInfo + pure $ makeCabalCompletionItem (completionRange ctx) fullDirPath fullDirPath + ) + where + -- Takes a directory and PathCompletionInfo and + -- returns the whole path including the prefix that was already written + makeFullDirPath :: T.Text -> PathCompletionInfo -> IO T.Text + makeFullDirPath completion' complInfo = do + let fullPath = partialFileDir complInfo Posix. T.unpack completion' + pure $ T.pack fullPath + +{- | Takes a path completion info and returns the list of files + in the directory the path completion info describes +-} +listFileCompletions :: PathCompletionInfo -> IO [FilePath] +listFileCompletions complInfo = do + try (evaluate =<< listDirectory (mkCompletionDirectory complInfo)) >>= \case + Right dirs -> do + fixedDirs <- + mapM + ( \d -> do + isDir <- doesDirectoryExist $ mkDirFromCWD complInfo d + pure $ if isDir then Posix.addTrailingPathSeparator d else d + ) + dirs + pure fixedDirs + Left (_ :: IOError) -> pure [] + +{- | Returns a list of all (and only) directories in the + directory described by path completion info +-} +listDirectoryCompletions :: PathCompletionInfo -> IO [FilePath] +listDirectoryCompletions complInfo = do + filepaths <- listFileCompletions complInfo + filterM (doesDirectoryExist . mkDirFromCWD complInfo) filepaths + +pathCompletionInfoFromCompletionContext :: CabalCompletionContext -> PathCompletionInfo +pathCompletionInfoFromCompletionContext ctx = + PathCompletionInfo + { partialFileName = dirNamePrefix + , partialFileDir = Posix.addTrailingPathSeparator $ Posix.takeDirectory prefix + , cabalFileDir = dir + } + where + prefix = T.unpack $ completionPrefix ctx + dirNamePrefix = T.pack $ Posix.takeFileName prefix + dir = Posix.takeDirectory $ completionCabalFileDir ctx + +{- | Returns the directory, the currently handled cabal file is in. + + We let System.FilePath handle the separator syntax since this is used + to query filepaths from the system. +-} +mkCompletionDirectory :: PathCompletionInfo -> FilePath +mkCompletionDirectory complInfo = + FP.addTrailingPathSeparator $ + cabalFileDir complInfo FP. (FP.normalise $ partialFileDir complInfo) + +{- | Returns the complete filepath for the given filepath. + + Since cabal files only use posix syntax, and this is used for completions + we use posix separators here. +-} +mkDirFromCWD :: PathCompletionInfo -> FilePath -> FilePath +mkDirFromCWD complInfo fp = Posix.addTrailingPathSeparator $ mkCompletionDirectory complInfo Posix. Posix.normalise fp + +{- | Information used to query and build file path/directory completions. + + Note that partialFileName combined with partialFileDir results in + the original prefix. + + Example: + On the written filepath: @dir1/fi@ the + resulting PathCompletionInfo would be: + + @ + partialFileName = "fi" + partialFileDir = "dir1/dir2/fi" + ... + @ +-} +data PathCompletionInfo = PathCompletionInfo + { partialFileName :: T.Text + -- ^ partly written start of next part of path + , partialFileDir :: FilePath + -- ^ written part of path + , cabalFileDir :: FilePath + -- ^ current working directory of the handled file + } + deriving (Eq, Show, Read) + +-- ---------------------------------------------------------------- +-- Completion Data +-- ---------------------------------------------------------------- + +-- | Keyword for cabal version; required to be the top line in a cabal file +cabalVersionKeyword :: Map KeyWordName Completer +cabalVersionKeyword = + Map.singleton "cabal-version:" $ + constantCompleter $ + map (T.pack . showCabalSpecVersion) [CabalSpecV2_2 .. maxBound] + +{- | Top level keywords of a cabal file. + + TODO: we could add descriptions of field values and then show them when inside the field's context +-} +cabalKeywords :: Map KeyWordName Completer +cabalKeywords = + Map.fromList + [ ("name:", noopCompleter) -- TODO: should complete to filename, needs meta info + , ("version:", noopCompleter) + , ("build-type:", constantCompleter ["Simple", "Custom", "Configure", "Make"]) + , ("license:", constantCompleter licenseNames) + , ("license-file:", filePathCompleter) + , ("license-files:", filePathCompleter) -- list of filenames + , ("copyright:", noopCompleter) + , ("author:", noopCompleter) + , ("maintainer:", noopCompleter) -- email address, use git config? + , ("stability:", noopCompleter) + , ("homepage:", noopCompleter) + , ("bug-reports:", noopCompleter) + , ("package-url:", noopCompleter) + , ("synopsis:", noopCompleter) + , ("description:", noopCompleter) + , ("category:", noopCompleter) + , ("tested-with:", constantCompleter ["GHC"]) -- list of compilers, i.e. "GHC == 8.6.3, GHC == 8.4.4" + , ("data-files:", filePathCompleter) -- list of filenames + , ("data-dir:", directoryCompleter) -- directory + , ("extra-source-files:", filePathCompleter) -- filename list + , ("extra-doc-files:", filePathCompleter) -- filename list + , ("extra-tmp-files:", filePathCompleter) -- filename list + ] + +-- | Map, containing all stanzas in a cabal file as keys and lists of their possible nested keywords as values +stanzaKeywordMap :: Map StanzaName (Map KeyWordName Completer) +stanzaKeywordMap = + Map.fromList + [ + ( "library" + , Map.fromList $ + [ ("exposed-modules:", noopCompleter) -- identifier list + , ("virtual-modules:", noopCompleter) + , ("exposed:", constantCompleter ["True", "False"]) + , ("visibility:", constantCompleter ["private", "public"]) + , ("reexported-modules:", noopCompleter) -- export list, i.e. "orig-okg:Name as NewName" + , ("signatures:", noopCompleter) -- list of signatures + ] + ++ libExecTestBenchCommons + ) + , + ( "executable" + , Map.fromList $ + [ ("main-is:", filePathCompleter) + , ("scope:", constantCompleter ["public", "private"]) + ] + ++ libExecTestBenchCommons + ) + , + ( "test-suite" + , Map.fromList $ + [ ("type:", constantCompleter ["exitcode-stdio-1.0", "detailed-0.9"]) + , ("main-is:", filePathCompleter) + ] + ++ libExecTestBenchCommons + ) + , + ( "benchmark" + , Map.fromList $ + [ ("type:", noopCompleter) + , ("main-is:", filePathCompleter) + ] + ++ libExecTestBenchCommons + ) + , + ( "foreign-library" + , Map.fromList + [ ("type:", constantCompleter ["native-static", "native-shared"]) + , ("options:", constantCompleter ["standalone"]) + , ("mod-def-file:", filePathCompleter) + , ("lib-version-info:", noopCompleter) + , ("lib-version-linux:", noopCompleter) + ] + ) + , + ( "flag" + , Map.fromList + [ ("description:", noopCompleter) + , ("default:", constantCompleter ["True", "False"]) + , ("manual:", constantCompleter ["False", "True"]) + , ("lib-def-file:", noopCompleter) + , ("lib-version-info:", noopCompleter) + , ("lib-version-linux:", noopCompleter) + ] + ) + , + ( "source-repository" + , Map.fromList $ + [ + ( "type:" + , constantCompleter + [ "darcs" + , "git" + , "svn" + , "cvs" + , "mercurial" + , "hg" + , "bazaar" + , "bzr" + , "arch" + , "monotone" + ] + ) + , ("location:", noopCompleter) + , ("module:", noopCompleter) + , ("branch:", noopCompleter) + , ("tag:", noopCompleter) + , ("subdir:", directoryCompleter) + ] + ) + ] + where + libExecTestBenchCommons = + [ ("build-depends:", noopCompleter) + , ("other-modules:", noopCompleter) + , ("hs-source-dirs:", directoryCompleter) + , ("default-extensions:", noopCompleter) + , ("other-extensions:", noopCompleter) + , ("default-language:", constantCompleter ["GHC2021", "Haskell2010", "Haskell98"]) + , ("other-languages:", noopCompleter) + , ("build-tool-depends:", noopCompleter) + , ("buildable:", constantCompleter ["True", "False"]) + , ("ghc-options:", noopCompleter) -- todo: maybe there is a list of possible ghc options somewhere + , ("ghc-prof-options:", noopCompleter) + , ("ghc-shared-options:", noopCompleter) + , ("ghcjs-options:", noopCompleter) + , ("ghcjs-prof-options:", noopCompleter) + , ("ghcjs-shared-options:", noopCompleter) + , ("includes:", filePathCompleter) -- list of filenames + , ("install-includes:", filePathCompleter) -- list of filenames + , ("include-dirs:", directoryCompleter) -- list of directories + , ("c-sources:", filePathCompleter) -- list of filenames + , ("cxx-sources:", filePathCompleter) -- list of filenames + , ("asm-sources:", filePathCompleter) -- list of filenames + , ("cmm-sources:", filePathCompleter) -- list of filenames + , ("js-sources:", filePathCompleter) -- list of filenames + , ("extra-libraries:", noopCompleter) + , ("extra-ghci-libraries:", noopCompleter) + , ("extra-bundled-libraries:", noopCompleter) + , ("extra-lib-dirs:", directoryCompleter) -- list of directories + , ("cc-options:", noopCompleter) + , ("cpp-options:", noopCompleter) + , ("cxx-options:", noopCompleter) + , ("cmm-options:", noopCompleter) + , ("asm-options:", noopCompleter) + , ("ld-options:", noopCompleter) + , ("pkgconfig-depends:", noopCompleter) + , ("frameworks:", noopCompleter) + , ("extra-framework-dirs:", directoryCompleter) -- list of directories + , ("mixins:", noopCompleter) + ] + +-- cabalFlagKeywords :: [(T.Text, T.Text)] +-- cabalFlagKeywords = +-- [ +-- ("flag", "name"), +-- ("description:", "freeform"), +-- ("default:", "boolean"), +-- ("manual:", "boolean") +-- ] + +-- cabalStanzaKeywords :: [(T.Text, T.Text)] +-- cabalStanzaKeywords = +-- [ +-- ("common", "name"), +-- ("import:", "token-list") +-- ] diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs index 6165cfd1358..899733197c3 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs @@ -6,6 +6,7 @@ module Ide.Plugin.Cabal.LicenseSuggest ( licenseErrorSuggestion , licenseErrorAction +, licenseNames -- * Re-exports , T.Text , Diagnostic(..) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 9fa843347d3..0c83eb4771f 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -1,22 +1,29 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} -module Main - ( main - ) where +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Main ( + main, +) where import Control.Lens ((^.)) import Control.Monad (guard) import qualified Data.ByteString as BS import Data.Either (isRight) -import qualified Data.Text as Text +import qualified Language.LSP.VFS as VFS + +import Data.List (sort) +import qualified Data.Text as T import Ide.Plugin.Cabal +import Ide.Plugin.Cabal.Completions import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Types.Lens as J -import System.FilePath +import System.Directory (getCurrentDirectory) +import System.FilePath.Posix import Test.Hls cabalPlugin :: PluginTestDescriptor Log @@ -25,7 +32,8 @@ cabalPlugin = mkPluginTestDescriptor descriptor "cabal" main :: IO () main = do defaultTestRunner $ - testGroup "Cabal Plugin Tests" + testGroup + "Cabal Plugin Tests" [ unitTests , pluginTests ] @@ -36,136 +44,482 @@ main = do unitTests :: TestTree unitTests = - testGroup "Unit Tests" - [ cabalParserUnitTests, - codeActionUnitTests - ] + testGroup + "Unit Tests" + [ cabalParserUnitTests + , codeActionUnitTests + , completionHelperTests + , contextTests + , filePathCompletionContextTests + , pathCompleterTests + ] cabalParserUnitTests :: TestTree -cabalParserUnitTests = testGroup "Parsing Cabal" - [ testCase "Simple Parsing works" $ do - (warnings, pm) <- Lib.parseCabalFileContents =<< BS.readFile (testDataDir "simple.cabal") - liftIO $ do - null warnings @? "Found unexpected warnings" - isRight pm @? "Failed to parse GenericPackageDescription" - ] +cabalParserUnitTests = + testGroup + "Parsing Cabal" + [ testCase "Simple Parsing works" $ do + (warnings, pm) <- Lib.parseCabalFileContents =<< BS.readFile (testDataDir "simple.cabal") + liftIO $ do + null warnings @? "Found unexpected warnings" + isRight pm @? "Failed to parse GenericPackageDescription" + ] codeActionUnitTests :: TestTree -codeActionUnitTests = testGroup "Code Action Tests" - [ testCase "Unknown format" $ do - -- the message has the wrong format - licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= [], - - testCase "BSD-3-Clause" $ do - take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?") - @?= [("BSD3","BSD-3-Clause"),("BSD3","BSD-3-Clause-LBNL")], - - testCase "MiT" $ do - -- contains no suggestion - take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'MiT'") - @?= [("MiT","MIT"),("MiT","MIT-0")] - ] +codeActionUnitTests = + testGroup + "Code Action Tests" + [ testCase "Unknown format" $ do + -- the message has the wrong format + licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= [] + , testCase "BSD-3-Clause" $ do + take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?") + @?= [("BSD3", "BSD-3-Clause"), ("BSD3", "BSD-3-Clause-LBNL")] + , testCase "MiT" $ do + -- contains no suggestion + take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'MiT'") + @?= [("MiT", "MIT"), ("MiT", "MIT-0")] + ] + +completionHelperTests :: TestTree +completionHelperTests = + testGroup + "Completion Helper Tests" + [ testCase "get FilePath - partly written file path" $ do + getFilePathCursorPrefix "src/a" 0 5 @?= "src/a" + , testCase "get FilePath - ignores spaces" $ do + getFilePathCursorPrefix " src/a" 0 7 @?= "src/a" + , testCase "get FilePath - ignores spaces and keyword" $ do + getFilePathCursorPrefix "license-file: src/a" 0 19 @?= "src/a" + , testCase "get FilePath - with apostrophe, ignores spaces and keyword" $ do + getFilePathCursorPrefix "license-file: \"src/a" 0 20 @?= "src/a" + , testCase "get FilePath - ignores list of filepaths beforehand, space separated" $ do + getFilePathCursorPrefix " ./text.txt file.h" 0 19 @?= "file.h" + , testCase "get FilePath - ignores list of filepaths after, space separated" $ do + getFilePathCursorPrefix " ./text.t file.h" 0 10 @?= "./text.t" + , testCase "get FilePath - ignores list of filepaths and rest of filepath after, space separated" $ do + getFilePathCursorPrefix " ./text.t file.h" 0 6 @?= "./te" + , testCase "get FilePath - ignores list of filepaths beforehand, multiple space separated" $ do + getFilePathCursorPrefix " ./text.txt file.h" 0 21 @?= "file.h" + , testCase "get FilePath - ignores list of filepaths beforehand, comma separated" $ do + getFilePathCursorPrefix " ./text.txt, file.h" 0 20 @?= "file.h" + , testCase "get FilePath - ignores list of filepaths beforehand, comma separated, many whitespaces" $ do + getFilePathCursorPrefix " ./text.txt, file.h" 0 22 @?= "file.h" + , testCase "get FilePath - ignores list of filepaths beforehand, comma separated, no whitespace" $ do + getFilePathCursorPrefix " ./text.txt,file.h" 0 19 @?= "file.h" + , testCase "get FilePath - with apostrophes, ignores list of filepaths beforehand" $ do + getFilePathCursorPrefix " \"./text.txt\" \"file.h" 0 23 @?= "file.h" + , testCase "get FilePath - ignores list of filepaths with apostrophe beforehand" $ do + getFilePathCursorPrefix " \"./text.txt\" file.h" 0 22 @?= "file.h" + ] + where + getFilePathCursorPrefix :: T.Text -> UInt -> UInt -> T.Text + getFilePathCursorPrefix lineString linePos charPos = + completionPrefix . getCabalCompletionContext "" $ + VFS.PosPrefixInfo + { VFS.fullLine = lineString + , VFS.prefixModule = "" + , VFS.prefixText = "" + , VFS.cursorPos = Position linePos charPos + } + +filePathCompletionContextTests :: TestTree +filePathCompletionContextTests = + testGroup + "File Path Completion Context Tests" + [ testCase "empty line" $ do + let complContext = getCabalCompletionContext "" (simplePosPrefixInfo " " 0 3) + completionSuffix complContext @?= Just "" + completionPrefix complContext @?= "" + , testCase "simple filepath" $ do + let complContext = getCabalCompletionContext "" (simplePosPrefixInfo " src/" 0 7) + completionSuffix complContext @?= Just "" + completionPrefix complContext @?= "src/" + , testCase "simple filepath - starting apostrophe" $ do + let complContext = getCabalCompletionContext "" (simplePosPrefixInfo " \"src/" 0 8) + completionSuffix complContext @?= Just "\"" + completionPrefix complContext @?= "src/" + , testCase "simple filepath - starting apostrophe, already closed" $ do + let complContext = getCabalCompletionContext "" (simplePosPrefixInfo " \"src/\"" 0 8) + completionSuffix complContext @?= Just "" + completionPrefix complContext @?= "src/" + , testCase "second filepath - starting apostrophe" $ do + let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "fp.txt \"src/" 0 12) + completionSuffix complContext @?= Just "\"" + completionPrefix complContext @?= "src/" + , testCase "middle filepath - starting apostrophe" $ do + let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "fp.txt \"src/ fp2.txt" 0 12) + completionSuffix complContext @?= Just "\"" + completionPrefix complContext @?= "src/" + , testCase "middle filepath - starting apostrophe, already closed" $ do + let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "fp.t xt \"src\" fp2.txt" 0 12) + completionSuffix complContext @?= Just "" + completionPrefix complContext @?= "src" + , testCase "middle filepath - starting apostrophe, already closed" $ do + let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "\"fp.txt\" \"src fp2.txt" 0 13) + completionSuffix complContext @?= Just "\"" + completionPrefix complContext @?= "src" + ] + where + simplePosPrefixInfo :: T.Text -> UInt -> UInt -> VFS.PosPrefixInfo + simplePosPrefixInfo lineString linePos charPos = + VFS.PosPrefixInfo + { VFS.fullLine = lineString + , VFS.prefixModule = "" + , VFS.prefixText = "" + , VFS.cursorPos = Position linePos charPos + } + +pathCompleterTests :: TestTree +pathCompleterTests = + testGroup + "Path Completion Tests" + [ fileCompleterTests + , directoryCompleterTests + , pathCompletionInfoFromCompletionContextTests + , testGroup + "Helper - List File Completion Tests" + [ testCase "Current Directory" $ do + testDir <- getTestDir + compls <- + listFileCompletions + PathCompletionInfo + { partialFileName = "" + , partialFileDir = "" + , cabalFileDir = testDir + } + sort compls @?= [".hidden", "dir1/", "dir2/", "textfile.txt"] + , testCase "In directory" $ do + testDir <- getTestDir + compls <- + listFileCompletions $ + PathCompletionInfo + { partialFileName = "" + , partialFileDir = "dir1/" + , cabalFileDir = testDir + } + sort compls @?= ["f1.txt", "f2.hs"] + ] + ] + where + simpleCabalCompletionContext :: T.Text -> FilePath -> CabalCompletionContext + simpleCabalCompletionContext prefix fp = + CabalCompletionContext + { completionPrefix = prefix + , completionSuffix = Nothing + , completionRange = Range (Position 0 0) (Position 0 0) + , completionCabalFileDir = fp "test.cabal" + } + getTestDir :: IO FilePath + getTestDir = do + cwd <- getCurrentDirectory + pure $ cwd "test/testdata/filepath-completions/" + pathCompletionInfoFromCompletionContextTests :: TestTree + pathCompletionInfoFromCompletionContextTests = + testGroup + "Completion Info to Completion Context Tests" + [ testCase "Current Directory" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCompletionContext $ simpleCabalCompletionContext "" testDir + partialFileDir complInfo @?= "./" + , testCase "Current Directory - partly written next" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCompletionContext $ simpleCabalCompletionContext "di" testDir + partialFileDir complInfo @?= "./" + partialFileName complInfo @?= "di" + , testCase "Current Directory - alternative writing" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCompletionContext $ simpleCabalCompletionContext "./" testDir + partialFileDir complInfo @?= "./" + , testCase "Subdirectory" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCompletionContext $ simpleCabalCompletionContext "dir1/" testDir + partialFileDir complInfo @?= "dir1/" + partialFileName complInfo @?= "" + , testCase "Subdirectory - partly written next" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCompletionContext $ simpleCabalCompletionContext "dir1/d" testDir + partialFileDir complInfo @?= "dir1/" + partialFileName complInfo @?= "d" + , testCase "Subdirectory - partly written next" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCompletionContext $ simpleCabalCompletionContext "dir1/dir2/d" testDir + partialFileDir complInfo @?= "dir1/dir2/" + partialFileName complInfo @?= "d" + ] + directoryCompleterTests :: TestTree + directoryCompleterTests = + testGroup + "Directory Completer Tests" + [ testCase "Current Directory" $ do + testDir <- getTestDir + completions <- directoryCompleter $ simpleCabalCompletionContext "" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["./dir1/", "./dir2/"] + , testCase "Current Directory - alternative writing" $ do + testDir <- getTestDir + completions <- directoryCompleter $ simpleCabalCompletionContext "./" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["./dir1/", "./dir2/"] + , testCase "Current Directory - incomplete directory path written" $ do + testDir <- getTestDir + completions <- directoryCompleter $ simpleCabalCompletionContext "di" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["./dir1/", "./dir2/"] + , testCase "Current Directory - incomplete filepath written" $ do + testDir <- getTestDir + completions <- directoryCompleter $ simpleCabalCompletionContext "te" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= [] + , testCase "Subdirectory - no more directories found" $ do + testDir <- getTestDir + completions <- directoryCompleter $ simpleCabalCompletionContext "dir1/" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= [] + , testCase "Subdirectory - available subdirectory" $ do + testDir <- getTestDir + completions <- directoryCompleter $ simpleCabalCompletionContext "dir2/" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["dir2/dir3/"] + , testCase "Nonexistent directory" $ do + testDir <- getTestDir + completions <- directoryCompleter $ simpleCabalCompletionContext "dir2/dir4/" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= [] + ] + fileCompleterTests :: TestTree + fileCompleterTests = + testGroup + "File Completer Tests" + [ testCase "Current Directory" $ do + testDir <- getTestDir + completions <- filePathCompleter $ simpleCabalCompletionContext "" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["./.hidden", "./dir1/", "./dir2/", "./textfile.txt"] + , testCase "Current Directory - alternative writing" $ do + testDir <- getTestDir + completions <- filePathCompleter $ simpleCabalCompletionContext "./" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["./.hidden", "./dir1/", "./dir2/", "./textfile.txt"] + , testCase "Current Directory - hidden file start" $ do + testDir <- getTestDir + completions <- filePathCompleter $ simpleCabalCompletionContext "." testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["./.hidden", "./textfile.txt"] + , testCase "Current Directory - incomplete directory path written" $ do + testDir <- getTestDir + completions <- filePathCompleter $ simpleCabalCompletionContext "di" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["./dir1/", "./dir2/"] + , testCase "Current Directory - incomplete filepath written" $ do + testDir <- getTestDir + completions <- filePathCompleter $ simpleCabalCompletionContext "te" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["./textfile.txt"] + , testCase "Subdirectory" $ do + testDir <- getTestDir + completions <- filePathCompleter $ simpleCabalCompletionContext "dir1/" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["dir1/f1.txt", "dir1/f2.hs"] + , testCase "Subdirectory - incomplete filepath written" $ do + testDir <- getTestDir + completions <- filePathCompleter $ simpleCabalCompletionContext "dir2/dir3/MA" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= ["dir2/dir3/MARKDOWN.md"] + , testCase "Nonexistent directory" $ do + testDir <- getTestDir + completions <- filePathCompleter $ simpleCabalCompletionContext "dir2/dir4/" testDir + let insertCompletions = map itemInsert completions + sort insertCompletions @?= [] + ] + +contextTests :: TestTree +contextTests = + testGroup + "Context Tests" + [ testCase "Empty File - Start" $ do + -- for a completely empty file, the context needs to + -- be top level without a specified keyword + getContext (Position 0 0) [""] @?= Just (TopLevel, None) + , testCase "Cabal version keyword - no value, no space after :" $ do + -- on a file, where the keyword is already written + -- the context should still be toplevel but the keyword should be recognized + getContext (Position 0 14) ["cabal-version:"] @?= Just (TopLevel, KeyWord "cabal-version:") + , testCase "Cabal version keyword - cursor in keyword" $ do + -- on a file, where the keyword is already written + -- but the cursor is in the middle of the keyword, + -- we are not in a keyword context + getContext (Position 0 5) ["cabal-version:"] @?= Just (TopLevel, None) + , testCase "Cabal version keyword - no value, many spaces" $ do + -- on a file, where the "cabal-version:" keyword is already written + -- the context should still be top level but the keyword should be recognized + getContext (Position 0 45) ["cabal-version:" <> T.replicate 50 " "] @?= Just (TopLevel, KeyWord "cabal-version:") + , testCase "Cabal version keyword - keyword partly written" $ do + -- in the first line of the file, if the keyword + -- has not been written completely, the keyword context + -- should still be None + getContext (Position 0 5) ["cabal"] @?= Just (TopLevel, None) + , testCase "Cabal version keyword - value partly written" $ do + -- in the first line of the file, if the keyword + -- has not been written completely, the keyword context + -- should still be None + getContext (Position 0 17) ["cabal-version: 1."] @?= Just (TopLevel, KeyWord "cabal-version:") + , testCase "Inside Stanza - no keyword" $ do + -- on a file, where the library stanza has been defined + -- but no keyword is defined afterwards, the stanza context should be recognized + getContext (Position 3 2) libraryStanzaData @?= Just (Stanza "library", None) + , testCase "Inside Stanza - keyword, no value" $ do + -- on a file, where the library stanza and a keyword + -- has been defined, the keyword and stanza should be recognized + getContext (Position 4 21) libraryStanzaData @?= Just (Stanza "library", KeyWord "build-depends:") + , expectFailBecause "While not valid, it is not that important to make the code more complicated for this" $ + testCase "Cabal version keyword - no value, next line" $ do + -- if the cabal version keyword has been written but without a value, + -- in the next line we still should be in top level context with no keyword + -- since the cabal version keyword and value pair need to be in the same line + getContext (Position 1 2) ["cabal-version:", ""] @?= Just (TopLevel, None) + , testCase "Non-cabal-version keyword - no value, next line indentented position" $ do + -- if a keyword, other than the cabal version keyword has been written + -- with no value, in the next line we still should be in top level keyword context + -- of the keyword with no value, since its value may be written in the next line + getContext (Position 2 4) topLevelData @?= Just (TopLevel, KeyWord "name:") + , testCase "Non-cabal-version keyword - no value, next line at start" $ do + -- if a keyword, other than the cabal version keyword has been written + -- with no value, in the next line we still should be in top level context + -- but not the keyword's, since it is not viable to write a value for a + -- keyword a the start of the next line + getContext (Position 2 0) topLevelData @?= Just (TopLevel, None) + , testCase "Non-cabal-version keyword - no value, multiple lines between" $ do + -- if a keyword, other than the cabal version keyword has been written + -- with no value, even with multiple lines in between we can still write the + -- value corresponding to the keyword + getContext (Position 5 4) topLevelData @?= Just (TopLevel, KeyWord "name:") + , testCase "Keyword inside stanza - cursor indented more than keyword in next line" $ do + -- if a keyword, other than the cabal version keyword has been written + -- in a stanza context with no value, then the value may be written in the next line, + -- when the cursor is indented more than the keyword + getContext (Position 5 8) libraryStanzaData @?= Just (Stanza "library", KeyWord "build-depends:") + , testCase "Keyword inside stanza - cursor indented less than keyword in next line" $ do + -- if a keyword, other than the cabal version keyword has been written + -- in a stanza context with no value, then the value may not be written in the next line, + -- when the cursor is indented less than the keyword + getContext (Position 5 2) libraryStanzaData @?= Just (Stanza "library", None) + , testCase "Keyword inside stanza - cursor at start of next line" $ do + -- in a stanza context with no value the value may not be written in the next line, + -- when the cursor is not indented and we are in the top level context + getContext (Position 5 0) libraryStanzaData @?= Just (TopLevel, None) + , testCase "Top level - cursor in later line with partially written value" $ do + getContext (Position 5 13) topLevelData @?= Just (TopLevel, KeyWord "name:") + ] -- ------------------------------------------------------------------------ -- Integration Tests -- ------------------------------------------------------------------------ pluginTests :: TestTree -pluginTests = testGroup "Plugin Tests" - [ testGroup "Diagnostics" - [ runCabalTestCaseSession "Publishes Diagnostics on Error" "" $ do - doc <- openDoc "invalid.cabal" "cabal" - diags <- waitForDiagnosticsFromSource doc "cabal" - unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"] - liftIO $ do - length diags @?= 1 - unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0) - unknownLicenseDiag ^. J.severity @?= Just DsError - , runCabalTestCaseSession "Clears diagnostics" "" $ do - doc <- openDoc "invalid.cabal" "cabal" - diags <- waitForDiagnosticsFrom doc - unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"] - liftIO $ do - length diags @?= 1 - unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0) - unknownLicenseDiag ^. J.severity @?= Just DsError - _ <- applyEdit doc $ TextEdit (Range (Position 3 20) (Position 4 0)) "BSD-3-Clause\n" - newDiags <- waitForDiagnosticsFrom doc - liftIO $ newDiags @?= [] - , runCabalTestCaseSession "No Diagnostics in .hs files from valid .cabal file" "simple-cabal" $ do - hsDoc <- openDoc "A.hs" "haskell" - expectNoMoreDiagnostics 1 hsDoc "typechecking" - cabalDoc <- openDoc "simple-cabal.cabal" "cabal" - expectNoMoreDiagnostics 1 cabalDoc "parsing" - , ignoreTestBecause "Testcase is flaky for certain GHC versions (e.g. 9.2.5). See #3333 for details." $ do - runCabalTestCaseSession "Diagnostics in .hs files from invalid .cabal file" "simple-cabal" $ do - hsDoc <- openDoc "A.hs" "haskell" - expectNoMoreDiagnostics 1 hsDoc "typechecking" - cabalDoc <- openDoc "simple-cabal.cabal" "cabal" - expectNoMoreDiagnostics 1 cabalDoc "parsing" - let theRange = Range (Position 3 20) (Position 3 23) - -- Invalid license - changeDoc cabalDoc [TextDocumentContentChangeEvent (Just theRange) Nothing "MIT3"] - cabalDiags <- waitForDiagnosticsFrom cabalDoc - unknownLicenseDiag <- liftIO $ inspectDiagnostic cabalDiags ["Unknown SPDX license identifier: 'MIT3'"] - expectNoMoreDiagnostics 1 hsDoc "typechecking" - liftIO $ do - length cabalDiags @?= 1 - unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0) - unknownLicenseDiag ^. J.severity @?= Just DsError - ] - , testGroup "Code Actions" - [ runCabalTestCaseSession "BSD-3" "" $ do - doc <- openDoc "licenseCodeAction.cabal" "cabal" - diags <- waitForDiagnosticsFromSource doc "cabal" - reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"] - liftIO $ do - length diags @?= 1 - reduceDiag ^. J.range @?= Range (Position 3 24) (Position 4 0) - reduceDiag ^. J.severity @?= Just DsError - [codeAction] <- getLicenseAction "BSD-3-Clause" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) - executeCodeAction codeAction - contents <- documentContents doc - liftIO $ contents @?= Text.unlines - [ "cabal-version: 3.0" - , "name: licenseCodeAction" - , "version: 0.1.0.0" - , "license: BSD-3-Clause" - , "" - , "library" - , " build-depends: base" - , " default-language: Haskell2010" - ] - , runCabalTestCaseSession "Apache-2.0" "" $ do - doc <- openDoc "licenseCodeAction2.cabal" "cabal" - diags <- waitForDiagnosticsFromSource doc "cabal" - -- test if it supports typos in license name, here 'apahe' - reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'APAHE'"] - liftIO $ do - length diags @?= 1 - reduceDiag ^. J.range @?= Range (Position 3 25) (Position 4 0) - reduceDiag ^. J.severity @?= Just DsError - [codeAction] <- getLicenseAction "Apache-2.0" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) - executeCodeAction codeAction - contents <- documentContents doc - liftIO $ contents @?= Text.unlines - [ "cabal-version: 3.0" - , "name: licenseCodeAction2" - , "version: 0.1.0.0" - , "license: Apache-2.0" - , "" - , "library" - , " build-depends: base" - , " default-language: Haskell2010" - ] +pluginTests = + testGroup + "Plugin Tests" + [ testGroup + "Diagnostics" + [ runCabalTestCaseSession "Publishes Diagnostics on Error" "" $ do + doc <- openDoc "invalid.cabal" "cabal" + diags <- waitForDiagnosticsFromSource doc "cabal" + unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"] + liftIO $ do + length diags @?= 1 + unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0) + unknownLicenseDiag ^. J.severity @?= Just DsError + , runCabalTestCaseSession "Clears diagnostics" "" $ do + doc <- openDoc "invalid.cabal" "cabal" + diags <- waitForDiagnosticsFrom doc + unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"] + liftIO $ do + length diags @?= 1 + unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0) + unknownLicenseDiag ^. J.severity @?= Just DsError + _ <- applyEdit doc $ TextEdit (Range (Position 3 20) (Position 4 0)) "BSD-3-Clause\n" + newDiags <- waitForDiagnosticsFrom doc + liftIO $ newDiags @?= [] + , runCabalTestCaseSession "No Diagnostics in .hs files from valid .cabal file" "simple-cabal" $ do + hsDoc <- openDoc "A.hs" "haskell" + expectNoMoreDiagnostics 1 hsDoc "typechecking" + cabalDoc <- openDoc "simple-cabal.cabal" "cabal" + expectNoMoreDiagnostics 1 cabalDoc "parsing" + , ignoreTestBecause "Test case is flaky for certain GHC versions (e.g. 9.2.5). See #3333 for details." $ do + runCabalTestCaseSession "Diagnostics in .hs files from invalid .cabal file" "simple-cabal" $ do + hsDoc <- openDoc "A.hs" "haskell" + expectNoMoreDiagnostics 1 hsDoc "typechecking" + cabalDoc <- openDoc "simple-cabal.cabal" "cabal" + expectNoMoreDiagnostics 1 cabalDoc "parsing" + let theRange = Range (Position 3 20) (Position 3 23) + -- Invalid license + changeDoc cabalDoc [TextDocumentContentChangeEvent (Just theRange) Nothing "MIT3"] + cabalDiags <- waitForDiagnosticsFrom cabalDoc + unknownLicenseDiag <- liftIO $ inspectDiagnostic cabalDiags ["Unknown SPDX license identifier: 'MIT3'"] + expectNoMoreDiagnostics 1 hsDoc "typechecking" + liftIO $ do + length cabalDiags @?= 1 + unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0) + unknownLicenseDiag ^. J.severity @?= Just DsError + ] + , testGroup + "Code Actions" + [ runCabalTestCaseSession "BSD-3" "" $ do + doc <- openDoc "licenseCodeAction.cabal" "cabal" + diags <- waitForDiagnosticsFromSource doc "cabal" + reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"] + liftIO $ do + length diags @?= 1 + reduceDiag ^. J.range @?= Range (Position 3 24) (Position 4 0) + reduceDiag ^. J.severity @?= Just DsError + [codeAction] <- getLicenseAction "BSD-3-Clause" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) + executeCodeAction codeAction + contents <- documentContents doc + liftIO $ + contents + @?= T.unlines + [ "cabal-version: 3.0" + , "name: licenseCodeAction" + , "version: 0.1.0.0" + , "license: BSD-3-Clause" + , "" + , "library" + , " build-depends: base" + , " default-language: Haskell2010" + ] + , runCabalTestCaseSession "Apache-2.0" "" $ do + doc <- openDoc "licenseCodeAction2.cabal" "cabal" + diags <- waitForDiagnosticsFromSource doc "cabal" + -- test if it supports typos in license name, here 'apahe' + reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'APAHE'"] + liftIO $ do + length diags @?= 1 + reduceDiag ^. J.range @?= Range (Position 3 25) (Position 4 0) + reduceDiag ^. J.severity @?= Just DsError + [codeAction] <- getLicenseAction "Apache-2.0" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) + executeCodeAction codeAction + contents <- documentContents doc + liftIO $ + contents + @?= T.unlines + [ "cabal-version: 3.0" + , "name: licenseCodeAction2" + , "version: 0.1.0.0" + , "license: Apache-2.0" + , "" + , "library" + , " build-depends: base" + , " default-language: Haskell2010" + ] + ] ] - ] - where - getLicenseAction :: Text.Text -> [Command |? CodeAction] -> [CodeAction] - getLicenseAction license codeActions = do - InR action@CodeAction{_title} <- codeActions - guard (_title=="Replace with " <> license) - pure action + where + getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction] + getLicenseAction license codeActions = do + InR action@CodeAction{_title} <- codeActions + guard (_title == "Replace with " <> license) + pure action -- ------------------------------------------------------------------------ -- Runner utils @@ -176,7 +530,30 @@ runCabalTestCaseSession title subdir = testCase title . runCabalSession subdir runCabalSession :: FilePath -> Session a -> IO a runCabalSession subdir = - failIfSessionTimeout . runSessionWithServer cabalPlugin (testDataDir subdir) + failIfSessionTimeout . runSessionWithServer cabalPlugin (testDataDir subdir) testDataDir :: FilePath testDataDir = "test" "testdata" + +-- ------------------------------------------------------------------------ +-- Test Data +-- ------------------------------------------------------------------------ +libraryStanzaData :: [T.Text] +libraryStanzaData = + [ "cabal-version: 3.0" + , "name: simple-cabal" + , "library " + , "" + , " build-depends: " + , " " + ] + +topLevelData :: [T.Text] +topLevelData = + [ "cabal-version: 3.0" + , "name:" + , "" + , "" + , "" + , " eee" + ] diff --git a/plugins/hls-cabal-plugin/test/testdata/filepath-completions/.hidden b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/.hidden new file mode 100644 index 00000000000..82df2e0fff8 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/.hidden @@ -0,0 +1 @@ +test hidden file diff --git a/plugins/hls-cabal-plugin/test/testdata/filepath-completions/dir1/f1.txt b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/dir1/f1.txt new file mode 100644 index 00000000000..016496005ac --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/dir1/f1.txt @@ -0,0 +1 @@ +test text file diff --git a/plugins/hls-cabal-plugin/test/testdata/filepath-completions/dir1/f2.hs b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/dir1/f2.hs new file mode 100644 index 00000000000..6c5963631fc --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/dir1/f2.hs @@ -0,0 +1 @@ +-- test haskell file diff --git a/plugins/hls-cabal-plugin/test/testdata/filepath-completions/dir2/dir3/MARKDOWN.md b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/dir2/dir3/MARKDOWN.md new file mode 100644 index 00000000000..95c3d0e5492 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/dir2/dir3/MARKDOWN.md @@ -0,0 +1 @@ +test markdown file diff --git a/plugins/hls-cabal-plugin/test/testdata/filepath-completions/textfile.txt b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/textfile.txt new file mode 100644 index 00000000000..016496005ac --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/textfile.txt @@ -0,0 +1 @@ +test text file