diff --git a/cabal-helper.cabal b/cabal-helper.cabal index 6a035c4..20ad842 100644 --- a/cabal-helper.cabal +++ b/cabal-helper.cabal @@ -39,6 +39,11 @@ extra-source-files: README.md tests/fliblib/stack.yaml tests/fliblib/lib/*.hs + tests/custom-setup/*.hs + tests/custom-setup/*.cabal + tests/custom-setup/packages.list + tests/custom-setup/stack.yaml + tests/bkpregex/*.hs tests/bkpregex/*.cabal tests/bkpregex/packages.list @@ -137,6 +142,7 @@ common c-h-internal CabalHelper.Compiletime.Program.GHC CabalHelper.Compiletime.Sandbox CabalHelper.Compiletime.Types + CabalHelper.Compiletime.Types.Cabal CabalHelper.Compiletime.Types.RelativePath CabalHelper.Runtime.Compat CabalHelper.Runtime.HelperMain diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs index 507adad..f8adcc4 100644 --- a/lib/Distribution/Helper.hs +++ b/lib/Distribution/Helper.hs @@ -147,6 +147,7 @@ import CabalHelper.Compiletime.Log import CabalHelper.Compiletime.Process import CabalHelper.Compiletime.Sandbox import CabalHelper.Compiletime.Types +import CabalHelper.Compiletime.Types.Cabal import CabalHelper.Compiletime.Types.RelativePath import CabalHelper.Shared.InterfaceTypes import CabalHelper.Shared.Common @@ -281,19 +282,25 @@ getUnitModTimes package_yaml_path = pSourceDir "package.yaml" setup_config_path = distdirv1 "setup-config" +-- | Get a random unit from the project. Sometimes we need to get info we +-- can only get after configuring _any_ unit but we do assume that this +-- info is uniform across units. +someUnit :: ProjInfo pt -> Unit pt +someUnit proj_info = + NonEmpty.head $ pUnits $ + NonEmpty.head $ piPackages proj_info -- | The version of GHC the project is configured to use for compilation. compilerVersion :: Query pt (String, Version) compilerVersion = Query $ \qe -> getProjInfo qe >>= \proj_info -> - let someUnit = NonEmpty.head $ pUnits $ - NonEmpty.head $ piPackages proj_info in + let unit = someUnit proj_info in -- ^ ASSUMPTION: Here we assume the compiler version is uniform across all -- units so we just pick any one. case piImpl proj_info of - ProjInfoV1 {} -> uiCompilerId <$> getUnitInfo qe someUnit + ProjInfoV1 {} -> uiCompilerId <$> getUnitInfo qe unit ProjInfoV2 { piV2CompilerId } -> return piV2CompilerId - ProjInfoStack {} -> uiCompilerId <$> getUnitInfo qe someUnit + ProjInfoStack {} -> uiCompilerId <$> getUnitInfo qe unit -- | All local packages currently active in a project\'s build plan. projectPackages :: Query pt (NonEmpty (Package pt)) @@ -409,6 +416,25 @@ getProjInfo qe = do readProjInfo qe proj_conf mtime pre_info } + +-- | Get the cabal version we need to build for this project. +getCabalLibVersion :: QueryEnv pt -> Reconfigured pt -> ProjInfo pt -> IO CabalVersion +getCabalLibVersion _ _ ProjInfo{piImpl=ProjInfoV1 {piV1CabalVersion}} = + return piV1CabalVersion +getCabalLibVersion qe reconf proj_info = do + unit <- case reconf of + AlreadyReconfigured unit -> + return unit + Haven'tReconfigured -> do + let unit = someUnit proj_info + reconfigureUnit qe unit + return unit + let DistDirLib distdir = uDistDir $ unit + hdr <- readSetupConfigHeader $ distdir "setup-config" + let ("Cabal", cabalVer) = uhSetupId hdr + return $ CabalVersion cabalVer + + getUnitInfo :: QueryEnv pt -> Unit pt -> IO UnitInfo getUnitInfo qe@QueryEnv{..} unit@Unit{uDistDir} = do pre_info <- getPreInfo qe @@ -426,8 +452,9 @@ getUnitInfo qe@QueryEnv{..} unit@Unit{uDistDir} = do , cKeyValid = (==) , cRegen = \mtimes -> do - reconfigureUnit qe unit - helper <- getHelper pre_info proj_info qe + reconf <- reconfigureUnit qe unit + cabal_ver <- getCabalLibVersion qe reconf proj_info + helper <- getHelper qe pre_info proj_info cabal_ver readUnitInfo helper unit mtimes } @@ -456,8 +483,11 @@ shallowReconfigureProject QueryEnv shallowReconfigureProject qe = do buildProjectTarget qe Nothing DryRun -reconfigureUnit :: QueryEnvI c pt -> Unit pt -> IO () -reconfigureUnit qe u = buildProjectTarget qe (Just u) OnlyCfg +data Reconfigured pt = AlreadyReconfigured (Unit pt) | Haven'tReconfigured +reconfigureUnit :: QueryEnvI c pt -> Unit pt -> IO (Reconfigured pt) +reconfigureUnit qe u = do + buildProjectTarget qe (Just u) OnlyCfg + return (AlreadyReconfigured u) buildUnits :: [Unit pt] -> Query pt () buildUnits units = Query $ \qe -> do @@ -488,6 +518,8 @@ buildProjectTarget qe mu stage = do cmd <- return $ case stage of DryRun | SCV1 <- cpt -> CabalInstall.CIConfigure + -- TODO: in v1 we configure twice because we do configure for + -- DryRun and OnlyCfg. OnlyCfg -> CabalInstall.CIConfigure _ -> @@ -502,7 +534,7 @@ buildProjectTarget qe mu stage = do Just Unit{uImpl} -> concat [ if uiV2OnlyDependencies uImpl then ["--only-dependencies"] else [] - , uiV2Components uImpl + , map snd $ filter ((/= ChSetupHsName) . fst) $ uiV2Components uImpl ] case qeProjLoc of ProjLocV2File {plCabalProjectFile} -> @@ -537,43 +569,39 @@ getFileModTime f = do readProjInfo :: QueryEnvI c pt -> ProjConf pt -> ProjConfModTimes -> PreInfo pt -> IO (ProjInfo pt) -readProjInfo qe pc pcm pi = withVerbosity $ do +readProjInfo qe pc pcm _pi = withVerbosity $ do let projloc = qeProjLoc qe case (qeDistDir qe, pc) of (DistDirCabal SCV1 distdir, ProjConfV1{pcV1CabalFile}) -> do setup_config_path <- canonicalizePath (distdir "setup-config") - mhdr <- readSetupConfigHeader setup_config_path - case mhdr of - Just hdr@(UnitHeader (pkg_name_bs, _pkg_ver) ("Cabal", hdrCabalVersion) _compId) -> do - let - v3_0_0_0 = makeVersion [3,0,0,0] - pkg_name - | hdrCabalVersion >= v3_0_0_0 = BSU.toString pkg_name_bs - | otherwise = BS8.unpack pkg_name_bs - pkg = Package - { pPackageName = pkg_name - , pSourceDir = plCabalProjectDir projloc - , pCabalFile = CabalFile pcV1CabalFile - , pFlags = [] - , pUnits = (:|[]) Unit - { uUnitId = UnitId pkg_name - , uPackage = pkg { pUnits = () } - , uDistDir = DistDirLib distdir - , uImpl = UnitImplV1 - } - } - piImpl = ProjInfoV1 { piV1SetupHeader = hdr } - return ProjInfo - { piCabalVersion = hdrCabalVersion - , piProjConfModTimes = pcm - , piPackages = pkg :| [] - , piImpl + hdr@(UnitHeader (pkg_name_bs, _pkg_ver) ("Cabal", hdrCabalVersion) _) + <- readSetupConfigHeader setup_config_path + let + v3_0_0_0 = makeVersion [3,0,0,0] + pkg_name + | hdrCabalVersion >= v3_0_0_0 = BSU.toString pkg_name_bs + | otherwise = BS8.unpack pkg_name_bs + pkg = Package + { pPackageName = pkg_name + , pSourceDir = plCabalProjectDir projloc + , pCabalFile = CabalFile pcV1CabalFile + , pFlags = [] + , pUnits = (:|[]) Unit + { uUnitId = UnitId pkg_name + , uPackage = pkg { pUnits = () } + , uDistDir = DistDirLib distdir + , uImpl = UnitImplV1 } - Just UnitHeader {uhSetupId=(setup_name, _)} -> - panicIO $ printf "Unknown Setup package-id in setup-config header '%s': '%s'" - (BS8.unpack setup_name) setup_config_path - Nothing -> - panicIO $ printf "Could not read '%s' header" setup_config_path + } + piImpl = ProjInfoV1 + { piV1SetupHeader = hdr + , piV1CabalVersion = CabalVersion hdrCabalVersion + } + return ProjInfo + { piProjConfModTimes = pcm + , piPackages = pkg :| [] + , piImpl + } (DistDirCabal SCV2 distdirv2, _) -> do let plan_path = distdirv2 "cache" "plan.json" @@ -590,8 +618,7 @@ readProjInfo qe pc pcm pi = withVerbosity $ do Just pkgs <- NonEmpty.nonEmpty <$> CabalInstall.planPackages plan return ProjInfo - { piCabalVersion = makeDataVersion pjCabalLibVersion - , piProjConfModTimes = pcm + { piProjConfModTimes = pcm , piPackages = NonEmpty.sortWith pPackageName pkgs , piImpl = ProjInfoV2 { piV2Plan = plan @@ -602,33 +629,26 @@ readProjInfo qe pc pcm pi = withVerbosity $ do (DistDirStack{}, _) -> do Just cabal_files <- NonEmpty.nonEmpty <$> Stack.listPackageCabalFiles qe pkgs <- mapM (Stack.getPackage qe) cabal_files - Just (cabalVer:_) <- runMaybeT $ - let ?progs = qePrograms qe in - let PreInfoStack {piStackProjPaths} = pi in - GHC.listCabalVersions (Just (sppGlobalPkgDb piStackProjPaths)) - -- ^ See [Note Stack Cabal Version] return ProjInfo - { piCabalVersion = cabalVer - , piProjConfModTimes = pcm + { piProjConfModTimes = pcm , piPackages = NonEmpty.sortWith pPackageName pkgs , piImpl = ProjInfoStack } --- [Note Stack Cabal Version] --- --- Stack just uses ghc-pkg on the global-pkg-db to determine the --- appropriate Cabal version for a resolver when building, see --- Stack.Setup.pathsFromCompiler(cabalPkgVer). We do essentially the same --- thing here. --- --- The code for building Setup.hs is in Stack.Build.Execute and the version --- of cabal is set in withSingleContext.withCabal.getPackageArgs. --- --- Note there is some special casing going on (see 'depsMinusCabal'), they --- use the packages from the snapshot pkg-db except Cabal which comes from --- the global pkg-db. - readUnitInfo :: Helper pt -> Unit pt -> UnitModTimes -> IO UnitInfo +readUnitInfo helper u@Unit{uImpl=ui@UnitImplV2{uiV2Components}} umt + | ChSetupHsName `elem` map fst uiV2Components = do + let unit' = u { + uImpl = ui + { uiV2Components = filter ((/= ChSetupHsName) . fst) uiV2Components + } + } + -- TODO: Add a synthetic UnitInfo for the setup executable. Cabal + -- doesn't allow building it via a target on the cmdline and it + -- doesn't really exist as far as setup-config is concerned but + -- plan.json has the dependency versions for custom-setup so we + -- should be able to represet that as a UnitInfo. + readUnitInfo helper unit' umt readUnitInfo helper unit@Unit {uUnitId=uiUnitId} uiModTimes = do res <- runHelper helper unit [ "package-id" @@ -698,7 +718,8 @@ prepare :: Query pt () prepare = Query $ \qe -> do pre_info <- getPreInfo qe proj_info <- getProjInfo qe - void $ getHelper pre_info proj_info qe + cabal_ver <- getCabalLibVersion qe Haven'tReconfigured proj_info + void $ getHelper qe pre_info proj_info cabal_ver -- | Create @cabal_macros.h@, @Paths_\.hs@ and other generated files -- in the usual place. See 'Distribution.Simple.Build.initialBuildSteps'. @@ -709,7 +730,8 @@ writeAutogenFiles :: Unit pt -> Query pt () writeAutogenFiles unit = Query $ \qe -> do pre_info <- getPreInfo qe proj_info <- getProjInfo qe - helper <- getHelper pre_info proj_info qe + cabal_ver <- getCabalLibVersion qe Haven'tReconfigured proj_info + helper <- getHelper qe pre_info proj_info cabal_ver void $ runHelper helper unit ["write-autogen-files"] -- | Get the path to the sandbox package-db in a project @@ -766,19 +788,19 @@ configurePrograms qe@QueryEnv{..} pre_info = withVerbosity $ do newtype Helper pt = Helper { runHelper :: Unit pt -> [String] -> IO [Maybe ChResponse] } -getHelper :: PreInfo pt -> ProjInfo pt -> QueryEnvI c pt -> IO (Helper pt) -getHelper _pre_info ProjInfo{piCabalVersion} qe@QueryEnv{..} - | piCabalVersion == bultinCabalVersion = return $ Helper $ +getHelper :: QueryEnvI c pt -> PreInfo pt -> ProjInfo pt -> CabalVersion -> IO (Helper pt) +getHelper qe@QueryEnv{..} _pre_info _proj_info cabal_ver + | cabal_ver == bultinCabalVersion = return $ Helper $ \Unit{ uDistDir=DistDirLib distdir , uPackage=Package{pCabalFile=CabalFile cabal_file} } args -> let pt = dispHelperProjectType (projTypeOfQueryEnv qe) in helper_main $ cabal_file : distdir : pt : args -getHelper pre_info proj_info qe@QueryEnv{..} = do +getHelper qe@QueryEnv{..} pre_info proj_info cabal_ver = do withVerbosity $ do let ?progs = qePrograms t0 <- Clock.getTime Monotonic - eexe <- compileHelper $ mkCompHelperEnv qeProjLoc qeDistDir pre_info proj_info + eexe <- compileHelper $ mkCompHelperEnv qeProjLoc qeDistDir pre_info proj_info cabal_ver t1 <- Clock.getTime Monotonic let dt = (/10^9) $ fromInteger $ Clock.toNanoSecs $ Clock.diffTimeSpec t0 t1 dt :: Float @@ -805,18 +827,20 @@ mkCompHelperEnv -> DistDir pt -> PreInfo pt -> ProjInfo pt + -> CabalVersion -> CompHelperEnv mkCompHelperEnv projloc (DistDirCabal SCV1 distdir) PreInfoCabal - ProjInfo{piCabalVersion} + ProjInfo {} + cabal_ver = CompHelperEnv - { cheCabalVer = CabalVersion piCabalVersion + { cheCabalVer = cabal_ver , cheProjDir = plCabalProjectDir projloc , cheProjLocalCacheDir = distdir - , chePkgDb = Nothing - , chePlanJson = Nothing + , chePkgDb = [] + , chePjUnits = Nothing , cheDistV2 = Nothing } mkCompHelperEnv @@ -824,30 +848,31 @@ mkCompHelperEnv (DistDirCabal SCV2 distdir) PreInfoCabal ProjInfo{piImpl=ProjInfoV2{piV2Plan=plan}} + cabal_ver = CompHelperEnv {..} where cheProjDir = plCabalProjectDir projloc - cheCabalVer = CabalVersion $ makeDataVersion pjCabalLibVersion + cheCabalVer = cabal_ver cheProjLocalCacheDir = distdir "cache" - chePkgDb = Nothing - chePlanJson = Just plan + chePkgDb = [] + chePjUnits = Just $ pjUnits plan cheDistV2 = Just distdir - PlanJson {pjCabalLibVersion=Ver pjCabalLibVersion } = plan mkCompHelperEnv (ProjLocStackYaml stack_yaml) (DistDirStack mworkdir) PreInfoStack { piStackProjPaths=StackProjPaths - { sppGlobalPkgDb } + { sppGlobalPkgDb, sppSnapPkgDb, sppLocalPkgDb } } - ProjInfo { piCabalVersion } + ProjInfo {} + cabal_ver = let workdir = fromMaybe ".stack-work" $ unRelativePath <$> mworkdir in let projdir = takeDirectory stack_yaml in CompHelperEnv - { cheCabalVer = CabalVersion $ piCabalVersion + { cheCabalVer = cabal_ver , cheProjDir = projdir , cheProjLocalCacheDir = projdir workdir - , chePkgDb = Just sppGlobalPkgDb - , chePlanJson = Nothing + , chePkgDb = [sppGlobalPkgDb, sppSnapPkgDb, sppLocalPkgDb] + , chePjUnits = Nothing , cheDistV2 = Nothing } diff --git a/src/CabalHelper/Compiletime/Cabal.hs b/src/CabalHelper/Compiletime/Cabal.hs index 1c4efa5..1ecf01f 100644 --- a/src/CabalHelper/Compiletime/Cabal.hs +++ b/src/CabalHelper/Compiletime/Cabal.hs @@ -15,7 +15,8 @@ Description : Cabal library source unpacking License : Apache-2.0 -} -{-# LANGUAGE DeriveFunctor, ViewPatterns, OverloadedStrings, CPP #-} +{-# LANGUAGE DeriveFunctor, ViewPatterns, OverloadedStrings #-} +{-# LANGUAGE CPP #-} -- for VERSION_Cabal module CabalHelper.Compiletime.Cabal where @@ -30,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) @@ -37,43 +39,10 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import CabalHelper.Compiletime.Types +import CabalHelper.Compiletime.Types.Cabal import CabalHelper.Compiletime.Process import CabalHelper.Shared.Common (replace, parseVer, parseVerMay, parsePkgIdBS, panicIO) -type UnpackedCabalVersion = CabalVersion' (CommitId, CabalSourceDir) -type ResolvedCabalVersion = CabalVersion' CommitId -type CabalVersion = CabalVersion' () - -unpackedToResolvedCabalVersion :: UnpackedCabalVersion -> ResolvedCabalVersion -unpackedToResolvedCabalVersion (CabalHEAD (commit, _)) = CabalHEAD commit -unpackedToResolvedCabalVersion (CabalVersion ver) = CabalVersion ver - --- | Cabal library version we're compiling the helper exe against. -data CabalVersion' a - = CabalHEAD a - | CabalVersion { cvVersion :: Version } - deriving (Eq, Ord, Functor) - -newtype CommitId = CommitId { unCommitId :: String } - -showUnpackedCabalVersion :: UnpackedCabalVersion -> String -showUnpackedCabalVersion (CabalHEAD (commitid, _)) = - "HEAD-" ++ unCommitId commitid -showUnpackedCabalVersion CabalVersion {cvVersion} = - showVersion cvVersion - -showResolvedCabalVersion :: ResolvedCabalVersion -> String -showResolvedCabalVersion (CabalHEAD commitid) = - "HEAD-" ++ unCommitId commitid -showResolvedCabalVersion CabalVersion {cvVersion} = - showVersion cvVersion - -showCabalVersion :: CabalVersion -> String -showCabalVersion (CabalHEAD ()) = - "HEAD" -showCabalVersion CabalVersion {cvVersion} = - showVersion cvVersion - data CabalPatchDescription = CabalPatchDescription { cpdVersions :: [Version] , cpdUnpackVariant :: UnpackCabalVariant @@ -164,8 +133,6 @@ unpackCabal (CabalHEAD ()) tmpdir = do (commit, csdir) <- unpackCabalHEAD tmpdir return $ CabalHEAD (commit, csdir) -data UnpackCabalVariant = Pristine | LatestRevision -newtype CabalSourceDir = CabalSourceDir { unCabalSourceDir :: FilePath } unpackCabalHackage :: (Verbose, Progs) => Version @@ -254,12 +221,21 @@ complainIfNoCabalFile _ (Just cabal_file) = return cabal_file complainIfNoCabalFile pkgdir Nothing = panicIO $ "No cabal file found in package-dir: '"++pkgdir++"'" -bultinCabalVersion :: Version -bultinCabalVersion = parseVer VERSION_Cabal +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 d2886e8..e468c1b 100644 --- a/src/CabalHelper/Compiletime/Compile.hs +++ b/src/CabalHelper/Compiletime/Compile.hs @@ -21,7 +21,7 @@ module CabalHelper.Compiletime.Compile where import qualified Cabal.Plan as CP import Cabal.Plan - ( PlanJson(..), PkgId(..), PkgName(..), Ver(..), uPId) + ( PkgId(..), PkgName(..), Ver(..), uPId) import Control.Applicative import Control.Arrow import Control.Exception as E @@ -30,6 +30,7 @@ import Control.Monad.Trans.Maybe import Control.Monad.IO.Class import Data.Char import Data.List +import Data.Map.Strict (Map) import Data.Maybe import Data.String import Data.Version @@ -58,6 +59,7 @@ import CabalHelper.Compiletime.Program.CabalInstall import CabalHelper.Compiletime.Sandbox ( getSandboxPkgDb ) import CabalHelper.Compiletime.Types +import CabalHelper.Compiletime.Types.Cabal import CabalHelper.Shared.Common @@ -90,10 +92,10 @@ 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) + , chePjUnits :: !(Maybe (Map CP.UnitId CP.Unit)) , cheDistV2 :: !(Maybe FilePath) , cheProjLocalCacheDir :: FilePath } @@ -119,7 +121,7 @@ compileHelper' CompHelperEnv {..} = do CabalVersion cabalVerPlain -> do runMaybeT $ msum $ map (\f -> f ghcVer cabalVerPlain) $ case chePkgDb of - Nothing -> + [] -> [ compileWithCabalV2Inplace , compileWithCabalV2GhcEnv , compileCabalSource @@ -127,8 +129,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 @@ -148,11 +150,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 } @@ -184,8 +186,8 @@ compileHelper' CompHelperEnv {..} = do compileWithCabalV2Inplace ghcVer cabalVer = do -- TODO: Test coverage! Neither compile-test nor ghc-session test out -- this code path - PlanJson {pjUnits} <- maybe mzero pure chePlanJson - distdir_newstyle <- maybe mzero pure cheDistV2 + pjUnits <- maybe mzero pure chePjUnits + distdir_newstyle <- maybe mzero pure cheDistV2 let cabal_pkgid = PkgId (PkgName (Text.pack "Cabal")) (Ver $ versionBranch cabalVer) mcabal_unit = listToMaybe $ diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs index d5ed15e..71866ae 100644 --- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs +++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs @@ -43,8 +43,10 @@ import qualified CabalHelper.Compiletime.Cabal as Cabal import CabalHelper.Compiletime.Types import CabalHelper.Compiletime.Program.GHC ( GhcVersion(..), createPkgDb ) +import CabalHelper.Compiletime.Types.Cabal + ( CabalSourceDir(..), UnpackedCabalVersion, CabalVersion'(..) ) import CabalHelper.Compiletime.Cabal - ( CabalSourceDir(..), UnpackedCabalVersion, CabalVersion'(..), unpackCabalV1 ) + ( unpackCabalV1 ) import CabalHelper.Compiletime.Process import CabalHelper.Shared.InterfaceTypes ( ChComponentName(..), ChLibraryName(..) ) @@ -298,10 +300,13 @@ planPackages plan = do | otherwise = ch_unit - unitTargets :: CP.Unit -> [String] + unitTargets :: CP.Unit -> [(ChComponentName, String)] unitTargets CP.Unit {uComps, uPId=CP.PkgId pkg_name _} = - map (Text.unpack . (((coerce pkg_name) <> ":") <>) . CP.dispCompNameTarget pkg_name) $ - Map.keys uComps + [ (cpCompNameToChComponentName comp, Text.unpack target) + | comp <- Map.keys uComps + , let comp_str = CP.dispCompNameTarget pkg_name comp + , let target = ((coerce pkg_name) <> ":") <> comp_str + ] mkUnit :: Package' () -> CP.Unit -> Unit ('Cabal 'CV2) mkUnit pkg u@CP.Unit diff --git a/src/CabalHelper/Compiletime/Program/GHC.hs b/src/CabalHelper/Compiletime/Program/GHC.hs index 95293fb..9ab0b33 100644 --- a/src/CabalHelper/Compiletime/Program/GHC.hs +++ b/src/CabalHelper/Compiletime/Program/GHC.hs @@ -31,7 +31,7 @@ import System.Directory import CabalHelper.Shared.Common (parseVer, trim, appCacheDir, parsePkgId) import CabalHelper.Compiletime.Types -import CabalHelper.Compiletime.Cabal +import CabalHelper.Compiletime.Types.Cabal ( ResolvedCabalVersion, showResolvedCabalVersion, UnpackedCabalVersion , unpackedToResolvedCabalVersion, CabalVersion'(..) ) import CabalHelper.Compiletime.Process diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs index ab84178..07596a9 100644 --- a/src/CabalHelper/Compiletime/Types.hs +++ b/src/CabalHelper/Compiletime/Types.hs @@ -30,6 +30,7 @@ import GHC.Generics import System.FilePath (takeDirectory) import System.Posix.Types import CabalHelper.Compiletime.Types.RelativePath +import CabalHelper.Compiletime.Types.Cabal import CabalHelper.Shared.InterfaceTypes import Data.List.NonEmpty (NonEmpty) @@ -347,8 +348,7 @@ data UnitImpl pt where UnitImplV1 :: UnitImpl ('Cabal 'CV1) UnitImplV2 :: - { uiV2ComponentNames :: ![ChComponentName] - , uiV2Components :: ![String] + { uiV2Components :: ![(ChComponentName, String)] , uiV2OnlyDependencies :: !Bool } -> UnitImpl ('Cabal 'CV2) @@ -365,7 +365,7 @@ deriving instance Show (UnitImpl pt) -- of helper invocations for clients that don't need to know the entire project -- structure. uComponentName :: Unit pt -> Maybe ChComponentName -uComponentName Unit { uImpl=UnitImplV2 { uiV2ComponentNames=[comp] } } = +uComponentName Unit { uImpl=UnitImplV2 { uiV2Components=[(comp, _)] } } = Just comp uComponentName _ = Nothing @@ -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 diff --git a/src/CabalHelper/Compiletime/Types/Cabal.hs b/src/CabalHelper/Compiletime/Types/Cabal.hs new file mode 100644 index 0000000..90ee975 --- /dev/null +++ b/src/CabalHelper/Compiletime/Types/Cabal.hs @@ -0,0 +1,59 @@ +-- cabal-helper: Simple interface to Cabal's configuration state +-- Copyright (C) 2020 Daniel Gröber +-- +-- SPDX-License-Identifier: Apache-2.0 +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 + +{-| +Module : CabalHelper.Compiletime.Types.Cabal +License : Apache-2.0 +-} + +{-# LANGUAGE DeriveFunctor #-} + +module CabalHelper.Compiletime.Types.Cabal where + +import Data.Version + +-- | Cabal library version we're compiling the helper exe against. +data CabalVersion' a + = CabalHEAD a + | CabalVersion { cvVersion :: Version } + deriving (Eq, Ord, Functor) + +newtype CommitId = CommitId { unCommitId :: String } + +type UnpackedCabalVersion = CabalVersion' (CommitId, CabalSourceDir) +type ResolvedCabalVersion = CabalVersion' CommitId +type CabalVersion = CabalVersion' () + +data UnpackCabalVariant = Pristine | LatestRevision +newtype CabalSourceDir = CabalSourceDir { unCabalSourceDir :: FilePath } + + +unpackedToResolvedCabalVersion :: UnpackedCabalVersion -> ResolvedCabalVersion +unpackedToResolvedCabalVersion (CabalHEAD (commit, _)) = CabalHEAD commit +unpackedToResolvedCabalVersion (CabalVersion ver) = CabalVersion ver + +showUnpackedCabalVersion :: UnpackedCabalVersion -> String +showUnpackedCabalVersion (CabalHEAD (commitid, _)) = + "HEAD-" ++ unCommitId commitid +showUnpackedCabalVersion CabalVersion {cvVersion} = + showVersion cvVersion + +showResolvedCabalVersion :: ResolvedCabalVersion -> String +showResolvedCabalVersion (CabalHEAD commitid) = + "HEAD-" ++ unCommitId commitid +showResolvedCabalVersion CabalVersion {cvVersion} = + showVersion cvVersion + +showCabalVersion :: CabalVersion -> String +showCabalVersion (CabalHEAD ()) = + "HEAD" +showCabalVersion CabalVersion {cvVersion} = + showVersion cvVersion diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs index 8f79868..c0280bf 100644 --- a/tests/CompileTest.hs +++ b/tests/CompileTest.hs @@ -36,6 +36,7 @@ import CabalHelper.Compiletime.Cabal import CabalHelper.Compiletime.Compile import CabalHelper.Compiletime.Program.GHC import CabalHelper.Compiletime.Types +import CabalHelper.Compiletime.Types.Cabal import CabalHelper.Shared.Common import TestOptions @@ -141,7 +142,7 @@ testCabalVersions versions = do { cheCabalVer = icv , chePkgDb = db , cheProjDir = tmpdir - , chePlanJson = Nothing + , chePjUnits = Nothing , cheDistV2 = Just $ tmpdir "dist-newstyle" , cheProjLocalCacheDir = tmpdir "dist-newstyle" "cache" @@ -154,11 +155,11 @@ testCabalVersions versions = do mcabalVersions <- runMaybeT $ listCabalVersions (Just db) case mcabalVersions of Just [hdver] -> - return $ che0 (CabalVersion hdver) (Just db) + return $ che0 (CabalVersion hdver) [db] _ -> - return $ che0 (CabalHEAD ()) Nothing + return $ che0 (CabalHEAD ()) [] (CabalVersion ver) -> - return $ che0 (CabalVersion ver) Nothing + return $ che0 (CabalVersion ver) [] compileHelper che diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs index d05a0a3..c776164 100644 --- a/tests/GhcSession.hs +++ b/tests/GhcSession.hs @@ -2,8 +2,8 @@ DataKinds, ExistentialQuantification, PolyKinds, ViewPatterns, DeriveFunctor, MonoLocalBinds, GADTs, MultiWayIf #-} -{-| This test ensures we can get a GHC API session up and running in a variety of - project environments. +{-| This test ensures we can get a GHC API session up and running in a + variety of project environments. -} module Main where @@ -126,13 +126,31 @@ main = do -- fucking awesome store cache to keep CI times down. -- -- TODO: Better test coverage for helper compilation with the other two! - [ TC (TN "exelib") (parseVer "1.10") (parseVer "0") [] - , TC (TN "exeintlib") (parseVer "2.0") (parseVer "0") [] - , TC (TN "fliblib") (parseVer "2.0") (parseVer "0") [] - , TC (TN "bkpregex") (parseVer "2.0") (parseVer "8.1") [Cabal CV2, Cabal CV1] - , TC (TN "src-repo") (parseVer "2.4") (parseVer "0") [Cabal CV2] + [ TC (TN "exelib") (parseVer "1.10") (parseVer "0") [] + , TC (TN "exeintlib") (parseVer "2.0") (parseVer "0") [] + , TC (TN "fliblib") (parseVer "2.0") (parseVer "0") [] + , TC (TN "custom-setup") (parseVer "1.24") (parseVer "0") [Cabal CV2, Stack] + -- ^ Custom setup has issues in v1. Specifically we can get into the + -- situation where v1-configure --with-ghc=... will pick one Cabal + -- lib version but then v1-build (without --with-ghc) will pick + -- another because the system ghc has different packages available + -- than the --with-ghc one. + -- + -- At this point a setup recompile happens and hell breaks loose + -- because setup-config is mismatched. The reason we can't just pass + -- --with-ghc to v1-build to fix this is that it will actually ignore + -- it as far as setup compilation is concerned while v1-configure + -- will pick it up. + -- + -- We could fuck around with $PATH in the v1-build case too but I + -- really don't think that many people use v1 still and with + -- built-type:custom no less. + -- + -- See haskell/cabal#6749 + , TC (TN "bkpregex") (parseVer "2.0") (parseVer "8.1") [Cabal CV2, Cabal CV1] + , TC (TN "src-repo") (parseVer "2.4") (parseVer "0") [Cabal CV2] , let multipkg_loc = TF "tests/multipkg/" "proj/" "proj/proj.cabal" in - TC multipkg_loc (parseVer "1.10") (parseVer "0") [Cabal CV2, Stack] + TC multipkg_loc (parseVer "1.10") (parseVer "0") [Cabal CV2, Stack] -- min Cabal lib ver -^ min GHC ver -^ ] @@ -512,7 +530,7 @@ stackBuiltinCabalVersion s_ver g_ver = do res <- lookupStackResolver g_ver return $ parseVer . trim <$> readProcess (stackProgram ?progs) [ "--resolver="++res, "--system-ghc", "exec", "--" - , "ghc-pkg", "--simple-output", "field", "Cabal", "version" + , "ghc-pkg", "--simple-output", "--global", "field", "Cabal", "version" ] "" stackCheckCompat :: Version -> Either SkipReason () diff --git a/tests/custom-setup/Lib.hs b/tests/custom-setup/Lib.hs new file mode 100644 index 0000000..417a0ad --- /dev/null +++ b/tests/custom-setup/Lib.hs @@ -0,0 +1,8 @@ +module Lib where + +import System.Directory +import System.FilePath + +filepath = "a" "b" +directory = doesFileExist "Exe.hs" +foo = 1 diff --git a/tests/custom-setup/Setup.hs b/tests/custom-setup/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/tests/custom-setup/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/tests/custom-setup/custom-setup.cabal b/tests/custom-setup/custom-setup.cabal new file mode 100644 index 0000000..63410ac --- /dev/null +++ b/tests/custom-setup/custom-setup.cabal @@ -0,0 +1,13 @@ +name: custom-setup +version: 0 +build-type: Custom +cabal-version: >=1.10 +extra-source-files: stack.yaml + +custom-setup + setup-depends: base, Cabal + +library + exposed-modules: Lib + build-depends: base, filepath, directory + default-language: Haskell2010 diff --git a/tests/custom-setup/packages.list b/tests/custom-setup/packages.list new file mode 100644 index 0000000..80e52ce --- /dev/null +++ b/tests/custom-setup/packages.list @@ -0,0 +1 @@ +./ diff --git a/tests/custom-setup/stack.yaml b/tests/custom-setup/stack.yaml new file mode 100644 index 0000000..27cc995 --- /dev/null +++ b/tests/custom-setup/stack.yaml @@ -0,0 +1,3 @@ +resolver: lts-0.0 # will be overridden on the commandline +packages: +- ./