shake: Make package builds version-specific

This commit is contained in:
Chris Done 2015-01-15 08:52:47 +01:00
parent e774fc15fd
commit 1abef8ff44

View File

@ -5,6 +5,9 @@
module Stackage.ShakeBuild where module Stackage.ShakeBuild where
import Control.Concurrent.MVar import Control.Concurrent.MVar
import Data.List
import Data.Maybe
import Data.Version
import Stackage.BuildConstraints import Stackage.BuildConstraints
import Stackage.BuildPlan import Stackage.BuildPlan
import Stackage.CheckBuildPlan import Stackage.CheckBuildPlan
@ -55,13 +58,13 @@ shakePlan haddockFiles registerLock pb shakeDir = do
fetchedTarget shakeDir pb fetchedTarget shakeDir pb
db <- target (targetForDb shakeDir) $ db <- target (targetForDb shakeDir) $
databaseTarget shakeDir pb databaseTarget shakeDir pb
_ <- forM corePackages $ _ <- forM (mapMaybe (\p -> find ((==p) . fst) versionMappings) corePackages) $
\name -> \(name,version) ->
let fp = targetForPackage shakeDir name let fp = targetForPackage shakeDir name version
in target fp (makeFile fp) in target fp (makeFile fp)
packageTargets <- forM normalPackages $ packageTargets <- forM normalPackages $
\(name,plan) -> \(name,plan) ->
target (targetForPackage shakeDir name) $ target (targetForPackage shakeDir name (ppVersion plan)) $
do need [db, fetched] do need [db, fetched]
packageTarget packageTarget
haddockFiles haddockFiles
@ -72,13 +75,14 @@ shakePlan haddockFiles registerLock pb shakeDir = do
plan plan
haddockTargets <- forM normalPackages $ haddockTargets <- forM normalPackages $
\(name,plan) -> \(name,plan) ->
target (targetForDocs shakeDir name) $ target (targetForDocs shakeDir name (ppVersion plan)) $
do need [targetForPackage shakeDir name] do need [targetForPackage shakeDir name (ppVersion plan)]
packageDocs haddockFiles shakeDir pb plan name packageDocs haddockFiles shakeDir pb plan name
if True if True
then want haddockTargets then want haddockTargets
else want packageTargets else want packageTargets
where corePackages = M.keys $ siCorePackages $ bpSystemInfo $ pbPlan pb where versionMappings = M.toList (M.map ppVersion (bpPackages (pbPlan pb)))
corePackages = M.keys $ siCorePackages $ bpSystemInfo $ pbPlan pb
normalPackages = filter (not . (`elem` corePackages) . fst) $ normalPackages = filter (not . (`elem` corePackages) . fst) $
M.toList $ bpPackages $ pbPlan pb M.toList $ bpPackages $ pbPlan pb
@ -95,11 +99,11 @@ packageDocs haddockFiles shakeDir pb plan name = do
when when
(haddocksFlag /= Don'tBuild && (haddocksFlag /= Don'tBuild &&
not (S.null $ sdModules $ ppDesc plan)) $ not (S.null $ sdModules $ ppDesc plan)) $
generateHaddocks haddockFiles pb pkgDir env name nameVer haddocksFlag generateHaddocks haddockFiles pb shakeDir pkgDir env name nameVer haddocksFlag
makeFile (targetForDocs shakeDir name) makeFile (targetForDocs shakeDir name (ppVersion plan))
where haddocksFlag = pcHaddocks $ ppConstraints plan where haddocksFlag = pcHaddocks $ ppConstraints plan
defaultEnv pwd = [( "HASKELL_PACKAGE_SANDBOX" defaultEnv pwd = [( "HASKELL_PACKAGE_SANDBOX"
, pwd <//> buildDatabase pb) | pbGlobalInstall pb] , pwd <//> buildDatabase shakeDir) | pbGlobalInstall pb]
pkgDir = shakeDir <//> nameVer pkgDir = shakeDir <//> nameVer
nameVer = display name ++ nameVer = display name ++
"-" ++ "-" ++
@ -115,9 +119,9 @@ databaseTarget shakeDir pb = do
liftIO (createDirectoryIfMissing True dir) liftIO (createDirectoryIfMissing True dir)
liftIO (removeDirectoryRecursive dir) liftIO (removeDirectoryRecursive dir)
() <- cmd "ghc-pkg" "init" dir () <- cmd "ghc-pkg" "init" dir
liftIO $ copyBuiltInHaddocks $ FP.decodeString $ pbDocDir pb liftIO $ copyBuiltInHaddocks $ FP.decodeString $ pbDocDir shakeDir
makeFile (targetForDb shakeDir) makeFile (targetForDb shakeDir)
where dir = buildDatabase pb where dir = buildDatabase shakeDir
-- | Build, test and generate documentation for the package. -- | Build, test and generate documentation for the package.
packageTarget :: TVar (Map String FilePath) packageTarget :: TVar (Map String FilePath)
@ -129,19 +133,21 @@ packageTarget :: TVar (Map String FilePath)
-> Action () -> Action ()
packageTarget haddockFiles registerLock pb shakeDir name plan = do packageTarget haddockFiles registerLock pb shakeDir name plan = do
need $ need $
map (targetForPackage shakeDir) $ map (\(name,version) -> targetForPackage shakeDir name version) $
mapMaybe (\p -> find ((==p) . fst) versionMappings) $
filter (/= name) $ filter (/= name) $
M.keys $ M.filter libAndExe $ sdPackages $ ppDesc plan M.keys $ M.filter libAndExe $ sdPackages $ ppDesc plan
pwd <- liftIO getCurrentDirectory pwd <- liftIO getCurrentDirectory
env <- liftIO (fmap (Env . (++ defaultEnv pwd)) getEnvironment) env <- liftIO (fmap (Env . (++ defaultEnv pwd)) getEnvironment)
unpack shakeDir nameVer unpack shakeDir nameVer
configure pkgDir env pb plan configure shakeDir pkgDir env pb plan
() <- cmd cwd env "cabal" "build" "--ghc-options=-O0" () <- cmd cwd env "cabal" "build" "--ghc-options=-O0"
register pkgDir env registerLock register pkgDir env registerLock
makeFile (targetForPackage shakeDir name) makeFile (targetForPackage shakeDir name (ppVersion plan))
where cwd = Cwd pkgDir where versionMappings = M.toList (M.map ppVersion (bpPackages (pbPlan pb)))
cwd = Cwd pkgDir
defaultEnv pwd = [( "HASKELL_PACKAGE_SANDBOX" defaultEnv pwd = [( "HASKELL_PACKAGE_SANDBOX"
, pwd <//> buildDatabase pb) | pbGlobalInstall pb] , pwd <//> buildDatabase shakeDir) | pbGlobalInstall pb]
pkgDir = shakeDir <//> nameVer pkgDir = shakeDir <//> nameVer
nameVer = display name ++ nameVer = display name ++
"-" ++ "-" ++
@ -168,8 +174,8 @@ unpack shakeDir nameVer = do
where pkgDir = shakeDir <//> nameVer where pkgDir = shakeDir <//> nameVer
-- | Configure the given package. -- | Configure the given package.
configure :: FilePath -> CmdOption -> PerformBuild -> PackagePlan -> Action () configure :: FilePath -> FilePath -> CmdOption -> PerformBuild -> PackagePlan -> Action ()
configure pkgDir env pb plan = do configure shakeDir pkgDir env pb plan = do
configured <- liftIO $ doesFileExist $ pkgDir <//> "dist" <//> configured <- liftIO $ doesFileExist $ pkgDir <//> "dist" <//>
"setup-config" "setup-config"
unless configured $ unless configured $
@ -182,12 +188,12 @@ configure pkgDir env pb plan = do
(opts pwd) (opts pwd)
where opts pwd = [ "--package-db=clear" where opts pwd = [ "--package-db=clear"
, "--package-db=global" , "--package-db=global"
, "--libdir=" ++ pwd <//> pbLibDir pb , "--libdir=" ++ pbLibDir shakeDir
, "--bindir=" ++ pwd <//> pbBinDir pb , "--bindir=" ++ pbBinDir shakeDir
, "--datadir=" ++ pwd <//> pbDataDir pb , "--datadir=" ++ pbDataDir shakeDir
, "--docdir=" ++ pwd <//> pbDocDir pb , "--docdir=" ++ pbDocDir shakeDir
, "--flags=" ++ planFlags plan] ++ , "--flags=" ++ planFlags plan] ++
["--package-db=" ++ pwd <//> buildDatabase pb | not (pbGlobalInstall pb)] ["--package-db=" ++ buildDatabase shakeDir | not (pbGlobalInstall pb)]
-- | Register the package. -- | Register the package.
-- --
@ -207,12 +213,13 @@ register pkgDir env registerLock = do
generateHaddocks :: TVar (Map String FilePath) generateHaddocks :: TVar (Map String FilePath)
-> PerformBuild -> PerformBuild
-> FilePath -> FilePath
-> FilePath
-> CmdOption -> CmdOption
-> PackageName -> PackageName
-> FilePattern -> FilePattern
-> TestState -> TestState
-> Action () -> Action ()
generateHaddocks haddockFiles pb pkgDir env name nameVer expected = do generateHaddocks haddockFiles pb shakeDir pkgDir env name nameVer expected = do
hfs <- liftIO $ readTVarIO haddockFiles hfs <- liftIO $ readTVarIO haddockFiles
exitCode <- cmd exitCode <- cmd
(Cwd pkgDir) (Cwd pkgDir)
@ -246,11 +253,11 @@ generateHaddocks haddockFiles pb pkgDir env name nameVer expected = do
renameOrCopy renameOrCopy
(FP.decodeString orig) (FP.decodeString orig)
(FP.decodeString (FP.decodeString
(pbDocDir pb <//> nameVer)) (pbDocDir shakeDir <//> nameVer))
enewPath <- liftIO $ enewPath <- liftIO $
try $ try $
canonicalizePath canonicalizePath
(pbDocDir pb <//> nameVer <//> display name ++ (pbDocDir shakeDir <//> nameVer <//> display name ++
".haddock") ".haddock")
case enewPath of case enewPath of
Left (e :: IOException) -> return () -- FIXME: log it with Shake. Left (e :: IOException) -> return () -- FIXME: log it with Shake.
@ -273,8 +280,8 @@ planFlags plan = unwords $
, T.unpack (unFlagName name')] , T.unpack (unFlagName name')]
-- | Database location. -- | Database location.
buildDatabase :: PerformBuild -> FilePattern buildDatabase :: FilePath -> FilePattern
buildDatabase pb = FP.encodeString (pbInstallDest pb) <//> "pkgdb" buildDatabase shakeDir = shakeDir <//> "pkgdb"
-- | Get the target file for confirming that all packages have been -- | Get the target file for confirming that all packages have been
-- pre-fetched. -- pre-fetched.
@ -283,19 +290,25 @@ targetForFetched shakeDir =
shakeDir <//> "fetched" shakeDir <//> "fetched"
-- | Get the target file for a package. -- | Get the target file for a package.
targetForPackage :: FilePath -> PackageName -> FilePath targetForPackage :: FilePath -> PackageName -> Version -> FilePath
targetForPackage shakeDir name = targetForPackage shakeDir name version =
shakeDir <//> "packages" <//> display name shakeDir <//> "packages" <//> nameVer
where nameVer = display name ++
"-" ++
display version
-- | Get the target file for a package. -- | Get the target file for a package.
targetForDocs :: FilePath -> PackageName -> FilePath targetForDocs :: FilePath -> PackageName -> Version -> FilePath
targetForDocs shakeDir name = targetForDocs shakeDir name version =
shakeDir <//> "docs" <//> display name shakeDir <//> "docs" <//> nameVer
where nameVer = display name ++
"-" ++
display version
-- | Get a package database path. -- | Get a package database path.
targetForDb :: FilePath -> FilePath targetForDb :: FilePath -> FilePath
targetForDb shakeDir = targetForDb shakeDir =
shakeDir <//> "pkgdb" shakeDir <//> "pkgdb-built"
-- | Declare a target, returning the target name. -- | Declare a target, returning the target name.
target :: FilePattern -> Action () -> Rules FilePattern target :: FilePattern -> Action () -> Rules FilePattern
@ -307,8 +320,8 @@ target name act = do
makeFile :: FilePath -> Action () makeFile :: FilePath -> Action ()
makeFile fp = liftIO $ writeFile fp "" makeFile fp = liftIO $ writeFile fp ""
pbBinDir, pbLibDir, pbDataDir, pbDocDir :: PerformBuild -> FilePath pbBinDir, pbLibDir, pbDataDir, pbDocDir :: FilePath -> FilePath
pbBinDir pb = FP.encodeString (pbInstallDest pb) <//> "bin" pbBinDir shakeDir = shakeDir <//> "bin"
pbLibDir pb = FP.encodeString (pbInstallDest pb) <//> "lib" pbLibDir shakeDir = shakeDir <//> "lib"
pbDataDir pb = FP.encodeString (pbInstallDest pb) <//> "share" pbDataDir shakeDir = shakeDir <//> "share"
pbDocDir pb = FP.encodeString (pbInstallDest pb) <//> "doc" pbDocDir shakeDir = shakeDir <//> "doc"