From c46ba7db0a26b0968e0017aaf5330a1155cfbc70 Mon Sep 17 00:00:00 2001 From: Jana Chadt Date: Mon, 5 Jun 2023 17:29:43 +0200 Subject: [PATCH] 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 --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 298 +++++----- .../src/Ide/Plugin/Cabal/Completions.hs | 525 ++++++++++------- plugins/hls-cabal-plugin/test/Main.hs | 554 ++++++++++-------- 3 files changed, 762 insertions(+), 615 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 7f169ee093a..6d84430e6a9 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/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 diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs index 7a1bfb7cc3a..bbc4d3ed156 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs @@ -2,61 +2,86 @@ module Ide.Plugin.Cabal.Completions where -import Control.Monad (filterM) +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 (CabalSpecV1_2), showCabalSpecVersion) import Distribution.Compat.Lens ((^.)) -import Distribution.PackageDescription (GenericPackageDescription) -import Language.LSP.Types import qualified Language.LSP.Types as J import qualified Language.LSP.Types.Lens as JL import qualified Language.LSP.VFS as VFS import System.Console.Haskeline.Completion as Haskeline -import System.Directory (doesDirectoryExist) +import System.Directory (doesDirectoryExist, + doesFileExist) import System.FilePath import qualified Text.Fuzzy.Parallel as Fuzzy - - -type Completer = T.Text -> IO [T.Text] - --- | 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 +-- | 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 = (LevelContext, KeyWordContext) --- | context inside a cabal file, used to decide which keywords to suggest +-- | Context inside a cabal file, used to decide which keywords to suggest data LevelContext - = TopLevel - -- ^ Top level context in a cabal file such as 'author' - | Stanza T.Text - -- ^ Nested context in a cabal file, such as 'library', which has nested keywords, specific to the stanza - deriving (Eq, Show) - --- | Keyword context in cabal file --- used to decide whether to suggest values or keywords + = -- | 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 T.Text + deriving (Eq, Show, Read) + +{- | Keyword context in cabal file + used to decide whether to suggest values or keywords +-} data KeyWordContext - = KeyWord T.Text - -- ^ Key word context, where a keyword - -- occurs right before the current position - -- with no value associated to it - | None - -- ^ Keyword context where no keyword occurs - -- right before the current position - deriving (Eq, Show) + = -- | Key word context, where a keyword + -- occurs right before the current position + -- with no value associated to it + KeyWord T.Text + | -- | Keyword context where no keyword occurs + -- right before the current position + None + deriving (Eq, Show, Read) + +-- Information about a partly written filepath to complete +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 + } + deriving (Eq, Show, Read) -- ---------------------------------------------------------------- -- Public API for Completions -- ---------------------------------------------------------------- -contextToCompleter :: T.Text ->Context -> Completer +contextToCompleter :: T.Text -> 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 dir (TopLevel, None) = @@ -81,16 +106,18 @@ contextToCompleter _dir (Stanza s, KeyWord kw) = Nothing -> noopCompleter Just l -> l --- | Takes info about the current cursor position, information --- about the handled cabal file and a set of possible keywords --- and creates completion suggestions that fit the current input from the given list -makeCompletionItems :: Range -> [T.Text] -> [CompletionItem] -makeCompletionItems range l = map (buildCompletion range) 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 +{- | Takes info about the current cursor position, information + about 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 @@ -104,16 +131,17 @@ getContext pos ls = Just m -> do kwContext <- getKeyWordContext pos ls m pure (Stanza s, kwContext) - where - lvlContext = if pos ^. JL.character == 0 then TopLevel else findCurrentLevel (getPreviousLines pos ls) + where + lvlContext = if pos ^. JL.character == 0 then TopLevel else findCurrentLevel (getPreviousLines pos ls) -- ---------------------------------------------------------------- -- Helper Functions -- ---------------------------------------------------------------- --- | Takes a position, a list of lines (representing a file) and a map of keywords as keys --- and returns a keyword context if there is a keyword from the map before the current position --- in the given line list +{- | Takes a position, a list of lines (representing a file) and a map of keywords as keys + and returns a keyword context if there is a keyword from the map before the current position + in the given line list +-} getKeyWordContext :: Position -> [T.Text] -> Map T.Text a -> Maybe KeyWordContext getKeyWordContext pos ls keywords = do case lastNonEmptyLineM of @@ -123,224 +151,301 @@ getKeyWordContext pos ls keywords = do 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 + 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 - lastNonEmptyLineM = do - cur <- currentLineM - List.find (not . T.null . T.stripEnd) $ cur : getPreviousLines pos ls - currentLineM = ls Extra.!? (fromIntegral $ pos ^. JL.line) - --- | 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 + else Just None + where + lastNonEmptyLineM = do + cur <- currentLineM + List.find (not . T.null . T.stripEnd) $ cur : getPreviousLines pos ls + currentLineM = ls Extra.!? (fromIntegral $ pos ^. JL.line) + +{- | 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 +-} findCurrentLevel :: [T.Text] -> LevelContext findCurrentLevel [] = TopLevel findCurrentLevel (cur : xs) | Just s <- stanza = Stanza s | otherwise = findCurrentLevel xs - where - stanza = List.find (`T.isPrefixOf` cur) (Map.keys stanzaKeywordMap) + where + stanza = List.find (`T.isPrefixOf` cur) (Map.keys stanzaKeywordMap) --- | Get all lines before the given cursor position in the given file --- and reverse them since we want to traverse starting from our current position +{- | Get all lines before the given cursor position in the given file + and reverse them in order to traverse backwards starting from the current position +-} getPreviousLines :: Position -> [T.Text] -> [T.Text] getPreviousLines pos ls = reverse $ take (fromIntegral currentLine) ls - where - currentLine = pos ^. JL.line - --- | Takes information about the current cursor position in the file --- and returns the filepath up to that cursor position -getFilePathCursorPrefix :: VFS.PosPrefixInfo -> T.Text -getFilePathCursorPrefix pfixInfo = - T.takeWhileEnd (not . (`elem` stopConditionChars)) lineText - where - lineText = T.take cursorColumn $ VFS.fullLine pfixInfo - cursorColumn = fromIntegral $ VFS.cursorPos pfixInfo ^. JL.character - -- if the filepath is inside apostrophes, we parse until the apostrophe, - -- otherwise space is a separator - apostropheOrSpaceSeparator = if T.count "\"" lineText `mod` 2 == 1 then '\"' else ' ' - stopConditionChars = apostropheOrSpaceSeparator : [','] - - -buildCompletion ::Range -> T.Text -> J.CompletionItem -buildCompletion range label = - J.CompletionItem label (Just J.CiKeyword) Nothing Nothing - Nothing Nothing Nothing Nothing Nothing Nothing Nothing - Nothing (Just $ CompletionEditText (TextEdit range label)) Nothing Nothing Nothing Nothing + where + currentLine = pos ^. JL.line + +{- | Takes information about 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 +-} +getFilePathCompletionContext :: VFS.PosPrefixInfo -> CabalCompletionContext +getFilePathCompletionContext prefixInfo = + CabalCompletionContext + { completionPrefix = filepathPrefix + , completionSuffix = Just suffix + , completionRange = editRange + } + where + (Position linePos charPos) = VFS.cursorPos prefixInfo + editRange = + Range + (Position linePos (fromIntegral charPos - fromIntegral (T.length filepathPrefix))) + (Position linePos charPos) + filepathPrefix = T.takeWhileEnd (not . (`elem` stopConditionChars)) prevLineText + (prevLineText, endLineText) = T.splitAt cursorColumn $ VFS.fullLine prefixInfo + suffix = if (apostropheOrSpaceSeparator == '\"') && even (T.count "\"" endLineText) then "\"" else "" + cursorColumn = fromIntegral $ VFS.cursorPos prefixInfo ^. JL.character + -- if the filepath is inside apostrophes, we parse until the apostrophe, + -- otherwise space is a separator + apostropheOrSpaceSeparator = if odd $ T.count "\"" prevLineText then '\"' else ' ' + stopConditionChars = apostropheOrSpaceSeparator : [','] + +buildCompletion :: CabalCompletionItem -> J.CompletionItem +buildCompletion completionItem = + J.CompletionItem + toDisplay + (Just J.CiKeyword) + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + (Just $ J.CompletionEditText (J.TextEdit (itemRange completionItem) $ itemInsert completionItem)) + Nothing + Nothing + Nothing + Nothing + where + toDisplay = fromMaybe (itemInsert completionItem) (itemDisplay completionItem) -- ---------------------------------------------------------------- -- Completor API -- ---------------------------------------------------------------- +{- | Returns a CabalCompletionItem with the given range + and text to be inserted with no suffix to be written + after the inserted text +-} +makeSimpleCabalCompletionItem :: Range -> T.Text -> CabalCompletionItem +makeSimpleCabalCompletionItem r txt = CabalCompletionItem txt Nothing r + +{- | Returns a CabalCompletionItem with the given range, + text to be inserted and suffix to be written after the inserted text +-} +makeCabalCompletionItem :: Range -> T.Text -> T.Text -> CabalCompletionItem +makeCabalCompletionItem r insertTxt displayTxt = CabalCompletionItem insertTxt (Just displayTxt) r + +{- | 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 pfix = do - let scored = Fuzzy.simpleFilter 1000 10 pfix completions - pure $ map Fuzzy.original scored - --- | returns all possible files and directories reachable --- from the given filepath +constantCompleter completions ctxInfo = do + let scored = Fuzzy.simpleFilter 1000 10 (completionPrefix ctxInfo) completions + pure $ map (makeSimpleCabalCompletionItem (completionRange ctxInfo) . Fuzzy.original) scored + +{- | Completer to be used when a file path can be + completed for the field, takes the file path of the directory to start from, + completes file paths as well as directories +-} filePathCompleter :: FilePath -> Completer -filePathCompleter fp pfix = do - completions <- Haskeline.listFiles (fp T.unpack pfix) - pure $ map (T.pack . Haskeline.replacement) completions - --- | returns all possible directories reachable --- from the given filepath +filePathCompleter fp ctxInfo = do + let prefix = completionPrefix ctxInfo + let suffix = fromMaybe "" $ completionSuffix ctxInfo + completions <- Haskeline.listFiles (fp T.unpack prefix) + let filePathCompletions = map (T.pack . Haskeline.replacement) completions + forM + filePathCompletions + ( \compl -> do + withSuffix <- addSuffixIfFilePath suffix compl + pure $ makeCabalCompletionItem (completionRange ctxInfo) withSuffix compl + ) + where + addSuffixIfFilePath :: T.Text -> T.Text -> IO T.Text + addSuffixIfFilePath suffix' completion' = do + isFilePath <- doesFileExist $ T.unpack completion' + let completion = if isFilePath then T.append completion' suffix' else completion' + pure completion + +{- | 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 :: FilePath -> Completer -directoryCompleter fp pfix = do - completions <- Haskeline.listFiles (fp T.unpack pfix) +directoryCompleter fp ctxInfo = do + let prefix = completionPrefix ctxInfo + completions <- Haskeline.listFiles (fp T.unpack prefix) let filepathCompletions = fmap Haskeline.replacement completions directoryCompletions <- filterM doesDirectoryExist filepathCompletions - pure $ map T.pack directoryCompletions + pure $ map (makeSimpleCabalCompletionItem (completionRange ctxInfo) . T.pack) directoryCompletions -- ---------------------------------------------------------------- -- Completion Data -- ---------------------------------------------------------------- -- | Keyword for cabal version; required to be the top line in a cabal file -cabalVersionKeyword :: Map T.Text Completer -cabalVersionKeyword = Map.singleton "cabal-version:" $ - constantCompleter $ - map (T.pack . showCabalSpecVersion) [CabalSpecV1_2 .. maxBound] +cabalVersionKeyword :: Map T.Text Completer +cabalVersionKeyword = + Map.singleton "cabal-version:" $ + constantCompleter $ + map (T.pack . showCabalSpecVersion) [CabalSpecV1_2 .. maxBound] -- todo: we could add file path completion for file path fields -- we could add descriptions of field values and then show them when inside the field's context + -- | Top level keywords of a cabal file cabalKeywords :: T.Text -> Map T.Text Completer cabalKeywords rootDir' = - Map.fromList [ - ("name:", noopCompleter), -- TODO: should complete to filename, needs meta info - ("version:", noopCompleter), - ("build-type:", constantCompleter ["Simple", "Custom", "Configure", "Make"]), - ("license:", constantCompleter ["NONE"]), -- TODO: add possible values, spdx - ("license-file:", filePathCompleter rootDir), - ("license-files:", filePathCompleter rootDir), -- 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 rootDir), -- list of filenames - ("data-dir:", directoryCompleter rootDir), -- directory - ("extra-source-files:", filePathCompleter rootDir), -- filename list - ("extra-doc-files:", filePathCompleter rootDir), -- filename list - ("extra-tmp-files:", filePathCompleter rootDir) -- filename list - ] - where - rootDir = T.unpack rootDir' - + Map.fromList + [ ("name:", noopCompleter) -- TODO: should complete to filename, needs meta info + , ("version:", noopCompleter) + , ("build-type:", constantCompleter ["Simple", "Custom", "Configure", "Make"]) + , ("license:", constantCompleter ["NONE"]) -- TODO: add possible values, spdx + , ("license-file:", filePathCompleter rootDir) + , ("license-files:", filePathCompleter rootDir) -- 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 rootDir) -- list of filenames + , ("data-dir:", directoryCompleter rootDir) -- directory + , ("extra-source-files:", filePathCompleter rootDir) -- filename list + , ("extra-doc-files:", filePathCompleter rootDir) -- filename list + , ("extra-tmp-files:", filePathCompleter rootDir) -- filename list + ] + where + rootDir = T.unpack rootDir' -- | Map, containing all stanzas in a cabal file as keys and lists of their possible nested keywords as values stanzaKeywordMap :: Map T.Text (Map T.Text 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), -- exportlist, i.e. "orig-okg:Name as NewName" - ("signatures:", noopCompleter) -- list of signatures + [ + ( "library" + , Map.fromList $ + [ ("exposed-modules:", noopCompleter) -- identifier list + , ("virtual-modules:", noopCompleter) + , ("exposed:", constantCompleter ["True", "False"]) + , ("visibility:", constantCompleter ["private", "public"]) + , ("reexported-modules:", noopCompleter) -- exportlist, i.e. "orig-okg:Name as NewName" + , ("signatures:", noopCompleter) -- list of signatures ] ++ libExecTestBenchCommons - ), - ( "executable", - Map.fromList $ - [ ("main-is:", filePathCompleter ""), - ("scope:", constantCompleter ["public", "private"]) + ) + , + ( "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 "") + ) + , + ( "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 "") + ) + , + ( "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) + ) + , + ( "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) + ) + , + ( "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) ] ) ] - where - libExecTestBenchCommons = - [ ("build-depends:", noopCompleter), - ("other-modules:", noopCompleter), - ("hs-source-dirs:", directoryCompleter ""), - ("default-extensions:", noopCompleter), - ("other-extensions:", noopCompleter), - ("default-language:", noopCompleter), - ("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) - ] + where + libExecTestBenchCommons = + [ ("build-depends:", noopCompleter) + , ("other-modules:", noopCompleter) + , ("hs-source-dirs:", directoryCompleter "") + , ("default-extensions:", noopCompleter) + , ("other-extensions:", noopCompleter) + , ("default-language:", noopCompleter) + , ("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 = diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index b01f5443976..c31c0b88ebc 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module Main - ( main - ) where +{-# OPTIONS_GHC -Wno-orphans #-} + +module Main ( + main, +) where import Control.Lens ((^.)) import Control.Monad (guard) @@ -29,7 +30,8 @@ cabalPlugin = mkPluginTestDescriptor descriptor "cabal" main :: IO () main = do defaultTestRunner $ - testGroup "Cabal Plugin Tests" + testGroup + "Cabal Plugin Tests" [ unitTests , pluginTests ] @@ -40,253 +42,299 @@ main = do unitTests :: TestTree unitTests = - testGroup "Unit Tests" - [ cabalParserUnitTests, - codeActionUnitTests, - completionHelperTests, - contextTests - ] + testGroup + "Unit Tests" + [ cabalParserUnitTests + , codeActionUnitTests + , completionHelperTests + , contextTests + , filePathCompletionContextTests + ] 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 (makeSimplePosPrefInfo "src/a" 0 5) @?= "src/a", - testCase "get FilePath - ignores spaces" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo " src/a" 0 7) @?= "src/a", - testCase "get FilePath - ignores spaces and keyword" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo "license-file: src/a" 0 19) @?= "src/a", - testCase "get FilePath - with apostrophe, ignores spaces and keyword" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo "license-file: \"src/a" 0 20) @?= "src/a", - testCase "get FilePath - ignores list of filepaths beforehand, space separated" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo " ./text.txt file.h" 0 19) @?= "file.h", - testCase "get FilePath - ignores list of filepaths after, space separated" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo " ./text.t file.h" 0 10) @?= "./text.t", - testCase "get FilePath - ignores list of filepaths and rest of filepath after, space separated" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo " ./text.t file.h" 0 6) @?= "./te", - testCase "get FilePath - ignores list of filepaths beforehand, multiple space separated" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo " ./text.txt file.h" 0 21) @?= "file.h", - testCase "get FilePath - ignores list of filepaths beforehand, comma separated" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo " ./text.txt, file.h" 0 20) @?= "file.h", - testCase "get FilePath - ignores list of filepaths beforehand, comma separated, many whitespaces" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo " ./text.txt, file.h" 0 22) @?= "file.h", - testCase "get FilePath - ignores list of filepaths beforehand, comma separated, no whitespace" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo " ./text.txt,file.h" 0 19) @?= "file.h", - testCase "get FilePath - with apostrophes, ignores list of filepaths beforehand" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo " \"./text.txt\" \"file.h" 0 23) @?= "file.h", - testCase "get FilePath - ignores list of filepaths with apostrophe beforehand" $ do - getFilePathCursorPrefix (makeSimplePosPrefInfo " \"./text.txt\" file.h" 0 22) @?= "file.h" - ] - where - makeSimplePosPrefInfo :: T.Text -> UInt -> UInt -> VFS.PosPrefixInfo - makeSimplePosPrefInfo lineString linePos charPos = VFS.PosPrefixInfo - { VFS.fullLine = lineString, - VFS.prefixModule = "", - VFS.prefixText = "", - VFS.cursorPos = Position linePos charPos - } - +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 . getFilePathCompletionContext $ + 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 + (completionSuffix $ getFilePathCompletionContext (simplePosPrefixInfo " " 0 3)) @?= Just "" + , testCase "simple filepath" $ do + (completionSuffix $ getFilePathCompletionContext (simplePosPrefixInfo " src/" 0 7)) @?= Just "" + , testCase "simple filepath - starting apostrophe" $ do + (completionSuffix $ getFilePathCompletionContext (simplePosPrefixInfo " \"src/" 0 7)) @?= Just "\"" + , testCase "simple filepath - starting apostrophe, already closed" $ do + (completionSuffix $ getFilePathCompletionContext (simplePosPrefixInfo " \"src/\"" 0 7)) @?= Just "" + , testCase "second filepath - starting apostrophe" $ do + (completionSuffix $ getFilePathCompletionContext (simplePosPrefixInfo "fp.txt \"src/" 0 12)) @?= Just "\"" + , testCase "middle filepath - starting apostrophe" $ do + (completionSuffix $ getFilePathCompletionContext (simplePosPrefixInfo "fp.txt \"src/ fp2.txt" 0 12)) @?= Just "\"" + , testCase "middle filepath - starting apostrophe, already closed" $ do + (completionSuffix $ getFilePathCompletionContext (simplePosPrefixInfo "fp.t xt \"src\" fp2.txt" 0 12)) @?= Just "" + , testCase "middle filepath - starting apostrophe, already closed" $ do + (completionSuffix $ getFilePathCompletionContext (simplePosPrefixInfo "\"fp.txt\" \"src fp2.txt" 0 11)) @?= Just "\"" + ] + 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 + } contextTests :: TestTree -contextTests = testGroup "Context Tests" - [ - testCase "Empty File - Start" $ do - -- for a completely empty file, the context needs to - -- be toplevel without a specified keyword - getContext (Position 0 0) [""] @?= Just (TopLevel, None), - testCase "Cabal version keyword - no value" $ do - -- on a file, where the "cabal-version:" keyword is already written - -- the context should still be toplevel but the keyword should be recognized - getContext (Position 0 15) ["cabal-version:"] @?= Just (TopLevel, KeyWord "cabal-version:"), - testCase "Cabal version keyword - cursor in keyword" $ do - -- on a file, where the "cabal-version:" keyword is already written - -- but the cursor is in the middle of the keyword, the keyword context - -- is cabal-version since after the keyword, the value needs to be inserted still - getContext (Position 0 5) ["cabal-version:"] @?= Just (TopLevel, KeyWord "cabal-version:"), - 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 toplevel but the keyword should be recognized - getContext (Position 0 45) ["cabal-version:" <> T.replicate 50 " "] @?= Just (TopLevel, KeyWord "cabal-version:"), - testCase "Cabal version keyword - no value, many spaces" $ 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 toplevel context - getContext (Position 5 0) libraryStanzaData @?= Just (TopLevel, None) - ] +contextTests = + testGroup + "Context Tests" + [ testCase "Empty File - Start" $ do + -- for a completely empty file, the context needs to + -- be toplevel without a specified keyword + getContext (Position 0 0) [""] @?= Just (TopLevel, None) + , testCase "Cabal version keyword - no value" $ do + -- on a file, where the "cabal-version:" keyword is already written + -- the context should still be toplevel but the keyword should be recognized + getContext (Position 0 15) ["cabal-version:"] @?= Just (TopLevel, KeyWord "cabal-version:") + , testCase "Cabal version keyword - cursor in keyword" $ do + -- on a file, where the "cabal-version:" keyword is already written + -- but the cursor is in the middle of the keyword, the keyword context + -- is cabal-version since after the keyword, the value needs to be inserted still + getContext (Position 0 5) ["cabal-version:"] @?= Just (TopLevel, KeyWord "cabal-version:") + , 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 toplevel but the keyword should be recognized + getContext (Position 0 45) ["cabal-version:" <> T.replicate 50 " "] @?= Just (TopLevel, KeyWord "cabal-version:") + , testCase "Cabal version keyword - no value, many spaces" $ 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 toplevel context + getContext (Position 5 0) libraryStanzaData @?= Just (TopLevel, None) + ] + -- ------------------------------------------------------------------------ -- 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 +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 + @?= 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" + ] + ] ] - , 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 :: T.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 @@ -297,7 +345,7 @@ 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" @@ -307,22 +355,20 @@ testDataDir = "test" "testdata" -- ------------------------------------------------------------------------ libraryStanzaData :: [T.Text] libraryStanzaData = - [ - "cabal-version: 3.0", - "name: simple-cabal", - "library ", - "", - " build-depends: ", - " " + [ "cabal-version: 3.0" + , "name: simple-cabal" + , "library " + , "" + , " build-depends: " + , " " ] topLevelData :: [T.Text] topLevelData = - [ - "cabal-version: 3.0", - "name:", - "", - "", - "", - "" + [ "cabal-version: 3.0" + , "name:" + , "" + , "" + , "" + , "" ]