Start building benchmarks commercialhaskell/stackage#1372

ChangeLog.md

@@ -2,6 +2,7 @@
 
 * Move stackage-types into this package
 * Move stackage-build-plan into this package
+* Start building benchmarks [stackage#1372](https://github.com/fpco/stackage/issues/1372)
 
 ## 0.13.3
 

Stackage/BuildConstraints.hs

@@ -111,6 +111,7 @@ data ConstraintFile = ConstraintFile
     , cfSkippedTests            :: Set PackageName
     , cfSkippedBuilds           :: Set PackageName
     , cfExpectedTestFailures    :: Set PackageName
+    , cfExpectedBenchFailures   :: Set PackageName
     , cfExpectedHaddockFailures :: Set PackageName
     , cfSkippedBenchmarks       :: Set PackageName
     , cfPackages                :: Map Maintainer (Vector Dependency)
@@ -127,6 +128,8 @@ instance FromJSON ConstraintFile where
         cfSkippedTests <- getPackages o "skipped-tests"
         cfSkippedBuilds <- getPackages o "skipped-builds" <|> return mempty
         cfExpectedTestFailures <- getPackages o "expected-test-failures"
+        cfExpectedBenchFailures <- getPackages o "expected-bench-failures"
+                               <|> pure mempty -- backwards compat
         cfExpectedHaddockFailures <- getPackages o "expected-haddock-failures"
         cfSkippedBenchmarks <- getPackages o "skipped-benchmarks"
         cfSkippedLibProfiling <- getPackages o "skipped-profiling"
@@ -196,7 +199,10 @@ toBC ConstraintFile {..} = do
             | name `member` cfSkippedTests = Don'tBuild
             | name `member` cfExpectedTestFailures = ExpectFailure
             | otherwise = ExpectSuccess
-        pcBuildBenchmarks = name `notMember` cfSkippedBenchmarks
+        pcBenches
+            | name `member` cfSkippedBenchmarks = Don'tBuild
+            | name `member` cfExpectedBenchFailures = ExpectFailure
+            | otherwise = ExpectSuccess
         pcHaddocks
             | name `member` cfExpectedHaddockFailures = ExpectFailure
 

Stackage/BuildPlan.hs

@@ -152,7 +152,7 @@ mkPackagePlan bc spd = do
     ccCompilerVersion = siGhcVersion
     ccFlags = flags
     ccIncludeTests = pcTests ppConstraints /= Don'tBuild
-    ccIncludeBenchmarks = pcBuildBenchmarks ppConstraints
+    ccIncludeBenchmarks = pcBenches ppConstraints /= Don'tBuild
 
     SystemInfo {..} = bcSystemInfo bc
 

Stackage/CompleteBuild.hs

@@ -48,6 +48,7 @@ import System.Directory (doesDirectoryExist, doesFileExist)
 -- | Flags passed in from the command line.
 data BuildFlags = BuildFlags
     { bfEnableTests      :: !Bool
+    , bfEnableBenches    :: !Bool
     , bfEnableHaddock    :: !Bool
     , bfDoUpload         :: !Bool
     , bfEnableLibProfile :: !Bool
@@ -70,9 +71,10 @@ createPlan :: Target
            -> [Dependency] -- ^ additional constraints
            -> [PackageName] -- ^ newly added packages
            -> [PackageName] -- ^ newly expected test failures
+           -> [PackageName] -- ^ newly expected bench failures
            -> [PackageName] -- ^ newly expected haddock failures
            -> IO ()
-createPlan target dest constraints addPackages expectTestFailures expectHaddockFailures = do
+createPlan target dest constraints addPackages expectTestFailures expectBenchFailures expectHaddockFailures = do
     man <- newManager tlsManagerSettings
     putStrLn $ "Creating plan for: " ++ tshow target
     bc <-
@@ -96,6 +98,7 @@ createPlan target dest constraints addPackages expectTestFailures expectHaddockF
     plan <- planFromConstraints
           $ flip (foldr expectHaddockFailure) expectHaddockFailures
           $ flip (foldr expectTestFailure) expectTestFailures
+          $ flip (foldr expectBenchFailure) expectBenchFailures
           $ flip (foldr addPackage) addPackages
           $ setConstraints constraints bc
 
@@ -107,6 +110,7 @@ createPlan target dest constraints addPackages expectTestFailures expectHaddockF
     addPackage name bc = bc { bcPackages = insertSet name $ bcPackages bc }
 
     expectTestFailure = tweak $ \pc -> pc { pcTests = ExpectFailure }
+    expectBenchFailure = tweak $ \pc -> pc { pcBenches = ExpectFailure }
     expectHaddockFailure = tweak $ \pc -> pc { pcHaddocks = ExpectFailure }
 
     tweak f name bc = bc
@@ -403,6 +407,7 @@ makeBundle
     -> Target
     -> Maybe Int -- ^ jobs
     -> Bool -- ^ skip tests?
+    -> Bool -- ^ skip benches?
     -> Bool -- ^ skip haddock?
     -> Bool -- ^ skip hoogle?
     -> Bool -- ^ enable library profiling?
@@ -412,7 +417,7 @@ makeBundle
     -> Bool -- ^ no rebuild cabal?
     -> IO ()
 makeBundle
-  planFile docmapFile bundleFile target mjobs skipTests skipHaddocks skipHoogle
+  planFile docmapFile bundleFile target mjobs skipTests skipBenches skipHaddocks skipHoogle
   enableLibraryProfiling enableExecutableDynamic verbose allowNewer
   noRebuildCabal
         = do
@@ -429,6 +434,7 @@ makeBundle
             , pbJobs = jobs
             , pbGlobalInstall = False
             , pbEnableTests = not skipTests
+            , pbEnableBenches = not skipBenches
             , pbEnableHaddock = not skipHaddocks
             , pbEnableLibProfiling = enableLibraryProfiling
             , pbEnableExecDyn = enableExecutableDynamic

Stackage/InstallBuild.hs

@@ -29,6 +29,7 @@ data InstallFlags = InstallFlags
     , ifJobs               :: !Int
     , ifGlobalInstall      :: !Bool
     , ifEnableTests        :: !Bool
+    , ifEnableBenches      :: !Bool
     , ifEnableHaddock      :: !Bool
     , ifEnableLibProfiling :: !Bool
     , ifEnableExecDyn      :: !Bool
@@ -53,6 +54,7 @@ getPerformBuild plan InstallFlags{..} =
     , pbJobs               = ifJobs
     , pbGlobalInstall      = ifGlobalInstall
     , pbEnableTests        = ifEnableTests
+    , pbEnableBenches      = ifEnableBenches
     , pbEnableHaddock      = ifEnableHaddock
     , pbEnableLibProfiling = ifEnableLibProfiling
     , pbEnableExecDyn      = ifEnableExecDyn

Stackage/PerformBuild.hs

@@ -77,6 +77,7 @@ data PerformBuild = PerformBuild
     , pbGlobalInstall :: Bool
     -- ^ Register packages in the global database
     , pbEnableTests        :: Bool
+    , pbEnableBenches      :: Bool
     , pbEnableHaddock      :: Bool
     , pbEnableLibProfiling :: Bool
     , pbEnableExecDyn      :: Bool
@@ -292,6 +293,7 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} = do
   where
     libComps = setFromList [CompLibrary, CompExecutable]
     testComps = insertSet CompTestSuite libComps
+    benchComps = insertSet CompBenchmark libComps
 
     inner
       | pname == PackageName "Cabal" && pbNoRebuildCabal =
@@ -303,6 +305,7 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} = do
         withUnpacked <- wfd libComps buildLibrary
 
         wfd testComps (runTests withUnpacked)
+        wfd benchComps (buildBenches withUnpacked)
 
     pname = piName sbPackageInfo
     pident = PackageIdentifier pname (ppVersion $ piPlan sbPackageInfo)
@@ -371,6 +374,7 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} = do
             ]
     libOut = pbLogDir </> unpack namever </> "build.out"
     testOut = pbLogDir </> unpack namever </> "test.out"
+    benchOut = pbLogDir </> unpack namever </> "bench.out"
 
     wf fp inner' = do
         ref <- newIORef Nothing
@@ -603,6 +607,30 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} = do
                 (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected test success"
                 _ -> return ()
 
+    buildBenches withUnpacked = wf benchOut $ \getOutH -> do
+        let run = runChild getOutH
+            cabal args = run "runghc" $ runghcArgs $ "Setup" : args
+
+        prevBenchResult <- getPreviousResult pb Bench pident
+        let needTest = pbEnableBenches
+                    && checkPrevResult prevBenchResult pcBenches
+                    && not pcSkipBuild
+        when needTest $ withUnpacked $ \gpd -> do
+            log' $ "Benchmark configure " ++ namever
+            cabal $ "configure" : "--enable-benchmarks" : configArgs
+
+            eres <- tryAny $ do
+                log' $ "Benchmark build " ++ namever
+                cabal ["build"]
+
+                log' "We do not currently run benchmarks"
+
+            savePreviousResult pb Bench pident $ either (const False) (const True) eres
+            case (eres, pcBenches) of
+                (Left e, ExpectSuccess) -> throwM e
+                (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected benchmark success"
+                _ -> return ()
+
     warn t = atomically $ modifyTVar sbWarningsVar (. (t:))
 
     updateErrs exc = do
@@ -640,7 +668,7 @@ copyBuiltInHaddocks docdir = do
 ------------- Previous results
 
 -- | The previous actions that can be run
-data ResultType = Build | Haddock | Test
+data ResultType = Build | Haddock | Test | Bench
     deriving (Show, Enum, Eq, Ord, Bounded, Read)
 
 -- | The result generated on a previous run

Stackage/Types.hs

@@ -213,8 +213,8 @@ data PackageConstraints = PackageConstraints
     { pcVersionRange     :: VersionRange
     , pcMaintainer       :: Maybe Maintainer
     , pcTests            :: TestState
+    , pcBenches          :: TestState
     , pcHaddocks         :: TestState
-    , pcBuildBenchmarks  :: Bool
     , pcFlagOverrides    :: Map FlagName Bool
     , pcEnableLibProfile :: Bool
     , pcSkipBuild        :: Bool
@@ -227,8 +227,15 @@ instance ToJSON PackageConstraints where
     toJSON PackageConstraints {..} = object $ addMaintainer
         [ "version-range" .= display pcVersionRange
         , "tests" .= pcTests
+        , "benches" .= pcBenches
+
+        -- for backwards compatibility
+        , "build-benchmarks" .=
+            case pcBenches of
+              Don'tBuild -> False
+              _          -> True
+
         , "haddocks" .= pcHaddocks
-        , "build-benchmarks" .= pcBuildBenchmarks
         , "flags" .= Map.mapKeysWith const unFlagName pcFlagOverrides
         , "library-profiling" .= pcEnableLibProfile
         , "skip-build" .= pcSkipBuild
@@ -240,8 +247,11 @@ instance FromJSON PackageConstraints where
         pcVersionRange <- (o .: "version-range")
                       >>= either (fail . show) return . simpleParse
         pcTests <- o .: "tests"
+        pcBenches <- o .: "benches" <|>
+          -- Compatibility with old build-benchmarks boolean
+          ((\x -> if x then ExpectFailure else Don'tBuild)
+             <$> (o .: "build-benchmarks"))
         pcHaddocks <- o .: "haddocks"
-        pcBuildBenchmarks <- o .: "build-benchmarks"
         pcFlagOverrides <- Map.mapKeysWith const mkFlagName <$> o .: "flags"
         pcMaintainer <- o .:? "maintainer"
         pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling")

Stackage/UpdateBuildPlan.hs

@@ -33,7 +33,7 @@ updateBuildConstraints BuildPlan {..} =
         , pcMaintainer = moldPC >>= pcMaintainer
         , pcTests = maybe ExpectSuccess pcTests moldPC
         , pcHaddocks = maybe ExpectSuccess pcHaddocks moldPC
-        , pcBuildBenchmarks = maybe True pcBuildBenchmarks moldPC
+        , pcBenches = maybe ExpectSuccess pcBenches moldPC
         , pcFlagOverrides = maybe mempty pcFlagOverrides moldPC
         , pcEnableLibProfile = maybe True pcEnableLibProfile moldPC
         , pcSkipBuild = maybe False pcSkipBuild moldPC

app/stackage.hs

@@ -41,6 +41,7 @@ main = do
                 <*> many constraint
                 <*> many addPackage
                 <*> many expectTestFailure
+                <*> many expectBenchFailure
                 <*> many expectHaddockFailure
                 )
         addCommand "check" "Verify that a plan is valid" id
@@ -80,6 +81,7 @@ main = do
         <*> target
         <*> jobs
         <*> skipTests
+        <*> skipBenches
         <*> skipHaddock
         <*> skipHoogle
         <*> enableLibraryProfiling
@@ -128,6 +130,11 @@ main = do
             (switch
                 (long "skip-tests" <>
                  help "Skip build and running the test suites")) <*>
+        fmap
+            not
+            (switch
+                (long "skip-benches" <>
+                 help "Skip building the benchmarks")) <*>
         fmap
             not
             (switch
@@ -169,6 +176,11 @@ main = do
             (long "skip-tests" ++
              help "Skip build and running the test suites")
 
+    skipBenches =
+        switch
+            (long "skip-benches" ++
+             help "Skip building the benchmarks")
+
     skipHaddock =
         switch
             (long "skip-haddock" ++
@@ -278,6 +290,12 @@ main = do
              metavar "PACKAGE-NAME" ++
              help "Newly expected test failures")
 
+    expectBenchFailure =
+        option packageRead
+            (long "expect-bench-failure" ++
+             metavar "PACKAGE-NAME" ++
+             help "Newly expected benchmark build failures")
+
     expectHaddockFailure =
         option packageRead
             (long "expect-haddock-failure" ++

build-constraints.yaml

@@ -2335,6 +2335,10 @@ expected-test-failures:
     - zlib
 # end of expected-test-failures
 
+expected-benchmark-failures:
+    []
+
+# end of expected-benchmark-failures
 
 # Haddocks which are expected to fail. Same concept as expected test failures.
 expected-haddock-failures: