diff --git a/.gitignore b/.gitignore
index 2413a1fcf5..0e23fac134 100644
--- a/.gitignore
+++ b/.gitignore
@@ -51,3 +51,6 @@ store/
gh-release-artifacts/
.hls/
+
+# local cabal package
+vendor/parse-cabal-project
diff --git a/.gitmodules b/.gitmodules
index 7856aaec36..49b0b3c940 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -8,3 +8,7 @@
# Commit git commit -m "Removed submodule <name>"
# Delete the now untracked submodule files
# rm -rf path_to_submodule
+
+[submodule "vendor/cabal"]
+ path = vendor/cabal
+ url = https://github.com/rm41339/cabal.git
diff --git a/cabal.project b/cabal.project
index a795f0126b..0315ff65a8 100644
--- a/cabal.project
+++ b/cabal.project
@@ -6,7 +6,16 @@ packages:
./ghcide
./hls-plugin-api
./hls-test-utils
+ ./vendor/cabal/Cabal
+ ./vendor/cabal/Cabal-syntax
+ ./vendor/cabal/cabal-install
+ ./vendor/cabal/cabal-install-solver
+ ./vendor/cabal/Cabal-described
+ ./vendor/cabal/Cabal-tree-diff
+package cabal-install
+ tests: False
+ benchmarks: False
index-state: 2025-05-12T13:26:29Z
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
index 157f5703f2..d85b367ae2 100644
--- a/haskell-language-server.cabal
+++ b/haskell-language-server.cabal
@@ -317,6 +317,86 @@ test-suite hls-cabal-plugin-tests
, text
, hls-plugin-api
+-----------------------------
+-- cabal project plugin
+-----------------------------
+
+flag cabalProject
+ description: Enable cabalProject plugin
+ default: True
+ manual: True
+
+common cabalProject
+ if flag(cabalProject)
+ build-depends: haskell-language-server:hls-cabal-project-plugin
+ cpp-options: -Dhls_cabal_project
+
+library hls-cabal-project-plugin
+ import: defaults, pedantic, warnings
+ if !flag(cabalProject)
+ buildable: False
+ exposed-modules:
+ Ide.Plugin.CabalProject
+ Ide.Plugin.CabalProject.Parse
+ Ide.Plugin.CabalProject.Diagnostics
+ Ide.Plugin.CabalProject.Types
+
+ build-depends:
+ , bytestring
+ , Cabal-syntax >= 3.7
+ , containers
+ , deepseq
+ , directory
+ , filepath
+ , extra >=1.7.4
+ , ghcide == 2.11.0.0
+ , hashable
+ , hls-plugin-api == 2.11.0.0
+ , hls-graph == 2.11.0.0
+ , lens
+ , lsp ^>=2.7
+ , lsp-types ^>=2.3
+ , regex-tdfa ^>=1.3.1
+ , text
+ , text-rope
+ , transformers
+ , unordered-containers >=0.2.10.0
+ , containers
+ , process
+ , aeson
+ , Cabal
+ , pretty
+ , cabal-install
+ , cabal-install-solver
+ , haskell-language-server:hls-cabal-plugin
+ , base16-bytestring
+ , cryptohash-sha1
+
+ hs-source-dirs: plugins/hls-cabal-project-plugin/src
+
+test-suite hls-cabal-project-plugin-tests
+ import: defaults, pedantic, test-defaults, warnings
+ if !flag(cabalProject)
+ buildable: False
+ type: exitcode-stdio-1.0
+ hs-source-dirs: plugins/hls-cabal-project-plugin/test
+ main-is: Main.hs
+ other-modules:
+ Utils
+ build-depends:
+ , bytestring
+ , Cabal-syntax >= 3.7
+ , extra
+ , filepath
+ , ghcide
+ , haskell-language-server:hls-cabal-project-plugin
+ , hls-test-utils == 2.11.0.0
+ , lens
+ , lsp-types
+ , text
+ , hls-plugin-api
+ , cabal-install
+
-----------------------------
-- class plugin
-----------------------------
@@ -1830,6 +1910,7 @@ library
, pedantic
-- plugins
, cabal
+ , cabalProject
, callHierarchy
, cabalfmt
, cabalgild
diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs
index 3a06656a77..6e7dd7102f 100644
--- a/hls-plugin-api/src/Ide/Types.hs
+++ b/hls-plugin-api/src/Ide/Types.hs
@@ -14,7 +14,7 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Ide.Types
-( PluginDescriptor(..), defaultPluginDescriptor, defaultCabalPluginDescriptor
+( PluginDescriptor(..), defaultPluginDescriptor, defaultCabalPluginDescriptor, defaultCabalProjectPluginDescriptor
, defaultPluginPriority
, describePlugin
, IdeCommand(..)
@@ -1077,6 +1077,21 @@ defaultCabalPluginDescriptor plId desc =
Nothing
[".cabal"]
+defaultCabalProjectPluginDescriptor :: PluginId -> T.Text -> PluginDescriptor ideState
+defaultCabalProjectPluginDescriptor plId desc =
+ PluginDescriptor
+ plId
+ desc
+ defaultPluginPriority
+ mempty
+ mempty
+ mempty
+ defaultConfigDescriptor
+ mempty
+ mempty
+ Nothing
+ [".project"]
+
newtype CommandId = CommandId T.Text
deriving (Show, Read, Eq, Ord)
instance IsString CommandId where
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs
index 5429ac0bb9..3650ac5a25 100644
--- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs
+++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs
@@ -5,6 +5,8 @@ module Ide.Plugin.Cabal.Diagnostics
, warningDiagnostic
, positionFromCabalPosition
, fatalParseErrorDiagnostic
+, toBeginningOfNextLine
+, mkDiag
-- * Re-exports
, FileDiagnostic
, Diagnostic(..)
diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs
new file mode 100644
index 0000000000..3ff1bccb68
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs
@@ -0,0 +1,271 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Ide.Plugin.CabalProject where
+
+import Control.Concurrent.Strict
+import Control.DeepSeq
+import Control.Monad.Extra
+import Control.Monad.IO.Class
+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 Data.Proxy
+import qualified Data.Text ()
+import qualified Data.Text.Encoding as Encoding
+import Data.Text.Utf16.Rope.Mixed as Rope
+import Development.IDE as D
+import Development.IDE.Core.Shake (restartShakeSession)
+import qualified Development.IDE.Core.Shake as Shake
+import Development.IDE.Graph (Key, alwaysRerun)
+import Development.IDE.Types.Shake (toKey)
+import GHC.Generics
+import Ide.Plugin.Cabal.Orphans ()
+import Ide.Plugin.CabalProject.Diagnostics as Diagnostics
+import Ide.Plugin.CabalProject.Parse as Parse
+import Ide.Plugin.CabalProject.Types as Types
+import Ide.Types
+import qualified Language.LSP.Protocol.Message as LSP
+import Language.LSP.Protocol.Types
+import qualified Language.LSP.VFS as VFS
+
+data Log
+ = LogModificationTime NormalizedFilePath FileVersion
+ | LogShake Shake.Log
+ | LogDocOpened Uri
+ | LogDocModified Uri
+ | LogDocSaved Uri
+ | LogDocClosed Uri
+ | LogFOI (HashMap NormalizedFilePath FileOfInterestStatus)
+ deriving (Show)
+
+instance Pretty Log where
+ pretty = \case
+ LogShake log' -> pretty log'
+ LogModificationTime nfp modTime ->
+ "Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime)
+ LogDocOpened uri ->
+ "Opened text document:" <+> pretty (getUri uri)
+ LogDocModified uri ->
+ "Modified text document:" <+> pretty (getUri uri)
+ LogDocSaved uri ->
+ "Saved text document:" <+> pretty (getUri uri)
+ LogDocClosed uri ->
+ "Closed text document:" <+> pretty (getUri uri)
+ LogFOI files ->
+ "Set files of interest to:" <+> viaShow files
+
+descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
+descriptor recorder plId =
+ (defaultCabalProjectPluginDescriptor plId "Provides a variety of IDE features in cabal.project files")
+ { pluginRules = cabalProjectRules recorder plId
+ , pluginHandlers =
+ mconcat
+ []
+ , pluginNotificationHandlers =
+ mconcat
+ [ mkPluginNotificationHandler LSP.SMethod_TextDocumentDidOpen $
+ \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do
+ whenUriFile _uri $ \file -> do
+ log' Debug $ LogDocOpened _uri
+ restartCabalProjectShakeSession (shakeExtras ide) vfs file "(opened)" $
+ addFileOfInterest recorder ide file Modified{firstOpen = True}
+ , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $
+ \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do
+ whenUriFile _uri $ \file-> do
+ log' Debug $ LogDocModified _uri
+ restartCabalProjectShakeSession (shakeExtras ide) vfs file "(changed)" $
+ addFileOfInterest recorder ide file Modified{firstOpen = False}
+ , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $
+ \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
+ whenUriFile _uri $ \file -> do
+ log' Debug $ LogDocSaved _uri
+ restartCabalProjectShakeSession (shakeExtras ide) vfs file "(saved)" $
+ addFileOfInterest recorder ide file OnDisk
+ , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $
+ \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
+ whenUriFile _uri $ \file -> do
+ log' Debug $ LogDocClosed _uri
+ restartCabalProjectShakeSession (shakeExtras ide) vfs file "(closed)" $
+ deleteFileOfInterest recorder ide file
+ ]
+ , pluginConfigDescriptor = defaultConfigDescriptor
+ { configHasDiagnostics = True
+ }
+ }
+ where
+ log' = logWith recorder
+
+ whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
+ whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath'
+
+{- | Helper function to restart the shake session, specifically for modifying cabal.project 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.
+-}
+restartCabalProjectShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO ()
+restartCabalProjectShakeSession shakeExtras vfs file actionMsg actionBetweenSession = do
+ restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do
+ keys <- actionBetweenSession
+ return (toKey GetModificationTime file:keys)
+
+
+cabalProjectRules :: Recorder (WithPriority Log) -> PluginId -> Rules ()
+cabalProjectRules recorder plId = do
+ -- Make sure we initialise the cabal project files-of-interest.
+ ofInterestRules recorder
+ -- Rule to produce diagnostics for cabal project files.
+ define (cmapWithPrio LogShake recorder) $ \ParseCabalProjectFields file -> do
+ config <- getPluginConfigAction plId
+ if not (plcGlobalOn config && plcDiagnosticsOn config)
+ then pure ([], Nothing)
+ else 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, mCabalProjectSource) <- use_ GetFileContents file
+ log' Debug $ LogModificationTime file t
+ contents <- case mCabalProjectSource of
+ Just sources ->
+ pure $ Encoding.encodeUtf8 $ Rope.toText sources
+ Nothing -> do
+ liftIO $ BS.readFile $ fromNormalizedFilePath file
+
+ case Parse.readCabalProjectFields file contents of
+ Left _ ->
+ pure ([], Nothing)
+ Right fields ->
+ pure ([], Just fields)
+
+ define (cmapWithPrio LogShake recorder) $ \ParseCabalProjectFile file -> do
+ cfg <- getPluginConfigAction plId
+ if not (plcGlobalOn cfg && plcDiagnosticsOn cfg)
+ then pure ([], Nothing)
+ else 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, mCabalProjectSource) <- use_ GetFileContents file
+ log' Debug $ LogModificationTime file t
+
+ contents <- case mCabalProjectSource of
+ Just sources ->
+ pure $ Encoding.encodeUtf8 $ Rope.toText sources
+ Nothing ->
+ liftIO $ BS.readFile $ fromNormalizedFilePath file
+
+ (pWarnings, pResult) <- liftIO $ Parse.parseCabalProjectFileContents (fromNormalizedFilePath file) contents
+ let warnDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
+
+ case pResult of
+ Left (_specVer, pErrNE) -> do
+ let errDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrNE
+ pure (errDiags ++ warnDiags, Nothing)
+
+ Right projCfg -> do
+ pure (warnDiags, Just projCfg)
+
+ action $ do
+ -- Run the cabal project kick. This code always runs when 'shakeRestart' is run.
+ -- Must be careful to not impede the performance too much. Crucial to
+ -- a snappy IDE experience.
+ kick
+ where
+ log' = logWith recorder
+
+{- | This is the kick function for the cabal project plugin.
+We run this action, whenever we shake session us run/restarted, which triggers
+actions to produce diagnostics for cabal project 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 <$> getCabalProjectFilesOfInterestUntracked
+ Shake.runWithSignal (Proxy @"kick/start/cabal-project") (Proxy @"kick/done/cabal-project") files Types.ParseCabalProjectFile
+
+
+-- ----------------------------------------------------------------
+-- Cabal project file of Interest rules and global variable
+-- ----------------------------------------------------------------
+
+{- | Cabal project 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 OfInterestCabalProjectVar = OfInterestCabalProjectVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
+
+instance Shake.IsIdeGlobal OfInterestCabalProjectVar
+
+data IsCabalProjectFileOfInterest = IsCabalProjectFileOfInterest
+ deriving (Eq, Show, Generic)
+instance Hashable IsCabalProjectFileOfInterest
+instance NFData IsCabalProjectFileOfInterest
+
+type instance RuleResult IsCabalProjectFileOfInterest = CabalProjectFileOfInterestResult
+
+data CabalProjectFileOfInterestResult = NotCabalProjectFOI | IsCabalProjectFOI FileOfInterestStatus
+ deriving (Eq, Show, Generic)
+instance Hashable CabalProjectFileOfInterestResult
+instance NFData CabalProjectFileOfInterestResult
+
+{- | 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 . OfInterestCabalProjectVar =<< liftIO (newVar HashMap.empty)
+ Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalProjectFileOfInterest f -> do
+ alwaysRerun
+ filesOfInterest <- getCabalProjectFilesOfInterestUntracked
+ let foi = maybe NotCabalProjectFOI IsCabalProjectFOI $ f `HashMap.lookup` filesOfInterest
+ fp = summarize foi
+ res = (Just fp, Just foi)
+ return res
+ where
+ summarize NotCabalProjectFOI = BS.singleton 0
+ summarize (IsCabalProjectFOI OnDisk) = BS.singleton 1
+ summarize (IsCabalProjectFOI (Modified False)) = BS.singleton 2
+ summarize (IsCabalProjectFOI (Modified True)) = BS.singleton 3
+
+getCabalProjectFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
+getCabalProjectFilesOfInterestUntracked = do
+ OfInterestCabalProjectVar var <- Shake.getIdeGlobalAction
+ liftIO $ readVar var
+
+addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key]
+addFileOfInterest recorder state f v = do
+ OfInterestCabalProjectVar var <- Shake.getIdeGlobalState state
+ (prev, files) <- modifyVar var $ \dict -> do
+ let (prev, new) = HashMap.alterF (,Just v) f dict
+ pure (new, (prev, new))
+ if prev /= Just v
+ then do
+ log' Debug $ LogFOI files
+ return [toKey IsCabalProjectFileOfInterest f]
+ else return []
+ where
+ log' = logWith recorder
+
+deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO [Key]
+deleteFileOfInterest recorder state f = do
+ OfInterestCabalProjectVar var <- Shake.getIdeGlobalState state
+ files <- modifyVar' var $ HashMap.delete f
+ log' Debug $ LogFOI files
+ return [toKey IsFileOfInterest f]
+ where
+ log' = logWith recorder
diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs
new file mode 100644
index 0000000000..8eda8c80aa
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Ide.Plugin.CabalProject.Diagnostics
+( errorDiagnostic
+, warningDiagnostic
+, positionFromCabalPosition
+, fatalParseErrorDiagnostic
+ -- * Re-exports
+, FileDiagnostic
+, Diagnostic(..)
+)
+where
+
+import qualified Data.Text as T
+import Development.IDE (FileDiagnostic)
+import qualified Distribution.Parsec as Syntax
+import Distribution.Parsec.Error (showPError)
+import Distribution.Parsec.Warning (showPWarning)
+import Ide.Plugin.Cabal.Diagnostics (mkDiag,
+ positionFromCabalPosition,
+ toBeginningOfNextLine)
+import Language.LSP.Protocol.Types (Diagnostic (..),
+ DiagnosticSeverity (..),
+ NormalizedFilePath,
+ fromNormalizedFilePath)
+
+-- | Produce a diagnostic for a fatal Cabal Project parser error.
+fatalParseErrorDiagnostic :: NormalizedFilePath -> T.Text -> FileDiagnostic
+fatalParseErrorDiagnostic fp msg =
+ mkDiag fp "cabal-project" DiagnosticSeverity_Error (toBeginningOfNextLine Syntax.zeroPos) msg
+
+-- | Produce a diagnostic from a Cabal Project parser error
+errorDiagnostic :: NormalizedFilePath -> Syntax.PError -> FileDiagnostic
+errorDiagnostic fp err@(Syntax.PError pos _) =
+ mkDiag fp "cabal-project" DiagnosticSeverity_Error (toBeginningOfNextLine pos) msg
+ where
+ msg = T.pack $ showPError (fromNormalizedFilePath fp) err
+
+-- | Produce a diagnostic from a Cabal Project parser warning
+warningDiagnostic :: NormalizedFilePath -> Syntax.PWarning -> FileDiagnostic
+warningDiagnostic fp warning@(Syntax.PWarning _ pos _) =
+ mkDiag fp "cabal-project" DiagnosticSeverity_Warning (toBeginningOfNextLine pos) msg
+ where
+ msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning
diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs
new file mode 100644
index 0000000000..674e3887ff
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Ide.Plugin.CabalProject.Parse
+ ( parseCabalProjectFileContents,
+ readCabalProjectFields
+ ) where
+
+import qualified Crypto.Hash.SHA1 as H
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as B16
+import qualified Data.ByteString.Char8 as B
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Text as T
+import Development.IDE
+import Distribution.Client.HttpUtils (configureTransport)
+import Distribution.Client.ProjectConfig.Parsec (ProjectConfigSkeleton,
+ parseProject,
+ readPreprocessFields)
+import Distribution.Client.ProjectConfig.Types (ProjectConfigToParse (..))
+import Distribution.Fields (PError (..),
+ PWarning (..))
+import qualified Distribution.Fields.Parser as Syntax
+import qualified Distribution.Fields.ParseResult as PR
+import qualified Distribution.Parsec.Position as Syntax
+import Distribution.Types.Version (Version)
+import Distribution.Verbosity (normal)
+import qualified Ide.Plugin.CabalProject.Diagnostics as Diagnostics
+import System.Directory.Extra (XdgDirectory (..),
+ getXdgDirectory)
+import System.FilePath (takeBaseName,
+ takeDirectory, (</>))
+
+parseCabalProjectFileContents
+ :: FilePath
+ -> BS.ByteString
+ -> IO ([PWarning]
+ , Either (Maybe Version, NonEmpty PError) ProjectConfigSkeleton)
+parseCabalProjectFileContents fp bytes = do
+ cacheDir <- getCabalProjectCacheDir fp
+ let toParse = ProjectConfigToParse bytes
+ verb = normal
+ httpTransport <- configureTransport verb [fp] Nothing
+
+ parseRes :: PR.ParseResult ProjectConfigSkeleton
+ <- parseProject fp cacheDir httpTransport verb toParse
+
+ pure (PR.runParseResult parseRes)
+
+readCabalProjectFields
+ :: NormalizedFilePath
+ -> BS.ByteString
+ -> Either FileDiagnostic [Syntax.Field Syntax.Position]
+readCabalProjectFields file contents =
+ case PR.runParseResult (readPreprocessFields contents) of
+ (_warnings, Left (_mbVer, errs)) ->
+ let perr = NE.head errs
+ in Left $
+ Diagnostics.fatalParseErrorDiagnostic file
+ ("Failed to parse cabal.project file: " <> T.pack (show perr))
+
+ (_warnings, Right fields) ->
+ Right fields
+
+getCabalProjectCacheDir :: FilePath -> IO FilePath
+getCabalProjectCacheDir fp = do
+ getXdgDirectory XdgCache (cacheDir </> prefix ++ "-" ++ opts_hash)
+ where
+ prefix = takeBaseName $ takeDirectory fp
+ -- Create a unique folder per cabal.project file
+ opts_hash = B.unpack $ B16.encode $ H.finalize $ H.updates H.init [B.pack fp]
+
+cacheDir :: String
+cacheDir = "ghcide"
diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Types.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Types.hs
new file mode 100644
index 0000000000..8e91db085d
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Types.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module Ide.Plugin.CabalProject.Types where
+
+import Control.DeepSeq (NFData)
+import Data.Hashable (Hashable)
+import Development.IDE (RuleResult)
+import Distribution.Client.ProjectConfig.Parsec (ProjectConfigSkeleton)
+import qualified Distribution.Fields as Syntax
+import qualified Distribution.Parsec.Position as Syntax
+import GHC.Generics (Generic)
+
+type instance RuleResult ParseCabalProjectFile = ProjectConfigSkeleton
+
+data ParseCabalProjectFile = ParseCabalProjectFile
+ deriving (Eq, Show, Generic)
+
+instance Hashable ParseCabalProjectFile
+
+instance NFData ParseCabalProjectFile
+
+type instance RuleResult ParseCabalProjectFields = [Syntax.Field Syntax.Position]
+
+data ParseCabalProjectFields = ParseCabalProjectFields
+ deriving (Eq, Show, Generic)
+
+instance Hashable ParseCabalProjectFields
+
+instance NFData ParseCabalProjectFields
+
diff --git a/plugins/hls-cabal-project-plugin/test/Main.hs b/plugins/hls-cabal-project-plugin/test/Main.hs
new file mode 100644
index 0000000000..b1ef14336a
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/test/Main.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main (
+ main,
+) where
+
+import qualified Control.Exception as E
+import Control.Lens ((^.))
+import Control.Lens.Fold ((^?))
+import Control.Monad (guard)
+import qualified Data.ByteString as BS
+import Data.ByteString.Char8 (pack)
+import Data.Either (isRight)
+import Data.List.Extra (nubOrdOn)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Maybe as Maybe
+import qualified Data.Text as T
+import Distribution.Client.ProjectConfig.Parsec (ProjectConfigSkeleton)
+import Distribution.Fields (PError (..),
+ PWarning (..))
+import Distribution.Types.Version (Version)
+import qualified Ide.Plugin.CabalProject.Parse as Lib
+import qualified Language.LSP.Protocol.Lens as L
+import System.FilePath
+import Test.Hls
+import Utils
+
+
+main :: IO ()
+main = do
+ defaultTestRunner $
+ testGroup
+ "Cabal Plugin Tests"
+ [ unitTests
+ , pluginTests
+ ]
+
+-- ------------------------------------------------------------------------
+-- Unit Tests
+-- ------------------------------------------------------------------------
+
+unitTests :: TestTree
+unitTests =
+ testGroup
+ "Unit Tests"
+ [ cabalProjectParserUnitTests
+ ]
+
+cabalProjectParserUnitTests :: TestTree
+cabalProjectParserUnitTests =
+ testGroup
+ "Parsing Cabal Project"
+ [ testCase "Simple Parsing works" $ do
+ let fp = testDataDir </> "cabal.project"
+ bytes <- BS.readFile fp
+ (warnings, pm) <- Lib.parseCabalProjectFileContents fp bytes
+ liftIO $ do
+ null warnings @? "Found unexpected warnings"
+ isRight pm @? "Failed to parse base cabal.project file"
+ , testCase "Correct root directory" $ do
+ let root = testDataDir </> "root-directory"
+ let cabalFp = root </> "cabal.project"
+ bytes <- BS.readFile cabalFp
+ result <- E.try @E.IOException (Lib.parseCabalProjectFileContents cabalFp bytes)
+ :: IO ( Either
+ E.IOException
+ ( [PWarning]
+ , Either (Maybe Version, NonEmpty PError)
+ ProjectConfigSkeleton
+ )
+ )
+ case result of
+ Left err ->
+ let errStr = show err
+ in (pack root `BS.isInfixOf` pack errStr)
+ @? ("Expected missing file error to mention the test-dir:\n"
+ ++ " " ++ root ++ "\n"
+ ++ "but got:\n" ++ errStr)
+ Right _ ->
+ False @? "Expected parse to fail (missing import), but it succeeded"
+ ]
+
+-- ------------------------ ------------------------------------------------
+-- Integration Tests
+-- ------------------------------------------------------------------------
+
+pluginTests :: TestTree
+pluginTests =
+ testGroup
+ "Plugin Tests"
+ [ testGroup
+ "Diagnostics"
+ [ runCabalProjectTestCaseSession "Publishes Diagnostics on Error" "invalid-cabal-project" $ do
+ _ <- openDoc "cabal.project" "cabal-project"
+ diags <- cabalProjectCaptureKick
+ unexpectedErrorDiag <- liftIO $ inspectDiagnostic diags ["unexpected 'f'"]
+ liftIO $ do
+ length diags @?= 1
+ unexpectedErrorDiag ^. L.range @?= Range (Position 2 6) (Position 3 0)
+ unexpectedErrorDiag ^. L.severity @?= Just DiagnosticSeverity_Error
+ , runCabalProjectTestCaseSession "Publishes Diagnostics on misspelled packages as Warning" "warning-cabal-project" $ do
+ _ <- openDoc "cabal.project" "cabal-project"
+ diags <- cabalProjectCaptureKick
+ stanzaWarningDiag <- liftIO $ inspectDiagnosticAny diags ["'\"package\"' is a stanza, not a field. Remove the trailing ':' to parse a stanza."]
+ liftIO $ do
+ length diags @?= 1
+ stanzaWarningDiag ^. L.range @?= Range (Position 0 0) (Position 1 0)
+ stanzaWarningDiag ^. L.severity @?= Just DiagnosticSeverity_Warning
+ , runCabalProjectTestCaseSession "Clears diagnostics" "invalid-cabal-project" $ do
+ doc <- openDoc "cabal.project" "cabal-project"
+ diags <- cabalProjectCaptureKick
+ unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["unexpected 'f'"]
+ liftIO $ do
+ length diags @?= 1
+ unknownLicenseDiag ^. L.range @?= Range (Position 2 6) (Position 3 0)
+ unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error
+ _ <- applyEdit doc $ TextEdit (Range (Position 2 6) (Position 3 0)) " -foo"
+ newDiags <- cabalProjectCaptureKick
+ liftIO $ newDiags @?= []
+ , runCabalProjectTestCaseSession "No Diagnostics in .hs files from valid cabal.project file" "simple-cabal-project" $ do
+ hsDoc <- openDoc "A.hs" "haskell"
+ expectNoMoreDiagnostics 1 hsDoc "typechecking"
+ cabalDoc <- openDoc "cabal.project" "cabal-project"
+ expectNoMoreDiagnostics 1 cabalDoc "parsing"
+ ]
+ ]
diff --git a/plugins/hls-cabal-project-plugin/test/Utils.hs b/plugins/hls-cabal-project-plugin/test/Utils.hs
new file mode 100644
index 0000000000..8ab90dd8bd
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/test/Utils.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Utils where
+
+import Control.Monad (guard)
+import Data.List (sort)
+import Data.Proxy (Proxy (Proxy))
+import qualified Data.Text as T
+import Ide.Plugin.CabalProject (descriptor)
+import qualified Ide.Plugin.CabalProject
+import Ide.Plugin.CabalProject.Types
+import System.FilePath
+import Test.Hls
+
+
+cabalProjectPlugin :: PluginTestDescriptor Ide.Plugin.CabalProject.Log
+cabalProjectPlugin = mkPluginTestDescriptor descriptor "cabal-project"
+
+runCabalProjectTestCaseSession :: TestName -> FilePath -> Session () -> TestTree
+runCabalProjectTestCaseSession title subdir = testCase title . runCabalProjectSession subdir
+
+runCabalProjectSession :: FilePath -> Session a -> IO a
+runCabalProjectSession subdir =
+ failIfSessionTimeout . runSessionWithServer def cabalProjectPlugin (testDataDir </> subdir)
+
+runCabalProjectGoldenSession :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
+runCabalProjectGoldenSession title subdir fp act = goldenWithCabalDoc def cabalProjectPlugin title testDataDir (subdir </> fp) "golden" "cabal-project" act
+
+testDataDir :: FilePath
+testDataDir = "plugins" </> "hls-cabal-project-plugin" </> "test" </> "testdata"
+
+-- | these functions are used to detect cabal kicks
+-- and look at diagnostics for cabal files
+-- kicks are run everytime there is a shake session run/restart
+cabalProjectKickDone :: Session ()
+cabalProjectKickDone = kick (Proxy @"kick/done/cabal-project") >>= guard . not . null
+
+cabalProjectKickStart :: Session ()
+cabalProjectKickStart = kick (Proxy @"kick/start/cabal-project") >>= guard . not . null
+
+cabalProjectCaptureKick :: Session [Diagnostic]
+cabalProjectCaptureKick = captureKickDiagnostics cabalProjectKickStart cabalProjectKickDone
+
+-- | list comparison where the order in the list is irrelevant
+(@?==) :: (HasCallStack, Ord a, Show a) => [a] -> [a] -> Assertion
+(@?==) l1 l2 = sort l1 @?= sort l2
diff --git a/plugins/hls-cabal-project-plugin/test/testdata/cabal.project b/plugins/hls-cabal-project-plugin/test/testdata/cabal.project
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/plugins/hls-cabal-project-plugin/test/testdata/invalid-cabal-project/cabal.project b/plugins/hls-cabal-project-plugin/test/testdata/invalid-cabal-project/cabal.project
new file mode 100644
index 0000000000..53e4c3b1f6
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/test/testdata/invalid-cabal-project/cabal.project
@@ -0,0 +1,3 @@
+packages: .
+
+flags:foo
diff --git a/plugins/hls-cabal-project-plugin/test/testdata/root-directory/cabal.project b/plugins/hls-cabal-project-plugin/test/testdata/root-directory/cabal.project
new file mode 100644
index 0000000000..241b892291
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/test/testdata/root-directory/cabal.project
@@ -0,0 +1 @@
+import: missing-folder/nonexistent.config
diff --git a/plugins/hls-cabal-project-plugin/test/testdata/simple-cabal-project/A.hs b/plugins/hls-cabal-project-plugin/test/testdata/simple-cabal-project/A.hs
new file mode 100644
index 0000000000..4eca137b41
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/test/testdata/simple-cabal-project/A.hs
@@ -0,0 +1,3 @@
+module A where
+
+a = undefined
diff --git a/plugins/hls-cabal-project-plugin/test/testdata/simple-cabal-project/cabal.project b/plugins/hls-cabal-project-plugin/test/testdata/simple-cabal-project/cabal.project
new file mode 100644
index 0000000000..e6fdbadb43
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/test/testdata/simple-cabal-project/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/plugins/hls-cabal-project-plugin/test/testdata/warning-cabal-project/cabal.project b/plugins/hls-cabal-project-plugin/test/testdata/warning-cabal-project/cabal.project
new file mode 100644
index 0000000000..a3cd59d23b
--- /dev/null
+++ b/plugins/hls-cabal-project-plugin/test/testdata/warning-cabal-project/cabal.project
@@ -0,0 +1 @@
+package: .
diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs
index 87a1af7392..3b34a06743 100644
--- a/src/HlsPlugins.hs
+++ b/src/HlsPlugins.hs
@@ -23,6 +23,9 @@ import qualified Ide.Plugin.CallHierarchy as CallHierarchy
#if hls_cabal
import qualified Ide.Plugin.Cabal as Cabal
#endif
+#if hls_cabal_project
+import qualified Ide.Plugin.CabalProject as CabalProject
+#endif
#if hls_class
import qualified Ide.Plugin.Class as Class
#endif
@@ -154,6 +157,9 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins
let pId = "cabal" in Cabal.descriptor (pluginRecorder pId) pId :
let caId = "cabalHaskellIntegration" in Cabal.haskellInteractionDescriptor (pluginRecorder caId) caId :
#endif
+#if hls_cabal_project
+ let pId = "cabalProject" in CabalProject.descriptor (pluginRecorder pId) pId :
+#endif
#if hls_pragmas
Pragmas.suggestPragmaDescriptor "pragmas-suggest" :
Pragmas.completionDescriptor "pragmas-completion" :
diff --git a/test.cpp b/test.cpp
new file mode 100644
index 0000000000..055115d2e8
--- /dev/null
+++ b/test.cpp
@@ -0,0 +1,3 @@
+#include <iostream>
+int main() { std::cout << "OK
+"; return 0; }
diff --git a/vendor/cabal b/vendor/cabal
new file mode 160000
index 0000000000..e8e48a6789
--- /dev/null
+++ b/vendor/cabal
@@ -0,0 +1 @@
+Subproject commit e8e48a6789823e00f392f87d532787a2c7604f88