From 987e467532531e91ae2dff881b419713606bda5f Mon Sep 17 00:00:00 2001 From: Max Ulidtko Date: Wed, 20 Nov 2024 21:52:59 +0100 Subject: [PATCH] fix: support cabal 3.14 Adaptations to API breakages in Cabal 3.14.0.0, discussed in https://github.com/haskell/cabal/issues/10559 Resolves #85. --- .gitignore | 1 + cabal-doctest.cabal | 2 +- cabal.project | 4 + changelog.md | 6 ++ src/Distribution/Extra/Doctest.hs | 126 +++++++++++++++++++++++++----- 5 files changed, 117 insertions(+), 22 deletions(-) diff --git a/.gitignore b/.gitignore index 31ff07b..e8386f2 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ dist/ dist-newstyle/ .stack-work/ .ghc.environment.* +cabal.project.local diff --git a/cabal-doctest.cabal b/cabal-doctest.cabal index 20aeeb0..98c47c8 100644 --- a/cabal-doctest.cabal +++ b/cabal-doctest.cabal @@ -53,7 +53,7 @@ library -- In any case, revisions may set tighter bounds afterwards, if exceptional -- circumstances would warrant that. base >=4.9 && <5 - , Cabal >=1.10 && <3.14 + , Cabal >=1.10 && <3.16 , directory >=1.3 && <2 , filepath >=1.4 && <2 diff --git a/cabal.project b/cabal.project index 92dd192..a0657fc 100644 --- a/cabal.project +++ b/cabal.project @@ -13,3 +13,7 @@ packages: . simple-example multiple-components-example -- allow-newer: *:ghc -- allow-newer: *:base -- allow-newer: *:Cabal + +tests: true + +-- constraints: Cabal==3.14.* diff --git a/changelog.md b/changelog.md index 34fd850..d4a2e6f 100644 --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,9 @@ +# 1.0.11 -- unreleased + +* Support Cabal 3.14.0.0. [cabal-doctest#85][]. + +[cabal-doctest#85]: https://github.com/ulidtko/cabal-doctest/issues/85 + # 1.0.10 -- 2024-06-26 * Maintainership hand-over. See [cabal-doctest#79][]. diff --git a/src/Distribution/Extra/Doctest.hs b/src/Distribution/Extra/Doctest.hs index 2ebad3d..b08cb50 100644 --- a/src/Distribution/Extra/Doctest.hs +++ b/src/Distribution/Extra/Doctest.hs @@ -1,5 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +#if MIN_VERSION_Cabal(3,14,0) +{-# LANGUAGE DataKinds #-} +#endif +{-# LANGUAGE MultiParamTypeClasses #-} + -- | See cabal-doctest README for full-fledged recipes & caveats. -- -- The provided 'generateBuildModule' generates a @Build_{suffix}@ module, with @@ -67,25 +73,28 @@ import Distribution.Simple (UserHooks (..), autoconfUserHooks, defaultMainWithHooks, simpleUserHooks) import Distribution.Simple.Compiler - (CompilerFlavor (GHC), CompilerId (..), PackageDB (..), compilerId) + (CompilerFlavor (GHC), CompilerId (..), compilerId) import Distribution.Simple.LocalBuildInfo (ComponentLocalBuildInfo (componentPackageDeps), LocalBuildInfo, compiler, withExeLBI, withLibLBI, withPackageDB, withTestLBI) import Distribution.Simple.Setup - (BuildFlags (buildDistPref, buildVerbosity), - HaddockFlags (haddockDistPref, haddockVerbosity), emptyBuildFlags, + (BuildFlags (..), + emptyBuildFlags, fromFlag) import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, info) import Distribution.Text (display) -import System.FilePath - (()) import qualified Data.Foldable as F (for_) import qualified Data.Traversable as T (traverse) +import qualified System.FilePath (()) + +#if MIN_VERSION_base(4,11,0) +import Data.Functor ((<&>)) +#endif #if MIN_VERSION_Cabal(1,25,0) import Distribution.Simple.BuildPaths @@ -134,6 +143,24 @@ import Distribution.Utils.Path (getSymbolicPath) #endif +#if MIN_VERSION_Cabal(3,14,0) +-- https://github.com/haskell/cabal/issues/10559 +import Distribution.Simple.Compiler + (PackageDB, PackageDBX (GlobalPackageDB, UserPackageDB, SpecificPackageDB)) +import Distribution.Simple.LocalBuildInfo + (absoluteWorkingDirLBI, interpretSymbolicPathLBI) +import Distribution.Simple.Setup + (HaddockFlags, haddockCommonFlags) +import Distribution.Utils.Path + (FileOrDir(..), SymbolicPath, interpretSymbolicPathAbsolute, makeRelativePathEx, makeSymbolicPath) +import qualified Distribution.Utils.Path as SymPath (()) +#else +import Distribution.Simple.Compiler + (PackageDB (GlobalPackageDB, UserPackageDB, SpecificPackageDB)) +import Distribution.Simple.Setup + (HaddockFlags (haddockDistPref, haddockVerbosity)) +#endif + #if MIN_VERSION_directory(1,2,2) import System.Directory (makeAbsolute) @@ -142,7 +169,42 @@ import System.Directory (getCurrentDirectory) import System.FilePath (isAbsolute) +#endif + +{- HLINT ignore "Use fewer imports" -} + +------------------------------------------------------------------------------- +-- Compat +------------------------------------------------------------------------------- + +#if !MIN_VERSION_base(4,11,0) +(<&>) :: Functor f => f a -> (a -> b) -> f b +(<&>) = flip fmap +infixl 1 <&> +#endif + +class CompatSymPath p q where + () :: p -> FilePath -> q +infixr 5 +instance CompatSymPath FilePath FilePath where + () = (System.FilePath.) +#if MIN_VERSION_Cabal(3,14,0) +instance CompatSymPath (SymbolicPath allowAbs ('Dir loc1)) + (SymbolicPath allowAbs ('Dir loc2)) where + dir name = dir SymPath. makeRelativePathEx name +#endif + +#if MIN_VERSION_Cabal(3,14,0) +unsymbolizePath = getSymbolicPath +#else +makeSymbolicPath :: FilePath -> FilePath +makeSymbolicPath = id +unsymbolizePath :: FilePath -> FilePath +unsymbolizePath = id +#endif + +#if !MIN_VERSION_directory(1,2,2) makeAbsolute :: FilePath -> IO FilePath makeAbsolute p | isAbsolute p = return p | otherwise = do @@ -216,10 +278,16 @@ addDoctestsUserHook testsuiteName uh = uh -- | Convert only flags used by 'generateBuildModule'. haddockToBuildFlags :: HaddockFlags -> BuildFlags -haddockToBuildFlags f = emptyBuildFlags +haddockToBuildFlags f = +#if MIN_VERSION_Cabal(3,14,0) + emptyBuildFlags + { buildCommonFlags = haddockCommonFlags f } +#else + emptyBuildFlags { buildVerbosity = haddockVerbosity f , buildDistPref = haddockDistPref f } +#endif data Name = NameLib (Maybe String) | NameExe String deriving (Eq, Show) @@ -270,12 +338,16 @@ generateBuildModule testSuiteName flags pkg lbi = do | otherwise = [] withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testSuiteName) $ do -#if MIN_VERSION_Cabal(1,25,0) + + -- Locate autogen dir, to put our output into. +#if MIN_VERSION_Cabal(3,14,0) + let testAutogenDir = interpretSymbolicPathLBI lbi + $ autogenComponentModulesDir lbi suitecfg +#elif MIN_VERSION_Cabal(1,25,0) let testAutogenDir = autogenComponentModulesDir lbi suitecfg #else let testAutogenDir = autogenModulesDir lbi #endif - createDirectoryIfMissingVerbose verbosity True testAutogenDir let buildDoctestsFile = testAutogenDir "Build_doctests.hs" @@ -326,23 +398,35 @@ generateBuildModule testSuiteName flags pkg lbi = do let module_sources = modules -- We need the directory with the component's cabal_macros.h! -#if MIN_VERSION_Cabal(1,25,0) +#if MIN_VERSION_Cabal(3,14,0) + let compAutogenDir = interpretSymbolicPathLBI lbi + $ autogenComponentModulesDir lbi compCfg +#elif MIN_VERSION_Cabal(1,25,0) let compAutogenDir = autogenComponentModulesDir lbi compCfg #else let compAutogenDir = autogenModulesDir lbi #endif -- Lib sources and includes - iArgsNoPrefix - <- mapM makeAbsolute - $ compAutogenDir -- autogenerated files - : (distPref ++ "/build") -- preprocessed files (.hsc -> .hs); "build" is hardcoded in Cabal. -#if MIN_VERSION_Cabal(3,5,0) - : map getSymbolicPath (hsSourceDirs compBI) + let iArgsSymbolic = + makeSymbolicPath compAutogenDir -- autogen dir + -- preprocessed files (.hsc -> .hs); "build" is hardcoded in Cabal. + : (distPref "build") +#if MIN_VERSION_Cabal(3,14,0) + : hsSourceDirs compBI +#elif MIN_VERSION_Cabal(3,5,0) + : (hsSourceDirs compBI <&> getSymbolicPath) #else - : hsSourceDirs compBI + : hsSourceDirs compBI #endif +#if MIN_VERSION_Cabal(3,14,0) + pkgWorkdir <- absoluteWorkingDirLBI lbi + let iArgsNoPrefix = iArgsSymbolic <&> interpretSymbolicPathAbsolute pkgWorkdir + let includeArgs = includeDirs compBI <&> ("-I"++) . interpretSymbolicPathAbsolute pkgWorkdir +#else + iArgsNoPrefix <- mapM makeAbsolute iArgsSymbolic includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs compBI +#endif -- We clear all includes, so the CWD isn't used. let iArgs' = map ("-i"++) iArgsNoPrefix iArgs = "-i" : iArgs' @@ -360,11 +444,11 @@ generateBuildModule testSuiteName flags pkg lbi = do -- even though the main-is module is named Main, its filepath might -- actually be Something.hs. To account for this possibility, we simply -- pass the full path to the main-is module instead. - mainIsPath <- T.traverse (findFileEx verbosity iArgsNoPrefix) (compMainIs comp) + mainIsPath <- T.traverse (findFileEx verbosity iArgsSymbolic) (compMainIs comp) let all_sources = map display module_sources ++ additionalModules - ++ maybeToList mainIsPath + ++ maybeToList (mainIsPath <&> unsymbolizePath) let component = Component (mbCompName comp) @@ -462,11 +546,11 @@ generateBuildModule testSuiteName flags pkg lbi = do packageDbArgsConf :: [PackageDB] -> [String] packageDbArgsConf dbstack = case dbstack of (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs - (GlobalPackageDB:dbs) -> ("-no-user-package-conf") + (GlobalPackageDB:dbs) -> "-no-user-package-conf" : concatMap specific dbs _ -> ierror where - specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ] + specific (SpecificPackageDB db) = [ "-package-conf=" ++ unsymbolizePath db ] specific _ = ierror ierror = error $ "internal error: unexpected package db stack: " ++ show dbstack @@ -484,7 +568,7 @@ generateBuildModule testSuiteName flags pkg lbi = do dbs -> "-clear-package-db" : concatMap single dbs where - single (SpecificPackageDB db) = [ "-package-db=" ++ db ] + single (SpecificPackageDB db) = [ "-package-db=" ++ unsymbolizePath db ] single GlobalPackageDB = [ "-global-package-db" ] single UserPackageDB = [ "-user-package-db" ] isSpecific (SpecificPackageDB _) = True