diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 2157a83511..97c58131b1 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -49,7 +49,6 @@ import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import qualified Language.LSP.Server as LSP -import qualified Language.LSP.VFS as VFS import Numeric.Natural import Text.Fuzzy.Parallel (Scored (..)) diff --git a/ghcide/src/Text/Fuzzy/Parallel.hs b/ghcide/src/Text/Fuzzy/Parallel.hs index 0137861468..13039e1e55 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -1,9 +1,9 @@ -- | Parallel versions of 'filter' and 'simpleFilter' module Text.Fuzzy.Parallel -( filter, - simpleFilter, - match, +( filter, filter', + simpleFilter, simpleFilter', + match, defChunkSize, defMaxResults, Scored(..) ) where @@ -29,7 +29,6 @@ data Scored a = Scored {score :: !Int, original:: !a} -- Just 5 -- {-# INLINABLE match #-} - match :: T.Text -- ^ Pattern in lowercase except for first character -> T.Text -- ^ The text to search in. -> Maybe Int -- ^ The score @@ -70,22 +69,13 @@ match (T.Text pArr pOff pLen) (T.Text sArr sOff sLen) = go 0 1 pOff sOff toLowerAscii w = if (w - 65) < 26 then w .|. 0x20 else w --- | The function to filter a list of values by fuzzy search on the text extracted from them. -filter :: Int -- ^ Chunk size. 1000 works well. - -> Int -- ^ Max. number of results wanted - -> T.Text -- ^ Pattern. - -> [t] -- ^ The list of values containing the text to search in. - -> (t -> T.Text) -- ^ The function to extract the text from the container. - -> [Scored t] -- ^ The list of results, sorted, highest score first. -filter chunkSize maxRes pattern ts extract = partialSortByAscScore maxRes perfectScore (concat vss) - where - -- Preserve case for the first character, make all others lowercase - pattern' = case T.uncons pattern of - Just (c, rest) -> T.cons c (T.toLower rest) - _ -> pattern - vss = map (mapMaybe (\t -> flip Scored t <$> match pattern' (extract t))) (chunkList chunkSize ts) - `using` parList (evalList rseq) - perfectScore = fromMaybe (error $ T.unpack pattern) $ match pattern' pattern' +-- | Sensible default value for chunk size to use when calling simple filter. +defChunkSize :: Int +defChunkSize = 1000 + +-- | Sensible default value for the number of max results to use when calling simple filter. +defMaxResults :: Int +defMaxResults = 10 -- | Return all elements of the list that have a fuzzy -- match against the pattern. Runs with default settings where @@ -102,6 +92,52 @@ simpleFilter :: Int -- ^ Chunk size. 1000 works well. simpleFilter chunk maxRes pattern xs = filter chunk maxRes pattern xs id + +-- | The function to filter a list of values by fuzzy search on the text extracted from them, +-- using a custom matching function which determines how close words are. +filter' :: Int -- ^ Chunk size. 1000 works well. + -> Int -- ^ Max. number of results wanted + -> T.Text -- ^ Pattern. + -> [t] -- ^ The list of values containing the text to search in. + -> (t -> T.Text) -- ^ The function to extract the text from the container. + -> (T.Text -> T.Text -> Maybe Int) + -- ^ Custom scoring function to use for calculating how close words are + -- When the function returns Nothing, this means the values are incomparable. + -> [Scored t] -- ^ The list of results, sorted, highest score first. +filter' chunkSize maxRes pattern ts extract match' = partialSortByAscScore maxRes perfectScore (concat vss) + where + -- Preserve case for the first character, make all others lowercase + pattern' = case T.uncons pattern of + Just (c, rest) -> T.cons c (T.toLower rest) + _ -> pattern + vss = map (mapMaybe (\t -> flip Scored t <$> match' pattern' (extract t))) (chunkList chunkSize ts) + `using` parList (evalList rseq) + perfectScore = fromMaybe (error $ T.unpack pattern) $ match' pattern' pattern' + +-- | The function to filter a list of values by fuzzy search on the text extracted from them, +-- using a custom matching function which determines how close words are. +filter :: Int -- ^ Chunk size. 1000 works well. + -> Int -- ^ Max. number of results wanted + -> T.Text -- ^ Pattern. + -> [t] -- ^ The list of values containing the text to search in. + -> (t -> T.Text) -- ^ The function to extract the text from the container. + -> [Scored t] -- ^ The list of results, sorted, highest score first. +filter chunkSize maxRes pattern ts extract = + filter' chunkSize maxRes pattern ts extract match + +-- | Return all elements of the list that have a fuzzy match against the pattern, +-- the closeness of the match is determined using the custom scoring match function that is passed. +-- Runs with default settings where nothing is added around the matches, as case insensitive. +{-# INLINABLE simpleFilter' #-} +simpleFilter' :: Int -- ^ Chunk size. 1000 works well. + -> Int -- ^ Max. number of results wanted + -> T.Text -- ^ Pattern to look for. + -> [T.Text] -- ^ List of texts to check. + -> (T.Text -> T.Text -> Maybe Int) + -- ^ Custom scoring function to use for calculating how close words are + -> [Scored T.Text] -- ^ The ones that match. +simpleFilter' chunk maxRes pattern xs match' = + filter' chunk maxRes pattern xs id match' -------------------------------------------------------------------------------- chunkList :: Int -> [a] -> [[a]] diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index e2ef02f8ec..f4bb539833 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -27,36 +27,39 @@ library exposed-modules: Ide.Plugin.Cabal Ide.Plugin.Cabal.Diagnostics + Ide.Plugin.Cabal.Completion.Completer.FilePath + Ide.Plugin.Cabal.Completion.Completer.Module + Ide.Plugin.Cabal.Completion.Completer.Simple + Ide.Plugin.Cabal.Completion.Completer.Snippet + Ide.Plugin.Cabal.Completion.Completer.Types + Ide.Plugin.Cabal.Completion.Completions + Ide.Plugin.Cabal.Completion.Data + Ide.Plugin.Cabal.Completion.Types Ide.Plugin.Cabal.LicenseSuggest Ide.Plugin.Cabal.Parse + build-depends: , base >=4.12 && <5 , bytestring - -- Ideally, we only want to support a single Cabal version, supporting - -- older versions is completely pointless since Cabal is backwards compatible, - -- the latest Cabal version can parse all versions of the Cabal file format. - -- - -- However, stack is making this difficult, if we change the version of Cabal, - -- we essentially need to make sure all other packages in the snapshot have their - -- Cabal dependency version relaxed. - -- Most packages have a Hackage revision, but stack won't pick these up (for sensible reasons) - -- automatically, forcing us to manually update the packages revision id. - -- 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 + , Cabal-syntax >= 3.7 + , containers , deepseq , directory + , filepath , extra >=1.7.4 , ghcide == 2.1.0.0 , hashable , hls-plugin-api == 2.1.0.0 , hls-graph == 2.1.0.0 + , lens , lsp ^>=2.0.0.0 , lsp-types ^>=2.0.0.1 , regex-tdfa ^>=1.3.1 , stm , text + , text-rope + , transformers , unordered-containers >=0.2.10.0 , containers hs-source-dirs: src @@ -68,15 +71,24 @@ test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs + other-modules: + Completer + Context + Utils build-depends: , base , bytestring + , Cabal-syntax >= 3.7 + , directory , filepath , ghcide , hls-cabal-plugin , hls-test-utils == 2.1.0.0 , lens + , lsp , lsp-types , tasty-hunit , text + , text-rope + , transformers , row-types diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 75db11f8fa..61c6f5df52 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -9,33 +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.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class -import qualified Data.ByteString as BS +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (runMaybeT) +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.Encoding as Encoding +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 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 Development.IDE as D +import Development.IDE.Core.Shake (restartShakeSession) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.Graph (alwaysRerun) import GHC.Generics -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.Completion.Completer.Types as CompleterTypes +import qualified Ide.Plugin.Cabal.Completion.Completions as Completions +import qualified Ide.Plugin.Cabal.Completion.Types as Types +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.Protocol.Message as LSP +import qualified Language.LSP.Protocol.Lens as JL +import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types -import qualified Language.LSP.Protocol.Types as LSP -import qualified Language.LSP.VFS as VFS +import Language.LSP.Server (getVirtualFile) +import qualified Language.LSP.VFS as VFS data Log = LogModificationTime NormalizedFilePath FileVersion @@ -45,12 +52,14 @@ data Log | LogDocSaved Uri | LogDocClosed Uri | LogFOI (HashMap NormalizedFilePath FileOfInterestStatus) - deriving Show + | LogCompletionContext Types.Context Position + | LogCompletions Types.Log + deriving (Show) instance Pretty Log where pretty = \case LogShake log' -> pretty log' - LogModificationTime nfp modTime -> + LogModificationTime nfp modTime -> "Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime) LogDocOpened uri -> "Opened text document:" <+> pretty (getUri uri) @@ -62,56 +71,65 @@ instance Pretty Log where "Closed text document:" <+> pretty (getUri uri) LogFOI files -> "Set files of interest to:" <+> viaShow files - + LogCompletionContext context position -> + "Determined completion context:" + <+> viaShow context + <+> "for cursor position:" + <+> viaShow position + LogCompletions logs -> pretty logs descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState -descriptor recorder plId = (defaultCabalPluginDescriptor plId) - { pluginRules = cabalRules recorder - , pluginHandlers = mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction - , pluginNotificationHandlers = mconcat - [ mkPluginNotificationHandler LSP.SMethod_TextDocumentDidOpen $ - \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.SMethod_TextDocumentDidChange $ - \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.SMethod_TextDocumentDidSave $ - \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.SMethod_TextDocumentDidClose $ - \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 = + mconcat + [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction + , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder + ] + , pluginNotificationHandlers = + mconcat + [ mkPluginNotificationHandler LSP.SMethod_TextDocumentDidOpen $ + \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do + whenUriFile _uri $ \file -> do + log' Debug $ LogDocOpened _uri + addFileOfInterest recorder ide file Modified{firstOpen = True} + restartCabalShakeSession (shakeExtras ide) vfs file "(opened)" + , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $ + \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.SMethod_TextDocumentDidSave $ + \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.SMethod_TextDocumentDidClose $ + \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 (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] @@ -121,25 +139,19 @@ restartCabalShakeSession shakeExtras vfs file actionMsg = do -- Plugin Rules -- ---------------------------------------------------------------- -data ParseCabal = ParseCabal - deriving (Eq, Show, Typeable, Generic) -instance Hashable ParseCabal -instance NFData ParseCabal - -type instance RuleResult ParseCabal = () - cabalRules :: Recorder (WithPriority Log) -> Rules () cabalRules recorder = do -- Make sure we initialise the cabal files-of-interest. ofInterestRules recorder -- Rule to produce diagnostics for cabal files. - define (cmapWithPrio LogShake recorder) $ \ParseCabal file -> do + define (cmapWithPrio LogShake recorder) $ \Types.ParseCabal file -> do -- whenever this key is marked as dirty (e.g., when a user writes stuff to it), -- we rerun this rule because this rule *depends* on GetModificationTime. (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 @@ -150,27 +162,28 @@ cabalRules recorder = do let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE allDiags = errorDiags <> warningDiags pure (allDiags, Nothing) - Right _ -> do - pure (warningDiags, Just ()) + Right gpd -> do + pure (warningDiags, Just gpd) action $ do -- Run the cabal kick. This code always runs when 'shakeRestart' is run. -- 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 - void $ uses ParseCabal files + void $ uses Types.ParseCabal files -- ---------------------------------------------------------------- -- Code Actions @@ -184,69 +197,113 @@ licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) -- Cabal file of Interest rules and global variable -- ---------------------------------------------------------------- --- | Cabal files that are currently open in the lsp-client. --- Specific actions happen when these files are saved, closed or modified, --- such as generating diagnostics, re-parsing, etc... --- --- We need to store the open files to parse them again if we restart the shake session. --- Restarting of the shake session happens whenever these files are modified. +{- | Cabal files that are currently open in the lsp-client. +Specific actions happen when these files are saved, closed or modified, +such as generating diagnostics, re-parsing, etc... + +We need to store the open files to parse them again if we restart the shake session. +Restarting of the shake session happens whenever these files are modified. +-} newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus)) instance Shake.IsIdeGlobal OfInterestCabalVar data IsCabalFileOfInterest = IsCabalFileOfInterest - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Typeable, Generic) instance Hashable IsCabalFileOfInterest -instance NFData IsCabalFileOfInterest +instance NFData IsCabalFileOfInterest type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus deriving (Eq, Show, Typeable, Generic) instance Hashable CabalFileOfInterestResult -instance NFData CabalFileOfInterestResult +instance NFData CabalFileOfInterestResult --- | The rule that initialises the files of interest state. --- --- Needs to be run on start-up. +{- | The rule that initialises the files of interest state. + +Needs to be run on start-up. +-} ofInterestRules :: Recorder (WithPriority Log) -> Rules () ofInterestRules recorder = do - Shake.addIdeGlobal . OfInterestCabalVar =<< liftIO (newVar HashMap.empty) - Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalFileOfInterest f -> do - alwaysRerun - filesOfInterest <- getCabalFilesOfInterestUntracked - let foi = maybe NotCabalFOI IsCabalFOI $ f `HashMap.lookup` filesOfInterest - fp = summarize foi - res = (Just fp, Just foi) - return res - where - summarize NotCabalFOI = BS.singleton 0 - summarize (IsCabalFOI OnDisk) = BS.singleton 1 - summarize (IsCabalFOI (Modified False)) = BS.singleton 2 - summarize (IsCabalFOI (Modified True)) = BS.singleton 3 + Shake.addIdeGlobal . OfInterestCabalVar =<< liftIO (newVar HashMap.empty) + Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalFileOfInterest f -> do + alwaysRerun + filesOfInterest <- getCabalFilesOfInterestUntracked + let foi = maybe NotCabalFOI IsCabalFOI $ f `HashMap.lookup` filesOfInterest + fp = summarize foi + res = (Just fp, Just foi) + return res + where + summarize NotCabalFOI = BS.singleton 0 + summarize (IsCabalFOI OnDisk) = BS.singleton 1 + summarize (IsCabalFOI (Modified False)) = BS.singleton 2 + summarize (IsCabalFOI (Modified True)) = BS.singleton 3 getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus) getCabalFilesOfInterestUntracked = do - OfInterestCabalVar var <- Shake.getIdeGlobalAction - liftIO $ readVar var + OfInterestCabalVar var <- Shake.getIdeGlobalAction + liftIO $ readVar var addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO () addFileOfInterest recorder state f v = do - OfInterestCabalVar var <- Shake.getIdeGlobalState state - (prev, files) <- modifyVar var $ \dict -> do - let (prev, new) = HashMap.alterF (, Just v) f dict - pure (new, (prev, new)) - when (prev /= Just v) $ do - join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] - log' Debug $ LogFOI files - where - log' = logWith recorder + OfInterestCabalVar var <- Shake.getIdeGlobalState state + (prev, files) <- modifyVar var $ \dict -> do + let (prev, new) = HashMap.alterF (,Just v) f dict + pure (new, (prev, new)) + when (prev /= Just v) $ do + join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] + log' Debug $ LogFOI files + where + log' = logWith recorder deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO () deleteFileOfInterest recorder state f = do - OfInterestCabalVar var <- Shake.getIdeGlobalState state - files <- modifyVar' var $ HashMap.delete f - join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] - log' Debug $ LogFOI files - where - log' = logWith recorder + OfInterestCabalVar var <- Shake.getIdeGlobalState state + files <- modifyVar' var $ HashMap.delete f + join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] + log' Debug $ LogFOI files + where + log' = logWith recorder + +-- ---------------------------------------------------------------- +-- Completion +-- ---------------------------------------------------------------- + +completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion +completion recorder ide _ complParams = do + let (TextDocumentIdentifier uri) = complParams ^. JL.textDocument + position = complParams ^. JL.position + contents <- lift $ getVirtualFile $ toNormalizedUri uri + case (contents, uriToFilePath' uri) of + (Just cnts, Just path) -> do + pref <- VFS.getCompletionPrefix position cnts + let res = result pref path cnts + liftIO $ fmap (InL) res + _ -> pure . InR $ InR Null + where + result :: Maybe VFS.PosPrefixInfo -> FilePath -> VFS.VirtualFile -> IO [CompletionItem] + result Nothing _ _ = pure [] + result (Just prefix) fp cnts = do + runMaybeT context >>= \case + Nothing -> pure [] + Just ctx -> do + logWith recorder Debug $ LogCompletionContext ctx pos + let completer = Completions.contextToCompleter ctx + let completerData = CompleterTypes.CompleterData + { getLatestGPD = do + mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast Types.ParseCabal $ toNormalizedFilePath fp + pure $ fmap fst mGPD + , cabalPrefixInfo = prefInfo + , stanzaName = + case fst ctx of + Types.Stanza _ name -> name + _ -> Nothing + } + completions <- completer completerRecorder completerData + pure completions + where + completerRecorder = cmapWithPrio LogCompletions recorder + pos = VFS.cursorPos prefix + context = Completions.getContext completerRecorder prefInfo (cnts ^. VFS.file_text) + prefInfo = Completions.getCabalPrefixInfo fp prefix diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs new file mode 100644 index 0000000000..b0681d467d --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Ide.Plugin.Cabal.Completion.Completer.FilePath where + +import Control.Exception (evaluate, try) +import Control.Monad (filterM) +import Control.Monad.Extra (forM) +import qualified Data.Text as T +import Ide.Logger +import Ide.Plugin.Cabal.Completion.Completer.Simple +import Ide.Plugin.Cabal.Completion.Completer.Types +import Ide.Plugin.Cabal.Completion.Types +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 + +-- | Completer to be used when a file path can be completed for a field. +-- Completes file paths as well as directories. +filePathCompleter :: Completer +filePathCompleter recorder cData = do + let prefInfo = cabalPrefixInfo cData + complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo + filePathCompletions <- listFileCompletions recorder complInfo + let scored = + Fuzzy.simpleFilter + Fuzzy.defChunkSize + Fuzzy.defMaxResults + (pathSegment complInfo) + (map T.pack filePathCompletions) + forM + scored + ( \compl' -> do + let compl = Fuzzy.original compl' + fullFilePath <- mkFilePathCompletion complInfo compl + pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath + ) + +-- | Completer to be used when a directory can be completed for the field. +-- Only completes directories. +directoryCompleter :: Completer +directoryCompleter recorder cData = do + let prefInfo = cabalPrefixInfo cData + complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo + directoryCompletions <- listDirectoryCompletions recorder complInfo + let scored = + Fuzzy.simpleFilter + Fuzzy.defChunkSize + Fuzzy.defMaxResults + (pathSegment complInfo) + (map T.pack directoryCompletions) + forM + scored + ( \compl' -> do + let compl = Fuzzy.original compl' + let fullDirPath = mkPathCompletionDir complInfo compl + pure $ mkCompletionItem (completionRange prefInfo) fullDirPath fullDirPath + ) + +{- Note [Using correct file path separators] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + Since cabal files only allow for posix style file paths + we need to be careful to use the correct path separators + whenever we work with file paths in cabal files. + + Thus we are using two different kinds of imports. + We use "FP" for platform-compatible file paths with which + we can query files independently of the platform. + We use "Posix" for the posix syntax paths which need to + be used for file path completions to be written to the cabal file. +-} + +-- | Information used to query and build path completions. +-- +-- Note that pathSegment combined with queryDirectory results in +-- the original prefix. +-- +-- Example: +-- When given the written prefix, @dir1\/dir2\/fi@, the +-- resulting PathCompletionInfo would be: +-- +-- @ +-- pathSegment = "fi" +-- queryDirectory = "dir1\/dir2\/fi" +-- ... +-- @ +data PathCompletionInfo = PathCompletionInfo + { -- | partly written segment of the next part of the path + pathSegment :: T.Text, + -- | written part of path, platform dependent + queryDirectory :: FilePath, + -- | directory relative to which relative paths are interpreted, platform dependent + workingDirectory :: FilePath, + -- | Did the completion happen in the context of a string notation, + -- if yes, contains the state of the string notation + isStringNotationPath :: Maybe Apostrophe + } + deriving (Eq, Show) + +-- | Takes a PathCompletionInfo and returns the list of files and directories +-- in the directory which match the path completion info in posix style. +-- +-- The directories end with a posix trailing path separator. +-- Since this is used for completions to be written to the cabal file, +-- we use posix separators here. +-- See Note [Using correct file path separators]. +listFileCompletions :: Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath] +listFileCompletions recorder complInfo = do + let complDir = mkCompletionDirectory complInfo + try (evaluate =<< listDirectory complDir) >>= \case + Right dirs -> do + forM dirs $ \d -> do + isDir <- doesDirectoryExist $ mkDirFromCWD complInfo d + pure $ if isDir then Posix.addTrailingPathSeparator d else d + Left (err :: IOError) -> do + logWith recorder Warning $ LogFilePathCompleterIOError complDir err + pure [] + +-- | Returns a list of all (and only) directories in the +-- directory described by path completion info. +listDirectoryCompletions :: Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath] +listDirectoryCompletions recorder complInfo = do + filepaths <- listFileCompletions recorder complInfo + filterM (doesDirectoryExist . mkDirFromCWD complInfo) filepaths + +pathCompletionInfoFromCabalPrefixInfo :: CabalPrefixInfo -> PathCompletionInfo +pathCompletionInfoFromCabalPrefixInfo ctx = + PathCompletionInfo + { pathSegment = T.pack pathSegment', + queryDirectory = queryDirectory', + workingDirectory = completionWorkingDir ctx, + isStringNotationPath = isStringNotation ctx + } + where + prefix = T.unpack $ completionPrefix ctx + (queryDirectory', pathSegment') = Posix.splitFileName prefix + +-- | Returns the directory where files and directories can be queried from +-- for the passed PathCompletionInfo. +-- +-- Returns the full path to the directory pointed to by the path prefix +-- by combining it with the working directory. +-- +-- Since this is used for querying paths we use platform +-- compatible separators here. +-- See Note [Using correct file path separators]. +mkCompletionDirectory :: PathCompletionInfo -> FilePath +mkCompletionDirectory complInfo = + FP.addTrailingPathSeparator $ + workingDirectory complInfo FP. (FP.normalise $ queryDirectory complInfo) + +-- | Returns the full path for the given path segment +-- by combining the working directory with the path prefix +-- and the path segment. +-- +-- Since this is used for querying paths we use platform +-- compatible separators here. +-- See Note [Using correct file path separators]. +mkDirFromCWD :: PathCompletionInfo -> FilePath -> FilePath +mkDirFromCWD complInfo fp = + FP.addTrailingPathSeparator $ + mkCompletionDirectory complInfo FP. FP.normalise fp + +-- | Takes a PathCompletionInfo and a directory and +-- returns the complete cabal path to be written on completion action +-- by combining the previously written path prefix and the completed +-- path segment. +-- +-- Since this is used for completions we use posix separators here. +-- See Note [Using correct file path separators]. +mkPathCompletionDir :: PathCompletionInfo -> T.Text -> T.Text +mkPathCompletionDir complInfo completion = + T.pack $ + queryDirectory complInfo Posix. T.unpack completion + +-- | Takes a PathCompletionInfo and a completed path segment and +-- generates the whole filepath to be completed. +-- +-- The returned text combines the completion with a relative path +-- generated from a possible previously written path prefix and +-- is relative to the cabal file location. +-- +-- If the completion results in a filepath, we know this is a +-- completed path and can thus apply wrapping of apostrophes if needed. +mkFilePathCompletion :: PathCompletionInfo -> T.Text -> IO T.Text +mkFilePathCompletion complInfo completion = do + let combinedPath = mkPathCompletionDir complInfo completion + isFilePath <- doesFileExist $ T.unpack combinedPath + let completedPath = if isFilePath then applyStringNotation (isStringNotationPath complInfo) combinedPath else combinedPath + pure completedPath diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs new file mode 100644 index 0000000000..4cae2dae5d --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ide.Plugin.Cabal.Completion.Completer.Module where + +import Control.Monad (filterM) +import Control.Monad.Extra (concatForM, + forM) +import Data.List (stripPrefix) +import qualified Data.List as List +import Data.Maybe (fromMaybe) +import qualified Data.Text as T +import Distribution.PackageDescription (Benchmark (..), + BuildInfo (..), + CondTree (condTreeData), + Executable (..), + GenericPackageDescription (..), + Library (..), + UnqualComponentName, + mkUnqualComponentName, + testBuildInfo) +import Distribution.Utils.Path (getSymbolicPath) +import Ide.Logger (Priority (..), + Recorder, + WithPriority, + logWith) +import Ide.Plugin.Cabal.Completion.Completer.FilePath (PathCompletionInfo (..), + listFileCompletions, + mkCompletionDirectory) +import Ide.Plugin.Cabal.Completion.Completer.Simple +import Ide.Plugin.Cabal.Completion.Completer.Types +import Ide.Plugin.Cabal.Completion.Types +import System.Directory (doesFileExist) +import qualified System.FilePath as FP +import qualified Text.Fuzzy.Parallel as Fuzzy + +-- | Completer to be used when module paths can be completed for the field. +-- +-- Takes an extraction function which extracts the source directories +-- to be used by the completer. +modulesCompleter :: (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> Completer +modulesCompleter extractionFunction recorder cData = do + mGPD <- getLatestGPD cData + case mGPD of + Just gpd -> do + let sourceDirs = extractionFunction sName gpd + filePathCompletions <- + filePathsForExposedModules recorder sourceDirs prefInfo + pure $ map (\compl -> mkSimpleCompletionItem (completionRange prefInfo) compl) filePathCompletions + Nothing -> do + logWith recorder Debug LogUseWithStaleFastNoResult + pure [] + where + sName = stanzaName cData + prefInfo = cabalPrefixInfo cData + +-- | Extracts the source directories of the library stanza. +sourceDirsExtractionLibrary :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] +sourceDirsExtractionLibrary Nothing gpd = + -- we use condLibrary to get the information contained in the library stanza + -- since the library in PackageDescription is not populated by us + case libM of + Just lib -> do + map getSymbolicPath $ hsSourceDirs $ libBuildInfo $ condTreeData lib + Nothing -> [] + where + libM = condLibrary gpd +sourceDirsExtractionLibrary name gpd = extractRelativeDirsFromStanza name gpd condSubLibraries libBuildInfo + +-- | Extracts the source directories of the executable stanza with the given name. +sourceDirsExtractionExecutable :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] +sourceDirsExtractionExecutable name gpd = extractRelativeDirsFromStanza name gpd condExecutables buildInfo + +-- | Extracts the source directories of the test suite stanza with the given name. +sourceDirsExtractionTestSuite :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] +sourceDirsExtractionTestSuite name gpd = extractRelativeDirsFromStanza name gpd condTestSuites testBuildInfo + +-- | Extracts the source directories of benchmark stanza with the given name. +sourceDirsExtractionBenchmark :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] +sourceDirsExtractionBenchmark name gpd = extractRelativeDirsFromStanza name gpd condBenchmarks benchmarkBuildInfo + +-- | Takes a possible stanza name, a GenericPackageDescription, +-- a function to access the stanza information we are interested in +-- and a function to access the build info from the specific stanza. +-- +-- Returns a list of relative source directory paths specified for the extracted stanza. +extractRelativeDirsFromStanza :: + Maybe StanzaName -> + GenericPackageDescription -> + (GenericPackageDescription -> [(UnqualComponentName, CondTree b c a)]) -> + (a -> BuildInfo) -> + [FilePath] +extractRelativeDirsFromStanza Nothing _ _ _ = [] +extractRelativeDirsFromStanza (Just name) gpd getStanza getBuildInfo + | Just stanza <- stanzaM = map getSymbolicPath $ hsSourceDirs $ getBuildInfo stanza + | otherwise = [] + where + stanzaM = fmap (condTreeData . snd) res + allStanzasM = getStanza gpd + res = + List.find + ( \(n, _) -> + n == mkUnqualComponentName (T.unpack name) + ) + allStanzasM + +-- | Takes a list of source directories and returns a list of path completions +-- relative to any of the passed source directories which fit the passed prefix info. +filePathsForExposedModules :: Recorder (WithPriority Log) -> [FilePath] -> CabalPrefixInfo -> IO [T.Text] +filePathsForExposedModules recorder srcDirs prefInfo = do + concatForM + srcDirs + ( \dir' -> do + let dir = FP.normalise dir' + let pInfo = + PathCompletionInfo + { isStringNotationPath = Nothing, + pathSegment = T.pack $ FP.takeFileName prefix, + queryDirectory = FP.addTrailingPathSeparator $ FP.takeDirectory prefix, + workingDirectory = completionWorkingDir prefInfo FP. dir + } + completions <- listFileCompletions recorder pInfo + validExposedCompletions <- filterM (isValidExposedModulePath pInfo) completions + let toMatch = pathSegment pInfo + scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults toMatch (map T.pack validExposedCompletions) + forM + scored + ( \compl' -> do + let compl = Fuzzy.original compl' + fullFilePath <- mkExposedModulePathCompletion pInfo $ T.unpack compl + pure fullFilePath + ) + ) + where + prefix = + exposedModulePathToFp $ + completionPrefix prefInfo + -- \| Takes a PathCompletionInfo and a path segment and checks whether + -- the path segment can be completed for an exposed module. + -- + -- This is the case if the segment represents either a directory or a Haskell file. + -- + isValidExposedModulePath :: PathCompletionInfo -> FilePath -> IO Bool + isValidExposedModulePath pInfo path = do + let dir = mkCompletionDirectory pInfo + fileExists <- doesFileExist (dir FP. path) + pure $ not fileExists || FP.takeExtension path `elem` [".hs", ".lhs"] + +-- | Takes a pathCompletionInfo and a path segment and generates the whole +-- filepath to be written on completion including a possibly already written prefix; +-- using the cabal syntax for exposed modules. +-- +-- Examples: +-- When the partial directory path `Dir.Dir2.` is stored in the PathCompletionInfo +-- and the completed file `HaskellFile.hs` is passed along with that PathCompletionInfo, +-- the result would be `Dir1.Dir2.HaskellFile` +-- +-- When the partial directory path `Dir.` is stored in the PathCompletionInfo +-- and the completed directory `Dir2` is passed along with that PathCompletionInfo, +-- the result would be `Dir1.Dir2.` +mkExposedModulePathCompletion :: PathCompletionInfo -> FilePath -> IO T.Text +mkExposedModulePathCompletion complInfo completion = do + let combinedPath = queryDirectory complInfo FP. completion + isFilePath <- doesFileExist (workingDirectory complInfo FP. combinedPath) + let addTrailingDot modPath = if isFilePath then modPath else modPath <> "." + let exposedPath = FP.makeRelative "." combinedPath + pure $ addTrailingDot $ fpToExposedModulePath "" exposedPath + +-- | Takes a source directory path and a module path and returns +-- the module path relative to the source directory +-- in exposed module syntax where the separators are '.' +-- and the file ending is removed. +-- +-- Synopsis: @'fpToExposedModulePath' sourceDir modPath@. +fpToExposedModulePath :: FilePath -> FilePath -> T.Text +fpToExposedModulePath sourceDir modPath = + T.intercalate "." $ fmap T.pack $ FP.splitDirectories $ FP.dropExtension fp + where + fp = fromMaybe modPath $ stripPrefix sourceDir modPath + +-- | Takes a path in the exposed module syntax and translates it to a platform-compatible file path. +exposedModulePathToFp :: T.Text -> FilePath +exposedModulePathToFp fp = T.unpack $ T.replace "." (T.singleton FP.pathSeparator) fp diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs new file mode 100644 index 0000000000..d4fb54bb5c --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Ide.Plugin.Cabal.Completion.Completer.Simple where + +import Control.Lens ((?~)) +import Data.Function ((&)) +import qualified Data.List as List +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe) +import Data.Ord (Down (Down)) +import qualified Data.Text as T +import Ide.Logger (Priority (..), + logWith) +import Ide.Plugin.Cabal.Completion.Completer.Types +import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo (..), + Log) +import qualified Language.LSP.Protocol.Lens as JL +import qualified Language.LSP.Protocol.Types as Compls (CompletionItem (..)) +import qualified Language.LSP.Protocol.Types as LSP +import qualified Text.Fuzzy.Parallel as Fuzzy + +-- | Completer to be used when no completion suggestions +-- are implemented for the field +noopCompleter :: Completer +noopCompleter _ _ = pure [] + +-- | Completer to be used when no completion suggestions +-- are implemented for the field and a log message should be emitted. +errorNoopCompleter :: Log -> Completer +errorNoopCompleter l recorder _ = do + logWith recorder Warning l + pure [] + +-- | Completer to be used when a simple set of values +-- can be completed for a field. +constantCompleter :: [T.Text] -> Completer +constantCompleter completions _ cData = do + let prefInfo = cabalPrefixInfo cData + scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults (completionPrefix prefInfo) completions + range = completionRange prefInfo + pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored + +-- | Completer to be used for the field @name:@ value. +-- +-- This is almost always the name of the cabal file. However, +-- it is not forbidden by the specification to have a different name, +-- it is just forbidden on hackage. +nameCompleter :: Completer +nameCompleter _ cData = do + let scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults (completionPrefix prefInfo) [completionFileName prefInfo] + prefInfo = cabalPrefixInfo cData + range = completionRange prefInfo + pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored + +-- | Completer to be used when a set of values with priority weights +-- attached to some values are to be completed for a field. +-- +-- The higher the weight, the higher the priority to show +-- the value in the completion suggestion. +-- +-- If the value does not occur in the weighted map its weight is defaulted to zero. +weightedConstantCompleter :: [T.Text] -> Map T.Text Double -> Completer +weightedConstantCompleter completions weights _ cData = do + let scored = + if perfectScore > 0 + then + fmap Fuzzy.original $ + Fuzzy.simpleFilter' Fuzzy.defChunkSize Fuzzy.defMaxResults prefix completions customMatch + else topTenByWeight + range = completionRange prefInfo + pure $ map (mkSimpleCompletionItem range) scored + where + prefInfo = cabalPrefixInfo cData + prefix = completionPrefix prefInfo + -- The perfect score is the score of the word matched with itself + -- this should never return Nothing since we match the word with itself + perfectScore = fromMaybe (error "match is broken") $ Fuzzy.match prefix prefix + -- \| Since the best score is cut off at the perfect score, we use a custom match + -- which allows for the score to be larger than the perfect score. + -- + -- This is necessary since the weight is multiplied with the originally matched + -- score and thus the calculated score may be larger than the perfect score. + customMatch :: (T.Text -> T.Text -> Maybe Int) + customMatch toSearch searchSpace = do + matched <- Fuzzy.match toSearch searchSpace + let weight = fromMaybe 0 $ Map.lookup searchSpace weights + let score = + min + perfectScore + (round (fromIntegral matched * (1 + weight))) + pure score + -- \| Sorts the list in descending order based on the map of weights and then + -- returns the top ten items in the list + topTenByWeight :: [T.Text] + topTenByWeight = take 10 $ map fst $ List.sortOn (Down . snd) $ Map.assocs weights + +-- | Creates a CompletionItem with the given text as the label +-- where the completion item kind is keyword. +mkDefaultCompletionItem :: T.Text -> LSP.CompletionItem +mkDefaultCompletionItem label = + LSP.CompletionItem + { Compls._label = label, + Compls._labelDetails = Nothing, + Compls._kind = Just LSP.CompletionItemKind_Keyword, + 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 = Nothing, + Compls._textEditText = Nothing, + Compls._additionalTextEdits = Nothing, + Compls._commitCharacters = Nothing, + Compls._command = Nothing, + Compls._data_ = Nothing + } + +-- | Returns a CompletionItem with the given starting position +-- and text to be inserted, where the displayed text is the same as the +-- inserted text. +mkSimpleCompletionItem :: LSP.Range -> T.Text -> LSP.CompletionItem +mkSimpleCompletionItem range txt = + mkDefaultCompletionItem txt + & JL.textEdit ?~ LSP.InL (LSP.TextEdit range txt) + +-- | Returns a completionItem with the given starting position, +-- text to be inserted and text to be displayed in the completion suggestion. +mkCompletionItem :: LSP.Range -> T.Text -> T.Text -> LSP.CompletionItem +mkCompletionItem range insertTxt displayTxt = + mkDefaultCompletionItem displayTxt + & JL.textEdit ?~ LSP.InL (LSP.TextEdit range insertTxt) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs new file mode 100644 index 0000000000..800a39bfbc --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ide.Plugin.Cabal.Completion.Completer.Snippet where + +import Control.Lens ((?~)) +import Control.Monad.Extra (mapMaybeM) +import Data.Function ((&)) +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Text as T +import Ide.Logger (Priority (..), + logWith) +import Ide.Plugin.Cabal.Completion.Completer.Simple +import Ide.Plugin.Cabal.Completion.Completer.Types +import Ide.Plugin.Cabal.Completion.Types +import qualified Language.LSP.Protocol.Lens as JL +import qualified Language.LSP.Protocol.Types as LSP +import qualified Text.Fuzzy.Parallel as Fuzzy + +-- | Maps snippet triggerwords with their completers +snippetCompleter :: Completer +snippetCompleter recorder cData = do + let scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults (completionPrefix prefInfo) $ Map.keys snippets + mapMaybeM + ( \compl -> do + let matched = Fuzzy.original compl + let completion' = Map.lookup matched snippets + case completion' of + Nothing -> do + logWith recorder Warning $ LogMapLookUpOfKnownKeyFailed matched + pure Nothing + Just completion -> + pure $ Just $ mkSnippetCompletion completion matched + ) + scored + where + snippets = snippetMap prefInfo + prefInfo = cabalPrefixInfo cData + mkSnippetCompletion :: T.Text -> T.Text -> LSP.CompletionItem + mkSnippetCompletion insertText toDisplay = + mkDefaultCompletionItem toDisplay + & JL.kind ?~ LSP.CompletionItemKind_Snippet + & JL.insertText ?~ insertText + & JL.insertTextFormat ?~ LSP.InsertTextFormat_Snippet + +type TriggerWord = T.Text + +snippetMap :: CabalPrefixInfo -> Map TriggerWord T.Text +snippetMap prefInfo = + fmap T.unlines $ + Map.fromList + [ ( "library-snippet", + [ "library", + " hs-source-dirs: $1", + " exposed-modules: $2", + " build-depends: base", + " default-language: Haskell2010" + ] + ), + ( "recommended-fields", + [ "cabal-version: $1", + "name: " <> completionFileName prefInfo, + "version: 0.1.0.0", + "maintainer: $4", + "category: $5", + "synopsis: $6", + "license: $7", + "build-type: Simple" + ] + ), + ( "executable-snippet", + [ "executable $1", + " main-is: ${2:Main.hs}", + " build-depends: base" + ] + ), + ( "benchmark-snippet", + [ "benchmark $1", + " type: exitcode-stdio-1.0", + " main-is: ${3:Main.hs}", + " build-depends: base" + ] + ), + ( "testsuite-snippet", + [ "test-suite $1", + " type: exitcode-stdio-1.0", + " main-is: ${3:Main.hs}", + " build-depends: base" + ] + ), + ( "common-warnings", + [ "common warnings", + " ghc-options: -Wall" + ] + ), + ( "source-repo-github-snippet", + [ "source-repository head", + " type: git", + " location: git://github.com/$2" + ] + ), + ( "source-repo-git-snippet", + [ "source-repository head", + " type: git", + " location: $1" + ] + ) + ] diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs new file mode 100644 index 0000000000..c39ad2d953 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module Ide.Plugin.Cabal.Completion.Completer.Types where + +import Development.IDE as D +import Distribution.PackageDescription (GenericPackageDescription) +import Ide.Plugin.Cabal.Completion.Types +import Language.LSP.Protocol.Types (CompletionItem) + +-- | Takes information needed to build possible completion items +-- and returns the list of possible completion items +type Completer = Recorder (WithPriority Log) -> CompleterData -> IO [CompletionItem] + +-- | Contains information to be used by completers. +data CompleterData = CompleterData + { -- | Access to the latest available generic package description for the handled cabal file, + -- relevant for some completion actions which require the file's meta information + -- such as the module completers which require access to source directories + getLatestGPD :: IO (Maybe GenericPackageDescription), + -- | Prefix info to be used for constructing completion items + cabalPrefixInfo :: CabalPrefixInfo, + -- | The name of the stanza in which the completer is applied + stanzaName :: Maybe StanzaName + } diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs new file mode 100644 index 0000000000..840dc44e50 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Ide.Plugin.Cabal.Completion.Completions (contextToCompleter, getContext, getCabalPrefixInfo) where + +import Control.Lens ((^.)) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Trans.Maybe +import Data.Foldable (asum) +import qualified Data.List as List +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Text as T +import Data.Text.Utf16.Rope (Rope) +import qualified Data.Text.Utf16.Rope as Rope +import Development.IDE as D +import Ide.Plugin.Cabal.Completion.Completer.Simple +import Ide.Plugin.Cabal.Completion.Completer.Snippet +import Ide.Plugin.Cabal.Completion.Completer.Types (Completer) +import Ide.Plugin.Cabal.Completion.Data +import Ide.Plugin.Cabal.Completion.Types +import qualified Language.LSP.Protocol.Lens as JL +import qualified Language.LSP.VFS as VFS +import qualified System.FilePath as FP +import System.FilePath (takeBaseName) + +-- ---------------------------------------------------------------- +-- Public API for Completions +-- ---------------------------------------------------------------- + +-- | Takes information about the completion context 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) = + snippetCompleter + <> ( 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 -> errorNoopCompleter (LogUnknownKeyWordInContextError kw) + 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 -> errorNoopCompleter (LogUnknownStanzaNameInContextError s) + 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 -> errorNoopCompleter (LogUnknownStanzaNameInContextError s) + Just m -> case Map.lookup kw m of + Nothing -> errorNoopCompleter (LogUnknownKeyWordInContextError kw) + Just l -> l + +-- | Takes prefix info about the previously written text +-- and a rope (representing a file), returns the corresponding context. +-- +-- Can return Nothing if an error occurs. +-- +-- TODO: first line can only have cabal-version: keyword +getContext :: (MonadIO m) => Recorder (WithPriority Log) -> CabalPrefixInfo -> Rope -> MaybeT m Context +getContext recorder prefInfo ls = + case prevLinesM of + Just prevLines -> do + let lvlContext = + if completionIndentation prefInfo == 0 + then TopLevel + else currentLevel prevLines + case lvlContext of + TopLevel -> do + kwContext <- MaybeT . pure $ getKeyWordContext prefInfo prevLines (cabalVersionKeyword <> cabalKeywords) + pure (TopLevel, kwContext) + Stanza s n -> + case Map.lookup s stanzaKeywordMap of + Nothing -> do + pure (Stanza s n, None) + Just m -> do + kwContext <- MaybeT . pure $ getKeyWordContext prefInfo prevLines m + pure (Stanza s n, kwContext) + Nothing -> do + logWith recorder Warning $ LogFileSplitError pos + -- basically returns nothing + fail "Abort computation" + where + pos = completionCursorPosition prefInfo + prevLinesM = splitAtPosition pos ls + +-- | Takes information about the current file's file path, +-- and the cursor position in the file; and builds a CabalPrefixInfo +-- with the prefix up to that cursor position. +-- Checks whether a suffix needs to be completed +-- and calculates the range in the document +-- where the completion action should be applied. +getCabalPrefixInfo :: FilePath -> VFS.PosPrefixInfo -> CabalPrefixInfo +getCabalPrefixInfo fp prefixInfo = + CabalPrefixInfo + { completionPrefix = completionPrefix', + isStringNotation = mkIsStringNotation separator afterCursorText, + completionCursorPosition = VFS.cursorPos prefixInfo, + completionRange = Range completionStart completionEnd, + completionWorkingDir = FP.takeDirectory fp, + completionFileName = T.pack $ takeBaseName fp + } + where + completionEnd = VFS.cursorPos prefixInfo + completionStart = + Position + (_line completionEnd) + (_character completionEnd - (fromIntegral $ T.length completionPrefix')) + (beforeCursorText, afterCursorText) = T.splitAt cursorColumn $ VFS.fullLine prefixInfo + completionPrefix' = T.takeWhileEnd (not . (`elem` stopConditionChars)) beforeCursorText + separator = + -- if there is an opening apostrophe before the cursor in the line somewhere, + -- everything after that apostrophe is the completion prefix + if odd $ T.count "\"" beforeCursorText + then '\"' + else ' ' + cursorColumn = fromIntegral $ VFS.cursorPos prefixInfo ^. JL.character + stopConditionChars = separator : [',', ':'] + + -- \| Takes the character occurring exactly before, + -- and the text occurring after the item to be completed and + -- returns whether the item is already surrounded by apostrophes. + -- + -- Example: (@|@ indicates the cursor position) + -- + -- @"./src|@ would call @'\"'@ @""@ and result in Just LeftSide + -- + -- @"./src|"@ would call @'\"'@ @'\"'@ and result in Just Surrounded + -- + mkIsStringNotation :: Char -> T.Text -> Maybe Apostrophe + mkIsStringNotation '\"' restLine + | Just ('\"', _) <- T.uncons restLine = Just Surrounded + | otherwise = Just LeftSide + mkIsStringNotation _ _ = Nothing + +-- ---------------------------------------------------------------- +-- Implementation Details +-- ---------------------------------------------------------------- + +-- | Takes prefix info about the previously written text, +-- 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. +-- +-- From a cursor position, we traverse the cabal file upwards to +-- find the latest written keyword if there is any. +-- Values may be written on subsequent lines, +-- in order to allow for this we take the indentation of the current +-- word to be completed into account to find the correct keyword context. +getKeyWordContext :: CabalPrefixInfo -> [T.Text] -> Map KeyWordName a -> Maybe FieldContext +getKeyWordContext prefInfo 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 = completionIndentation prefInfo + -- 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 + lastNonEmptyLineM :: Maybe T.Text + lastNonEmptyLineM = do + (curLine, rest) <- List.uncons ls + -- represents the current line while disregarding the + -- currently written text we want to complete + let cur = stripPartiallyWritten curLine + List.find (not . T.null . T.stripEnd) $ + cur : rest + +-- | Traverse the given 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. +-- +-- TODO: this could be merged with getKeyWordContext in order to increase +-- performance by reducing the number of times we have to traverse the cabal file. +currentLevel :: [T.Text] -> StanzaContext +currentLevel [] = TopLevel +currentLevel (cur : xs) + | Just (s, n) <- stanza = Stanza s n + | otherwise = currentLevel xs + where + stanza = asum $ map checkStanza (Map.keys stanzaKeywordMap) + checkStanza :: StanzaType -> Maybe (StanzaType, Maybe StanzaName) + checkStanza t = + case T.stripPrefix t (T.strip cur) of + Just n + | T.null n -> Just (t, Nothing) + | otherwise -> Just (t, Just $ T.strip n) + Nothing -> Nothing + +-- | Get all lines before the given cursor position in the given file +-- and reverse their order to traverse backwards starting from the given position. +splitAtPosition :: Position -> Rope -> Maybe [T.Text] +splitAtPosition pos ls = do + split <- splitFile + pure $ reverse $ Rope.lines $ fst split + where + splitFile = Rope.splitAtPosition ropePos ls + ropePos = + Rope.Position + { Rope.posLine = fromIntegral $ pos ^. JL.line, + Rope.posColumn = fromIntegral $ pos ^. JL.character + } + +-- | Takes a line of text and removes the last partially +-- written word to be completed. +stripPartiallyWritten :: T.Text -> T.Text +stripPartiallyWritten = T.dropWhileEnd (\y -> (y /= ' ') && (y /= ':')) + +-- | Calculates how many spaces the currently completed item is indented. +completionIndentation :: CabalPrefixInfo -> Int +completionIndentation prefInfo = fromIntegral (pos ^. JL.character) - (T.length $ completionPrefix prefInfo) + where + pos = completionCursorPosition prefInfo diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs new file mode 100644 index 0000000000..5c42dca708 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs @@ -0,0 +1,261 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Redundant bracket" #-} + +module Ide.Plugin.Cabal.Completion.Data where + +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Text as T +import Development.IDE.GHC.Compat.Core (flagsForCompletion) +import Distribution.CabalSpecVersion (CabalSpecVersion (CabalSpecV2_2), + showCabalSpecVersion) +import Ide.Plugin.Cabal.Completion.Completer.FilePath +import Ide.Plugin.Cabal.Completion.Completer.Module +import Ide.Plugin.Cabal.Completion.Completer.Simple +import Ide.Plugin.Cabal.Completion.Completer.Types (Completer) +import Ide.Plugin.Cabal.Completion.Types +import Ide.Plugin.Cabal.LicenseSuggest (licenseNames) + +-- ---------------------------------------------------------------- +-- 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 $ + -- We only suggest cabal versions newer than 2.2 + -- since we don't recommend using older ones. + 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:", nameCompleter), + ("version:", noopCompleter), + ("build-type:", constantCompleter ["Simple", "Custom", "Configure", "Make"]), + ("license:", weightedConstantCompleter licenseNames weightedLicenseNames), + ("license-file:", filePathCompleter), + ("license-files:", filePathCompleter), + ("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"]), + ("data-files:", filePathCompleter), + ("data-dir:", directoryCompleter), + ("extra-source-files:", filePathCompleter), + ("extra-doc-files:", filePathCompleter), + ("extra-tmp-files:", filePathCompleter) + ] + +-- | Map, containing all stanzas in a cabal file as keys +-- and lists of their possible nested keywords as values. +stanzaKeywordMap :: Map StanzaType (Map KeyWordName Completer) +stanzaKeywordMap = + Map.fromList + [ ("library", libraryFields <> libExecTestBenchCommons), + ("executable", executableFields <> libExecTestBenchCommons), + ("test-suite", testSuiteFields <> libExecTestBenchCommons), + ("benchmark", benchmarkFields <> libExecTestBenchCommons), + ("foreign-library", foreignLibraryFields <> libExecTestBenchCommons), + ("flag", flagFields), + ("source-repository", sourceRepositoryFields) + ] + +libraryFields :: Map KeyWordName Completer +libraryFields = + Map.fromList + [ ("exposed-modules:", modulesCompleter sourceDirsExtractionLibrary), + ("virtual-modules:", noopCompleter), + ("exposed:", constantCompleter ["True", "False"]), + ("visibility:", constantCompleter ["private", "public"]), + ("reexported-modules:", noopCompleter), + ("signatures:", noopCompleter), + ("other-modules:", modulesCompleter sourceDirsExtractionLibrary) + ] + +executableFields :: Map KeyWordName Completer +executableFields = + Map.fromList + [ ("main-is:", filePathCompleter), + ("scope:", constantCompleter ["public", "private"]), + ("other-modules:", modulesCompleter (sourceDirsExtractionExecutable)) + ] + +testSuiteFields :: Map KeyWordName Completer +testSuiteFields = + Map.fromList + [ ("type:", constantCompleter ["exitcode-stdio-1.0", "detailed-0.9"]), + ("main-is:", filePathCompleter), + ("other-modules:", modulesCompleter sourceDirsExtractionTestSuite) + ] + +benchmarkFields :: Map KeyWordName Completer +benchmarkFields = + Map.fromList + [ ("type:", noopCompleter), + ("main-is:", filePathCompleter), + ("other-modules:", modulesCompleter (sourceDirsExtractionBenchmark)) + ] + +foreignLibraryFields :: Map KeyWordName Completer +foreignLibraryFields = + Map.fromList + [ ("type:", constantCompleter ["native-static", "native-shared"]), + ("options:", constantCompleter ["standalone"]), + ("mod-def-file:", filePathCompleter), + ("lib-version-info:", noopCompleter), + ("lib-version-linux:", noopCompleter) + ] + +sourceRepositoryFields :: Map KeyWordName Completer +sourceRepositoryFields = + Map.fromList + [ ( "type:", + constantCompleter + [ "darcs", + "git", + "svn", + "cvs", + "mercurial", + "hg", + "bazaar", + "bzr", + "arch", + "monotone" + ] + ), + ("location:", noopCompleter), + ("module:", noopCompleter), + ("branch:", noopCompleter), + ("tag:", noopCompleter), + ("subdir:", directoryCompleter) + ] + +flagFields :: Map KeyWordName Completer +flagFields = + Map.fromList + [ ("description:", noopCompleter), + ("default:", constantCompleter ["True", "False"]), + ("manual:", constantCompleter ["False", "True"]), + ("lib-def-file:", noopCompleter), + ("lib-version-info:", noopCompleter), + ("lib-version-linux:", noopCompleter) + ] + +libExecTestBenchCommons :: Map KeyWordName Completer +libExecTestBenchCommons = + Map.fromList + [ ("build-depends:", 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:", constantCompleter ghcOptions), + ("ghc-prof-options:", constantCompleter ghcOptions), + ("ghc-shared-options:", constantCompleter ghcOptions), + ("ghcjs-options:", constantCompleter ghcOptions), + ("ghcjs-prof-options:", constantCompleter ghcOptions), + ("ghcjs-shared-options:", constantCompleter ghcOptions), + ("includes:", filePathCompleter), + ("install-includes:", filePathCompleter), + ("include-dirs:", directoryCompleter), + ("c-sources:", filePathCompleter), + ("cxx-sources:", filePathCompleter), + ("asm-sources:", filePathCompleter), + ("cmm-sources:", filePathCompleter), + ("js-sources:", filePathCompleter), + ("extra-libraries:", noopCompleter), + ("extra-ghci-libraries:", noopCompleter), + ("extra-bundled-libraries:", noopCompleter), + ("extra-lib-dirs:", directoryCompleter), + ("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), + ("mixins:", noopCompleter) + ] + +-- | Contains a map of the most commonly used licenses, weighted by their popularity. +-- +-- The data was extracted by Kleidukos from the alternative hackage frontend flora.pm. +weightedLicenseNames :: Map T.Text Double +weightedLicenseNames = + fmap statisticsToWeight $ + Map.fromList + [ ("BSD-3-Clause", 9955), + ("MIT", 3336), + ("GPL-3.0-only", 679), + ("LicenseRef-OtherLicense", 521), + ("Apache-2.0", 514), + ("LicenseRef-GPL", 443), + ("LicenseRef-PublicDomain", 318), + ("MPL-2.0", 288), + ("BSD-2-Clause", 174), + ("GPL-2.0-only", 160), + ("LicenseRef-LGPL", 146), + ("LGPL-2.1-only", 112), + ("LGPL-3.0-only", 100), + ("AGPL-3.0-only", 96), + ("ISC", 89), + ("LicenseRef-Apache", 45), + ("GPL-3.0-or-later", 43), + ("BSD-2-Clause-Patent", 33), + ("GPL-2.0-or-later", 21), + ("CC0-1.0", 16), + ("AGPL-3.0-or-later", 15), + ("LGPL-2.1-or-later", 12), + ("(BSD-2-Clause OR Apache-2.0)", 10), + ("(Apache-2.0 OR MPL-2.0)", 8), + ("LicenseRef-AGPL", 6), + ("(BSD-3-Clause OR Apache-2.0)", 4), + ("0BSD", 3), + ("BSD-4-Clause", 3), + ("LGPL-3.0-or-later", 3), + ("LicenseRef-LGPL-2", 2), + ("GPL-2.0-or-later AND BSD-3-Clause", 2), + ("NONE", 2), + ("Zlib", 2), + ("(Apache-2.0 OR BSD-3-Clause)", 2), + ("BSD-3-Clause AND GPL-2.0-or-later", 2), + ("BSD-3-Clause AND GPL-3.0-or-later", 2) + ] + where + -- Add weights to each usage value from above, the weights are chosen + -- arbitrarily in order for completions to prioritize which licenses to + -- suggest in a sensible way + statisticsToWeight :: Int -> Double + statisticsToWeight stat + | stat < 10 = 0.1 + | stat < 20 = 0.3 + | stat < 50 = 0.4 + | stat < 100 = 0.5 + | stat < 500 = 0.6 + | stat < 650 = 0.7 + | otherwise = 0.9 + +ghcOptions :: [T.Text] +ghcOptions = map T.pack $ flagsForCompletion False diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs new file mode 100644 index 0000000000..4783c2bbe3 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module Ide.Plugin.Cabal.Completion.Types where + +import Control.DeepSeq (NFData) +import Data.Hashable +import qualified Data.Text as T +import Data.Typeable +import Development.IDE as D +import GHC.Generics +import qualified Ide.Plugin.Cabal.Parse as Parse + +data Log + = LogFileSplitError Position + | -- | This should never occur since we extract the word to lookup from the same map we look it up in. + LogUnknownKeyWordInContextError KeyWordName + | -- | This should never occur since we extract the word to lookup from the same map we look it up in. + LogUnknownStanzaNameInContextError StanzaName + | LogFilePathCompleterIOError FilePath IOError + | LogUseWithStaleFastNoResult + | LogMapLookUpOfKnownKeyFailed T.Text + deriving (Show) + +instance Pretty Log where + pretty = \case + LogFileSplitError pos -> "An error occured when trying to separate the lines of the cabal file at position:" <+> viaShow pos + LogUnknownKeyWordInContextError kw -> + "Lookup of key word failed for:" <+> viaShow kw + LogUnknownStanzaNameInContextError sn -> + "Lookup of stanza name failed for:" <+> viaShow sn + LogFilePathCompleterIOError fp ioErr -> + "When trying to complete the file path:" <+> viaShow fp <+> "the following unexpected IO error occured" <+> viaShow ioErr + LogUseWithStaleFastNoResult -> "Package description couldn't be read" + LogMapLookUpOfKnownKeyFailed key -> "Lookup of key in map failed even though it should exist" <+> viaShow key + +type instance RuleResult ParseCabal = Parse.GenericPackageDescription + +data ParseCabal = ParseCabal + deriving (Eq, Show, Typeable, Generic) + +instance Hashable ParseCabal + +instance NFData ParseCabal + +-- | 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 = (StanzaContext, FieldContext) + +-- | Context inside a cabal file. +-- Used to decide which keywords to suggest. +data StanzaContext + = -- | Top level context in a cabal file such as 'author' + TopLevel + | -- | Nested context in a cabal file, such as 'library'. + -- + -- Stanzas have their own fields which differ from top-level fields. + -- Each stanza must be named, such as 'executable exe', + -- except for the main library. + Stanza StanzaType (Maybe StanzaName) + deriving (Eq, Show, Read) + +-- | Keyword context in a cabal file. +-- +-- Used to decide whether to suggest values or keywords. +data FieldContext + = -- | Key word context, where a keyword + -- occurs right before the current word + -- to be completed + KeyWord KeyWordName + | -- | Keyword context where no keyword occurs + -- right before the current word to be completed + None + deriving (Eq, Show, Read) + +type KeyWordName = T.Text + +type StanzaName = T.Text + +type StanzaType = T.Text + +-- | Information regarding the current completion status +-- +-- Example: @"dir1/fi@ having been written to the file +-- would correspond to: +-- +-- @ +-- completionPrefix = "dir1/fi" +-- isStringNotation = LeftSide +-- ... +-- @ +-- +-- We define this type instead of simply using +-- VFS.PosPrefixInfo since e.g. for filepaths we +-- need more than just the word before the +-- cursor (as can be seen above), +-- since we want to capture the whole filepath +-- before the cursor. +-- +-- We also use this type to wrap all information +-- necessary to complete filepaths and other values +-- in a cabal file. +data CabalPrefixInfo = CabalPrefixInfo + { -- | text prefix to complete + completionPrefix :: T.Text, + -- | Did the completion happen in the context of a string notation, + -- i.e. are there apostrophes around the item to be completed + isStringNotation :: Maybe Apostrophe, + -- | the current position of the cursor in the file + completionCursorPosition :: Position, + -- | range where completion is to be inserted + completionRange :: Range, + -- | directory of the handled cabal file + completionWorkingDir :: FilePath, + -- | filename of the handled cabal file + completionFileName :: T.Text + } + deriving (Eq, Show) + +-- | Where are the apostrophes around the item to be completed? +-- +-- 'Surrounded' means the item to complete already has the necessary apostrophes, +-- while 'LeftSide' means, a closing apostrophe has to be added after the completion item. +data Apostrophe = Surrounded | LeftSide + deriving (Eq, Ord, Show) + +-- | Wraps a completion in apostrophes where appropriate. +-- +-- If a completion starts with an apostrophe we want to end it with an apostrophe. +-- If a completed filepath contains a space, it can only be written in the cabal +-- file if it is wrapped in apostrophes, thus we wrap it. +applyStringNotation :: Maybe Apostrophe -> T.Text -> T.Text +applyStringNotation (Just Surrounded) compl = compl +applyStringNotation (Just LeftSide) compl = compl <> "\"" +applyStringNotation Nothing compl + | Just _ <- T.find (== ' ') compl = "\"" <> compl <> "\"" + | otherwise = compl 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 5580f2b31d..8ff0f9e988 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(..) @@ -77,7 +78,7 @@ licenseErrorSuggestion :: licenseErrorSuggestion msg = (getMatch <$> msg =~~ regex) >>= \case [original] -> - let matches = map Fuzzy.original $ Fuzzy.simpleFilter 1000 10 original licenseNames + let matches = map Fuzzy.original $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults original licenseNames in [(original,candidate) | candidate <- List.sortBy (lengthDistance original) matches] _ -> [] where diff --git a/plugins/hls-cabal-plugin/test/Completer.hs b/plugins/hls-cabal-plugin/test/Completer.hs new file mode 100644 index 0000000000..d2d28fc07b --- /dev/null +++ b/plugins/hls-cabal-plugin/test/Completer.hs @@ -0,0 +1,314 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} + +module Completer where + +import Control.Lens ((^.)) +import qualified Data.ByteString as ByteString +import qualified Data.Text as T +import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe) +import Ide.Plugin.Cabal.Completion.Completer.FilePath +import Ide.Plugin.Cabal.Completion.Completer.Module +import Ide.Plugin.Cabal.Completion.Completer.Types (CompleterData (..)) +import Ide.Plugin.Cabal.Completion.Completions +import Ide.Plugin.Cabal.Completion.Types +import Ide.Plugin.Cabal.Parse (GenericPackageDescription) +import qualified Language.LSP.Protocol.Lens as L +import qualified Language.LSP.VFS as VFS +import System.FilePath +import Test.Hls +import Utils + +completerTests :: TestTree +completerTests = + testGroup + "Completer Tests" + [ fileCompleterTests, + filePathCompletionContextTests, + directoryCompleterTests, + completionHelperTests, + filePathExposedModulesTests, + exposedModuleCompleterTests + ] + +fileCompleterTests :: TestTree +fileCompleterTests = + testGroup + "File Completer Tests" + [ testCase "Current Directory" $ do + testDir <- getFilePathComplTestDir + completions <- completeFilePath "" testDir + completions @?== ["./.hidden", "./Content.hs", "./dir1/", "./dir2/", "./textfile.txt"], + testCase "Current Directory - alternative writing" $ do + testDir <- getFilePathComplTestDir + completions <- completeFilePath "./" testDir + completions @?== ["./.hidden", "./Content.hs", "./dir1/", "./dir2/", "./textfile.txt"], + testCase "Current Directory - hidden file start" $ do + testDir <- getFilePathComplTestDir + completions <- completeFilePath "." testDir + completions @?== ["./Content.hs", "./.hidden", "./textfile.txt"], + testCase "Current Directory - incomplete directory path written" $ do + testDir <- getFilePathComplTestDir + completions <- completeFilePath "di" testDir + completions @?== ["./dir1/", "./dir2/"], + testCase "Current Directory - incomplete filepath written" $ do + testDir <- getFilePathComplTestDir + completions <- completeFilePath "te" testDir + completions @?== ["./Content.hs", "./textfile.txt"], + testCase "Subdirectory" $ do + testDir <- getFilePathComplTestDir + completions <- completeFilePath "dir1/" testDir + completions @?== ["dir1/f1.txt", "dir1/f2.hs"], + testCase "Subdirectory - incomplete filepath written" $ do + testDir <- getFilePathComplTestDir + completions <- completeFilePath "dir2/dir3/MA" testDir + completions @?== ["dir2/dir3/MARKDOWN.md"], + testCase "Nonexistent directory" $ do + testDir <- getFilePathComplTestDir + completions <- completeFilePath "dir2/dir4/" testDir + completions @?== [] + ] + where + completeFilePath :: T.Text -> TestName -> IO [T.Text] + completeFilePath written dirName = do + completer <- filePathCompleter mempty $ mkCompleterData $ simpleCabalPrefixInfoFromFp written dirName + pure $ fmap extract completer + +filePathCompletionContextTests :: TestTree +filePathCompletionContextTests = + testGroup + "File Path Completion Context Tests" + [ testCase "empty file - start" $ do + let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "" 0 0) + completionPrefix complContext @?= "", + testCase "only whitespaces" $ do + let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo " " 0 3) + completionPrefix complContext @?= "", + testCase "simple filepath" $ do + let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo " src/" 0 7) + completionPrefix complContext @?= "src/", + testCase "simple filepath - starting apostrophe" $ do + let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo " \"src/" 0 8) + completionPrefix complContext @?= "src/", + testCase "simple filepath - starting apostrophe, already closed" $ do + let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo " \"src/\"" 0 8) + completionPrefix complContext @?= "src/", + testCase "second filepath - starting apostrophe" $ do + let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "fp.txt \"src/" 0 12) + completionPrefix complContext @?= "src/", + testCase "middle filepath - starting apostrophe" $ do + let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "fp.txt \"src/ fp2.txt" 0 12) + completionPrefix complContext @?= "src/", + testCase "middle filepath - starting apostrophe, already closed" $ do + let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "fp.t xt \"src\" fp2.txt" 0 12) + completionPrefix complContext @?= "src", + testCase "middle filepath - starting apostrophe, already closed" $ do + let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "\"fp.txt\" \"src fp2.txt" 0 13) + completionPrefix complContext @?= "src", + testCase "Current Directory" $ do + testDir <- getFilePathComplTestDir + compls <- + listFileCompletions + mempty + PathCompletionInfo + { isStringNotationPath = Nothing, + pathSegment = "", + queryDirectory = "", + workingDirectory = testDir + } + compls @?== [".hidden", "Content.hs", "dir1/", "dir2/", "textfile.txt"], + testCase "In directory" $ do + testDir <- getFilePathComplTestDir + compls <- + listFileCompletions + mempty + PathCompletionInfo + { isStringNotationPath = Nothing, + pathSegment = "", + queryDirectory = "dir1/", + workingDirectory = testDir + } + compls @?== ["f1.txt", "f2.hs"] + ] + 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 + } + +directoryCompleterTests :: TestTree +directoryCompleterTests = + testGroup + "Directory Completer Tests" + [ testCase "Current Directory" $ do + testDir <- getFilePathComplTestDir + completions <- completeDirectory "" testDir + completions @?== ["./dir1/", "./dir2/"], + testCase "Current Directory - alternative writing" $ do + testDir <- getFilePathComplTestDir + completions <- completeDirectory "./" testDir + completions @?== ["./dir1/", "./dir2/"], + testCase "Current Directory - incomplete directory path written" $ do + testDir <- getFilePathComplTestDir + completions <- completeDirectory "di" testDir + completions @?== ["./dir1/", "./dir2/"], + testCase "Current Directory - incomplete filepath written" $ do + testDir <- getFilePathComplTestDir + completions <- completeDirectory "te" testDir + completions @?== [], + testCase "Subdirectory - no more directories found" $ do + testDir <- getFilePathComplTestDir + completions <- completeDirectory "dir1/" testDir + completions @?== [], + testCase "Subdirectory - available subdirectory" $ do + testDir <- getFilePathComplTestDir + completions <- completeDirectory "dir2/" testDir + completions @?== ["dir2/dir3/"], + testCase "Nonexistent directory" $ do + testDir <- getFilePathComplTestDir + completions <- completeDirectory "dir2/dir4/" testDir + completions @?== [] + ] + where + completeDirectory :: T.Text -> TestName -> IO [T.Text] + completeDirectory written dirName = do + completer <- directoryCompleter mempty $ mkCompleterData $ simpleCabalPrefixInfoFromFp written dirName + pure $ fmap extract completer + +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 . getCabalPrefixInfo "" $ + VFS.PosPrefixInfo + { VFS.fullLine = lineString, + VFS.prefixModule = "", + VFS.prefixText = "", + VFS.cursorPos = Position linePos charPos + } + +filePathExposedModulesTests :: TestTree +filePathExposedModulesTests = + testGroup + "Filepaths for Exposed Modules Tests" + [ testCase "Root dir" $ do + exposed <- callFilePathsForExposedModules ["./"] + exposed @?== ["Dir1.", "File1"], + testCase "Nested path" $ do + exposed <- callFilePathsForExposedModules ["./Dir1/Dir2/"] + exposed @?== ["File2"], + testCase "Nested empty dir" $ do + exposed <- callFilePathsForExposedModules ["./Dir1/Dir2/Dir4"] + exposed @?== [], + testCase "Two dirs" $ do + exposed <- callFilePathsForExposedModules ["./Dir1/", "Dir1/Dir3/Dir4/"] + exposed @?== ["Dir2.", "Dir3.", "File3"] + ] + where + callFilePathsForExposedModules :: [FilePath] -> IO [T.Text] + callFilePathsForExposedModules srcDirs = do + cwd <- getExposedTestDir + let prefInfo = simpleCabalPrefixInfoFromFp "" cwd + filePathsForExposedModules mempty srcDirs prefInfo + +exposedModuleCompleterTests :: TestTree +exposedModuleCompleterTests = + testGroup + "Exposed Modules Completer Tests" + [ testCase "Top level single source dir, library" $ do + completions <- callModulesCompleter Nothing sourceDirsExtractionLibrary "" + completions @?== ["Dir2.", "Dir3."], + testCase "Top level single source dir, benchmark, with prefix" $ do + completions <- callModulesCompleter (Just "benchie") sourceDirsExtractionBenchmark "Fi" + completions @?== ["File1"], + testCase "Top level single source dir, named executable" $ do + completions <- callModulesCompleter (Just "executie") sourceDirsExtractionExecutable "" + completions @?== ["File1", "Dir1.", "Dir2.", "Dir3."], + testCase "Top level single source dir, named executable" $ do + completions <- callModulesCompleter (Just "exe-not-so-cutie") sourceDirsExtractionExecutable "" + completions @?== ["File2", "Dir4."], + testCase "Top level single source dir, nonexistent name" $ do + completions <- callModulesCompleter (Just "exe-the-beste") sourceDirsExtractionExecutable "" + completions @?== [], + testCase "Top level single source dir, testsuite, with prefix" $ do + completions <- callModulesCompleter (Just "suitor") sourceDirsExtractionTestSuite "3" + completions @?== ["File3"], + testCase "Name nothing but not library" $ do + completions <- callModulesCompleter Nothing sourceDirsExtractionTestSuite "3" + completions @?== [] + ] + where + simpleCompleterData :: Maybe StanzaName -> FilePath -> T.Text -> CompleterData + simpleCompleterData sName dir pref = do + CompleterData + { cabalPrefixInfo = simpleExposedCabalPrefixInfo pref dir, + getLatestGPD = do + testDir <- getTestDir + cabalContents <- ByteString.readFile $ testDir "exposed.cabal" + pure $ parseGenericPackageDescriptionMaybe cabalContents, + stanzaName = sName + } + callModulesCompleter :: Maybe StanzaName -> (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> T.Text -> IO [T.Text] + callModulesCompleter sName func prefix = do + cwd <- getTestDir + let cData = simpleCompleterData sName cwd prefix + completer <- modulesCompleter func mempty cData + pure $ fmap extract completer + +mkCompleterData :: CabalPrefixInfo -> CompleterData +mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing} + +getExposedTestDir :: IO FilePath +getExposedTestDir = do + testDir <- getTestDir + pure $ addTrailingPathSeparator $ testDir "src-modules" + +simpleExposedCabalPrefixInfo :: T.Text -> FilePath -> CabalPrefixInfo +simpleExposedCabalPrefixInfo prefix fp = + CabalPrefixInfo + { completionPrefix = prefix, + isStringNotation = Nothing, + completionCursorPosition = Position 0 0, + completionRange = Range (Position 0 0) (Position 0 0), + completionWorkingDir = fp, + completionFileName = "exposed.cabal" + } + +extract :: CompletionItem -> T.Text +extract item = case item ^. L.textEdit of + Just (InL v) -> v ^. L.newText + _ -> error "" diff --git a/plugins/hls-cabal-plugin/test/Context.hs b/plugins/hls-cabal-plugin/test/Context.hs new file mode 100644 index 0000000000..356da51481 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/Context.hs @@ -0,0 +1,203 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Context where + +import Control.Monad.Trans.Maybe (runMaybeT) +import qualified Data.Text as T +import qualified Data.Text.Utf16.Rope as Rope +import Ide.Plugin.Cabal +import Ide.Plugin.Cabal.Completion.Completer.FilePath +import Ide.Plugin.Cabal.Completion.Completions +import Ide.Plugin.Cabal.Completion.Types (Context, + FieldContext (KeyWord, None), + StanzaContext (Stanza, TopLevel)) +import Test.Hls +import Utils as T + +cabalPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log +cabalPlugin = mkPluginTestDescriptor descriptor "cabal context" + +contextTests :: TestTree +contextTests = + testGroup + "Context Tests " + [ pathCompletionInfoFromCompletionContextTests + , getContextTests + ] + +pathCompletionInfoFromCompletionContextTests :: TestTree +pathCompletionInfoFromCompletionContextTests = + testGroup + "Completion Info to Completion Context Tests" + [ testCase "Current Directory" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "" testDir + queryDirectory complInfo @?= "./" + , testCase "Current Directory - partly written next" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "di" testDir + queryDirectory complInfo @?= "./" + pathSegment complInfo @?= "di" + , testCase "Current Directory - alternative writing" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "./" testDir + queryDirectory complInfo @?= "./" + , testCase "Subdirectory" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "dir1/" testDir + queryDirectory complInfo @?= "dir1/" + pathSegment complInfo @?= "" + , testCase "Subdirectory - partly written next" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "dir1/d" testDir + queryDirectory complInfo @?= "dir1/" + pathSegment complInfo @?= "d" + , testCase "Subdirectory - partly written next" $ do + testDir <- getTestDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "dir1/dir2/d" testDir + queryDirectory complInfo @?= "dir1/dir2/" + pathSegment complInfo @?= "d" + ] + +getContextTests :: TestTree +getContextTests = + testGroup + "Context Tests" + [ testCase "Empty File - Start" $ do + -- for a completely empty file, the context needs to + -- be top level without a specified keyword + ctx <- callGetContext (Position 0 0) "" [""] + ctx @?= (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 + ctx <- callGetContext (Position 0 14) "" ["cabal-version:"] + ctx @?= (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 + ctx <- callGetContext (Position 0 5) "cabal" ["cabal-version:"] + ctx @?= (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 + ctx <- callGetContext (Position 0 45) ("") ["cabal-version:" <> T.replicate 50 " "] + ctx @?= (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 + ctx <- callGetContext (Position 0 5) "cabal" ["cabal"] + ctx @?= (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 + ctx <- callGetContext (Position 0 17) "1." ["cabal-version: 1."] + ctx @?= (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 + ctx <- callGetContext (Position 3 2) "" libraryStanzaData + ctx @?= (Stanza "library" Nothing, 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 + ctx <- callGetContext (Position 4 21) "" libraryStanzaData + ctx @?= (Stanza "library" Nothing, 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 + ctx <- callGetContext (Position 1 2) "" ["cabal-version:", ""] + ctx @?= (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 + ctx <- callGetContext (Position 2 4) "" topLevelData + ctx @?= (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 + ctx <- callGetContext (Position 2 0) "" topLevelData + ctx @?= (TopLevel, None) + , testCase "Toplevel after stanza partially written" $ do + ctx <- callGetContext (Position 6 2) "ma" libraryStanzaData + ctx @?= (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 + ctx <- callGetContext (Position 5 4) "" topLevelData + ctx @?= (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 + ctx <- callGetContext (Position 5 8) "" libraryStanzaData + ctx @?= (Stanza "library" Nothing, 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 + ctx <- callGetContext (Position 5 2) "" libraryStanzaData + ctx @?= (Stanza "library" Nothing, 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 + ctx <- callGetContext (Position 5 0) "" libraryStanzaData + ctx @?= (TopLevel, None) + , testCase "Top level - cursor in later line with partially written value" $ do + ctx <- callGetContext (Position 5 13) "eee" topLevelData + ctx @?= (TopLevel, KeyWord "name:") + , testCase "Named Stanza" $ do + ctx <- callGetContext (Position 2 18) "" executableStanzaData + ctx @?= (Stanza "executable" (Just "exeName"), None) + ] + where + callGetContext :: Position -> T.Text -> [T.Text] -> IO Context + callGetContext pos pref ls = do + runMaybeT (getContext mempty (simpleCabalPrefixInfoFromPos pos pref) (Rope.fromText $ T.unlines ls)) + >>= \case + Nothing -> assertFailure "Context must be found" + Just ctx -> pure ctx + +-- ------------------------------------------------------------------------ +-- Test Data +-- ------------------------------------------------------------------------ +libraryStanzaData :: [T.Text] +libraryStanzaData = + [ "cabal-version: 3.0" + , "name: simple-cabal" + , "library " + , " default-language: Haskell98" + , " build-depends: " + , " " + , "ma " + ] + +executableStanzaData :: [T.Text] +executableStanzaData = + [ "cabal-version: 3.0" + , "name: simple-cabal" + , "executable exeName" + , " default-language: Haskell2010" + , " hs-source-dirs: test/preprocessor" + ] + +topLevelData :: [T.Text] +topLevelData = + [ "cabal-version: 3.0" + , "name:" + , "" + , "" + , "" + , " eee" + ] diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index d67cb3b724..b2b32f6258 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -1,18 +1,21 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} -module Main - ( main - ) where +module Main ( + main, +) where + +import Completer (completerTests) +import Context (contextTests) import Control.Lens ((^.)) import Control.Monad (guard) import qualified Data.ByteString as BS import Data.Either (isRight) import Data.Row +import qualified Data.Text as T import qualified Data.Text as Text import Ide.Plugin.Cabal import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) @@ -21,16 +24,19 @@ import qualified Language.LSP.Protocol.Lens as L import System.FilePath import Test.Hls -cabalPlugin :: PluginTestDescriptor Log +cabalPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log cabalPlugin = mkPluginTestDescriptor descriptor "cabal" main :: IO () main = do - defaultTestRunner $ - testGroup "Cabal Plugin Tests" - [ unitTests - , pluginTests - ] + defaultTestRunner $ + testGroup + "Cabal Plugin Tests" + [ unitTests + , pluginTests + , completerTests + , contextTests + ] -- ------------------------------------------------------------------------ -- Unit Tests @@ -38,138 +44,157 @@ main = do unitTests :: TestTree unitTests = - testGroup "Unit Tests" - [ cabalParserUnitTests, - codeActionUnitTests - ] + testGroup + "Unit Tests" + [ cabalParserUnitTests + , codeActionUnitTests + ] 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?" @?= [], +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")] + ] - 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")] - ] - --- ------------------------------------------------------------------------ +-- ------------------------ ------------------------------------------------ -- 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 ^. L.range @?= Range (Position 3 24) (Position 4 0) - unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error - , 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 ^. L.range @?= Range (Position 3 24) (Position 4 0) - unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error - _ <- 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 $ InL $ #range .== theRange - .+ #rangeLength .== Nothing - .+ #text .== "MIT3"] - cabalDiags <- waitForDiagnosticsFrom cabalDoc - unknownLicenseDiag <- liftIO $ inspectDiagnostic cabalDiags ["Unknown SPDX license identifier: 'MIT3'"] - expectNoMoreDiagnostics 1 hsDoc "typechecking" - liftIO $ do - length cabalDiags @?= 1 - unknownLicenseDiag ^. L.range @?= Range (Position 3 24) (Position 4 0) - unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error - ] - , 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 ^. L.range @?= Range (Position 3 24) (Position 4 0) - reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error - [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 ^. L.range @?= Range (Position 3 25) (Position 4 0) - reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error - [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 ^. L.range @?= Range (Position 3 24) (Position 4 0) + unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error + , 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 ^. L.range @?= Range (Position 3 24) (Position 4 0) + unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error + _ <- 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 $ + InL $ + #range + .== theRange + .+ #rangeLength + .== Nothing + .+ #text + .== "MIT3" + ] + cabalDiags <- waitForDiagnosticsFrom cabalDoc + unknownLicenseDiag <- liftIO $ inspectDiagnostic cabalDiags ["Unknown SPDX license identifier: 'MIT3'"] + expectNoMoreDiagnostics 1 hsDoc "typechecking" + liftIO $ do + length cabalDiags @?= 1 + unknownLicenseDiag ^. L.range @?= Range (Position 3 24) (Position 4 0) + unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error + ] + , 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 ^. L.range @?= Range (Position 3 24) (Position 4 0) + reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error + [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 ^. L.range @?= Range (Position 3 25) (Position 4 0) + reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error + [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" + ] + ] + ] where - getLicenseAction :: Text.Text -> [Command |? CodeAction] -> [CodeAction] + getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction] getLicenseAction license codeActions = do - InR action@CodeAction{_title} <- codeActions - guard (_title=="Replace with " <> license) - pure action + InR action@CodeAction{_title} <- codeActions + guard (_title == "Replace with " <> license) + pure action -- ------------------------------------------------------------------------ -- Runner utils diff --git a/plugins/hls-cabal-plugin/test/Utils.hs b/plugins/hls-cabal-plugin/test/Utils.hs new file mode 100644 index 0000000000..6974b9e188 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/Utils.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} + +module Utils where + +import Data.List (sort) +import qualified Data.Text as T +import Ide.Plugin.Cabal.Completion.Types +import System.Directory (getCurrentDirectory) +import System.FilePath +import Test.Hls + + +simpleCabalPrefixInfoFromPos :: Position -> T.Text -> CabalPrefixInfo +simpleCabalPrefixInfoFromPos pos prefix = + CabalPrefixInfo + { completionPrefix = prefix + , completionCursorPosition = pos + , isStringNotation = Nothing + , completionRange = Range pos (Position 0 0) + , completionWorkingDir = "" + , completionFileName = "test" + } + +simpleCabalPrefixInfoFromFp :: T.Text -> FilePath -> CabalPrefixInfo +simpleCabalPrefixInfoFromFp prefix fp = + CabalPrefixInfo + { completionPrefix = prefix + , isStringNotation = Nothing + , completionCursorPosition = Position 0 0 + , completionRange = Range (Position 0 0) (Position 0 0) + , completionWorkingDir = fp + , completionFileName = "test" + } + +getTestDir :: IO FilePath +getTestDir = do + cwd <- getCurrentDirectory + pure $ addTrailingPathSeparator $ cwd "test" "testdata" + +getFilePathComplTestDir :: IO FilePath +getFilePathComplTestDir = do + testDir <- getTestDir + pure $ addTrailingPathSeparator $ testDir "filepath-completions" + +-- | list comparison where the order in the list is irrelevant +(@?==) :: (HasCallStack, Ord a, Show a) => [a] -> [a] -> Assertion +(@?==) l1 l2 = sort l1 @?= sort l2 diff --git a/plugins/hls-cabal-plugin/test/testdata/exposed.cabal b/plugins/hls-cabal-plugin/test/testdata/exposed.cabal new file mode 100644 index 0000000000..7237979fc2 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/exposed.cabal @@ -0,0 +1,40 @@ +cabal-version: 3.4 +name: test-hls +version: 0.1.0.0 +maintainer: milky +category: Dev +synopsis: dsasd +license: MIT +license-file: ./LICENSE.md + +library + hs-source-dirs: ./src-modules/Dir1/ + exposed-modules: + build-depends: base + default-language: Haskell2010 + +benchmark benchie + type: exitcode-stdio-1.0 + main-is: Main.hs + build-depends: base + hs-source-dirs: ./src-modules/ + exposed-modules: + +executable executie + main-is: Main.hs + build-depends: base + hs-source-dirs: ./src-modules/ ./src-modules/Dir1/ + exposed-modules: + +executable exe-not-so-cutie + main-is: Main.hs + build-depends: base + hs-source-dirs: ./src-modules/Dir1/Dir2/ ./src-modules/Dir1/Dir3 + exposed-modules: + +test-suite suitor + type: exitcode-stdio-1.0 + main-is: Main.hs + build-depends: base + hs-source-dirs: "./src-modules/Dir1/Dir3/Dir4" + exposed-modules: 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 0000000000..82df2e0fff --- /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/Content.hs b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/Content.hs new file mode 100644 index 0000000000..e69de29bb2 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 0000000000..016496005a --- /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 0000000000..6c5963631f --- /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 0000000000..95c3d0e549 --- /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 0000000000..016496005a --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/textfile.txt @@ -0,0 +1 @@ +test text file diff --git a/plugins/hls-cabal-plugin/test/testdata/src-modules/Dir1/Dir2/File2.hs b/plugins/hls-cabal-plugin/test/testdata/src-modules/Dir1/Dir2/File2.hs new file mode 100644 index 0000000000..e69de29bb2 diff --git a/plugins/hls-cabal-plugin/test/testdata/src-modules/Dir1/Dir3/Dir4/File3.hs b/plugins/hls-cabal-plugin/test/testdata/src-modules/Dir1/Dir3/Dir4/File3.hs new file mode 100644 index 0000000000..e69de29bb2 diff --git a/plugins/hls-cabal-plugin/test/testdata/src-modules/File1.hs b/plugins/hls-cabal-plugin/test/testdata/src-modules/File1.hs new file mode 100644 index 0000000000..e69de29bb2 diff --git a/plugins/hls-cabal-plugin/test/testdata/src-modules/test.cabal b/plugins/hls-cabal-plugin/test/testdata/src-modules/test.cabal new file mode 100644 index 0000000000..e69de29bb2 diff --git a/stack.yaml b/stack.yaml index 7c2af3269c..5e6d741478 100644 --- a/stack.yaml +++ b/stack.yaml @@ -45,6 +45,7 @@ ghc-options: allow-newer: true extra-deps: +- Cabal-syntax-3.10.1.0@sha256:bb835ebab577fd0f9c11dab96210dbb8d68ffc62652576f4b092563c345930e7,7434 # - floskell-0.10.7 - hiedb-0.4.3.0 - implicit-hie-0.1.2.7