From 852dbc69d276e19add3917d17dff5541d84e29d4 Mon Sep 17 00:00:00 2001 From: Daniel Gröber Date: Sat, 11 Jan 2020 07:46:33 +0100 Subject: Fix Cabal version selection for build-type:Custom Previously we would pick up Stack's Cabal version with ghc-pkg on the global package-db. This however ignores that Stack also supports custom Setup.hs with the Cabal version from the snapshot instead. In cabal v2-build we have a similar problem. We used to assume that plan.json's cabal-lib-version is used uniformly across units but this is similarly untrue. To fix both of these we re-stage the cabal version query to after reconfiguring a unit, then we can just lookup the Cabal version in setup-config. Fixes #95 --- src/CabalHelper/Compiletime/Cabal.hs | 14 ++++++++++++-- src/CabalHelper/Compiletime/Compile.hs | 12 ++++++------ src/CabalHelper/Compiletime/Types.hs | 12 ++++++------ 3 files changed, 24 insertions(+), 14 deletions(-) (limited to 'src/CabalHelper') diff --git a/src/CabalHelper/Compiletime/Cabal.hs b/src/CabalHelper/Compiletime/Cabal.hs index aad004c..1ecf01f 100644 --- a/src/CabalHelper/Compiletime/Cabal.hs +++ b/src/CabalHelper/Compiletime/Cabal.hs @@ -31,6 +31,7 @@ import Data.Version import System.Directory import System.FilePath import System.IO +import Text.Printf import Distribution.Verbosity (Verbosity, silent, normal, verbose, deafening) @@ -223,9 +224,18 @@ complainIfNoCabalFile pkgdir Nothing = bultinCabalVersion :: CabalVersion bultinCabalVersion = CabalVersion $ parseVer VERSION_Cabal -readSetupConfigHeader :: FilePath -> IO (Maybe UnitHeader) +readSetupConfigHeader :: FilePath -> IO UnitHeader readSetupConfigHeader file = bracket (openFile file ReadMode) hClose $ \h -> do - parseSetupHeader <$> BS.hGetLine h + mhdr <- parseSetupHeader <$> BS.hGetLine h + case mhdr of + Just hdr@(UnitHeader _PkgId ("Cabal", _hdrCabalVersion) _compId) -> do + return hdr + Just UnitHeader {uhSetupId=(setup_name, _)} -> panicIO $ + printf "Unknown Setup package-id in setup-config header '%s': '%s'" + (BS8.unpack setup_name) file + Nothing -> panicIO $ + printf "Could not read '%s' header" file + parseSetupHeader :: BS.ByteString -> Maybe UnitHeader parseSetupHeader header = case BS8.words header of diff --git a/src/CabalHelper/Compiletime/Compile.hs b/src/CabalHelper/Compiletime/Compile.hs index 2993906..4c92fba 100644 --- a/src/CabalHelper/Compiletime/Compile.hs +++ b/src/CabalHelper/Compiletime/Compile.hs @@ -91,7 +91,7 @@ data CompilationProductScope = CPSGlobal | CPSProject type CompHelperEnv = CompHelperEnv' CabalVersion data CompHelperEnv' cv = CompHelperEnv { cheCabalVer :: !cv - , chePkgDb :: !(Maybe PackageDbDir) + , chePkgDb :: ![PackageDbDir] -- ^ A package-db where we are guaranteed to find Cabal-`cheCabalVer`. , cheProjDir :: !FilePath , chePlanJson :: !(Maybe PlanJson) @@ -120,7 +120,7 @@ compileHelper' CompHelperEnv {..} = do CabalVersion cabalVerPlain -> do runMaybeT $ msum $ map (\f -> f ghcVer cabalVerPlain) $ case chePkgDb of - Nothing -> + [] -> [ compileWithCabalV2Inplace , compileWithCabalV2GhcEnv , compileCabalSource @@ -128,8 +128,8 @@ compileHelper' CompHelperEnv {..} = do , compileGlobal , compileWithCabalInPrivatePkgDb ] - Just db -> - [ ((.).(.)) liftIO (compilePkgDb db) + dbs -> + [ ((.).(.)) liftIO (compilePkgDbs dbs) ] appdir <- appCacheDir let cp@CompPaths {compExePath} = compPaths appdir cheProjLocalCacheDir comp @@ -149,11 +149,11 @@ compileHelper' CompHelperEnv {..} = do -- for relaxed deps: find (sameMajorVersionAs cheCabalVer) . reverse . sort - compilePkgDb db _ghcVer cabalVer = return $ + compilePkgDbs dbs _ghcVer cabalVer = return $ (,) (pure ()) CompileWithCabalPackage - { compPackageSource = GPSPackageDBs [db] + { compPackageSource = GPSPackageDBs dbs , compCabalVersion = CabalVersion cabalVer , compProductTarget = CPSProject } diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs index bb36df8..07596a9 100644 --- a/src/CabalHelper/Compiletime/Types.hs +++ b/src/CabalHelper/Compiletime/Types.hs @@ -456,8 +456,7 @@ newtype ProjConfModTimes = ProjConfModTimes [(FilePath, EpochTime)] -- | Project-scope information cache. data ProjInfo pt = ProjInfo - { piCabalVersion :: !Version - , piPackages :: !(NonEmpty (Package pt)) + { piPackages :: !(NonEmpty (Package pt)) , piImpl :: !(ProjInfoImpl pt) , piProjConfModTimes :: !ProjConfModTimes -- ^ Key for cache invalidation. When this is not equal to the return @@ -466,13 +465,14 @@ data ProjInfo pt = ProjInfo data ProjInfoImpl pt where ProjInfoV1 :: - { piV1SetupHeader :: !UnitHeader + { piV1SetupHeader :: !UnitHeader + , piV1CabalVersion :: !CabalVersion } -> ProjInfoImpl ('Cabal 'CV1) ProjInfoV2 :: - { piV2Plan :: !PlanJson - , piV2PlanModTime :: !EpochTime - , piV2CompilerId :: !(String, Version) + { piV2Plan :: !PlanJson + , piV2PlanModTime :: !EpochTime + , piV2CompilerId :: !(String, Version) } -> ProjInfoImpl ('Cabal 'CV2) ProjInfoStack :: ProjInfoImpl 'Stack -- cgit v1.2.3