packages feed

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 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: