Proper caching of database

This commit is contained in:
Chris Done 2015-01-13 20:27:56 +01:00
parent 127fe575e7
commit 9d3bab31d0

View File

@ -35,7 +35,7 @@ shakePlan pb shakeDir = do
fetched <- target (targetForFetched shakeDir) $ fetched <- target (targetForFetched shakeDir) $
fetchedTarget shakeDir pb fetchedTarget shakeDir pb
db <- target db <- target
(targetForDb shakeDir pb) (targetForDb' shakeDir)
(databaseTarget shakeDir pb) (databaseTarget shakeDir pb)
_ <- forM corePackages $ _ <- forM corePackages $
\name -> \name ->
@ -59,13 +59,18 @@ shakePlan pb shakeDir = do
-- create the target file. -- create the target file.
databaseTarget :: FilePath -> PerformBuild -> Action () databaseTarget :: FilePath -> PerformBuild -> Action ()
databaseTarget shakeDir pb = databaseTarget shakeDir pb =
if pbGlobalInstall pb do if pbGlobalInstall pb
then liftIO (createDirectoryIfMissing True dir) then return ()
else do liftIO (createDirectoryIfMissing True (dir)) else do 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 pb)))
where dir = targetForDb shakeDir pb makeFile (targetForDb' shakeDir)
where dir = buildDatabase pb
-- | Database location.
buildDatabase :: PerformBuild -> FilePattern
buildDatabase pb = FP.encodeString (pbInstallDest pb) <//> "pkgdb"
-- | Make sure all package archives have been fetched. -- | Make sure all package archives have been fetched.
fetchedTarget :: FilePath -> PerformBuild -> Action () fetchedTarget :: FilePath -> PerformBuild -> Action ()
@ -101,7 +106,8 @@ packageTarget pb shakeDir name plan = do
defaultEnv pwd = defaultEnv pwd =
[ ( "HASKELL_PACKAGE_SANDBOX" [ ( "HASKELL_PACKAGE_SANDBOX"
, pwd <//> , pwd <//>
targetForDb shakeDir pb)] buildDatabase pb)
| pbGlobalInstall pb]
pkgDir = shakeDir <//> nameVer pkgDir = shakeDir <//> nameVer
nameVer = nameVer =
display name ++ display name ++
@ -120,7 +126,7 @@ opts shakeDir pb plan pwd =
, "--flags=" ++ planFlags plan] ++ , "--flags=" ++ planFlags plan] ++
["--package-db=" ++ ["--package-db=" ++
pwd <//> pwd <//>
targetForDb shakeDir pb | not (pbGlobalInstall pb)] buildDatabase pb | not (pbGlobalInstall pb)]
-- | Generate a flags string for the package plan. -- | Generate a flags string for the package plan.
planFlags :: PackagePlan -> String planFlags :: PackagePlan -> String
@ -145,11 +151,9 @@ targetForPackage shakeDir name =
shakeDir <//> "packages" <//> display name shakeDir <//> "packages" <//> display name
-- | Get a package database path. -- | Get a package database path.
targetForDb :: FilePath -> PerformBuild -> FilePath targetForDb' :: FilePath -> FilePath
targetForDb shakeDir pb = targetForDb' shakeDir =
if pbGlobalInstall pb shakeDir <//> "pkgdb"
then shakeDir <//> "pkgdb-global"
else FP.encodeString (pbInstallDest pb) <//> "pkgdb"
-- | Declare a target, returning the target name. -- | Declare a target, returning the target name.
target :: FilePattern -> Action () -> Rules FilePattern target :: FilePattern -> Action () -> Rules FilePattern