From e677c9b8388f46bf02321c7da80939542f033ebd Mon Sep 17 00:00:00 2001 From: rm41339 Date: Thu, 5 Jun 2025 19:56:10 +0100 Subject: [PATCH 01/15] Initial cabal-project plugin setup --- haskell-language-server.cabal | 72 ++++++ hls-plugin-api/src/Ide/Types.hs | 17 +- .../src/Ide/Plugin/CabalProject.hs | 218 ++++++++++++++++++ plugins/hls-cabal-project-plugin/test/Main.hs | 3 + src/HlsPlugins.hs | 6 + test.cpp | 3 + 6 files changed, 318 insertions(+), 1 deletion(-) create mode 100644 plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs create mode 100644 plugins/hls-cabal-project-plugin/test/Main.hs create mode 100644 test.cpp diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 157f5703f2..d267f5bc13 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -317,6 +317,77 @@ 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(cabal) + buildable: False + exposed-modules: + Ide.Plugin.CabalProject + + + build-depends: + , bytestring + , Cabal-syntax >= 3.7 + , containers + , deepseq + , directory + , filepath + , extra >=1.7.4 + , ghcide == 2.9.0.1 + , hashable + , hls-plugin-api == 2.9.0.1 + , hls-graph == 2.9.0.1 + , 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 + + 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: + build-depends: + , bytestring + , Cabal-syntax >= 3.7 + , extra + , filepath + , ghcide + , haskell-language-server:hls-cabal-project-plugin + , hls-test-utils == 2.9.0.1 + , lens + , lsp-types + , text + , hls-plugin-api + ----------------------------- -- class plugin ----------------------------- @@ -1830,6 +1901,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-project-plugin/src/Ide/Plugin/CabalProject.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs new file mode 100644 index 0000000000..24ca19945d --- /dev/null +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs @@ -0,0 +1,218 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +module Ide.Plugin.CabalProject where + +import Control.Concurrent.Strict +import Control.DeepSeq +import Control.Lens ((^.)) +import Control.Monad.Extra +import Control.Monad.IO.Class +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 as List +import qualified Data.List.NonEmpty as NE +import qualified Data.Maybe as Maybe +import Data.Proxy +import qualified Data.Text () +import qualified Data.Text as T +import qualified Data.Text.Encoding as Encoding +import Data.Text.Utf16.Rope.Mixed as Rope +import Development.IDE as D +import Development.IDE.Core.FileStore (getVersionedTextDoc) +import Development.IDE.Core.PluginUtils +import Development.IDE.Core.Shake (restartShakeSession) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.Graph (Key, + alwaysRerun) +import Development.IDE.LSP.HoverDefinition (foundHover) +import qualified Development.IDE.Plugin.Completions.Logic as Ghcide +import Development.IDE.Types.Shake (toKey) +import qualified Distribution.CabalSpecVersion as Cabal +import qualified Distribution.Fields as Syntax +import Distribution.Package (Dependency) +import Distribution.PackageDescription (allBuildDepends, + depPkgName, + unPackageName) +import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import Distribution.Parsec.Error +import qualified Distribution.Parsec.Position as Syntax +import GHC.Generics +import Ide.Plugin.Error +import Ide.Types +import qualified Language.LSP.Protocol.Lens as JL +import qualified Language.LSP.Protocol.Message as LSP +import Language.LSP.Protocol.Types +import qualified Language.LSP.VFS as VFS +import Text.Regex.TDFA + +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 files") + { pluginRules = cabalRules 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 + restartCabalShakeSession (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 + restartCabalShakeSession (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 + restartCabalShakeSession (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 + restartCabalShakeSession (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' + +cabalRules :: Recorder (WithPriority Log) -> PluginId -> Rules () +cabalRules recorder _ = do + ofInterestRules recorder + +{- | Helper function to restart the shake session, specifically for modifying .cabal files. +No special logic, just group up a bunch of functions you need for the base +Notification Handlers. + +To make sure diagnostics are up to date, we need to tell shake that the file was touched and +needs to be re-parsed. That's what we do when we record the dirty key that our parsing +rule depends on. +Then we restart the shake session, so that changes to our virtual files are actually picked up. +-} +restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO () +restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = do + restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do + keys <- actionBetweenSession + return (toKey GetModificationTime file:keys) + +-- ---------------------------------------------------------------- +-- 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. +-} +newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus)) + +instance Shake.IsIdeGlobal OfInterestCabalVar + +data IsCabalFileOfInterest = IsCabalFileOfInterest + deriving (Eq, Show, Generic) +instance Hashable IsCabalFileOfInterest +instance NFData IsCabalFileOfInterest + +type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult + +data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus + deriving (Eq, Show, Generic) +instance Hashable CabalFileOfInterestResult +instance NFData CabalFileOfInterestResult + +{- | 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 + +getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus) +getCabalFilesOfInterestUntracked = do + OfInterestCabalVar var <- Shake.getIdeGlobalAction + liftIO $ readVar var + +addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key] +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)) + if prev /= Just v + then do + log' Debug $ LogFOI files + return [toKey IsCabalFileOfInterest f] + else return [] + where + log' = logWith recorder + +deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO [Key] +deleteFileOfInterest recorder state f = do + OfInterestCabalVar 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/test/Main.hs b/plugins/hls-cabal-project-plugin/test/Main.hs new file mode 100644 index 0000000000..b41c7786b6 --- /dev/null +++ b/plugins/hls-cabal-project-plugin/test/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = undefined 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 +int main() { std::cout << "OK +"; return 0; } From 61e7d95f5d2c1b926d54c9cf0daeff992d7dd7a8 Mon Sep 17 00:00:00 2001 From: rm41339 Date: Fri, 6 Jun 2025 22:12:37 +0100 Subject: [PATCH 02/15] Upgrade to latest Haskell version --- haskell-language-server.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index d267f5bc13..f8aa75a492 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -347,10 +347,10 @@ library hls-cabal-project-plugin , directory , filepath , extra >=1.7.4 - , ghcide == 2.9.0.1 + , ghcide == 2.11.0.0 , hashable - , hls-plugin-api == 2.9.0.1 - , hls-graph == 2.9.0.1 + , hls-plugin-api == 2.11.0.0 + , hls-graph == 2.11.0.0 , lens , lsp ^>=2.7 , lsp-types ^>=2.3 @@ -382,7 +382,7 @@ test-suite hls-cabal-project-plugin-tests , filepath , ghcide , haskell-language-server:hls-cabal-project-plugin - , hls-test-utils == 2.9.0.1 + , hls-test-utils == 2.11.0.0 , lens , lsp-types , text From 595efc1961c99982b7bd85b1716610633ef3449c Mon Sep 17 00:00:00 2001 From: rm41339 Date: Mon, 9 Jun 2025 13:03:26 +0100 Subject: [PATCH 03/15] successful parsing of cabal.project file --- haskell-language-server.cabal | 6 +- .../src/Ide/Plugin/CabalProject.hs | 12 ++- .../Ide/Plugin/CabalProject/Diagnostics.hs | 97 +++++++++++++++++++ .../src/Ide/Plugin/CabalProject/Parse.hs | 32 ++++++ 4 files changed, 143 insertions(+), 4 deletions(-) create mode 100644 plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs create mode 100644 plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index f8aa75a492..17e3089f9d 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -333,11 +333,12 @@ common cabalProject library hls-cabal-project-plugin import: defaults, pedantic, warnings - if !flag(cabal) + if !flag(cabalProject) buildable: False exposed-modules: Ide.Plugin.CabalProject - + Ide.Plugin.CabalProject.Parse + Ide.Plugin.CabalProject.Diagnostics build-depends: , bytestring @@ -364,6 +365,7 @@ library hls-cabal-project-plugin , aeson , Cabal , pretty + , cabal-install-parsers >= 0.6 && < 0.7 hs-source-dirs: plugins/hls-cabal-project-plugin/src diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs index 24ca19945d..b9bb351155 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs @@ -45,14 +45,17 @@ import Distribution.PackageDescription.Configuration (flattenPackageDe import Distribution.Parsec.Error import qualified Distribution.Parsec.Position as Syntax import GHC.Generics +import Ide.Plugin.CabalProject.Parse (parseCabalProjectContents) import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as JL import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS +import System.FilePath (takeFileName) import Text.Regex.TDFA + data Log = LogModificationTime NormalizedFilePath FileVersion | LogShake Shake.Log @@ -81,7 +84,7 @@ instance Pretty Log where descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = - (defaultCabalProjectPluginDescriptor plId "Provides a variety of IDE features in cabal files") + (defaultCabalProjectPluginDescriptor plId "Provides a variety of IDE features in cabal.project files") { pluginRules = cabalRules recorder plId , pluginHandlers = mconcat @@ -92,11 +95,15 @@ descriptor recorder plId = \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocOpened _uri + result <- parseCabalProjectContents (fromNormalizedFilePath file) + case result of + Left err -> putStrLn $ "Cabal project parse failed: " ++ err + Right project -> putStrLn $ "Cabal project parsed successfully: " ++ show project restartCabalShakeSession (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 + whenUriFile _uri $ \file-> do log' Debug $ LogDocModified _uri restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $ addFileOfInterest recorder ide file Modified{firstOpen = False} @@ -126,6 +133,7 @@ descriptor recorder plId = cabalRules :: Recorder (WithPriority Log) -> PluginId -> Rules () cabalRules recorder _ = do ofInterestRules recorder + -- cabalProjectParseRules recorder {- | 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 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..002932c390 --- /dev/null +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs @@ -0,0 +1,97 @@ +module Ide.Plugin.CabalProject.Diagnostics where + +diagnostic = undefined + +-- {-# LANGUAGE DuplicateRecordFields #-} +-- {-# LANGUAGE OverloadedStrings #-} +-- module Ide.Plugin.CabalProject.Diagnostics +-- ( errorDiagnostic +-- , warningDiagnostic +-- , positionFromCabaProjectPosition +-- , fatalParseErrorDiagnostic +-- -- * Re-exports +-- , FileDiagnostic +-- , Diagnostic(..) +-- ) +-- where + +-- import Control.Lens ((&), (.~)) +-- import qualified Data.Text as T +-- import Development.IDE (FileDiagnostic) +-- import Development.IDE.Types.Diagnostics (fdLspDiagnosticL, +-- ideErrorWithSource) +-- import Distribution.Fields (showPError, showPWarning) +-- import qualified Distribution.Parsec as Syntax +-- import Ide.PluginUtils (extendNextLine) +-- import Language.LSP.Protocol.Lens (range) +-- import Language.LSP.Protocol.Types (Diagnostic (..), +-- DiagnosticSeverity (..), +-- NormalizedFilePath, +-- Position (Position), +-- Range (Range), +-- fromNormalizedFilePath) + +-- -- | Produce a diagnostic for a fatal Cabal parser error. +-- fatalParseErrorDiagnostic :: NormalizedFilePath -> T.Text -> FileDiagnostic +-- fatalParseErrorDiagnostic fp msg = +-- mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine Syntax.zeroPos) msg + +-- -- | Produce a diagnostic from a Cabal parser error +-- errorDiagnostic :: NormalizedFilePath -> Syntax.PError -> FileDiagnostic +-- errorDiagnostic fp err@(Syntax.PError pos _) = +-- 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 -> Syntax.PWarning -> FileDiagnostic +-- warningDiagnostic fp warning@(Syntax.PWarning _ pos _) = +-- mkDiag fp "cabal" DiagnosticSeverity_Warning (toBeginningOfNextLine pos) msg +-- where +-- msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning + +-- -- | The Cabal parser does not output a _range_ for a warning/error, +-- -- only a single source code 'Lib.Position'. +-- -- We define the range to be _from_ this position +-- -- _to_ the first column of the next line. +-- toBeginningOfNextLine :: Syntax.Position -> Range +-- toBeginningOfNextLine cabalPos = extendNextLine $ Range pos pos +-- where +-- pos = positionFromCabalPosition cabalPos + +-- -- | Convert a 'Lib.Position' from Cabal to a 'Range' that LSP understands. +-- -- +-- -- Prefer this function over hand-rolled unpacking/packing, since LSP is zero-based, +-- -- while Cabal is one-based. +-- -- +-- -- >>> positionFromCabalPosition $ Lib.Position 1 1 +-- -- Position 0 0 +-- positionFromCabalPosition :: Syntax.Position -> Position +-- positionFromCabalPosition (Syntax.Position line column) = Position (fromIntegral line') (fromIntegral col') +-- where +-- -- LSP is zero-based, Cabal is one-based +-- -- Cabal can return line 0 for errors in the first line +-- line' = if line <= 0 then 0 else line-1 +-- col' = if column <= 0 then 0 else column-1 + +-- -- | Create a 'FileDiagnostic' +-- mkDiag +-- :: NormalizedFilePath +-- -- ^ Cabal file path +-- -> T.Text +-- -- ^ Where does the diagnostic come from? +-- -> DiagnosticSeverity +-- -- ^ Severity +-- -> Range +-- -- ^ Which source code range should the editor highlight? +-- -> T.Text +-- -- ^ The message displayed by the editor +-- -> FileDiagnostic +-- mkDiag file diagSource sev loc msg = +-- ideErrorWithSource +-- (Just diagSource) +-- (Just sev) +-- file +-- msg +-- Nothing +-- & fdLspDiagnosticL . range .~ loc 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..743012962f --- /dev/null +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ide.Plugin.CabalProject.Parse + ( parseCabalProjectContents + ) where + +import Data.Void (Void) + +-- cabal-install-parsers 0.6 modules ----------------------------- +import Cabal.Parse (ParseError) +import Cabal.Project (Project, + parseProject) + +-- error type lives in Cabal-syntax +-- import Distribution.Parsec.Error (ParseError) + +import Distribution.Types.GenericPackageDescription (GenericPackageDescription) + +import qualified Data.ByteString as BS +-- import Distribution.Parsec.Project (parseProject) +-- import Distribution.Parsec.Common (ParseError) +import Data.List.NonEmpty (NonEmpty) +import Data.Text (pack) + +parseCabalProjectContents :: FilePath -> IO (Either String (Project Void String String)) +parseCabalProjectContents file = do + contents <- BS.readFile file + case parseProject file contents of + Left parseErr -> + pure $ Left ("Parse error in " ++ file ++ ": " ++ show parseErr) + Right project -> + pure $ Right project From fc7ac76380fbb4f059d78525266760f745802c65 Mon Sep 17 00:00:00 2001 From: rm41339 Date: Fri, 13 Jun 2025 19:38:19 +0100 Subject: [PATCH 04/15] implement basic parsing with parseProject --- .gitignore | 3 + cabal.project | 10 +++ haskell-language-server.cabal | 2 +- .../src/Ide/Plugin/CabalProject.hs | 68 ++++++++++++++++--- .../Ide/Plugin/CabalProject/Diagnostics.hs | 2 + .../src/Ide/Plugin/CabalProject/Parse.hs | 61 ++++++++++------- 6 files changed, 112 insertions(+), 34 deletions(-) diff --git a/.gitignore b/.gitignore index 2413a1fcf5..619ca1e9f1 100644 --- a/.gitignore +++ b/.gitignore @@ -51,3 +51,6 @@ store/ gh-release-artifacts/ .hls/ + +# local cabal package +vendor/ diff --git a/cabal.project b/cabal.project index a795f0126b..ed23c3e958 100644 --- a/cabal.project +++ b/cabal.project @@ -6,6 +6,16 @@ packages: ./ghcide ./hls-plugin-api ./hls-test-utils + ./vendor/parse-cabal-project/cabal/Cabal + ./vendor/parse-cabal-project/cabal/Cabal-syntax + ./vendor/parse-cabal-project/cabal/cabal-install + ./vendor/parse-cabal-project/cabal/cabal-install-solver + ./vendor/parse-cabal-project/cabal/Cabal-described + ./vendor/parse-cabal-project/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 17e3089f9d..1fe853efae 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -365,7 +365,7 @@ library hls-cabal-project-plugin , aeson , Cabal , pretty - , cabal-install-parsers >= 0.6 && < 0.7 + , cabal-install hs-source-dirs: plugins/hls-cabal-project-plugin/src diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs index b9bb351155..f213049edb 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs @@ -15,7 +15,7 @@ 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 Data.HashMap.Strict (HashMap, toList) import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List import qualified Data.List.NonEmpty as NE @@ -45,7 +45,7 @@ import Distribution.PackageDescription.Configuration (flattenPackageDe import Distribution.Parsec.Error import qualified Distribution.Parsec.Position as Syntax import GHC.Generics -import Ide.Plugin.CabalProject.Parse (parseCabalProjectContents) +import Ide.Plugin.CabalProject.Parse (parseCabalProjectFileContents) import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as JL @@ -95,16 +95,14 @@ descriptor recorder plId = \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocOpened _uri - result <- parseCabalProjectContents (fromNormalizedFilePath file) - case result of - Left err -> putStrLn $ "Cabal project parse failed: " ++ err - Right project -> putStrLn $ "Cabal project parsed successfully: " ++ show project + parseAndPrint (fromNormalizedFilePath file) restartCabalShakeSession (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 + parseAndPrint (fromNormalizedFilePath file) restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $ addFileOfInterest recorder ide file Modified{firstOpen = False} , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $ @@ -130,10 +128,20 @@ descriptor recorder plId = whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath' -cabalRules :: Recorder (WithPriority Log) -> PluginId -> Rules () -cabalRules recorder _ = do - ofInterestRules recorder - -- cabalProjectParseRules recorder + parseAndPrint :: FilePath -> IO () + parseAndPrint file = do + (warnings, res) <- parseCabalProjectFileContents file + + mapM_ (putStrLn . ("[Cabal warning] " ++) . show) warnings + + case res of + Left (_mbSpecVer, errs) -> + putStrLn $ + "Cabal project parse failed:\n" ++ unlines (map show (NE.toList errs)) + + Right project -> + putStrLn $ + "Cabal project parsed successfully:\n" ++ show project {- | 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 @@ -150,6 +158,46 @@ restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = d keys <- actionBetweenSession return (toKey GetModificationTime file:keys) + +cabalRules :: Recorder (WithPriority Log) -> PluginId -> 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) $ \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, mCabalSource) <- use_ GetFileContents file + log' Debug $ LogModificationTime file t + contents <- case mCabalSource 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) + +{- | 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 + Shake.runWithSignal (Proxy @"kick/start/cabal-project") (Proxy @"kick/done/cabal-project") files Types.ParseCabalProjectFile + + -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable -- ---------------------------------------------------------------- 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 index 002932c390..4356fcbc44 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs @@ -2,6 +2,8 @@ module Ide.Plugin.CabalProject.Diagnostics where diagnostic = undefined +-- can use renderParseError: https://github.com/haskell/cabal/blob/master/cabal-install/src/Distribution/Client/Utils/Parsec.hs + -- {-# LANGUAGE DuplicateRecordFields #-} -- {-# LANGUAGE OverloadedStrings #-} -- module Ide.Plugin.CabalProject.Diagnostics 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 index 743012962f..90c05dfbe3 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs @@ -1,32 +1,47 @@ {-# LANGUAGE OverloadedStrings #-} module Ide.Plugin.CabalProject.Parse - ( parseCabalProjectContents + ( parseCabalProjectFileContents ) where -import Data.Void (Void) +-- base ----------------------------------------------------------------------- +import Control.Monad (unless) +import qualified Data.ByteString as BS +import Data.List.NonEmpty (NonEmpty (..)) +import Distribution.Client.HttpUtils (configureTransport) +import Distribution.Client.ProjectConfig.Parsec (ProjectConfigSkeleton, + parseProject) +import Distribution.Client.ProjectConfig.Types (ProjectConfigToParse (..)) +import Distribution.Fields (PError (..), + PWarning (..)) +import Distribution.Fields.ParseResult (ParseResult, + runParseResult) +import Distribution.Types.Version (Version) +import Distribution.Verbosity (normal) +import System.Directory (doesFileExist) +import System.FilePath (takeDirectory) --- cabal-install-parsers 0.6 modules ----------------------------- -import Cabal.Parse (ParseError) -import Cabal.Project (Project, - parseProject) +parseCabalProjectFileContents + :: FilePath + -> IO ([PWarning] + , Either (Maybe Version, NonEmpty PError) ProjectConfigSkeleton) +parseCabalProjectFileContents fp = do + bytes <- BS.readFile fp + let toParse = ProjectConfigToParse bytes + rootDir = takeDirectory fp + verb = normal + httpTransport <- configureTransport verb [fp] Nothing --- error type lives in Cabal-syntax --- import Distribution.Parsec.Error (ParseError) + parseRes :: ParseResult ProjectConfigSkeleton + <- parseProject rootDir fp httpTransport verb toParse -import Distribution.Types.GenericPackageDescription (GenericPackageDescription) + pure (runParseResult parseRes) -import qualified Data.ByteString as BS --- import Distribution.Parsec.Project (parseProject) --- import Distribution.Parsec.Common (ParseError) -import Data.List.NonEmpty (NonEmpty) -import Data.Text (pack) - -parseCabalProjectContents :: FilePath -> IO (Either String (Project Void String String)) -parseCabalProjectContents file = do - contents <- BS.readFile file - case parseProject file contents of - Left parseErr -> - pure $ Left ("Parse error in " ++ file ++ ": " ++ show parseErr) - Right project -> - pure $ Right project +-- parseCabalProjectContents :: FilePath -> IO (Either String (Project Void String String)) +-- parseCabalProjectContents file = do +-- contents <- BS.readFile file +-- case parseProject file contents of +-- Left parseErr -> +-- pure $ Left ("Parse error in " ++ file ++ ": " ++ show parseErr) +-- Right project -> +-- pure $ Right project From 594bba172033b24016c5323c27d63fdf7b69a4fb Mon Sep 17 00:00:00 2001 From: rm41339 Date: Sat, 14 Jun 2025 16:15:15 +0100 Subject: [PATCH 05/15] preliminary, very basic working diagnostics --- haskell-language-server.cabal | 5 +- .../src/Ide/Plugin/CabalProject.hs | 96 +++++++--- .../Ide/Plugin/CabalProject/Diagnostics.hs | 178 +++++++++--------- .../src/Ide/Plugin/CabalProject/Orphans.hs | 42 +++++ .../src/Ide/Plugin/CabalProject/Parse.hs | 36 +++- .../src/Ide/Plugin/CabalProject/Types.hs | 32 ++++ 6 files changed, 264 insertions(+), 125 deletions(-) create mode 100644 plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs create mode 100644 plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Types.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 1fe853efae..caa01095be 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -339,6 +339,8 @@ library hls-cabal-project-plugin Ide.Plugin.CabalProject Ide.Plugin.CabalProject.Parse Ide.Plugin.CabalProject.Diagnostics + Ide.Plugin.CabalProject.Types + Ide.Plugin.CabalProject.Orphans build-depends: , bytestring @@ -365,7 +367,8 @@ library hls-cabal-project-plugin , aeson , Cabal , pretty - , cabal-install + , cabal-install + , cabal-install-solver hs-source-dirs: plugins/hls-cabal-project-plugin/src diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs index f213049edb..846ff96665 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} @@ -45,7 +46,10 @@ import Distribution.PackageDescription.Configuration (flattenPackageDe import Distribution.Parsec.Error import qualified Distribution.Parsec.Position as Syntax import GHC.Generics -import Ide.Plugin.CabalProject.Parse (parseCabalProjectFileContents) +import Ide.Plugin.CabalProject.Diagnostics as Diagnostics +import Ide.Plugin.CabalProject.Orphans () +import Ide.Plugin.CabalProject.Parse as Parse +import Ide.Plugin.CabalProject.Types as Types import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as JL @@ -130,7 +134,7 @@ descriptor recorder plId = parseAndPrint :: FilePath -> IO () parseAndPrint file = do - (warnings, res) <- parseCabalProjectFileContents file + (warnings, res) <- Parse.parseCabalProjectFileContents file mapM_ (putStrLn . ("[Cabal warning] " ++) . show) warnings @@ -143,6 +147,11 @@ descriptor recorder plId = putStrLn $ "Cabal project parsed successfully:\n" ++ show project + bs <- BS.readFile file + case Parse.readCabalProjectFields (toNormalizedFilePath' file) bs of + Left diag -> putStrLn $ "readCabalProjectFields error:\n" ++ show diag + Right flds -> putStrLn $ "readCabalProjectFields success:\n" ++ show flds + {- | 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. @@ -160,30 +169,64 @@ restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = d cabalRules :: Recorder (WithPriority Log) -> PluginId -> 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) $ \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, mCabalSource) <- use_ GetFileContents file - log' Debug $ LogModificationTime file t - contents <- case mCabalSource 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) +cabalRules recorder plId = do + -- Make sure we initialise the cabal files-of-interest. + ofInterestRules recorder + -- Rule to produce diagnostics for cabal 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, mCabalSource) <- use_ GetFileContents file + log' Debug $ LogModificationTime file t + contents <- case mCabalSource 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 + -- 1. Grab file contents (virtual-file or disk) + (_hash, mRope) <- use_ GetFileContents file + bytes <- case mRope of + Just rope -> pure (Encoding.encodeUtf8 (Rope.toText rope)) + Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath file) + + -- 2. Run Cabal’s parser for cabal.project + (pWarnings, pResult) <- liftIO $ Parse.parseCabalProjectFileContents (fromNormalizedFilePath file) + + -- 3. Convert warnings + let warnDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings + + -- 4. Convert result or errors + 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 kick. This code always runs when 'shakeRestart' is run. + -- Must be careful to not impede the performance too much. Crucial to + -- a snappy IDE experience. + kick + where + log' = logWith recorder {- | This is the kick function for the cabal plugin. We run this action, whenever we shake session us run/restarted, which triggers @@ -195,6 +238,7 @@ function invocation. kick :: Action () kick = do files <- HashMap.keys <$> getCabalFilesOfInterestUntracked +-- let keys = map Types.ParseCabalProjectFile files Shake.runWithSignal (Proxy @"kick/start/cabal-project") (Proxy @"kick/done/cabal-project") files Types.ParseCabalProjectFile 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 index 4356fcbc44..5ba8856eae 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs @@ -1,99 +1,93 @@ -module Ide.Plugin.CabalProject.Diagnostics where +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +module Ide.Plugin.CabalProject.Diagnostics +( errorDiagnostic +, warningDiagnostic +, positionFromCabalProjectPosition +, fatalParseErrorDiagnostic + -- * Re-exports +, FileDiagnostic +, Diagnostic(..) +) +where -diagnostic = undefined +import Control.Lens ((&), (.~)) +import qualified Data.Text as T +import Development.IDE (FileDiagnostic) +import Development.IDE.Types.Diagnostics (fdLspDiagnosticL, + ideErrorWithSource) +import Distribution.Fields (showPError, showPWarning) +import qualified Distribution.Parsec as Syntax +import Ide.PluginUtils (extendNextLine) +import Language.LSP.Protocol.Lens (range) +import Language.LSP.Protocol.Types (Diagnostic (..), + DiagnosticSeverity (..), + NormalizedFilePath, + Position (Position), + Range (Range), + fromNormalizedFilePath) --- can use renderParseError: https://github.com/haskell/cabal/blob/master/cabal-install/src/Distribution/Client/Utils/Parsec.hs +-- | Produce a diagnostic for a fatal Cabal parser error. +fatalParseErrorDiagnostic :: NormalizedFilePath -> T.Text -> FileDiagnostic +fatalParseErrorDiagnostic fp msg = + mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine Syntax.zeroPos) msg --- {-# LANGUAGE DuplicateRecordFields #-} --- {-# LANGUAGE OverloadedStrings #-} --- module Ide.Plugin.CabalProject.Diagnostics --- ( errorDiagnostic --- , warningDiagnostic --- , positionFromCabaProjectPosition --- , fatalParseErrorDiagnostic --- -- * Re-exports --- , FileDiagnostic --- , Diagnostic(..) --- ) --- where +-- | Produce a diagnostic from a Cabal parser error +errorDiagnostic :: NormalizedFilePath -> Syntax.PError -> FileDiagnostic +errorDiagnostic fp err@(Syntax.PError pos _) = + mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine pos) msg + where + msg = T.pack $ showPError (fromNormalizedFilePath fp) err --- import Control.Lens ((&), (.~)) --- import qualified Data.Text as T --- import Development.IDE (FileDiagnostic) --- import Development.IDE.Types.Diagnostics (fdLspDiagnosticL, --- ideErrorWithSource) --- import Distribution.Fields (showPError, showPWarning) --- import qualified Distribution.Parsec as Syntax --- import Ide.PluginUtils (extendNextLine) --- import Language.LSP.Protocol.Lens (range) --- import Language.LSP.Protocol.Types (Diagnostic (..), --- DiagnosticSeverity (..), --- NormalizedFilePath, --- Position (Position), --- Range (Range), --- fromNormalizedFilePath) +-- | Produce a diagnostic from a Cabal parser warning +warningDiagnostic :: NormalizedFilePath -> Syntax.PWarning -> FileDiagnostic +warningDiagnostic fp warning@(Syntax.PWarning _ pos _) = + mkDiag fp "cabal" DiagnosticSeverity_Warning (toBeginningOfNextLine pos) msg + where + msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning --- -- | Produce a diagnostic for a fatal Cabal parser error. --- fatalParseErrorDiagnostic :: NormalizedFilePath -> T.Text -> FileDiagnostic --- fatalParseErrorDiagnostic fp msg = --- mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine Syntax.zeroPos) msg +-- | The Cabal parser does not output a _range_ for a warning/error, +-- only a single source code 'Lib.Position'. +-- We define the range to be _from_ this position +-- _to_ the first column of the next line. +toBeginningOfNextLine :: Syntax.Position -> Range +toBeginningOfNextLine cabalPos = extendNextLine $ Range pos pos + where + pos = positionFromCabalProjectPosition cabalPos --- -- | Produce a diagnostic from a Cabal parser error --- errorDiagnostic :: NormalizedFilePath -> Syntax.PError -> FileDiagnostic --- errorDiagnostic fp err@(Syntax.PError pos _) = --- mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine pos) msg --- where --- msg = T.pack $ showPError (fromNormalizedFilePath fp) err +-- | Convert a 'Lib.Position' from Cabal to a 'Range' that LSP understands. +-- +-- Prefer this function over hand-rolled unpacking/packing, since LSP is zero-based, +-- while Cabal is one-based. +-- +-- >>> positionFromCabalPosition $ Lib.Position 1 1 +-- Position 0 0 +positionFromCabalProjectPosition :: Syntax.Position -> Position +positionFromCabalProjectPosition (Syntax.Position line column) = Position (fromIntegral line') (fromIntegral col') + where + -- LSP is zero-based, Cabal is one-based + -- Cabal can return line 0 for errors in the first line + line' = if line <= 0 then 0 else line-1 + col' = if column <= 0 then 0 else column-1 --- -- | Produce a diagnostic from a Cabal parser warning --- warningDiagnostic :: NormalizedFilePath -> Syntax.PWarning -> FileDiagnostic --- warningDiagnostic fp warning@(Syntax.PWarning _ pos _) = --- mkDiag fp "cabal" DiagnosticSeverity_Warning (toBeginningOfNextLine pos) msg --- where --- msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning - --- -- | The Cabal parser does not output a _range_ for a warning/error, --- -- only a single source code 'Lib.Position'. --- -- We define the range to be _from_ this position --- -- _to_ the first column of the next line. --- toBeginningOfNextLine :: Syntax.Position -> Range --- toBeginningOfNextLine cabalPos = extendNextLine $ Range pos pos --- where --- pos = positionFromCabalPosition cabalPos - --- -- | Convert a 'Lib.Position' from Cabal to a 'Range' that LSP understands. --- -- --- -- Prefer this function over hand-rolled unpacking/packing, since LSP is zero-based, --- -- while Cabal is one-based. --- -- --- -- >>> positionFromCabalPosition $ Lib.Position 1 1 --- -- Position 0 0 --- positionFromCabalPosition :: Syntax.Position -> Position --- positionFromCabalPosition (Syntax.Position line column) = Position (fromIntegral line') (fromIntegral col') --- where --- -- LSP is zero-based, Cabal is one-based --- -- Cabal can return line 0 for errors in the first line --- line' = if line <= 0 then 0 else line-1 --- col' = if column <= 0 then 0 else column-1 - --- -- | Create a 'FileDiagnostic' --- mkDiag --- :: NormalizedFilePath --- -- ^ Cabal file path --- -> T.Text --- -- ^ Where does the diagnostic come from? --- -> DiagnosticSeverity --- -- ^ Severity --- -> Range --- -- ^ Which source code range should the editor highlight? --- -> T.Text --- -- ^ The message displayed by the editor --- -> FileDiagnostic --- mkDiag file diagSource sev loc msg = --- ideErrorWithSource --- (Just diagSource) --- (Just sev) --- file --- msg --- Nothing --- & fdLspDiagnosticL . range .~ loc +-- | Create a 'FileDiagnostic' +mkDiag + :: NormalizedFilePath + -- ^ Cabal file path + -> T.Text + -- ^ Where does the diagnostic come from? + -> DiagnosticSeverity + -- ^ Severity + -> Range + -- ^ Which source code range should the editor highlight? + -> T.Text + -- ^ The message displayed by the editor + -> FileDiagnostic +mkDiag file diagSource sev loc msg = + ideErrorWithSource + (Just diagSource) + (Just sev) + file + msg + Nothing + & fdLspDiagnosticL . range .~ loc diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs new file mode 100644 index 0000000000..c11c7b0faf --- /dev/null +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs @@ -0,0 +1,42 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Ide.Plugin.CabalProject.Orphans where + +import Control.DeepSeq +import Distribution.Fields.Field +import Distribution.Parsec.Position +-- import Control.DeepSeq (NFData) +import qualified Distribution.Solver.Types.ProjectConfigPath as PCPath +import GHC.Generics (Generic) + +import qualified Distribution.Client.ProjectConfig.Types as PC + +-- ---------------------------------------------------------------- +-- Cabal-syntax orphan instances we need sometimes +-- ---------------------------------------------------------------- + +instance NFData (Field Position) where + rnf (Field name fieldLines) = rnf name `seq` rnf fieldLines + rnf (Section name sectionArgs fields) = rnf name `seq` rnf sectionArgs `seq` rnf fields + +instance NFData (Name Position) where + rnf (Name ann fName) = rnf ann `seq` rnf fName + +instance NFData (FieldLine Position) where + rnf (FieldLine ann bs) = rnf ann `seq` rnf bs + +instance NFData (SectionArg Position) where + rnf (SecArgName ann bs) = rnf ann `seq` rnf bs + rnf (SecArgStr ann bs) = rnf ann `seq` rnf bs + rnf (SecArgOther ann bs) = rnf ann `seq` rnf bs + +-- Project Config Orphans + +deriving instance NFData PCPath.ProjectConfigPath + +instance NFData PC.ProjectConfig where + rnf !_ = () + 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 index 90c05dfbe3..4188189c87 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs @@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module Ide.Plugin.CabalProject.Parse - ( parseCabalProjectFileContents + ( parseCabalProjectFileContents, + readCabalProjectFields ) where -- base ----------------------------------------------------------------------- @@ -10,14 +11,22 @@ import qualified Data.ByteString as BS import Data.List.NonEmpty (NonEmpty (..)) import Distribution.Client.HttpUtils (configureTransport) import Distribution.Client.ProjectConfig.Parsec (ProjectConfigSkeleton, - parseProject) + parseProject, + readPreprocessFields) import Distribution.Client.ProjectConfig.Types (ProjectConfigToParse (..)) import Distribution.Fields (PError (..), PWarning (..)) -import Distribution.Fields.ParseResult (ParseResult, - runParseResult) +import qualified Distribution.Fields.ParseResult as PR +-- import Distribution.Fields.ParseResult (ParseResult, +-- runParseResult) +import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T +import Development.IDE +import qualified Distribution.Fields.Parser as Syntax +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 (doesFileExist) import System.FilePath (takeDirectory) @@ -32,10 +41,25 @@ parseCabalProjectFileContents fp = do verb = normal httpTransport <- configureTransport verb [fp] Nothing - parseRes :: ParseResult ProjectConfigSkeleton + parseRes :: PR.ParseResult ProjectConfigSkeleton <- parseProject rootDir fp httpTransport verb toParse - pure (runParseResult parseRes) + 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 -- parseCabalProjectContents :: FilePath -> IO (Either String (Project Void String String)) -- parseCabalProjectContents file = do 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..7df6bcd38d --- /dev/null +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Types.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE TypeFamilies #-} + +module Ide.Plugin.CabalProject.Types where + +import Control.DeepSeq (NFData) +import Data.Hashable (Hashable) +import Development.IDE (NormalizedFilePath, + 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 + From ba5216db0ab143f4964c049fce5a3ce4f4466e04 Mon Sep 17 00:00:00 2001 From: rm41339 Date: Mon, 16 Jun 2025 13:51:25 +0100 Subject: [PATCH 06/15] add parsing and diagnostics tests --- cabal.project | 1 - haskell-language-server.cabal | 1 + .../src/Ide/Plugin/CabalProject.hs | 5 +- .../src/Ide/Plugin/CabalProject/Parse.hs | 20 +--- plugins/hls-cabal-project-plugin/test/Main.hs | 98 ++++++++++++++++++- .../hls-cabal-project-plugin/test/Utils.hs | 48 +++++++++ .../test/testdata/cabal.project | 0 .../invalid-cabal-project/cabal.project | 3 + .../test/testdata/simple-cabal-project/A.hs | 3 + .../simple-cabal-project/cabal.project | 1 + .../warning-cabal-project/cabal.project | 1 + 11 files changed, 160 insertions(+), 21 deletions(-) create mode 100644 plugins/hls-cabal-project-plugin/test/Utils.hs create mode 100644 plugins/hls-cabal-project-plugin/test/testdata/cabal.project create mode 100644 plugins/hls-cabal-project-plugin/test/testdata/invalid-cabal-project/cabal.project create mode 100644 plugins/hls-cabal-project-plugin/test/testdata/simple-cabal-project/A.hs create mode 100644 plugins/hls-cabal-project-plugin/test/testdata/simple-cabal-project/cabal.project create mode 100644 plugins/hls-cabal-project-plugin/test/testdata/warning-cabal-project/cabal.project diff --git a/cabal.project b/cabal.project index ed23c3e958..1bd85d3090 100644 --- a/cabal.project +++ b/cabal.project @@ -17,7 +17,6 @@ package cabal-install tests: False benchmarks: False - index-state: 2025-05-12T13:26:29Z tests: True diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index caa01095be..83dcdb5d1a 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -380,6 +380,7 @@ test-suite hls-cabal-project-plugin-tests hs-source-dirs: plugins/hls-cabal-project-plugin/test main-is: Main.hs other-modules: + Utils build-depends: , bytestring , Cabal-syntax >= 3.7 diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs index 846ff96665..efe4c1c38e 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs @@ -99,14 +99,14 @@ descriptor recorder plId = \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocOpened _uri - parseAndPrint (fromNormalizedFilePath file) + -- parseAndPrint (fromNormalizedFilePath file) restartCabalShakeSession (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 - parseAndPrint (fromNormalizedFilePath file) + -- parseAndPrint (fromNormalizedFilePath file) restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $ addFileOfInterest recorder ide file Modified{firstOpen = False} , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $ @@ -132,6 +132,7 @@ descriptor recorder plId = whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath' + -- for development/debugging parseAndPrint :: FilePath -> IO () parseAndPrint file = do (warnings, res) <- Parse.parseCabalProjectFileContents file 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 index 4188189c87..004d117c24 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs @@ -5,10 +5,12 @@ module Ide.Plugin.CabalProject.Parse readCabalProjectFields ) where --- base ----------------------------------------------------------------------- import Control.Monad (unless) import qualified Data.ByteString as BS 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, @@ -16,13 +18,8 @@ import Distribution.Client.ProjectConfig.Parsec (ProjectConfigSkeleton import Distribution.Client.ProjectConfig.Types (ProjectConfigToParse (..)) import Distribution.Fields (PError (..), PWarning (..)) -import qualified Distribution.Fields.ParseResult as PR --- import Distribution.Fields.ParseResult (ParseResult, --- runParseResult) -import qualified Data.List.NonEmpty as NE -import qualified Data.Text as T -import Development.IDE 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) @@ -60,12 +57,3 @@ readCabalProjectFields file contents = (_warnings, Right fields) -> Right fields - --- parseCabalProjectContents :: FilePath -> IO (Either String (Project Void String String)) --- parseCabalProjectContents file = do --- contents <- BS.readFile file --- case parseProject file contents of --- Left parseErr -> --- pure $ Left ("Parse error in " ++ file ++ ": " ++ show parseErr) --- Right project -> --- pure $ Right project diff --git a/plugins/hls-cabal-project-plugin/test/Main.hs b/plugins/hls-cabal-project-plugin/test/Main.hs index b41c7786b6..fc004ce892 100644 --- a/plugins/hls-cabal-project-plugin/test/Main.hs +++ b/plugins/hls-cabal-project-plugin/test/Main.hs @@ -1,3 +1,97 @@ -module Main where +{-# LANGUAGE CPP #-} +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} -main = undefined +module Main ( + main, +) where + +import Control.Lens ((^.)) +import Control.Lens.Fold ((^?)) +import Control.Monad (guard) +import qualified Data.ByteString as BS +import Data.Either (isRight) +import Data.List.Extra (nubOrdOn) +import qualified Data.Maybe as Maybe +import qualified Data.Text as T +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 + (warnings, pm) <- Lib.parseCabalProjectFileContents (testDataDir "cabal.project") + liftIO $ do + null warnings @? "Found unexpected warnings" + isRight pm @? "Failed to parse base cabal.project file" + ] + +-- ------------------------ ------------------------------------------------ +-- 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/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: . From 2164729df5fa79efe118ff78a8cadc42aff7aca2 Mon Sep 17 00:00:00 2001 From: rm41339 Date: Tue, 17 Jun 2025 18:17:26 +0100 Subject: [PATCH 07/15] remove some redundancies between cabal and cabal-project plugin --- haskell-language-server.cabal | 2 + .../src/Ide/Plugin/Cabal/Diagnostics.hs | 2 + .../Ide/Plugin/CabalProject/Diagnostics.hs | 57 +++---------------- .../src/Ide/Plugin/CabalProject/Orphans.hs | 20 +------ 4 files changed, 12 insertions(+), 69 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 83dcdb5d1a..2281ce44f3 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -369,6 +369,8 @@ library hls-cabal-project-plugin , pretty , cabal-install , cabal-install-solver + , haskell-language-server:hls-cabal-plugin + hs-source-dirs: plugins/hls-cabal-project-plugin/src 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/Diagnostics.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs index 5ba8856eae..6fa601e16d 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Diagnostics.hs @@ -3,7 +3,7 @@ module Ide.Plugin.CabalProject.Diagnostics ( errorDiagnostic , warningDiagnostic -, positionFromCabalProjectPosition +, positionFromCabalPosition , fatalParseErrorDiagnostic -- * Re-exports , FileDiagnostic @@ -18,6 +18,9 @@ import Development.IDE.Types.Diagnostics (fdLspDiagnosticL, ideErrorWithSource) import Distribution.Fields (showPError, showPWarning) import qualified Distribution.Parsec as Syntax +import Ide.Plugin.Cabal.Diagnostics (mkDiag, + positionFromCabalPosition, + toBeginningOfNextLine) import Ide.PluginUtils (extendNextLine) import Language.LSP.Protocol.Lens (range) import Language.LSP.Protocol.Types (Diagnostic (..), @@ -30,64 +33,18 @@ import Language.LSP.Protocol.Types (Diagnostic (..), -- | Produce a diagnostic for a fatal Cabal parser error. fatalParseErrorDiagnostic :: NormalizedFilePath -> T.Text -> FileDiagnostic fatalParseErrorDiagnostic fp msg = - mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine Syntax.zeroPos) msg + mkDiag fp "cabal-project" DiagnosticSeverity_Error (toBeginningOfNextLine Syntax.zeroPos) msg -- | Produce a diagnostic from a Cabal parser error errorDiagnostic :: NormalizedFilePath -> Syntax.PError -> FileDiagnostic errorDiagnostic fp err@(Syntax.PError pos _) = - mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine pos) msg + mkDiag fp "cabal-project" DiagnosticSeverity_Error (toBeginningOfNextLine pos) msg where msg = T.pack $ showPError (fromNormalizedFilePath fp) err -- | Produce a diagnostic from a Cabal parser warning warningDiagnostic :: NormalizedFilePath -> Syntax.PWarning -> FileDiagnostic warningDiagnostic fp warning@(Syntax.PWarning _ pos _) = - mkDiag fp "cabal" DiagnosticSeverity_Warning (toBeginningOfNextLine pos) msg + mkDiag fp "cabal-project" DiagnosticSeverity_Warning (toBeginningOfNextLine pos) msg where msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning - --- | The Cabal parser does not output a _range_ for a warning/error, --- only a single source code 'Lib.Position'. --- We define the range to be _from_ this position --- _to_ the first column of the next line. -toBeginningOfNextLine :: Syntax.Position -> Range -toBeginningOfNextLine cabalPos = extendNextLine $ Range pos pos - where - pos = positionFromCabalProjectPosition cabalPos - --- | Convert a 'Lib.Position' from Cabal to a 'Range' that LSP understands. --- --- Prefer this function over hand-rolled unpacking/packing, since LSP is zero-based, --- while Cabal is one-based. --- --- >>> positionFromCabalPosition $ Lib.Position 1 1 --- Position 0 0 -positionFromCabalProjectPosition :: Syntax.Position -> Position -positionFromCabalProjectPosition (Syntax.Position line column) = Position (fromIntegral line') (fromIntegral col') - where - -- LSP is zero-based, Cabal is one-based - -- Cabal can return line 0 for errors in the first line - line' = if line <= 0 then 0 else line-1 - col' = if column <= 0 then 0 else column-1 - --- | Create a 'FileDiagnostic' -mkDiag - :: NormalizedFilePath - -- ^ Cabal file path - -> T.Text - -- ^ Where does the diagnostic come from? - -> DiagnosticSeverity - -- ^ Severity - -> Range - -- ^ Which source code range should the editor highlight? - -> T.Text - -- ^ The message displayed by the editor - -> FileDiagnostic -mkDiag file diagSource sev loc msg = - ideErrorWithSource - (Just diagSource) - (Just sev) - file - msg - Nothing - & fdLspDiagnosticL . range .~ loc diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs index c11c7b0faf..374dd22682 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs @@ -13,25 +13,7 @@ import qualified Distribution.Solver.Types.ProjectConfigPath as PCPath import GHC.Generics (Generic) import qualified Distribution.Client.ProjectConfig.Types as PC - --- ---------------------------------------------------------------- --- Cabal-syntax orphan instances we need sometimes --- ---------------------------------------------------------------- - -instance NFData (Field Position) where - rnf (Field name fieldLines) = rnf name `seq` rnf fieldLines - rnf (Section name sectionArgs fields) = rnf name `seq` rnf sectionArgs `seq` rnf fields - -instance NFData (Name Position) where - rnf (Name ann fName) = rnf ann `seq` rnf fName - -instance NFData (FieldLine Position) where - rnf (FieldLine ann bs) = rnf ann `seq` rnf bs - -instance NFData (SectionArg Position) where - rnf (SecArgName ann bs) = rnf ann `seq` rnf bs - rnf (SecArgStr ann bs) = rnf ann `seq` rnf bs - rnf (SecArgOther ann bs) = rnf ann `seq` rnf bs +import Ide.Plugin.Cabal.Orphans () -- Project Config Orphans From 7ff873194c1736de032a42cb4daabd9e015e72b8 Mon Sep 17 00:00:00 2001 From: rm41339 Date: Wed, 25 Jun 2025 15:57:08 +0200 Subject: [PATCH 08/15] removed submodule cabal (will replace in correct directory) --- .gitmodules | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitmodules b/.gitmodules index 7856aaec36..e41d57e61d 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,3 +8,4 @@ # Commit git commit -m "Removed submodule " # Delete the now untracked submodule files # rm -rf path_to_submodule + From 2f9f8262f86988f7b3e39a8b8f4f6be7e7a76f3a Mon Sep 17 00:00:00 2001 From: rm41339 Date: Wed, 25 Jun 2025 16:01:37 +0200 Subject: [PATCH 09/15] remove vendor from .gitignore --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 619ca1e9f1..8674ecc3fc 100644 --- a/.gitignore +++ b/.gitignore @@ -53,4 +53,4 @@ gh-release-artifacts/ .hls/ # local cabal package -vendor/ +# vendor/ From 87ecedfcbe32a6389f44a5ea3a47c79dfdadd12d Mon Sep 17 00:00:00 2001 From: rm41339 Date: Wed, 25 Jun 2025 16:03:42 +0200 Subject: [PATCH 10/15] add cabal submodule --- .gitignore | 2 +- .gitmodules | 3 +++ vendor/cabal | 1 + 3 files changed, 5 insertions(+), 1 deletion(-) create mode 160000 vendor/cabal diff --git a/.gitignore b/.gitignore index 8674ecc3fc..0e23fac134 100644 --- a/.gitignore +++ b/.gitignore @@ -53,4 +53,4 @@ gh-release-artifacts/ .hls/ # local cabal package -# vendor/ +vendor/parse-cabal-project diff --git a/.gitmodules b/.gitmodules index e41d57e61d..49b0b3c940 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,3 +9,6 @@ # 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/vendor/cabal b/vendor/cabal new file mode 160000 index 0000000000..369a520d2c --- /dev/null +++ b/vendor/cabal @@ -0,0 +1 @@ +Subproject commit 369a520d2ca162e5967407b68c107c3922204545 From 8adcdd5e34de8f9bb833a066ec3bed59b38a4632 Mon Sep 17 00:00:00 2001 From: rm41339 Date: Wed, 25 Jun 2025 16:11:47 +0200 Subject: [PATCH 11/15] update cabal.project to reflect new submodule location --- cabal.project | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cabal.project b/cabal.project index 1bd85d3090..0315ff65a8 100644 --- a/cabal.project +++ b/cabal.project @@ -6,12 +6,12 @@ packages: ./ghcide ./hls-plugin-api ./hls-test-utils - ./vendor/parse-cabal-project/cabal/Cabal - ./vendor/parse-cabal-project/cabal/Cabal-syntax - ./vendor/parse-cabal-project/cabal/cabal-install - ./vendor/parse-cabal-project/cabal/cabal-install-solver - ./vendor/parse-cabal-project/cabal/Cabal-described - ./vendor/parse-cabal-project/cabal/Cabal-tree-diff + ./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 From b74bced4f12031bbe17c6831677723cb9406fc85 Mon Sep 17 00:00:00 2001 From: rm41339 Date: Fri, 27 Jun 2025 08:26:23 +0200 Subject: [PATCH 12/15] fix bytes and cache error in parsing --- haskell-language-server.cabal | 2 + .../src/Ide/Plugin/CabalProject.hs | 20 +- .../src/Ide/Plugin/CabalProject/Orphans.hs | 195 ++++++++++++++++++ .../src/Ide/Plugin/CabalProject/Parse.hs | 33 ++- 4 files changed, 235 insertions(+), 15 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 2281ce44f3..c451a781e5 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -370,6 +370,8 @@ library hls-cabal-project-plugin , cabal-install , cabal-install-solver , haskell-language-server:hls-cabal-plugin + , base16-bytestring + , cryptohash-sha1 hs-source-dirs: plugins/hls-cabal-project-plugin/src diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs index efe4c1c38e..6f5f65c6ca 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs @@ -135,7 +135,8 @@ descriptor recorder plId = -- for development/debugging parseAndPrint :: FilePath -> IO () parseAndPrint file = do - (warnings, res) <- Parse.parseCabalProjectFileContents file + bytes <- BS.readFile file + (warnings, res) <- Parse.parseCabalProjectFileContents file bytes mapM_ (putStrLn . ("[Cabal warning] " ++) . show) warnings @@ -200,19 +201,18 @@ cabalRules recorder plId = do if not (plcGlobalOn cfg && plcDiagnosticsOn cfg) then pure ([], Nothing) else do - -- 1. Grab file contents (virtual-file or disk) - (_hash, mRope) <- use_ GetFileContents file - bytes <- case mRope of - Just rope -> pure (Encoding.encodeUtf8 (Rope.toText rope)) - Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath file) + -- 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, mRope) <- use_ GetFileContents file + log' Debug $ LogModificationTime file t - -- 2. Run Cabal’s parser for cabal.project - (pWarnings, pResult) <- liftIO $ Parse.parseCabalProjectFileContents (fromNormalizedFilePath file) + bytes <- case mRope of + Just sources -> pure (Encoding.encodeUtf8 (Rope.toText sources)) + Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath file) - -- 3. Convert warnings + (pWarnings, pResult) <- liftIO $ Parse.parseCabalProjectFileContents (fromNormalizedFilePath file) bytes let warnDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings - -- 4. Convert result or errors case pResult of Left (_specVer, pErrNE) -> do let errDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrNE diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs index 374dd22682..9f15a5a46c 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs @@ -22,3 +22,198 @@ deriving instance NFData PCPath.ProjectConfigPath instance NFData PC.ProjectConfig where rnf !_ = () +-- {-# OPTIONS_GHC -Wno-orphans #-} +-- {-# LANGUAGE FlexibleInstances #-} +-- {-# LANGUAGE RecordWildCards #-} + +-- module Ide.Plugin.CabalProject.Orphans () where + +-- import Control.DeepSeq ( NFData, rnf ) +-- import Distribution.Compat.Prelude ( genericRnf ) +-- import Distribution.Verbosity (Verbosity) +-- import Distribution.Verbosity.Internal (VerbosityLevel(..), VerbosityFlag(..)) +-- import Ide.Plugin.Cabal.Orphans () + +-- import Distribution.Client.ProjectConfig.Types +-- ( BuildTimeSettings(..) ) +-- import Distribution.Simple.InstallDirs.Internal +-- ( PathComponent(..), PathTemplateVariable(..) +-- ) +-- import Distribution.Simple.InstallDirs +-- ( PathTemplate(..) ) +-- import Control.DeepSeq ( NFData(rnf) ) +-- import Distribution.Client.BuildReports.Types (ReportLevel) + +-- import Distribution.Client.Types.Repo (RemoteRepo, LocalRepo) + +-- -- PathTemplate +-- instance NFData PathTemplate where +-- rnf = genericRnf + +-- instance NFData PathComponent where +-- rnf = genericRnf + +-- instance NFData PathTemplateVariable where +-- rnf = genericRnf + +-- -- Verbosity +-- instance NFData Verbosity where +-- rnf = genericRnf + +-- -- instance NFData VerbosityLevel where +-- -- rnf = genericRnf + +-- -- instance NFData VerbosityFlag where +-- -- rnf = genericRnf + +-- -- ReportLevel +-- instance NFData ReportLevel where +-- rnf = genericRnf + +-- -- RemoteRepo +-- instance NFData RemoteRepo where +-- rnf = genericRnf + +-- instance NFData LocalRepo where +-- rnf = genericRnf + +-- instance NFData BuildTimeSettings where +-- rnf bts = +-- rnf (buildSettingDryRun bts) +-- `seq` rnf (buildSettingOnlyDeps bts) +-- `seq` rnf (buildSettingOnlyDownload bts) +-- `seq` rnf (buildSettingSummaryFile bts) +-- `seq` () +-- `seq` rnf (buildSettingLogVerbosity bts) +-- `seq` rnf (buildSettingBuildReports bts) +-- `seq` rnf (buildSettingReportPlanningFailure bts) +-- `seq` rnf (buildSettingSymlinkBinDir bts) +-- `seq` rnf (buildSettingNumJobs bts) +-- `seq` rnf (buildSettingKeepGoing bts) +-- `seq` rnf (buildSettingOfflineMode bts) +-- `seq` rnf (buildSettingKeepTempFiles bts) +-- `seq` rnf (buildSettingRemoteRepos bts) +-- `seq` rnf (buildSettingLocalNoIndexRepos bts) +-- `seq` rnf (buildSettingCacheDir bts) +-- `seq` rnf (buildSettingHttpTransport bts) +-- `seq` rnf (buildSettingIgnoreExpiry bts) +-- `seq` rnf (buildSettingProgPathExtra bts) +-- `seq` rnf (buildSettingHaddockOpen bts) +-- `seq` () +-- {-# OPTIONS_GHC -Wno-orphans #-} +-- module Ide.Plugin.CabalProject.Orphans () where + +-- import Control.DeepSeq ( NFData, rnf) +-- import Distribution.Compat.Prelude (genericRnf) +-- import Ide.Plugin.Cabal.Orphans () +-- import Distribution.Client.ProjectConfig.Types (BuildTimeSettings(..)) +-- import GHC.Generics ( Generic ) +-- import Control.DeepSeq ( NFData(rnf) ) +-- import Distribution.Simple.InstallDirs ( PathTemplate ) +-- import Distribution.Verbosity ( Verbosity ) +-- import Distribution.Client.BuildReports.Types ( ReportLevel ) +-- import Distribution.Types.ParStrat ( ParStratInstall ) +-- import Distribution.Client.Types.Repo ( RemoteRepo, LocalRepo ) + +-- -- 1) Orphan NFData instances for all the “missing” imported types. +-- instance NFData PathTemplate where rnf = genericRnf +-- instance NFData Verbosity where rnf = genericRnf +-- instance NFData ReportLevel where rnf = genericRnf +-- instance NFData ParStratInstall where rnf = genericRnf +-- instance NFData RemoteRepo where rnf = genericRnf +-- instance NFData LocalRepo where rnf = genericRnf + +-- instance NFData BuildTimeSettings where +-- rnf bts = +-- rnf (buildSettingDryRun bts) +-- `seq` rnf (buildSettingOnlyDeps bts) +-- `seq` rnf (buildSettingOnlyDownload bts) +-- `seq` rnf (buildSettingSummaryFile bts) +-- `seq` () +-- `seq` rnf (buildSettingLogVerbosity bts) +-- `seq` rnf (buildSettingBuildReports bts) +-- `seq` rnf (buildSettingReportPlanningFailure bts) +-- `seq` rnf (buildSettingSymlinkBinDir bts) +-- `seq` rnf (buildSettingNumJobs bts) +-- `seq` rnf (buildSettingKeepGoing bts) +-- `seq` rnf (buildSettingOfflineMode bts) +-- `seq` rnf (buildSettingKeepTempFiles bts) +-- `seq` rnf (buildSettingRemoteRepos bts) +-- `seq` rnf (buildSettingLocalNoIndexRepos bts) +-- `seq` rnf (buildSettingCacheDir bts) +-- `seq` rnf (buildSettingHttpTransport bts) +-- `seq` rnf (buildSettingIgnoreExpiry bts) +-- `seq` rnf (buildSettingProgPathExtra bts) +-- `seq` rnf (buildSettingHaddockOpen bts) +-- `seq` () + + +-- import Control.DeepSeq (NFData(rnf)) +-- import qualified Data.Map as Map +-- import qualified Data.Set as Set +-- import Ide.Plugin.Cabal.Orphans () + + +-- import Distribution.Client.ProjectConfig.Types +-- ( ProjectConfig(..) +-- , ProjectConfigBuildOnly +-- , ProjectConfigShared +-- , ProjectConfigProvenance +-- , PackageConfig +-- , MapMappend(getMapMappend) +-- ) +-- import Distribution.Client.Types.SourceRepo +-- ( SourceRepoList ) +-- import Distribution.Types.PackageVersionConstraint +-- ( PackageVersionConstraint ) +-- import Distribution.Types.PackageName +-- ( PackageName ) + +-- -- | The only “deep” NFData: we pattern‐match on all ten fields and +-- -- rnf them. For the Set we convert to a list so we don’t need +-- -- a Set‐instance; for the MapMappend we unwrap to a list of pairs. +-- instance NFData ProjectConfig where +-- rnf (ProjectConfig +-- pkgs +-- pkgsOpt +-- pkgsRepo +-- pkgsNamed +-- buildOnly +-- shared +-- prov +-- allPkgs +-- localPkgs +-- specificM) = +-- rnf pkgs +-- `seq` rnf pkgsOpt +-- `seq` rnf pkgsRepo +-- `seq` rnf pkgsNamed +-- `seq` rnf buildOnly +-- `seq` rnf shared +-- `seq` rnf (Set.toList prov) +-- `seq` rnf allPkgs +-- `seq` rnf localPkgs +-- `seq` rnf (Map.toList (getMapMappend specificM)) + +-- -- Trivial NFData instances for all of the immediate field types +-- -- so that the above rnf calls will compile. + +-- instance NFData SourceRepoList where +-- rnf _ = () + +-- instance NFData ProjectConfigBuildOnly where +-- rnf _ = () + +-- instance NFData ProjectConfigShared where +-- rnf _ = () + +-- instance NFData ProjectConfigProvenance where +-- rnf _ = () + +-- instance NFData PackageConfig where +-- rnf _ = () + + +------------------------------------------------- OLD + + 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 index 004d117c24..d34e6bfaae 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs @@ -6,7 +6,10 @@ module Ide.Plugin.CabalProject.Parse ) where import Control.Monad (unless) +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 @@ -25,21 +28,30 @@ import Distribution.Types.Version (Version) import Distribution.Verbosity (normal) import qualified Ide.Plugin.CabalProject.Diagnostics as Diagnostics import System.Directory (doesFileExist) -import System.FilePath (takeDirectory) +import System.Directory.Extra (XdgDirectory (..), + getXdgDirectory) +import System.FilePath (takeBaseName, + takeDirectory, ()) +-- import System.Directory.Extra as SD + + + parseCabalProjectFileContents :: FilePath + -> BS.ByteString -> IO ([PWarning] , Either (Maybe Version, NonEmpty PError) ProjectConfigSkeleton) -parseCabalProjectFileContents fp = do - bytes <- BS.readFile fp +parseCabalProjectFileContents fp bytes = do + cacheDir <- getCabalProjectCacheDir fp +-- bytes <- BS.readFile fp let toParse = ProjectConfigToParse bytes - rootDir = takeDirectory fp + -- rootDir = takeDirectory fp verb = normal httpTransport <- configureTransport verb [fp] Nothing parseRes :: PR.ParseResult ProjectConfigSkeleton - <- parseProject rootDir fp httpTransport verb toParse + <- parseProject fp cacheDir httpTransport verb toParse pure (PR.runParseResult parseRes) @@ -57,3 +69,14 @@ readCabalProjectFields file contents = (_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" From 72fc5ab817b7bcb06905ec7c51fcce600e91eda6 Mon Sep 17 00:00:00 2001 From: rm41339 Date: Mon, 30 Jun 2025 13:42:48 +0200 Subject: [PATCH 13/15] add NFData instances to cabal --- .../src/Ide/Plugin/CabalProject/Orphans.hs | 15 ++++++++++++--- vendor/cabal | 2 +- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs index 9f15a5a46c..cd55360002 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs @@ -15,12 +15,21 @@ import GHC.Generics (Generic) import qualified Distribution.Client.ProjectConfig.Types as PC import Ide.Plugin.Cabal.Orphans () + +orphans = undefined -- Project Config Orphans -deriving instance NFData PCPath.ProjectConfigPath -instance NFData PC.ProjectConfig where - rnf !_ = () +-- more nfdata instances i need: +-- Distribution.Client.Types.SourceRepo.SourceRepositoryPackage [] +-- NFData (NubList PathTemplate) +-- NFData (InstallDirs (Flag PathTemplate)) +-- NFData (NubList FilePath) + +-- deriving instance NFData PCPath.ProjectConfigPath + +-- instance NFData PC.ProjectConfig where +-- rnf !_ = () -- {-# OPTIONS_GHC -Wno-orphans #-} -- {-# LANGUAGE FlexibleInstances #-} diff --git a/vendor/cabal b/vendor/cabal index 369a520d2c..e67e97fdd6 160000 --- a/vendor/cabal +++ b/vendor/cabal @@ -1 +1 @@ -Subproject commit 369a520d2ca162e5967407b68c107c3922204545 +Subproject commit e67e97fdd60983550bdc963dbf873a0895ceac8d From c05125e32c61be6b972a6f20a301dfbbac8649e4 Mon Sep 17 00:00:00 2001 From: rm41339 Date: Thu, 3 Jul 2025 22:28:19 +0200 Subject: [PATCH 14/15] fix parseCabalProjectFileContents arguments, add test --- haskell-language-server.cabal | 2 + .../src/Ide/Plugin/CabalProject.hs | 14 ++--- .../src/Ide/Plugin/CabalProject/Parse.hs | 4 -- plugins/hls-cabal-project-plugin/test/Main.hs | 54 +++++++++++++++---- .../testdata/root-directory/cabal.project | 1 + vendor/cabal | 2 +- 6 files changed, 55 insertions(+), 22 deletions(-) create mode 100644 plugins/hls-cabal-project-plugin/test/testdata/root-directory/cabal.project diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c451a781e5..59b4067db6 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -397,6 +397,8 @@ test-suite hls-cabal-project-plugin-tests , lsp-types , text , hls-plugin-api + , cabal-install + ----------------------------- -- class plugin diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs index 6f5f65c6ca..c9fb4a4386 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs @@ -58,7 +58,7 @@ import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS import System.FilePath (takeFileName) import Text.Regex.TDFA - +-- import Ide.Plugin.Cabal.Orphans () data Log = LogModificationTime NormalizedFilePath FileVersion @@ -203,14 +203,16 @@ cabalRules recorder plId = do 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, mRope) <- use_ GetFileContents file + (t, mCabalSource) <- use_ GetFileContents file log' Debug $ LogModificationTime file t - bytes <- case mRope of - Just sources -> pure (Encoding.encodeUtf8 (Rope.toText sources)) - Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath file) + contents <- case mCabalSource of + Just sources -> + pure $ Encoding.encodeUtf8 $ Rope.toText sources + Nothing -> + liftIO $ BS.readFile $ fromNormalizedFilePath file - (pWarnings, pResult) <- liftIO $ Parse.parseCabalProjectFileContents (fromNormalizedFilePath file) bytes + (pWarnings, pResult) <- liftIO $ Parse.parseCabalProjectFileContents (fromNormalizedFilePath file) contents let warnDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings case pResult of 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 index d34e6bfaae..1eaa2533ce 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs @@ -32,10 +32,6 @@ import System.Directory.Extra (XdgDirectory (..), getXdgDirectory) import System.FilePath (takeBaseName, takeDirectory, ()) --- import System.Directory.Extra as SD - - - parseCabalProjectFileContents :: FilePath diff --git a/plugins/hls-cabal-project-plugin/test/Main.hs b/plugins/hls-cabal-project-plugin/test/Main.hs index fc004ce892..b1ef14336a 100644 --- a/plugins/hls-cabal-project-plugin/test/Main.hs +++ b/plugins/hls-cabal-project-plugin/test/Main.hs @@ -6,20 +6,29 @@ module Main ( main, ) where -import Control.Lens ((^.)) -import Control.Lens.Fold ((^?)) -import Control.Monad (guard) -import qualified Data.ByteString as BS -import Data.Either (isRight) -import Data.List.Extra (nubOrdOn) -import qualified Data.Maybe as Maybe -import qualified Data.Text as T -import qualified Ide.Plugin.CabalProject.Parse as Lib -import qualified Language.LSP.Protocol.Lens as L +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 $ @@ -45,10 +54,33 @@ cabalProjectParserUnitTests = testGroup "Parsing Cabal Project" [ testCase "Simple Parsing works" $ do - (warnings, pm) <- Lib.parseCabalProjectFileContents (testDataDir "cabal.project") + 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" ] -- ------------------------ ------------------------------------------------ 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/vendor/cabal b/vendor/cabal index e67e97fdd6..447964a7b8 160000 --- a/vendor/cabal +++ b/vendor/cabal @@ -1 +1 @@ -Subproject commit e67e97fdd60983550bdc963dbf873a0895ceac8d +Subproject commit 447964a7b8fb430f69dcfd394188c0eafd576413 From 8dc4a545c27b13dffde9de58bca0b2c4a4994865 Mon Sep 17 00:00:00 2001 From: rm41339 Date: Thu, 3 Jul 2025 22:40:47 +0200 Subject: [PATCH 15/15] finish cleaning up diagnostics code --- haskell-language-server.cabal | 1 - .../src/Ide/Plugin/CabalProject.hs | 27 +-- .../src/Ide/Plugin/CabalProject/Orphans.hs | 228 ------------------ 3 files changed, 1 insertion(+), 255 deletions(-) delete mode 100644 plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 59b4067db6..58fb52ecb7 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -340,7 +340,6 @@ library hls-cabal-project-plugin Ide.Plugin.CabalProject.Parse Ide.Plugin.CabalProject.Diagnostics Ide.Plugin.CabalProject.Types - Ide.Plugin.CabalProject.Orphans build-depends: , bytestring diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs index c9fb4a4386..1c9ed94fe4 100644 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs +++ b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs @@ -46,8 +46,8 @@ import Distribution.PackageDescription.Configuration (flattenPackageDe import Distribution.Parsec.Error import qualified Distribution.Parsec.Position as Syntax import GHC.Generics +import Ide.Plugin.Cabal.Orphans () import Ide.Plugin.CabalProject.Diagnostics as Diagnostics -import Ide.Plugin.CabalProject.Orphans () import Ide.Plugin.CabalProject.Parse as Parse import Ide.Plugin.CabalProject.Types as Types import Ide.Plugin.Error @@ -58,7 +58,6 @@ import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS import System.FilePath (takeFileName) import Text.Regex.TDFA --- import Ide.Plugin.Cabal.Orphans () data Log = LogModificationTime NormalizedFilePath FileVersion @@ -99,14 +98,12 @@ descriptor recorder plId = \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocOpened _uri - -- parseAndPrint (fromNormalizedFilePath file) restartCabalShakeSession (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 - -- parseAndPrint (fromNormalizedFilePath file) restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $ addFileOfInterest recorder ide file Modified{firstOpen = False} , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $ @@ -132,28 +129,6 @@ descriptor recorder plId = whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath' - -- for development/debugging - parseAndPrint :: FilePath -> IO () - parseAndPrint file = do - bytes <- BS.readFile file - (warnings, res) <- Parse.parseCabalProjectFileContents file bytes - - mapM_ (putStrLn . ("[Cabal warning] " ++) . show) warnings - - case res of - Left (_mbSpecVer, errs) -> - putStrLn $ - "Cabal project parse failed:\n" ++ unlines (map show (NE.toList errs)) - - Right project -> - putStrLn $ - "Cabal project parsed successfully:\n" ++ show project - - bs <- BS.readFile file - case Parse.readCabalProjectFields (toNormalizedFilePath' file) bs of - Left diag -> putStrLn $ "readCabalProjectFields error:\n" ++ show diag - Right flds -> putStrLn $ "readCabalProjectFields success:\n" ++ show flds - {- | 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. diff --git a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs b/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs deleted file mode 100644 index cd55360002..0000000000 --- a/plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs +++ /dev/null @@ -1,228 +0,0 @@ -{-# OPTIONS_GHC -Wno-orphans #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -module Ide.Plugin.CabalProject.Orphans where - -import Control.DeepSeq -import Distribution.Fields.Field -import Distribution.Parsec.Position --- import Control.DeepSeq (NFData) -import qualified Distribution.Solver.Types.ProjectConfigPath as PCPath -import GHC.Generics (Generic) - -import qualified Distribution.Client.ProjectConfig.Types as PC -import Ide.Plugin.Cabal.Orphans () - - -orphans = undefined --- Project Config Orphans - - --- more nfdata instances i need: --- Distribution.Client.Types.SourceRepo.SourceRepositoryPackage [] --- NFData (NubList PathTemplate) --- NFData (InstallDirs (Flag PathTemplate)) --- NFData (NubList FilePath) - --- deriving instance NFData PCPath.ProjectConfigPath - --- instance NFData PC.ProjectConfig where --- rnf !_ = () - --- {-# OPTIONS_GHC -Wno-orphans #-} --- {-# LANGUAGE FlexibleInstances #-} --- {-# LANGUAGE RecordWildCards #-} - --- module Ide.Plugin.CabalProject.Orphans () where - --- import Control.DeepSeq ( NFData, rnf ) --- import Distribution.Compat.Prelude ( genericRnf ) --- import Distribution.Verbosity (Verbosity) --- import Distribution.Verbosity.Internal (VerbosityLevel(..), VerbosityFlag(..)) --- import Ide.Plugin.Cabal.Orphans () - --- import Distribution.Client.ProjectConfig.Types --- ( BuildTimeSettings(..) ) --- import Distribution.Simple.InstallDirs.Internal --- ( PathComponent(..), PathTemplateVariable(..) --- ) --- import Distribution.Simple.InstallDirs --- ( PathTemplate(..) ) --- import Control.DeepSeq ( NFData(rnf) ) --- import Distribution.Client.BuildReports.Types (ReportLevel) - --- import Distribution.Client.Types.Repo (RemoteRepo, LocalRepo) - --- -- PathTemplate --- instance NFData PathTemplate where --- rnf = genericRnf - --- instance NFData PathComponent where --- rnf = genericRnf - --- instance NFData PathTemplateVariable where --- rnf = genericRnf - --- -- Verbosity --- instance NFData Verbosity where --- rnf = genericRnf - --- -- instance NFData VerbosityLevel where --- -- rnf = genericRnf - --- -- instance NFData VerbosityFlag where --- -- rnf = genericRnf - --- -- ReportLevel --- instance NFData ReportLevel where --- rnf = genericRnf - --- -- RemoteRepo --- instance NFData RemoteRepo where --- rnf = genericRnf - --- instance NFData LocalRepo where --- rnf = genericRnf - --- instance NFData BuildTimeSettings where --- rnf bts = --- rnf (buildSettingDryRun bts) --- `seq` rnf (buildSettingOnlyDeps bts) --- `seq` rnf (buildSettingOnlyDownload bts) --- `seq` rnf (buildSettingSummaryFile bts) --- `seq` () --- `seq` rnf (buildSettingLogVerbosity bts) --- `seq` rnf (buildSettingBuildReports bts) --- `seq` rnf (buildSettingReportPlanningFailure bts) --- `seq` rnf (buildSettingSymlinkBinDir bts) --- `seq` rnf (buildSettingNumJobs bts) --- `seq` rnf (buildSettingKeepGoing bts) --- `seq` rnf (buildSettingOfflineMode bts) --- `seq` rnf (buildSettingKeepTempFiles bts) --- `seq` rnf (buildSettingRemoteRepos bts) --- `seq` rnf (buildSettingLocalNoIndexRepos bts) --- `seq` rnf (buildSettingCacheDir bts) --- `seq` rnf (buildSettingHttpTransport bts) --- `seq` rnf (buildSettingIgnoreExpiry bts) --- `seq` rnf (buildSettingProgPathExtra bts) --- `seq` rnf (buildSettingHaddockOpen bts) --- `seq` () --- {-# OPTIONS_GHC -Wno-orphans #-} --- module Ide.Plugin.CabalProject.Orphans () where - --- import Control.DeepSeq ( NFData, rnf) --- import Distribution.Compat.Prelude (genericRnf) --- import Ide.Plugin.Cabal.Orphans () --- import Distribution.Client.ProjectConfig.Types (BuildTimeSettings(..)) --- import GHC.Generics ( Generic ) --- import Control.DeepSeq ( NFData(rnf) ) --- import Distribution.Simple.InstallDirs ( PathTemplate ) --- import Distribution.Verbosity ( Verbosity ) --- import Distribution.Client.BuildReports.Types ( ReportLevel ) --- import Distribution.Types.ParStrat ( ParStratInstall ) --- import Distribution.Client.Types.Repo ( RemoteRepo, LocalRepo ) - --- -- 1) Orphan NFData instances for all the “missing” imported types. --- instance NFData PathTemplate where rnf = genericRnf --- instance NFData Verbosity where rnf = genericRnf --- instance NFData ReportLevel where rnf = genericRnf --- instance NFData ParStratInstall where rnf = genericRnf --- instance NFData RemoteRepo where rnf = genericRnf --- instance NFData LocalRepo where rnf = genericRnf - --- instance NFData BuildTimeSettings where --- rnf bts = --- rnf (buildSettingDryRun bts) --- `seq` rnf (buildSettingOnlyDeps bts) --- `seq` rnf (buildSettingOnlyDownload bts) --- `seq` rnf (buildSettingSummaryFile bts) --- `seq` () --- `seq` rnf (buildSettingLogVerbosity bts) --- `seq` rnf (buildSettingBuildReports bts) --- `seq` rnf (buildSettingReportPlanningFailure bts) --- `seq` rnf (buildSettingSymlinkBinDir bts) --- `seq` rnf (buildSettingNumJobs bts) --- `seq` rnf (buildSettingKeepGoing bts) --- `seq` rnf (buildSettingOfflineMode bts) --- `seq` rnf (buildSettingKeepTempFiles bts) --- `seq` rnf (buildSettingRemoteRepos bts) --- `seq` rnf (buildSettingLocalNoIndexRepos bts) --- `seq` rnf (buildSettingCacheDir bts) --- `seq` rnf (buildSettingHttpTransport bts) --- `seq` rnf (buildSettingIgnoreExpiry bts) --- `seq` rnf (buildSettingProgPathExtra bts) --- `seq` rnf (buildSettingHaddockOpen bts) --- `seq` () - - --- import Control.DeepSeq (NFData(rnf)) --- import qualified Data.Map as Map --- import qualified Data.Set as Set --- import Ide.Plugin.Cabal.Orphans () - - --- import Distribution.Client.ProjectConfig.Types --- ( ProjectConfig(..) --- , ProjectConfigBuildOnly --- , ProjectConfigShared --- , ProjectConfigProvenance --- , PackageConfig --- , MapMappend(getMapMappend) --- ) --- import Distribution.Client.Types.SourceRepo --- ( SourceRepoList ) --- import Distribution.Types.PackageVersionConstraint --- ( PackageVersionConstraint ) --- import Distribution.Types.PackageName --- ( PackageName ) - --- -- | The only “deep” NFData: we pattern‐match on all ten fields and --- -- rnf them. For the Set we convert to a list so we don’t need --- -- a Set‐instance; for the MapMappend we unwrap to a list of pairs. --- instance NFData ProjectConfig where --- rnf (ProjectConfig --- pkgs --- pkgsOpt --- pkgsRepo --- pkgsNamed --- buildOnly --- shared --- prov --- allPkgs --- localPkgs --- specificM) = --- rnf pkgs --- `seq` rnf pkgsOpt --- `seq` rnf pkgsRepo --- `seq` rnf pkgsNamed --- `seq` rnf buildOnly --- `seq` rnf shared --- `seq` rnf (Set.toList prov) --- `seq` rnf allPkgs --- `seq` rnf localPkgs --- `seq` rnf (Map.toList (getMapMappend specificM)) - --- -- Trivial NFData instances for all of the immediate field types --- -- so that the above rnf calls will compile. - --- instance NFData SourceRepoList where --- rnf _ = () - --- instance NFData ProjectConfigBuildOnly where --- rnf _ = () - --- instance NFData ProjectConfigShared where --- rnf _ = () - --- instance NFData ProjectConfigProvenance where --- rnf _ = () - --- instance NFData PackageConfig where --- rnf _ = () - - -------------------------------------------------- OLD - -