DRAFT: LSP folding range for Cabal plugin

.github/workflows/test.yml

@@ -238,6 +238,10 @@ jobs:
         name: Test hls-cabal-plugin test suite
         run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests
 
+      - if: matrix. test
+        name: Test hls-cabal-plugin test suite
+        run: cabal test hls-cabal-project-plugin-tests || cabal test hls-cabal-project-plugin-tests
+
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-retrie-plugin test suite

.gitmodules

@@ -8,3 +8,7 @@
 #     Commit git commit -m "Removed submodule <name>"
 #     Delete the now untracked submodule files
 #     rm -rf path_to_submodule
+
+[submodule "vendor/cabal"]
+	path = vendor/cabal
+	url = https://github.com/rm41339/cabal.git

cabal.project

@@ -5,9 +5,31 @@ packages:
          ./ghcide
          ./hls-plugin-api
          ./hls-test-utils
+         ./vendor/cabal/Cabal
+         ./vendor/cabal/Cabal-syntax
+         ./vendor/cabal/cabal-install
+         ./vendor/cabal/cabal-install-solver
+         ./vendor/cabal/Cabal-described
+         ./vendor/cabal/Cabal-tree-diff
 
+source-repository-package
+   type:     git
+   location: https://github.com/fendor/cabal-add/
+   tag: 3ae65c28bfc6eff66a7a05bb9547665f62a35b63
 
-index-state: 2025-08-08T12:31:54Z
+source-repository-package
+   type:     git
+   location: https://github.com/fendor/haskell-ci/
+   tag: e3e68f064f9610267bb47ea6404ccaa6924c2201
+   subdir: cabal-install-parsers
+
+package cabal-install
+  tests: False
+  benchmarks: False
+
+flags: -ormolu -stylishHaskell -stan -fourmolu
+
+index-state: 2025-08-08T12:31:54Z 
 
 tests: True
 test-show-details: direct
@@ -50,6 +72,9 @@ constraints:
 -- cabal-add depends on cabal-install-parsers.
 allow-newer:
   cabal-install-parsers:Cabal-syntax,
+  *:Cabal-syntax,
+  *:cabal-install,
+  *:Cabal
 
 if impl(ghc >= 9.11)
   benchmarks: False

ghcide/session-loader/Development/IDE/Session.hs

@@ -14,6 +14,7 @@
   ,retryOnException
   ,Log(..)
   ,runWithDb
+  , cacheDir
   ) where
 
 -- Unfortunately, we cannot use loadSession with ghc-lib since hie-bios uses
@@ -629,7 +630,7 @@
                  [] -> error $ "GHC version could not be parsed: " <> version
                  ((runTime, _):_)
                    | compileTime == runTime -> do
                      atomicModifyIORef' cradle_files (\xs -> (cfp:xs,()))
                      session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
                    | otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[])
              -- Failure case, either a cradle error or the none cradle
@@ -896,7 +897,7 @@
             x <- map errMsgDiagnostic closure_errs
             DriverHomePackagesNotClosed us <- pure x
             pure us
         isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units
     -- Whenever we spin up a session on Linux, dynamically load libm.so.6
     -- in. We need this in case the binary is statically linked, in which
     -- case the interactive session will fail when trying to load

haskell-language-server.cabal

@@ -264,7 +264,7 @@ library hls-cabal-plugin
     Ide.Plugin.Cabal.Orphans
     Ide.Plugin.Cabal.Outline
     Ide.Plugin.Cabal.Parse
-
+    Ide.Plugin.Cabal.FoldingRange
 
   build-depends:
     , bytestring
@@ -307,6 +307,7 @@ test-suite hls-cabal-plugin-tests
     Completer
     Context
     Definition
+    FoldingRange
     Outline
     Utils
   build-depends:
@@ -321,6 +322,87 @@ test-suite hls-cabal-plugin-tests
     , lsp
     , lsp-types
     , text
+    , haskell-language-server:hls-code-range-plugin
+
+-----------------------------
+-- cabal project plugin
+-----------------------------
+
+flag cabalProject
+  description: Enable cabalProject plugin
+  default:     True
+  manual:      True
+
+common cabalProject
+  if flag(cabalProject)
+    build-depends: haskell-language-server:hls-cabal-project-plugin
+    cpp-options: -Dhls_cabal_project
+
+library hls-cabal-project-plugin
+  import:           defaults, pedantic, warnings
+  if !flag(cabalProject)
+    buildable: False
+  exposed-modules:
+    Ide.Plugin.CabalProject
+    Ide.Plugin.CabalProject.Parse
+    Ide.Plugin.CabalProject.Diagnostics
+    Ide.Plugin.CabalProject.Types
+
+  build-depends:
+    , bytestring
+    , Cabal-syntax          >= 3.7
+    , containers
+    , deepseq
+    , directory
+    , filepath
+    , extra                 >=1.7.4
+    , ghcide                == 2.11.0.0
+    , hashable
+    , hls-plugin-api        == 2.11.0.0
+    , hls-graph             == 2.11.0.0
+    , lens
+    , lsp                   ^>=2.7
+    , lsp-types             ^>=2.3
+    , regex-tdfa            ^>=1.3.1
+    , text
+    , text-rope
+    , transformers
+    , unordered-containers  >=0.2.10.0
+    , containers
+    , process
+    , aeson
+    , Cabal
+    , pretty
+    , cabal-install
+    , cabal-install-solver
+    , haskell-language-server:hls-cabal-plugin
+    , base16-bytestring
+    , cryptohash-sha1
+
+  hs-source-dirs:   plugins/hls-cabal-project-plugin/src
+
+test-suite hls-cabal-project-plugin-tests
+  import:           defaults, pedantic, test-defaults, warnings
+  if !flag(cabalProject)
+    buildable: False
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   plugins/hls-cabal-project-plugin/test
+  main-is:          Main.hs
+  other-modules:
+    Utils
+  build-depends:
+    , bytestring
+    , Cabal-syntax          >= 3.7
+    , extra
+    , filepath
+    , ghcide
+    , haskell-language-server:hls-cabal-project-plugin
+    , hls-test-utils    == 2.11.0.0
+    , lens
+    , lsp-types
+    , text
+    , hls-plugin-api
+    , cabal-install
 
 -----------------------------
 -- class plugin
@@ -1847,6 +1929,7 @@ library
                   , pedantic
                   -- plugins
                   , cabal
+                  , cabalProject
                   , callHierarchy
                   , cabalfmt
                   , cabalgild

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

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

@@ -44,6 +44,7 @@ import qualified Ide.Plugin.Cabal.Completion.Types             as Types
 import           Ide.Plugin.Cabal.Definition                   (gotoDefinition)
 import qualified Ide.Plugin.Cabal.FieldSuggest                 as FieldSuggest
 import qualified Ide.Plugin.Cabal.Files                        as CabalAdd
+import           Ide.Plugin.Cabal.FoldingRange
 import qualified Ide.Plugin.Cabal.LicenseSuggest               as LicenseSuggest
 import qualified Ide.Plugin.Cabal.OfInterest                   as OfInterest
 import           Ide.Plugin.Cabal.Orphans                      ()
@@ -127,6 +128,7 @@ descriptor recorder plId =
           , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
           , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition
           , mkPluginHandler LSP.SMethod_TextDocumentHover hover
+          , mkPluginHandler LSP.SMethod_TextDocumentFoldingRange foldingRangeModuleOutline
           ]
     , pluginNotificationHandlers =
         mconcat

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(..)

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FoldingRange.hs

@@ -0,0 +1,117 @@
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+module Ide.Plugin.Cabal.FoldingRange where
+
+import           Control.Monad.IO.Class
+import           Data.Maybe
+import qualified Data.Text                               as T
+import           Data.Text.Encoding                      (decodeUtf8)
+import           Development.IDE.Core.Rules
+import           Development.IDE.Core.Shake              (IdeState (shakeExtras),
+                                                          runIdeAction,
+                                                          useWithStaleFast)
+import           Development.IDE.Types.Location          (toNormalizedFilePath')
+import           Distribution.Fields.Field               (Field (Field, Section),
+                                                          Name (Name))
+import           Distribution.Parsec.Position            (Position)
+import           Ide.Plugin.Cabal.Completion.CabalFields (onelineSectionArgs)
+import           Ide.Plugin.Cabal.Completion.Types       (ParseCabalFields (..),
+                                                          cabalPositionToLSPPosition)
+import           Ide.Plugin.Cabal.Orphans                ()
+import           Ide.Plugin.Cabal.Outline
+import           Ide.Types                               (PluginMethodHandler)
+import           Language.LSP.Protocol.Message           (Method (..))
+import           Language.LSP.Protocol.Types             (FoldingRange (..))
+import qualified Language.LSP.Protocol.Types             as LSP
+
+foldingRangeModuleOutline :: PluginMethodHandler IdeState Method_TextDocumentFoldingRange
+foldingRangeModuleOutline ideState _ LSP.FoldingRangeParams {_textDocument = LSP.TextDocumentIdentifier uri} =
+  case LSP.uriToFilePath uri of
+    Just (toNormalizedFilePath' -> fp) -> do
+      mFields <- liftIO $ runIdeAction "cabal-plugin.fields" (shakeExtras ideState) (useWithStaleFast ParseCabalFields fp)
+      case fmap fst mFields of
+        Just fieldPositions -> pure (LSP.InL allRanges)
+          where
+            allRanges = mapMaybe foldingRangeForField fieldPositions
+        Nothing -> pure (LSP.InL [])
+    Nothing -> pure (LSP.InL [])
+
+-- | Creates a @FoldingRange@ object for the
+--   cabal AST, without displaying @fieldLines@ and
+--   displaying @Section Name@ and @SectionArgs@ in one line.
+--
+--   @fieldLines@ are leaves of a cabal AST, so they are omitted
+--   in the outline. Sections have to be displayed in one line, because
+--   the AST representation looks unnatural. See examples:
+--
+-- *  part of a cabal file:
+--
+-- >   if impl(ghc >= 9.8)
+-- >      ghc-options: -Wall
+--
+-- * AST representation:
+--
+-- >   if
+-- >      impl
+-- >      (
+-- >      ghc >= 9.8
+-- >      )
+-- >
+-- >      ghc-options:
+-- >        -Wall
+--
+-- * resulting @DocumentSymbol@:
+--
+-- >   if impl(ghc >= 9.8)
+-- >      ghc-options:
+-- >
+foldingRangeForField :: Field Position -> Maybe FoldingRange
+foldingRangeForField (Field (Name pos fieldName) _) =
+  Just
+    (defFoldingRange lspPos)
+      { _collapsedText = Just (decodeUtf8 fieldName)
+      }
+  where
+    lspPos@(LSP.Position startLine startChar) = cabalPositionToLSPPosition pos
+
+foldingRangeForField (Section (Name pos fieldName) sectionArgs fields) =
+  Just
+    (defFoldingRange lspPos)
+      { _endLine = endLine,
+        _endCharacter = Just endChar,
+        _collapsedText = Just joinedName
+      }
+  where
+    lspPos = cabalPositionToLSPPosition pos
+    LSP.Position startLine startChar = lspPos
+    joinedName = decodeUtf8 fieldName <> " " <> onelineSectionArgs sectionArgs
+    LSP.Position endLine endChar = fromMaybe lspPos (lastFieldPosition fields)
+
+lastFieldPosition :: [Field Position] -> Maybe LSP.Position
+lastFieldPosition [] = Nothing
+lastFieldPosition xs =
+    case last xs of
+        Field (Name pos _) _     -> Just (cabalPositionToLSPPosition pos)
+        Section (Name pos _) _ _ -> Just (cabalPositionToLSPPosition pos)
+
+-- | Creates a single point LSP range
+--   using cabal position
+-- cabalPositionToLSPRange :: Position -> LSP.Range
+-- cabalPositionToLSPRange pos = LSP.Range lspPos lspPos
+--   where
+--     lspPos = cabalPositionToLSPPosition pos
+
+defFoldingRange :: LSP.Position -> FoldingRange
+defFoldingRange (LSP.Position line char) = FoldingRange
+  { _startLine = line
+  , _startCharacter = Just char
+  , _endLine = line
+  , _endCharacter = Just char
+  , _kind = Just LSP.FoldingRangeKind_Region
+  , _collapsedText = Nothing
+  }