hls-cabal-plugin 2.0.0.1 → 2.1.0.0
raw patch · 17 files changed
+2286/−306 lines, 17 filesdep +Cabal-syntaxdep +containersdep +row-typesdep −Cabaldep ~ghcidedep ~hls-graphdep ~hls-plugin-apiPVP ok
version bump matches the API change (PVP)
Dependencies added: Cabal-syntax, containers, row-types, text-rope, transformers
Dependencies removed: Cabal
Dependency ranges changed: ghcide, hls-graph, hls-plugin-api, hls-test-utils, lsp, lsp-types
API changes (from Hackage documentation)
- Ide.Plugin.Cabal: instance Control.DeepSeq.NFData Ide.Plugin.Cabal.ParseCabal
- Ide.Plugin.Cabal: instance Data.Hashable.Class.Hashable Ide.Plugin.Cabal.ParseCabal
- Ide.Plugin.Cabal: instance GHC.Classes.Eq Ide.Plugin.Cabal.ParseCabal
- Ide.Plugin.Cabal: instance GHC.Generics.Generic Ide.Plugin.Cabal.ParseCabal
- Ide.Plugin.Cabal: instance GHC.Show.Show Ide.Plugin.Cabal.ParseCabal
+ Ide.Plugin.Cabal: LogCompletionContext :: Context -> Position -> Log
+ Ide.Plugin.Cabal: LogCompletions :: Log -> Log
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: PathCompletionInfo :: Text -> FilePath -> FilePath -> Maybe Apostrophe -> PathCompletionInfo
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: [isStringNotationPath] :: PathCompletionInfo -> Maybe Apostrophe
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: [pathSegment] :: PathCompletionInfo -> Text
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: [queryDirectory] :: PathCompletionInfo -> FilePath
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: [workingDirectory] :: PathCompletionInfo -> FilePath
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: data PathCompletionInfo
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: directoryCompleter :: Completer
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: filePathCompleter :: Completer
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: instance GHC.Classes.Eq Ide.Plugin.Cabal.Completion.Completer.FilePath.PathCompletionInfo
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: instance GHC.Show.Show Ide.Plugin.Cabal.Completion.Completer.FilePath.PathCompletionInfo
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: listDirectoryCompletions :: Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath]
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: listFileCompletions :: Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath]
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: mkCompletionDirectory :: PathCompletionInfo -> FilePath
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: mkDirFromCWD :: PathCompletionInfo -> FilePath -> FilePath
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: mkFilePathCompletion :: PathCompletionInfo -> Text -> IO Text
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: mkPathCompletionDir :: PathCompletionInfo -> Text -> Text
+ Ide.Plugin.Cabal.Completion.Completer.FilePath: pathCompletionInfoFromCabalPrefixInfo :: CabalPrefixInfo -> PathCompletionInfo
+ Ide.Plugin.Cabal.Completion.Completer.Module: exposedModulePathToFp :: Text -> FilePath
+ Ide.Plugin.Cabal.Completion.Completer.Module: extractRelativeDirsFromStanza :: Maybe StanzaName -> GenericPackageDescription -> (GenericPackageDescription -> [(UnqualComponentName, CondTree b c a)]) -> (a -> BuildInfo) -> [FilePath]
+ Ide.Plugin.Cabal.Completion.Completer.Module: filePathsForExposedModules :: Recorder (WithPriority Log) -> [FilePath] -> CabalPrefixInfo -> IO [Text]
+ Ide.Plugin.Cabal.Completion.Completer.Module: fpToExposedModulePath :: FilePath -> FilePath -> Text
+ Ide.Plugin.Cabal.Completion.Completer.Module: mkExposedModulePathCompletion :: PathCompletionInfo -> FilePath -> IO Text
+ Ide.Plugin.Cabal.Completion.Completer.Module: modulesCompleter :: (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> Completer
+ Ide.Plugin.Cabal.Completion.Completer.Module: sourceDirsExtractionBenchmark :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
+ Ide.Plugin.Cabal.Completion.Completer.Module: sourceDirsExtractionExecutable :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
+ Ide.Plugin.Cabal.Completion.Completer.Module: sourceDirsExtractionLibrary :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
+ Ide.Plugin.Cabal.Completion.Completer.Module: sourceDirsExtractionTestSuite :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
+ Ide.Plugin.Cabal.Completion.Completer.Simple: constantCompleter :: [Text] -> Completer
+ Ide.Plugin.Cabal.Completion.Completer.Simple: errorNoopCompleter :: Log -> Completer
+ Ide.Plugin.Cabal.Completion.Completer.Simple: mkCompletionItem :: Range -> Text -> Text -> CompletionItem
+ Ide.Plugin.Cabal.Completion.Completer.Simple: mkDefaultCompletionItem :: Text -> CompletionItem
+ Ide.Plugin.Cabal.Completion.Completer.Simple: mkSimpleCompletionItem :: Range -> Text -> CompletionItem
+ Ide.Plugin.Cabal.Completion.Completer.Simple: nameCompleter :: Completer
+ Ide.Plugin.Cabal.Completion.Completer.Simple: noopCompleter :: Completer
+ Ide.Plugin.Cabal.Completion.Completer.Simple: weightedConstantCompleter :: [Text] -> Map Text Double -> Completer
+ Ide.Plugin.Cabal.Completion.Completer.Snippet: snippetCompleter :: Completer
+ Ide.Plugin.Cabal.Completion.Completer.Snippet: snippetMap :: CabalPrefixInfo -> Map TriggerWord Text
+ Ide.Plugin.Cabal.Completion.Completer.Snippet: type TriggerWord = Text
+ Ide.Plugin.Cabal.Completion.Completer.Types: CompleterData :: IO (Maybe GenericPackageDescription) -> CabalPrefixInfo -> Maybe StanzaName -> CompleterData
+ Ide.Plugin.Cabal.Completion.Completer.Types: [cabalPrefixInfo] :: CompleterData -> CabalPrefixInfo
+ Ide.Plugin.Cabal.Completion.Completer.Types: [getLatestGPD] :: CompleterData -> IO (Maybe GenericPackageDescription)
+ Ide.Plugin.Cabal.Completion.Completer.Types: [stanzaName] :: CompleterData -> Maybe StanzaName
+ Ide.Plugin.Cabal.Completion.Completer.Types: data CompleterData
+ Ide.Plugin.Cabal.Completion.Completer.Types: type Completer = Recorder (WithPriority Log) -> CompleterData -> IO [CompletionItem]
+ Ide.Plugin.Cabal.Completion.Completions: contextToCompleter :: Context -> Completer
+ Ide.Plugin.Cabal.Completion.Completions: getCabalPrefixInfo :: FilePath -> PosPrefixInfo -> CabalPrefixInfo
+ Ide.Plugin.Cabal.Completion.Completions: getContext :: MonadIO m => Recorder (WithPriority Log) -> CabalPrefixInfo -> Rope -> MaybeT m Context
+ Ide.Plugin.Cabal.Completion.Data: benchmarkFields :: Map KeyWordName Completer
+ Ide.Plugin.Cabal.Completion.Data: cabalKeywords :: Map KeyWordName Completer
+ Ide.Plugin.Cabal.Completion.Data: cabalVersionKeyword :: Map KeyWordName Completer
+ Ide.Plugin.Cabal.Completion.Data: executableFields :: Map KeyWordName Completer
+ Ide.Plugin.Cabal.Completion.Data: flagFields :: Map KeyWordName Completer
+ Ide.Plugin.Cabal.Completion.Data: foreignLibraryFields :: Map KeyWordName Completer
+ Ide.Plugin.Cabal.Completion.Data: ghcOptions :: [Text]
+ Ide.Plugin.Cabal.Completion.Data: libExecTestBenchCommons :: Map KeyWordName Completer
+ Ide.Plugin.Cabal.Completion.Data: libraryFields :: Map KeyWordName Completer
+ Ide.Plugin.Cabal.Completion.Data: sourceRepositoryFields :: Map KeyWordName Completer
+ Ide.Plugin.Cabal.Completion.Data: stanzaKeywordMap :: Map StanzaType (Map KeyWordName Completer)
+ Ide.Plugin.Cabal.Completion.Data: testSuiteFields :: Map KeyWordName Completer
+ Ide.Plugin.Cabal.Completion.Data: weightedLicenseNames :: Map Text Double
+ Ide.Plugin.Cabal.Completion.Types: CabalPrefixInfo :: Text -> Maybe Apostrophe -> Position -> Range -> FilePath -> Text -> CabalPrefixInfo
+ Ide.Plugin.Cabal.Completion.Types: KeyWord :: KeyWordName -> FieldContext
+ Ide.Plugin.Cabal.Completion.Types: LeftSide :: Apostrophe
+ Ide.Plugin.Cabal.Completion.Types: LogFilePathCompleterIOError :: FilePath -> IOError -> Log
+ Ide.Plugin.Cabal.Completion.Types: LogFileSplitError :: Position -> Log
+ Ide.Plugin.Cabal.Completion.Types: LogMapLookUpOfKnownKeyFailed :: Text -> Log
+ Ide.Plugin.Cabal.Completion.Types: LogUnknownKeyWordInContextError :: KeyWordName -> Log
+ Ide.Plugin.Cabal.Completion.Types: LogUnknownStanzaNameInContextError :: StanzaName -> Log
+ Ide.Plugin.Cabal.Completion.Types: LogUseWithStaleFastNoResult :: Log
+ Ide.Plugin.Cabal.Completion.Types: None :: FieldContext
+ Ide.Plugin.Cabal.Completion.Types: ParseCabal :: ParseCabal
+ Ide.Plugin.Cabal.Completion.Types: Stanza :: StanzaType -> Maybe StanzaName -> StanzaContext
+ Ide.Plugin.Cabal.Completion.Types: Surrounded :: Apostrophe
+ Ide.Plugin.Cabal.Completion.Types: TopLevel :: StanzaContext
+ Ide.Plugin.Cabal.Completion.Types: [completionCursorPosition] :: CabalPrefixInfo -> Position
+ Ide.Plugin.Cabal.Completion.Types: [completionFileName] :: CabalPrefixInfo -> Text
+ Ide.Plugin.Cabal.Completion.Types: [completionPrefix] :: CabalPrefixInfo -> Text
+ Ide.Plugin.Cabal.Completion.Types: [completionRange] :: CabalPrefixInfo -> Range
+ Ide.Plugin.Cabal.Completion.Types: [completionWorkingDir] :: CabalPrefixInfo -> FilePath
+ Ide.Plugin.Cabal.Completion.Types: [isStringNotation] :: CabalPrefixInfo -> Maybe Apostrophe
+ Ide.Plugin.Cabal.Completion.Types: applyStringNotation :: Maybe Apostrophe -> Text -> Text
+ Ide.Plugin.Cabal.Completion.Types: data Apostrophe
+ Ide.Plugin.Cabal.Completion.Types: data CabalPrefixInfo
+ Ide.Plugin.Cabal.Completion.Types: data FieldContext
+ Ide.Plugin.Cabal.Completion.Types: data Log
+ Ide.Plugin.Cabal.Completion.Types: data ParseCabal
+ Ide.Plugin.Cabal.Completion.Types: data StanzaContext
+ Ide.Plugin.Cabal.Completion.Types: instance Control.DeepSeq.NFData Ide.Plugin.Cabal.Completion.Types.ParseCabal
+ Ide.Plugin.Cabal.Completion.Types: instance Data.Hashable.Class.Hashable Ide.Plugin.Cabal.Completion.Types.ParseCabal
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Classes.Eq Ide.Plugin.Cabal.Completion.Types.Apostrophe
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Classes.Eq Ide.Plugin.Cabal.Completion.Types.CabalPrefixInfo
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Classes.Eq Ide.Plugin.Cabal.Completion.Types.FieldContext
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Classes.Eq Ide.Plugin.Cabal.Completion.Types.ParseCabal
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Classes.Eq Ide.Plugin.Cabal.Completion.Types.StanzaContext
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Classes.Ord Ide.Plugin.Cabal.Completion.Types.Apostrophe
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Generics.Generic Ide.Plugin.Cabal.Completion.Types.ParseCabal
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Read.Read Ide.Plugin.Cabal.Completion.Types.FieldContext
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Read.Read Ide.Plugin.Cabal.Completion.Types.StanzaContext
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Show.Show Ide.Plugin.Cabal.Completion.Types.Apostrophe
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Show.Show Ide.Plugin.Cabal.Completion.Types.CabalPrefixInfo
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Show.Show Ide.Plugin.Cabal.Completion.Types.FieldContext
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Show.Show Ide.Plugin.Cabal.Completion.Types.Log
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Show.Show Ide.Plugin.Cabal.Completion.Types.ParseCabal
+ Ide.Plugin.Cabal.Completion.Types: instance GHC.Show.Show Ide.Plugin.Cabal.Completion.Types.StanzaContext
+ Ide.Plugin.Cabal.Completion.Types: instance Prettyprinter.Internal.Pretty Ide.Plugin.Cabal.Completion.Types.Log
+ Ide.Plugin.Cabal.Completion.Types: type Context = (StanzaContext, FieldContext)
+ Ide.Plugin.Cabal.Completion.Types: type KeyWordName = Text
+ Ide.Plugin.Cabal.Completion.Types: type StanzaName = Text
+ Ide.Plugin.Cabal.Completion.Types: type StanzaType = Text
+ Ide.Plugin.Cabal.Diagnostics: [$sel:_codeDescription:Diagnostic] :: Diagnostic -> Maybe CodeDescription
+ Ide.Plugin.Cabal.Diagnostics: [$sel:_data_:Diagnostic] :: Diagnostic -> Maybe Value
+ Ide.Plugin.Cabal.LicenseSuggest: [$sel:_codeDescription:Diagnostic] :: Diagnostic -> Maybe CodeDescription
+ Ide.Plugin.Cabal.LicenseSuggest: [$sel:_data_:Diagnostic] :: Diagnostic -> Maybe Value
+ Ide.Plugin.Cabal.LicenseSuggest: licenseNames :: [Text]
- Ide.Plugin.Cabal.Diagnostics: Diagnostic :: Range -> Maybe DiagnosticSeverity -> Maybe (Int32 |? Text) -> Maybe DiagnosticSource -> Text -> Maybe (List DiagnosticTag) -> Maybe (List DiagnosticRelatedInformation) -> Diagnostic
+ Ide.Plugin.Cabal.Diagnostics: Diagnostic :: Range -> Maybe DiagnosticSeverity -> Maybe (Int32 |? Text) -> Maybe CodeDescription -> Maybe Text -> Text -> Maybe [DiagnosticTag] -> Maybe [DiagnosticRelatedInformation] -> Maybe Value -> Diagnostic
- Ide.Plugin.Cabal.Diagnostics: [$sel:_relatedInformation:Diagnostic] :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
+ Ide.Plugin.Cabal.Diagnostics: [$sel:_relatedInformation:Diagnostic] :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
- Ide.Plugin.Cabal.Diagnostics: [$sel:_source:Diagnostic] :: Diagnostic -> Maybe DiagnosticSource
+ Ide.Plugin.Cabal.Diagnostics: [$sel:_source:Diagnostic] :: Diagnostic -> Maybe Text
- Ide.Plugin.Cabal.Diagnostics: [$sel:_tags:Diagnostic] :: Diagnostic -> Maybe (List DiagnosticTag)
+ Ide.Plugin.Cabal.Diagnostics: [$sel:_tags:Diagnostic] :: Diagnostic -> Maybe [DiagnosticTag]
- Ide.Plugin.Cabal.LicenseSuggest: Diagnostic :: Range -> Maybe DiagnosticSeverity -> Maybe (Int32 |? Text) -> Maybe DiagnosticSource -> Text -> Maybe (List DiagnosticTag) -> Maybe (List DiagnosticRelatedInformation) -> Diagnostic
+ Ide.Plugin.Cabal.LicenseSuggest: Diagnostic :: Range -> Maybe DiagnosticSeverity -> Maybe (Int32 |? Text) -> Maybe CodeDescription -> Maybe Text -> Text -> Maybe [DiagnosticTag] -> Maybe [DiagnosticRelatedInformation] -> Maybe Value -> Diagnostic
- Ide.Plugin.Cabal.LicenseSuggest: [$sel:_relatedInformation:Diagnostic] :: Diagnostic -> Maybe (List DiagnosticRelatedInformation)
+ Ide.Plugin.Cabal.LicenseSuggest: [$sel:_relatedInformation:Diagnostic] :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
- Ide.Plugin.Cabal.LicenseSuggest: [$sel:_source:Diagnostic] :: Diagnostic -> Maybe DiagnosticSource
+ Ide.Plugin.Cabal.LicenseSuggest: [$sel:_source:Diagnostic] :: Diagnostic -> Maybe Text
- Ide.Plugin.Cabal.LicenseSuggest: [$sel:_tags:Diagnostic] :: Diagnostic -> Maybe (List DiagnosticTag)
+ Ide.Plugin.Cabal.LicenseSuggest: [$sel:_tags:Diagnostic] :: Diagnostic -> Maybe [DiagnosticTag]
Files
- hls-cabal-plugin.cabal +33/−20
- src/Ide/Plugin/Cabal.hs +186/−134
- src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs +193/−0
- src/Ide/Plugin/Cabal/Completion/Completer/Module.hs +182/−0
- src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs +138/−0
- src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs +108/−0
- src/Ide/Plugin/Cabal/Completion/Completer/Types.hs +25/−0
- src/Ide/Plugin/Cabal/Completion/Completions.hs +227/−0
- src/Ide/Plugin/Cabal/Completion/Data.hs +261/−0
- src/Ide/Plugin/Cabal/Completion/Types.hs +143/−0
- src/Ide/Plugin/Cabal/Diagnostics.hs +17/−14
- src/Ide/Plugin/Cabal/LicenseSuggest.hs +8/−7
- test/Completer.hs +314/−0
- test/Context.hs +203/−0
- test/Main.hs +160/−131
- test/Utils.hs +48/−0
- test/testdata/exposed.cabal +40/−0
hls-cabal-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hls-cabal-plugin-version: 2.0.0.1+version: 2.1.0.0 synopsis: Cabal integration plugin with Haskell Language Server description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -27,38 +27,41 @@ 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.0.0.1+ , ghcide == 2.1.0.0 , hashable- , hls-plugin-api == 2.0.0.1- , hls-graph == 2.0.0.1- , lsp ^>=1.6.0.0- , lsp-types ^>=1.6.0.0+ , hls-plugin-api == 2.1.0.0+ , hls-graph == 2.1.0.0+ , lens+ , lsp ^>=2.1.0.0+ , lsp-types ^>=2.0.1.0 , regex-tdfa ^>=1.3.1 , stm , text+ , text-rope+ , transformers , unordered-containers >=0.2.10.0-+ , containers hs-source-dirs: src default-language: Haskell2010 @@ -68,14 +71,24 @@ 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.0.0.1+ , hls-test-utils == 2.1.0.0 , lens+ , lsp , lsp-types , tasty-hunit , text+ , text-rope+ , transformers+ , row-types
src/Ide/Plugin/Cabal.hs view
@@ -9,34 +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 Ide.Plugin.Config (Config)+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 Language.LSP.Server (LspM)-import Language.LSP.Types-import qualified Language.LSP.Types as LSP-import qualified Language.LSP.VFS as VFS+import qualified Language.LSP.Protocol.Lens as JL+import qualified Language.LSP.Protocol.Message as LSP+import Language.LSP.Protocol.Types+import Language.LSP.Server (getVirtualFile)+import qualified Language.LSP.VFS as VFS data Log = LogModificationTime NormalizedFilePath FileVersion@@ -46,12 +52,14 @@ | 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)@@ -63,56 +71,65 @@ "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 STextDocumentCodeAction licenseSuggestCodeAction- , pluginNotificationHandlers = mconcat- [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $- \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do- whenUriFile _uri $ \file -> do- log' Debug $ LogDocOpened _uri- addFileOfInterest recorder ide file Modified{firstOpen=True}- restartCabalShakeSession (shakeExtras ide) vfs file "(opened)"-- , mkPluginNotificationHandler LSP.STextDocumentDidChange $- \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do- whenUriFile _uri $ \file -> do- log' Debug $ LogDocModified _uri- addFileOfInterest recorder ide file Modified{firstOpen=False}- restartCabalShakeSession (shakeExtras ide) vfs file "(changed)"-- , mkPluginNotificationHandler LSP.STextDocumentDidSave $- \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do- whenUriFile _uri $ \file -> do- log' Debug $ LogDocSaved _uri- addFileOfInterest recorder ide file OnDisk- restartCabalShakeSession (shakeExtras ide) vfs file "(saved)"+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 - , mkPluginNotificationHandler LSP.STextDocumentDidClose $- \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do- whenUriFile _uri $ \file -> do- log' Debug $ LogDocClosed _uri- deleteFileOfInterest recorder ide file- restartCabalShakeSession (shakeExtras ide) vfs file "(closed)"- ]- }- where- log' = logWith recorder+ whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()+ whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath' - 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. --- | 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.+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]@@ -122,25 +139,19 @@ -- 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 @@ -151,107 +162,148 @@ 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+ where+ log' = logWith recorder --- | This is the kick function for the cabal plugin.--- We run this action, whenever we shake session us run/restarted, which triggers--- actions to produce diagnostics for cabal files.------ It is paramount that this kick-function can be run quickly, since it is a blocking--- function invocation.+{- | This is the kick function for the cabal plugin.+We run this action, whenever we shake session us run/restarted, which triggers+actions to produce diagnostics for cabal files.++It is paramount that this kick-function can be run quickly, since it is a blocking+function invocation.+-} kick :: Action () kick = do files <- HashMap.keys <$> getCabalFilesOfInterestUntracked- void $ uses ParseCabal files+ void $ uses Types.ParseCabal files -- ---------------------------------------------------------------- -- Code Actions -- ---------------------------------------------------------------- -licenseSuggestCodeAction- :: IdeState- -> PluginId- -> CodeActionParams- -> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))-licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List diags}) =- pure $ Right $ List $ diags >>= (fmap InR . (LicenseSuggest.licenseErrorAction uri))+licenseSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction+licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) =+ pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction uri) -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable -- ---------------------------------------------------------------- --- | Cabal files that are currently open in the lsp-client.--- Specific actions happen when these files are saved, closed or modified,--- such as generating diagnostics, re-parsing, etc...------ We need to store the open files to parse them again if we restart the shake session.--- Restarting of the shake session happens whenever these files are modified.+{- | Cabal files that are currently open in the lsp-client.+Specific actions happen when these files are saved, closed or modified,+such as generating diagnostics, re-parsing, etc...++We need to store the open files to parse them again if we restart the shake session.+Restarting of the shake session happens whenever these files are modified.+-} newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus)) instance Shake.IsIdeGlobal OfInterestCabalVar data IsCabalFileOfInterest = IsCabalFileOfInterest- deriving (Eq, Show, Typeable, Generic)+ deriving (Eq, Show, Typeable, Generic) instance Hashable IsCabalFileOfInterest-instance NFData IsCabalFileOfInterest+instance NFData IsCabalFileOfInterest type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus deriving (Eq, Show, Typeable, Generic) instance Hashable CabalFileOfInterestResult-instance NFData CabalFileOfInterestResult+instance NFData CabalFileOfInterestResult --- | The rule that initialises the files of interest state.------ Needs to be run on start-up.+{- | The rule that initialises the files of interest state.++Needs to be run on start-up.+-} ofInterestRules :: Recorder (WithPriority Log) -> Rules () ofInterestRules recorder = do- Shake.addIdeGlobal . OfInterestCabalVar =<< liftIO (newVar HashMap.empty)- Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalFileOfInterest f -> do- alwaysRerun- filesOfInterest <- getCabalFilesOfInterestUntracked- let foi = maybe NotCabalFOI IsCabalFOI $ f `HashMap.lookup` filesOfInterest- fp = summarize foi- res = (Just fp, Just foi)- return res- where- summarize NotCabalFOI = BS.singleton 0- summarize (IsCabalFOI OnDisk) = BS.singleton 1- summarize (IsCabalFOI (Modified False)) = BS.singleton 2- summarize (IsCabalFOI (Modified True)) = BS.singleton 3+ Shake.addIdeGlobal . OfInterestCabalVar =<< liftIO (newVar HashMap.empty)+ Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalFileOfInterest f -> do+ alwaysRerun+ filesOfInterest <- getCabalFilesOfInterestUntracked+ let foi = maybe NotCabalFOI IsCabalFOI $ f `HashMap.lookup` filesOfInterest+ fp = summarize foi+ res = (Just fp, Just foi)+ return res+ where+ summarize NotCabalFOI = BS.singleton 0+ summarize (IsCabalFOI OnDisk) = BS.singleton 1+ summarize (IsCabalFOI (Modified False)) = BS.singleton 2+ summarize (IsCabalFOI (Modified True)) = BS.singleton 3 getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus) getCabalFilesOfInterestUntracked = do- OfInterestCabalVar var <- Shake.getIdeGlobalAction- liftIO $ readVar var+ OfInterestCabalVar var <- Shake.getIdeGlobalAction+ liftIO $ readVar var addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO () addFileOfInterest recorder state f v = do- OfInterestCabalVar var <- Shake.getIdeGlobalState state- (prev, files) <- modifyVar var $ \dict -> do- let (prev, new) = HashMap.alterF (, Just v) f dict- pure (new, (prev, new))- when (prev /= Just v) $ do- join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]- log' Debug $ LogFOI files- where- log' = logWith recorder+ OfInterestCabalVar var <- Shake.getIdeGlobalState state+ (prev, files) <- modifyVar var $ \dict -> do+ let (prev, new) = HashMap.alterF (,Just v) f dict+ pure (new, (prev, new))+ when (prev /= Just v) $ do+ join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]+ log' Debug $ LogFOI files+ where+ log' = logWith recorder deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO () deleteFileOfInterest recorder state f = do- OfInterestCabalVar var <- Shake.getIdeGlobalState state- files <- modifyVar' var $ HashMap.delete f- join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]- log' Debug $ LogFOI files- where- log' = logWith recorder+ OfInterestCabalVar var <- Shake.getIdeGlobalState state+ files <- modifyVar' var $ HashMap.delete f+ join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]+ log' Debug $ LogFOI files+ where+ log' = logWith recorder++-- ----------------------------------------------------------------+-- Completion+-- ----------------------------------------------------------------++completion :: 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
+ src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs view
@@ -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
+ src/Ide/Plugin/Cabal/Completion/Completer/Module.hs view
@@ -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
+ src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs view
@@ -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)
+ src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs view
@@ -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"+ ]+ )+ ]
+ src/Ide/Plugin/Cabal/Completion/Completer/Types.hs view
@@ -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+ }
+ src/Ide/Plugin/Cabal/Completion/Completions.hs view
@@ -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
+ src/Ide/Plugin/Cabal/Completion/Data.hs view
@@ -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
+ src/Ide/Plugin/Cabal/Completion/Types.hs view
@@ -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
src/Ide/Plugin/Cabal/Diagnostics.hs view
@@ -11,29 +11,30 @@ ) where -import qualified Data.Text as T-import Development.IDE (FileDiagnostic,- ShowDiagnostic (ShowDiag))-import Distribution.Fields (showPError, showPWarning)-import qualified Ide.Plugin.Cabal.Parse as Lib-import Ide.PluginUtils (extendNextLine)-import Language.LSP.Types (Diagnostic (..),- DiagnosticSeverity (..),- DiagnosticSource, NormalizedFilePath,- Position (Position), Range (Range),- fromNormalizedFilePath)+import qualified Data.Text as T+import Development.IDE (FileDiagnostic,+ ShowDiagnostic (ShowDiag))+import Distribution.Fields (showPError, showPWarning)+import qualified Ide.Plugin.Cabal.Parse as Lib+import Ide.PluginUtils (extendNextLine)+import Language.LSP.Protocol.Types (Diagnostic (..),+ DiagnosticSeverity (..),+ NormalizedFilePath,+ Position (Position),+ Range (Range),+ fromNormalizedFilePath) -- | Produce a diagnostic from a Cabal parser error errorDiagnostic :: NormalizedFilePath -> Lib.PError -> FileDiagnostic errorDiagnostic fp err@(Lib.PError pos _) =- mkDiag fp "cabal" DsError (toBeginningOfNextLine pos) msg+ mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine pos) msg where msg = T.pack $ showPError (fromNormalizedFilePath fp) err -- | Produce a diagnostic from a Cabal parser warning warningDiagnostic :: NormalizedFilePath -> Lib.PWarning -> FileDiagnostic warningDiagnostic fp warning@(Lib.PWarning _ pos _) =- mkDiag fp "cabal" DsWarning (toBeginningOfNextLine pos) msg+ mkDiag fp "cabal" DiagnosticSeverity_Warning (toBeginningOfNextLine pos) msg where msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning @@ -64,7 +65,7 @@ mkDiag :: NormalizedFilePath -- ^ Cabal file path- -> DiagnosticSource+ -> T.Text -- ^ Where does the diagnostic come from? -> DiagnosticSeverity -- ^ Severity@@ -82,4 +83,6 @@ , _code = Nothing , _tags = Nothing , _relatedInformation = Nothing+ , _codeDescription = Nothing+ , _data_ = Nothing }
src/Ide/Plugin/Cabal/LicenseSuggest.hs view
@@ -6,17 +6,18 @@ module Ide.Plugin.Cabal.LicenseSuggest ( licenseErrorSuggestion , licenseErrorAction+, licenseNames -- * Re-exports , T.Text , Diagnostic(..) ) where -import qualified Data.HashMap.Strict as Map+import qualified Data.Map as Map import qualified Data.Text as T-import Language.LSP.Types (CodeAction (CodeAction),- CodeActionKind (CodeActionQuickFix),- Diagnostic (..), List (List),+import Language.LSP.Protocol.Types (CodeAction (CodeAction),+ CodeActionKind (CodeActionKind_QuickFix),+ Diagnostic (..), Position (Position), Range (Range), TextEdit (TextEdit), Uri,@@ -54,8 +55,8 @@ -- We must also add a newline character to the replacement since the range returned by -- 'Ide.Plugin.Cabal.Diag.errorDiagnostic' ends at the beginning of the following line. tedit = [TextEdit (adjustRange $ _range diag) (suggestion <> "\n")]- edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing- in CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing+ edit = WorkspaceEdit (Just $ Map.singleton uri tedit) Nothing Nothing+ in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing (Just edit) Nothing Nothing -- | License name of every license supported by cabal licenseNames :: [T.Text]@@ -77,7 +78,7 @@ 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
+ test/Completer.hs view
@@ -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 ""
+ test/Context.hs view
@@ -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"+ ]
test/Main.hs view
@@ -1,34 +1,42 @@-{-# 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) import qualified Ide.Plugin.Cabal.Parse as Lib-import qualified Language.LSP.Types.Lens as J+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@@ -36,136 +44,157 @@ 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?" @?= [],-- testCase "BSD-3-Clause" $ do- take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?")- @?= [("BSD3","BSD-3-Clause"),("BSD3","BSD-3-Clause-LBNL")],-- testCase "MiT" $ do- -- contains no suggestion- take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'MiT'")- @?= [("MiT","MIT"),("MiT","MIT-0")]- ]+codeActionUnitTests =+ testGroup+ "Code Action Tests"+ [ testCase "Unknown format" $ do+ -- the message has the wrong format+ licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= []+ , testCase "BSD-3-Clause" $ do+ take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?")+ @?= [("BSD3", "BSD-3-Clause"), ("BSD3", "BSD-3-Clause-LBNL")]+ , testCase "MiT" $ do+ -- contains no suggestion+ take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'MiT'")+ @?= [("MiT", "MIT"), ("MiT", "MIT-0")]+ ] --- ------------------------------------------------------------------------+-- ------------------------ ------------------------------------------------ -- Integration Tests -- ------------------------------------------------------------------------ pluginTests :: TestTree-pluginTests = testGroup "Plugin Tests"- [ testGroup "Diagnostics"- [ runCabalTestCaseSession "Publishes Diagnostics on Error" "" $ do- doc <- openDoc "invalid.cabal" "cabal"- diags <- waitForDiagnosticsFromSource doc "cabal"- unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]- liftIO $ do- length diags @?= 1- unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0)- unknownLicenseDiag ^. J.severity @?= Just DsError- , runCabalTestCaseSession "Clears diagnostics" "" $ do- doc <- openDoc "invalid.cabal" "cabal"- diags <- waitForDiagnosticsFrom doc- unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]- liftIO $ do- length diags @?= 1- unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0)- unknownLicenseDiag ^. J.severity @?= Just DsError- _ <- applyEdit doc $ TextEdit (Range (Position 3 20) (Position 4 0)) "BSD-3-Clause\n"- newDiags <- waitForDiagnosticsFrom doc- liftIO $ newDiags @?= []- , runCabalTestCaseSession "No Diagnostics in .hs files from valid .cabal file" "simple-cabal" $ do- hsDoc <- openDoc "A.hs" "haskell"- expectNoMoreDiagnostics 1 hsDoc "typechecking"- cabalDoc <- openDoc "simple-cabal.cabal" "cabal"- expectNoMoreDiagnostics 1 cabalDoc "parsing"- , ignoreTestBecause "Testcase is flaky for certain GHC versions (e.g. 9.2.5). See #3333 for details." $ do- runCabalTestCaseSession "Diagnostics in .hs files from invalid .cabal file" "simple-cabal" $ do- hsDoc <- openDoc "A.hs" "haskell"- expectNoMoreDiagnostics 1 hsDoc "typechecking"- cabalDoc <- openDoc "simple-cabal.cabal" "cabal"- expectNoMoreDiagnostics 1 cabalDoc "parsing"- let theRange = Range (Position 3 20) (Position 3 23)- -- Invalid license- changeDoc cabalDoc [TextDocumentContentChangeEvent (Just theRange) Nothing "MIT3"]- cabalDiags <- waitForDiagnosticsFrom cabalDoc- unknownLicenseDiag <- liftIO $ inspectDiagnostic cabalDiags ["Unknown SPDX license identifier: 'MIT3'"]- expectNoMoreDiagnostics 1 hsDoc "typechecking"- liftIO $ do- length cabalDiags @?= 1- unknownLicenseDiag ^. J.range @?= Range (Position 3 24) (Position 4 0)- unknownLicenseDiag ^. J.severity @?= Just DsError- ]- , testGroup "Code Actions"- [ runCabalTestCaseSession "BSD-3" "" $ do- doc <- openDoc "licenseCodeAction.cabal" "cabal"- diags <- waitForDiagnosticsFromSource doc "cabal"- reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]- liftIO $ do- length diags @?= 1- reduceDiag ^. J.range @?= Range (Position 3 24) (Position 4 0)- reduceDiag ^. J.severity @?= Just DsError- [codeAction] <- getLicenseAction "BSD-3-Clause" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0))- executeCodeAction codeAction- contents <- documentContents doc- liftIO $ contents @?= Text.unlines- [ "cabal-version: 3.0"- , "name: licenseCodeAction"- , "version: 0.1.0.0"- , "license: BSD-3-Clause"- , ""- , "library"- , " build-depends: base"- , " default-language: Haskell2010"- ]- , runCabalTestCaseSession "Apache-2.0" "" $ do- doc <- openDoc "licenseCodeAction2.cabal" "cabal"- diags <- waitForDiagnosticsFromSource doc "cabal"- -- test if it supports typos in license name, here 'apahe'- reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'APAHE'"]- liftIO $ do- length diags @?= 1- reduceDiag ^. J.range @?= Range (Position 3 25) (Position 4 0)- reduceDiag ^. J.severity @?= Just DsError- [codeAction] <- getLicenseAction "Apache-2.0" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0))- executeCodeAction codeAction- contents <- documentContents doc- liftIO $ contents @?= Text.unlines- [ "cabal-version: 3.0"- , "name: licenseCodeAction2"- , "version: 0.1.0.0"- , "license: Apache-2.0"- , ""- , "library"- , " build-depends: base"- , " default-language: Haskell2010"- ]- ]- ]+pluginTests =+ testGroup+ "Plugin Tests"+ [ testGroup+ "Diagnostics"+ [ runCabalTestCaseSession "Publishes Diagnostics on Error" "" $ do+ doc <- openDoc "invalid.cabal" "cabal"+ diags <- waitForDiagnosticsFromSource doc "cabal"+ unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]+ liftIO $ do+ length diags @?= 1+ unknownLicenseDiag ^. 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
+ test/Utils.hs view
@@ -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
+ test/testdata/exposed.cabal view
@@ -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: