diff --git a/Stackage/ShakeBuild.hs b/Stackage/ShakeBuild.hs index 02d694cd..ccadba05 100644 --- a/Stackage/ShakeBuild.hs +++ b/Stackage/ShakeBuild.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -19,6 +20,7 @@ import Stackage.PackageDescription import Stackage.PerformBuild (PerformBuild(..),copyBuiltInHaddocks,renameOrCopy) import Stackage.Prelude (unFlagName,unExeName) +import Data.Char import Control.Concurrent import Control.Concurrent.STM import Control.Exception @@ -109,7 +111,7 @@ shakePlan env@Env{..} = do \(name,version) -> let fp = targetForPackage envShake name version in target fp (makeTargetFile fp) - void $ forM normalPackages $ + builds <- forM normalPackages $ \(name,plan) -> target (targetForPackage envShake name (ppVersion plan)) $ do need [db, fetched] @@ -120,7 +122,14 @@ shakePlan env@Env{..} = do target (targetForDocs envShake name (ppVersion plan)) $ do need [targetForPackage envShake name (ppVersion plan)] packageDocs env plan name - want haddockTargets + tests <- forM normalPackages $ + \(name,plan) -> + target (targetForTest envShake name (ppVersion plan)) $ + do need (haddockTargets <> [db, fetched]) + testTarget env name plan + if pbEnableTests envPB + then want tests + else want haddockTargets where versionMappings = M.toList (M.map ppVersion (bpPackages (pbPlan envPB))) corePackages = M.keys $ siCorePackages $ bpSystemInfo $ pbPlan envPB normalPackages = filter (not . (`elem` corePackages) . fst) $ @@ -141,6 +150,13 @@ targetForPackage shakeDir name version = Target $ FP.decodeString (nameVer name version) <> "dist" <> "shake-build" +-- | Get the target file for a package. +targetForTest :: FilePath -> PackageName -> Version -> Target +targetForTest shakeDir name version = Target $ + shakeDir <> "packages" <> + FP.decodeString (nameVer name version) + <> "dist" <> "shake-test" + -- | Get the target file for a package. targetForDocs :: FilePath -> PackageName -> Version -> Target targetForDocs shakeDir name version = Target $ @@ -162,11 +178,29 @@ nameVer :: PackageName -> Version -> String nameVer name version = display name ++ "-" ++ display version -- | Default environment for running commands. -defaultEnv :: PerformBuild -> FilePath -> [(String, String)] -defaultEnv pb pwd = - [( "HASKELL_PACKAGE_SANDBOX" - , FP.encodeString (pwd <> buildDatabase pb)) - | pbGlobalInstall pb] +defaultEnv :: PerformBuild -> FilePath -> [(String, String)] -> [(String, String)] +defaultEnv pb pwd env = sandbox ++ rest + where sandbox = [( "HASKELL_PACKAGE_SANDBOX" + , FP.encodeString + (pwd <> buildDatabase pb)) | not (pbGlobalInstall pb)] + rest = map addPath env + where + addPath (key,val) + | map toUpper key == "PATH" = + ( key + , FP.encodeString + (pbBinDir pb) <> + pathSep <> + val) + | otherwise = (key,val) + +-- | Platform-independent PATH environment separator. +pathSep :: String +#ifdef mingw32_HOST_OS +pathSep = ";" +#else +pathSep = ":" +#endif -- | Database location. buildDatabase :: PerformBuild -> FilePath @@ -190,6 +224,11 @@ pkgLogFile :: Env -> PackageName -> Version -> FilePath pkgLogFile env@Env{..} name version = pkgDir env name version <> "dist" <> "stackage-log.txt" +-- | The package directory. +testLogFile :: Env -> PackageName -> Version -> FilePath +testLogFile env@Env{..} name version = pkgDir env name version <> + "dist" <> "stackage-test-log.txt" + -- | Installation paths. pbBinDir, pbLibDir, pbDataDir, pbDocDir :: PerformBuild -> FilePath pbBinDir root = (pbInstallDest root) <> "bin" @@ -378,18 +417,12 @@ packageTarget env@Env{..} name plan = do unpack env name version liftIO (do exists <- FP.isFile logFile when exists (FP.removeFile logFile)) - configure env name logFile dir plan prefix <- packageCmdPrefix name + cabal env Verbose prefix logFile dir ["clean"] + configure env name logFile dir plan False let pkgCabal :: (MonadIO m) => Verbosity -> [String] -> m () pkgCabal verbosity = succeed . cabal env verbosity prefix logFile dir pkgCabal Normal ["build","--ghc-options=" <> pbGhcOptions envPB] - when (pbEnableTests envPB) - (do result <- cabal env Normal prefix logFile dir ["test"] - case result of - ExitFailure{} -> - do logLn env Normal (prefix <> "TEST SUITE FAILED") - failed env result - _ -> return ()) pkgCabal Verbose ["copy"] liftIO (withMVar envRegLock (const (pkgCabal Verbose ["register"]))) @@ -399,6 +432,33 @@ packageTarget env@Env{..} name plan = do version = ppVersion plan versionMappings = M.toList (M.map ppVersion (bpPackages (pbPlan envPB))) +-- | Build, test and generate documentation for the package. +testTarget :: Env -> PackageName -> PackagePlan -> Action () +testTarget env@Env{..} name plan = do + need $ + map (\(pname,pver) -> targetForPackage envShake pname pver) $ + mapMaybe (\p -> find ((==p) . fst) versionMappings) $ + M.keys $ sdPackages $ ppDesc plan + unpack env name version + liftIO (do exists <- FP.isFile logFile + when exists (FP.removeFile logFile)) + prefix <- packageCmdPrefix name + when (pbEnableTests envPB && pcTests (ppConstraints plan) /= Don'tBuild) + (do configure env name logFile dir plan True + result <- cabal env Normal prefix logFile dir ["test"] + case (result,pcTests (ppConstraints plan)) of + (ExitFailure{},ExpectSuccess) -> + do logLn env Normal (prefix <> "TEST SUITE FAILED") + failed env result + (ExitSuccess,ExpectFailure) -> + logLn env Normal (prefix <> "Unexpected test suite success!") + _ -> return ()) + makeTargetFile (targetForTest envShake name version) + where logFile = testLogFile env name version + dir = pkgDir env name version + version = ppVersion plan + versionMappings = M.toList (M.map ppVersion (bpPackages (pbPlan envPB))) + -- | Make sure all package archives have been fetched. fetchedTarget :: Env -> Action () fetchedTarget env@Env{..} = do @@ -429,8 +489,8 @@ unpack env@Env{..} name version = do "-v0" -- | Configure the given package. -configure :: Env -> PackageName -> FilePath -> FilePath -> PackagePlan -> Action () -configure env@Env{..} name logfile pdir plan = +configure :: Env -> PackageName -> FilePath -> FilePath -> PackagePlan -> Bool -> Action () +configure env@Env{..} name logfile pdir plan enableTests = do prefix <- packageCmdPrefix name succeed (cabal env Verbose prefix logfile pdir ("configure" : opts)) where @@ -443,7 +503,8 @@ configure env@Env{..} name logfile pdir plan = , "--docdir=" ++ FP.encodeString (pbDocDir envPB) , "--flags=" ++ planFlags] ++ ["--package-db=" ++ FP.encodeString (buildDatabase envPB) - | not (pbGlobalInstall envPB)] + | not (pbGlobalInstall envPB)] ++ + ["--enable-tests" | enableTests] planFlags = unwords $ map go $ M.toList (pcFlagOverrides (ppConstraints plan)) where go (name',isOn) = concat @@ -513,7 +574,7 @@ packageCmdPrefix name = cabal :: MonadIO m => Env -> Verbosity -> Text -> FilePath -> FilePath -> [String] -> m ExitCode cabal env verbosity prefix logfile cwd args = do pwd <- liftIO FP.getWorkingDirectory - envmap <- liftIO $ fmap (++ defaultEnv (envPB env) pwd) $ getEnvironment + envmap <- liftIO $ fmap (defaultEnv (envPB env) pwd) $ getEnvironment logLn env verbosity (prefix <> T.pack (fromMaybe "" (listToMaybe args))) logLn env Verbose (prefix <> T.pack (unwords (cmd' : map show args))) liftIO (FP.createTree (FP.directory logfile))