diff --git a/Stackage/ShakeBuild.hs b/Stackage/ShakeBuild.hs index c9022699..d1081cf2 100644 --- a/Stackage/ShakeBuild.hs +++ b/Stackage/ShakeBuild.hs @@ -3,11 +3,16 @@ module Stackage.ShakeBuild where import Stackage.BuildPlan +import Stackage.PackageDescription +import Stackage.BuildConstraints import Stackage.PerformBuild (PerformBuild(..)) +import Control.Monad +import Data.List ((\\)) import qualified Data.Map.Strict as M import Data.Text (Text) import Development.Shake +import Distribution.Package (PackageName) import Distribution.Text (display) import System.Directory import System.Environment @@ -15,8 +20,7 @@ import System.Environment -- | Run the shake builder. performBuild :: PerformBuild -> IO () performBuild pb = do - shakeDir <- fmap ( "shake") getCurrentDirectory - createDirectoryIfMissing True shakeDir + shakeDir <- fmap ( "shake/") getCurrentDirectory withArgs [] (shakeArgs @@ -26,24 +30,75 @@ performBuild pb = do -- | The complete build plan as far as Shake is concerned. shakePlan :: PerformBuild -> FilePath -> Rules () shakePlan pb shakeDir = do - wantedFetched *> const (fetchedTarget wantedFetched pb) - want [wantedFetched] - where wantedFetched = - shakeDir "fetched" + fetched <- target (targetForFetched shakeDir) $ + fetchedTarget shakeDir pb + _ <- forM corePackages $ + \name -> + let fp = + targetForPackage shakeDir name + in target fp (makeFile fp) + packageTargets <- forM normalPackages $ + \(name,plan) -> + target + (targetForPackage shakeDir name) + (do need [fetched] + packageTarget shakeDir name plan) + want packageTargets + where corePackages = + M.keys $ siCorePackages $ bpSystemInfo $ pbPlan pb + normalPackages = + filter (not . (`elem` corePackages) . fst) $ + M.toList $ bpPackages $ pbPlan pb -- | Make sure all package archives have been fetched. fetchedTarget :: FilePath -> PerformBuild -> Action () -fetchedTarget wantedFile pb = - do () <- cmd - "cabal" - "fetch" - "--no-dependencies" - (map - (\(name,plan) -> - display name ++ - "-" ++ - display (ppVersion plan)) - (M.toList - (bpPackages - (pbPlan pb)))) - liftIO (writeFile wantedFile "") +fetchedTarget shakeDir pb = do + () <- cmd "cabal" "fetch" "--no-dependencies" $ + map + (\(name,plan) -> + display name ++ + "-" ++ + display (ppVersion plan)) + (M.toList + (bpPackages + (pbPlan pb))) + makeFile (targetForFetched shakeDir) + +-- | Build, test and generate documentation for the package. +packageTarget :: FilePath -> PackageName -> PackagePlan -> Action () +packageTarget shakeDir name plan = do + need (map (targetForPackage shakeDir) + (M.keys (sdPackages (ppDesc plan)))) + () <- cmd (Cwd shakeDir) "cabal" "unpack" nameVer + () <- cmd (Cwd pkgDir) "cabal" "configure" + () <- cmd (Cwd pkgDir) "cabal" "build" + () <- cmd (Cwd pkgDir) "cabal" "copy" + () <- cmd (Cwd pkgDir) "cabal" "register" + makeFile (targetForPackage shakeDir name) + where pkgDir = + shakeDir nameVer + nameVer = + display name ++ + "-" ++ + display (ppVersion plan) + +-- | Get the target file for confirming that all packages have been +-- pre-fetched. +targetForFetched :: FilePattern -> FilePattern +targetForFetched shakeDir = + shakeDir "fetched" + +-- | Get the target file for a package. +targetForPackage :: FilePattern -> PackageName -> FilePattern +targetForPackage shakeDir name = + shakeDir "packages" display name + +-- | Declare a target, returning the target name. +target :: FilePattern -> Action () -> Rules FilePattern +target name action = do + name *> const action + return name + +-- | Make a file of this name. +makeFile :: FilePath -> Action () +makeFile fp = liftIO $ writeFile fp "" diff --git a/stackage.cabal b/stackage.cabal index 877e9349..114e83cb 100644 --- a/stackage.cabal +++ b/stackage.cabal @@ -64,6 +64,7 @@ library , streaming-commons >= 0.1.7.1 , semigroups , xml-conduit + , shake executable stackage default-language: Haskell2010 diff --git a/test/Stackage/BuildPlanSpec.hs b/test/Stackage/BuildPlanSpec.hs index 4981c049..d13dee52 100644 --- a/test/Stackage/BuildPlanSpec.hs +++ b/test/Stackage/BuildPlanSpec.hs @@ -48,11 +48,11 @@ spec = do ,("transformers",anyV)]) ,("transformers",[0,4,1,0],[("base",anyV)])] it "shake build" $ shakeBuild $ makePackageSet - [("acme-strtok", [0,1,0,3], [("mtl", thisV [2, 2, 1])]) + [("acme-strtok", [0,1,0,3], [("mtl", thisV [2, 1, 3, 1])]) ,("acme-dont", [1,1], []) - ,("mtl",[2,2,1],[("base",anyV) - ,("transformers",anyV)]) - ,("transformers",[0,4,1,0],[("base",anyV)])] + ,("mtl",[2,1,3,1],[("base",anyV) + ,("transformers",anyV)]) + ,("transformers",[0,3,0,0],[("base",anyV)])] it "default package set checks ok" $ check defaultBuildConstraints getLatestAllowedPlans -}