Support cabal-install-3.12 store directory logic

phadej · Jul 1, 2024 · ea8089d · ea8089d
1 parent 7076f68
commit ea8089d
Show file tree

Hide file tree

Showing 9 changed files with 51 additions and 14 deletions.
diff --git a/cabal-docspec/Changelog.md b/cabal-docspec/Changelog.md
@@ -1,3 +1,7 @@
+# 0.0.0.20240702
+
+- Support `cabal-install-3.12` changed store directory logic
+
 # 0.0.0.20240414
 
 - `--extra-package` accepts sublibraries, i.e. `mypkg:sublib` syntax.

diff --git a/cabal-docspec/Makefile b/cabal-docspec/Makefile
@@ -1,8 +1,9 @@
-VERSION=0.0.0.20240414
+VERSION=0.0.0.20240702
+DATE="July 2nd, 2024"
 EXETARGET=cabal-docspec
 
 cabal-docspec.1 : MANUAL.md
-	echo '.TH CABAL-DOCSPEC 1 "May 17th, 2023" "cabal-docspec $(VERSION)" "Cabal Extras"' > cabal-docspec.1
+	echo '.TH CABAL-DOCSPEC 1 "$(DATE)" "cabal-docspec $(VERSION)" "Cabal Extras"' > cabal-docspec.1
 	pandoc -f markdown -t man MANUAL.md >> cabal-docspec.1
 
 man : cabal-docspec.1

diff --git a/cabal-docspec/cabal-docspec.1 b/cabal-docspec/cabal-docspec.1
@@ -1,4 +1,4 @@
-.TH CABAL-DOCSPEC 1 "May 17th, 2023" "cabal-docspec 0.0.0.20240414" "Cabal Extras"
+.TH CABAL-DOCSPEC 1 ""July 2nd, 2024"" "cabal-docspec 0.0.0.20240702" "Cabal Extras"
 .SH NAME
 .PP
 cabal-docspec - another doctest for Haskell

diff --git a/cabal-docspec/cabal-docspec.cabal b/cabal-docspec/cabal-docspec.cabal
@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               cabal-docspec
-version:            0.0.0.20240414
+version:            0.0.0.20240702
 synopsis:           Run examples in your docs
 category:           Development
 description:

diff --git a/cabal-docspec/src/CabalDocspec/Main.hs b/cabal-docspec/src/CabalDocspec/Main.hs
@@ -229,6 +229,9 @@ testComponent tracer0 tracerTop dynOptsCli ghcInfo buildDir cabalCfg plan env pk
         -- Skip other components
         _ -> return mempty
   where
+    mcabalVer :: Maybe Version
+    mcabalVer = Just $ toCabal $ Plan.pjCabalVersion plan
+
     sublibs :: Map C.UnqualComponentName (C.CondTree C.ConfVar [C.Dependency] C.Library)
     sublibs = Map.fromList (C.condSubLibraries $ pkgGpd pkg)
 
@@ -284,7 +287,7 @@ testComponent tracer0 tracerTop dynOptsCli ghcInfo buildDir cabalCfg plan env pk
         validated <- validate tracer parsed
         if optPhase dynOpts > Phase1
         then do
-            phase2 tracer dynOpts unitIds ghcInfo (Just buildDir) cabalCfg (pkgDir pkg) env validated
+            phase2 tracer dynOpts unitIds ghcInfo mcabalVer (Just buildDir) cabalCfg (pkgDir pkg) env validated
         else
             return $ foldMap skipModule parsed
 
@@ -374,11 +377,15 @@ testComponentNo tracer0 tracerTop dynOptsCli ghcInfo cabalCfg dbG pkg = do
 
     validated <- validate tracer parsed
 
+    -- without plan.json we cannot know which cabal-install is used.
+    -- assume latest.
+    let mcabalVer = Nothing
+
     if optPhase dynOpts > Phase1
     then do
         -- Note: we don't pass additional environment
         -- For non-cabal-plan setup we simply don't support data-files.
-        phase2 tracer dynOpts unitIds ghcInfo Nothing cabalCfg (pkgDir pkg) [] validated
+        phase2 tracer dynOpts unitIds ghcInfo mcabalVer Nothing cabalCfg (pkgDir pkg) [] validated
     else
         return $ foldMap skipModule parsed
 

diff --git a/cabal-docspec/src/CabalDocspec/Phase2.hs b/cabal-docspec/src/CabalDocspec/Phase2.hs
@@ -31,13 +31,14 @@ phase2
     -> DynOpts
     -> [UnitId]
     -> GhcInfo
+    -> Maybe Version -- ^ cabal-install version
     -> Maybe (Path Absolute) -- ^ Build directory, @builddir@
     -> Cabal.Config Identity
     -> Path Absolute
     -> [(String,String)]
     -> [Module [Located DocTest]]
     -> Peu r Summary
-phase2 tracer dynOpts unitIds ghcInfo mbuildDir cabalCfg cwd extraEnv parsed = do
+phase2 tracer dynOpts unitIds ghcInfo mcabalVer mbuildDir cabalCfg cwd extraEnv parsed = do
     let preserveIt = case optPreserveIt dynOpts of
             PreserveIt     -> True
             DontPreserveIt -> False
@@ -50,7 +51,7 @@ phase2 tracer dynOpts unitIds ghcInfo mbuildDir cabalCfg cwd extraEnv parsed = d
 
     -- second phase: fire up the ghci, and execute stuff
     storeDir <- makeAbsoluteFilePath $ runIdentity $ Cabal.cfgStoreDir cabalCfg
-    let storeDir' = storeDir </> fromUnrootedFilePath ("ghc-" ++ prettyShow (ghcVersion ghcInfo))
+    let storeDir' = ghcStoreDir mcabalVer ghcInfo storeDir
     let storeDb = storeDir' </> fromUnrootedFilePath "package.db"
     storeExists <- doesDirectoryExist storeDb
 

diff --git a/cabal.project b/cabal.project
@@ -1,4 +1,5 @@
 with-compiler: ghc-9.8.2
+index-state: 2024-07-01T20:10:11Z
 tests: True
 
 packages: cabal-bundler

diff --git a/peura/peura.cabal b/peura/peura.cabal
@@ -119,5 +119,6 @@ library
     ScopedTypeVariables
     TypeApplications
     TypeFamilies
+    TypeOperators
 
   x-docspec-options:  --verbose
diff --git a/peura/src/Peura/GHC.hs b/peura/src/Peura/GHC.hs
@@ -2,6 +2,8 @@ module Peura.GHC (
     -- * GHC info
     GhcInfo (..),
     getGhcInfo,
+    -- * cabal store dir
+    ghcStoreDir,
     -- * ghc-pkg
     findGhcPkg,
     -- * Package databases
@@ -38,12 +40,13 @@ import Peura.Tracer
 -------------------------------------------------------------------------------
 
 data GhcInfo = GhcInfo
-    { ghcPath     :: FilePath
-    , ghcPlatform :: String
-    , ghcVersion  :: Version
-    , ghcEnvDir   :: Path Absolute
-    , ghcGlobalDb :: Path Absolute
-    , ghcLibDir   :: Path Absolute
+    { ghcPath          :: FilePath
+    , ghcPlatform      :: String
+    , ghcVersion       :: Version
+    , ghcProjectUnitId :: String
+    , ghcEnvDir        :: Path Absolute
+    , ghcGlobalDb      :: Path Absolute
+    , ghcLibDir        :: Path Absolute
     }
   deriving Show
 
@@ -83,17 +86,36 @@ getGhcInfo tracer ghc = do
                 lookup "LibDir" info
             libDir <- makeAbsoluteFilePath libDirStr
 
+            let pui :: String
+                pui = fromMaybe "" $ lookup "Project Unit Id" info
+
             return GhcInfo
                 { ghcPath     = ghc
                 , ghcPlatform = x ++ "-" ++ y
                 , ghcVersion  = ver
+                , ghcProjectUnitId = pui
                 , ghcEnvDir   = ghcDir </> fromUnrootedFilePath (x ++ "-" ++ y ++ "-" ++ prettyShow ver) </> fromUnrootedFilePath "environments"
                 , ghcGlobalDb = globalDb
                 , ghcLibDir   = libDir
                 }
 
         _ -> die tracer "Your compiler is not GHC"
 
+-------------------------------------------------------------------------------
+-- cabal store dir
+-------------------------------------------------------------------------------
+
+ghcStoreDir :: Maybe Version -> GhcInfo -> Path Absolute -> Path Absolute
+ghcStoreDir (Just cabalVer) info storeDir
+    | cabalVer >= mkVersion [3,12]
+    , "" /= pui
+    = storeDir </> fromUnrootedFilePath pui
+  where
+    pui = ghcProjectUnitId info
+
+ghcStoreDir _ info storeDir
+    =  storeDir </> fromUnrootedFilePath ("ghc-" ++ prettyShow (ghcVersion info))
+
 -------------------------------------------------------------------------------
 -- ghc-pkg
 -------------------------------------------------------------------------------