buildbox 1.5.3.1 → 2.0.0.1

raw patch · 28 files changed

+567/−1817 lines, 28 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• BuildBox.hs +16/−35
• BuildBox/Aspect.hs +0/−86
• BuildBox/Aspect/Aspect.hs +0/−231
• BuildBox/Aspect/Comparison.hs +0/−91
• BuildBox/Aspect/Detail.hs +0/−63
• BuildBox/Aspect/Single.hs +0/−26
• BuildBox/Aspect/Stats.hs +0/−54
• BuildBox/Aspect/Units.hs +0/−237
• BuildBox/Benchmark.hs +0/−94
• BuildBox/Benchmark/BenchResult.hs +0/−369
• BuildBox/Benchmark/Benchmark.hs +0/−25
• BuildBox/Build/Benchmark.hs +66/−0
• BuildBox/Command/File.hs +5/−5
• BuildBox/Command/System/Internals.hs +2/−1
• BuildBox/Control/Cron.hs +43/−0
• BuildBox/Control/Gang.hs +4/−4
• BuildBox/Cron.hs +0/−43
• BuildBox/Cron/Schedule.hs +0/−210
• BuildBox/Data/Comparison.hs +46/−0
• BuildBox/Data/Detail.hs +63/−0
• BuildBox/Data/Physical.hs +55/−0
• BuildBox/Data/Range.hs +40/−0
• BuildBox/Data/Schedule.hs +210/−0
• BuildBox/FileFormat/BuildResults.hs +0/−112
• BuildBox/Quirk.hs +0/−37
• BuildBox/Reports/BenchResult.hs +0/−58
• LICENSE +1/−12
• buildbox.cabal +16/−24

@@ -1,39 +1,20 @@  module BuildBox-	( module BuildBox.Aspect-	, module BuildBox.Benchmark-	, module BuildBox.Build-	, module BuildBox.Command.Sleep-	, module BuildBox.Command.System-	, module BuildBox.Command.Network-	, module BuildBox.Command.Mail-	, module BuildBox.Command.Environment-	, module BuildBox.Command.File-	, module BuildBox.Command.Darcs-	, module BuildBox.Control.Gang-	, module BuildBox.Cron-	, module BuildBox.FileFormat.BuildResults-	, module BuildBox.IO.Directory-	, module BuildBox.Pretty-	, module BuildBox.Quirk-	, module BuildBox.Reports.BenchResult-	, module BuildBox.Time)+	( Build++        -- * Building+        , runBuild+        , runBuildWithState++        -- * Errors+        , throw+        , needs++        -- * Utils+        , io++        -- * Output+        , out+        , outLn) where-import BuildBox.Aspect-import BuildBox.Benchmark import BuildBox.Build-import BuildBox.Command.Sleep-import BuildBox.Command.System-import BuildBox.Command.Network-import BuildBox.Command.Mail-import BuildBox.Command.Environment-import BuildBox.Command.File-import BuildBox.Command.Darcs-import BuildBox.Control.Gang-import BuildBox.Cron-import BuildBox.FileFormat.BuildResults-import BuildBox.IO.Directory-import BuildBox.Pretty-import BuildBox.Quirk-import BuildBox.Reports.BenchResult-import BuildBox.Time

@@ -1,86 +0,0 @@---- | An aspect is a piece of data obtained from running a benchmark, like its ---   total runtime, heap usage, or executable size. Aspects have physical---   units, so runtime is in seconds, and executable size is in bytes. The type system---   ensures that you can't mess up the units, such as by treating executable size as though it was---   measured in seconds.------   Aspects are also parameterised over a carrier constructor, which is the collection type---   used to store the data. For single valued data use the `Single` constructor. For multi valued---   data use the @[]@ (the list constructor). Use this when you have several readings for---   the same benchmark, like runtimes from multiple independent runs. ---   Other useful constructors are `Stats`, `Comparison` and `StatsComparison`.------   Once you have a many-valued aspect, you can use `makeAspectStats` to compute statistics---   from the data.--- ---   Here is a worked example:------  @ --- -- This is our original, single valued data.---someData :: [`WithUnits` (`Aspect` `Single`)]---someData =  [ `Time` `TotalWall` \``secs`\`  100---            , `Time` `TotalWall` \``secs`\`  85---            , `Size` `ExeSize`   \``bytes`\` 1024---            , `Used` `HeapMax`   \``bytes`\` 100000---            , `Used` `HeapMax`   \``bytes`\` 100100]---  @---  ---  @--- -- Collate the data, which groups all the readings for the same aspect into a list.--- -- Note that the carrier constructor is now [].---collated  :: [`WithUnits` (`Aspect` [])]---collated  = `collateWithUnits` someData--- ...---show collated ---  =>   [ `WithSeconds` (`Time` `TotalWall` [`Seconds` 100.0, `Seconds` 85.0])---       , `WithBytes`   (`Used` `HeapMax`   [`Bytes` 100000,  `Bytes` 100100])---       , `WithBytes`   (`Size` `ExeSize`   [`Bytes` 1024])]---  @------  @--- -- Extract statistics from the collated data.---analysed   :: [`WithUnits` (`Aspect` `Stats`)]---analysed   =  map (`liftWithUnits` `makeAspectStats`) collated--- ...---show analysed---  =>   [ `WithSeconds` (`Time` `TotalWall` (`Stats` {`statsMin` = `Seconds` 85.0, `statsAvg` = `Seconds` 92.5, `statsMax` = `Seconds` 100.0}))---       , `WithBytes`   (`Used` `HeapMax`   (`Stats` {`statsMin` = `Bytes` 100000, `statsAvg` = `Bytes` 100050, `statsMax` = `Bytes` 100100}))---       , `WithBytes`   (`Size` `ExeSize`   (`Stats` {`statsMin` = `Bytes` 1024,   `statsAvg` = `Bytes` 1024,   `statsMax` = `Bytes` 1024}))]--- @-module BuildBox.Aspect-	( module BuildBox.Aspect.Units-	, module BuildBox.Aspect.Detail-	, module BuildBox.Aspect.Stats-	, module BuildBox.Aspect.Single-	, module BuildBox.Aspect.Comparison--	-- * Aspects-	, Aspect	(..)-	, makeAspect-	, splitAspect--	-- * Statistics and comparisons-	, makeAspectStats-	, makeAspectComparison-	, makeAspectComparisons--	-- * Application functions-	, appAspect-	, appAspectWithUnits--	-- * Lifting functions-	, liftAspect-	, liftAspect2)-where-import BuildBox.Aspect.Aspect-import BuildBox.Aspect.Detail-import BuildBox.Aspect.Stats-import BuildBox.Aspect.Units-import BuildBox.Aspect.Single-import BuildBox.Aspect.Comparison-----

@@ -1,231 +0,0 @@-{-# LANGUAGE 	ScopedTypeVariables, StandaloneDeriving,-		GADTs, FlexibleContexts, RankNTypes,-		UndecidableInstances, KindSignatures #-}-{-# OPTIONS_HADDOCK hide #-}-module BuildBox.Aspect.Aspect-	( Aspect	(..)-	, makeAspect-	, splitAspect-	, makeAspectStats-	, makeAspectComparison-	, makeAspectComparisons--	-- * Application functions-	, appAspect-	, appAspectWithUnits--	-- * Lifting functions-	, liftAspect-	, liftAspect2)-where-import BuildBox.Aspect.Single-import BuildBox.Aspect.Units-import BuildBox.Aspect.Detail-import BuildBox.Aspect.Stats-import BuildBox.Aspect.Comparison-import BuildBox.Pretty-import Text.Read-import Data.List-import qualified Data.Map	as Map----- | Holds a detail about a benchmark.------   The @c@ is the type constructor of the carrier that holds the data.------   Useful instances for @c@ include `Single`, `[ ]`, `Stats`, `Comparison` and `StatsComparison`.----data Aspect (c :: * -> *) units where-	Time	:: Timed	-> c Seconds	-> Aspect c Seconds-	Size	:: Sized	-> c Bytes	-> Aspect c Bytes-	Used	:: Used		-> c Bytes	-> Aspect c Bytes--deriving instance Show (c units) => Show (Aspect c units)	---- We need to write the read instance manually because it requires makeAspect-instance (  HasUnits (c units) units-	 ,  Read  (c units)) -	 => Read (Aspect c units) where- readPrec -  = do	tok <- lexP-	case tok of-	 Punc  "("-	  -> do	aspect		<- readPrec-		Punc ")"	<- lexP-		return aspect-		-	 Ident "Time" -	  -> do	timed		<- readPrec-		dat		<- readPrec-		let Just aspect	= makeAspect (DetailTimed timed) dat-		return aspect-	-	 Ident "Size"-	  -> do	sized		<- readPrec-		dat		<- readPrec-		let Just aspect	= makeAspect (DetailSized sized) dat-		return aspect--	 Ident "Used"-	  -> do	used		<- readPrec-		dat		<- readPrec-		let Just aspect	= makeAspect (DetailUsed used) dat-		return aspect-		-	 _ -> pfail---instance ( Pretty (c Seconds)-	 , Pretty (c Bytes))- 	 => Pretty (Aspect c units) where- ppr aa-  = case aa of-	Time timed dat	-> padL 30 (ppr timed) <+> text ":" <+> ppr dat-	Size sized dat	-> padL 30 (ppr sized) <+> text ":" <+> ppr dat-	Used used  dat	-> padL 30 (ppr used)  <+> text ":" <+> ppr dat--	---- | Split an aspect into its named detail and data.-splitAspect :: Aspect c units -> (Detail, c units)-splitAspect aa- = case aa of-	Time timed val		-> (DetailTimed timed, val)-	Size sized val		-> (DetailSized sized, val)-	Used used  val		-> (DetailUsed  used,  val)----- | Make an aspect from a named detail and data.---   If the detail doesn't match the units of the data then `Nothing`.-makeAspect-	:: HasUnits (c units) units -	=> Detail -> c units -> Maybe (Aspect c units)--makeAspect detail (val :: c units)- = case hasUnits val :: Maybe (IsUnits units) of-	Just IsSeconds-	 -> case detail of-		DetailTimed timed	-> Just (Time timed val)-		_			-> Nothing--	Just IsBytes-	 -> case detail of-		DetailUsed  used	-> Just (Used used  val)-		DetailSized sized	-> Just (Size sized val)-		_			-> Nothing--	Nothing -> Nothing------ Collate -----------------------------------------------------------------------------------------instance Collatable Aspect where- collate as-  = let	-- This Just match will always succeed provided the implementation of gather is correct.-	Just as' = sequence -		 $ map (uncurry makeAspect) -		 $ gather [(detail, val) | (detail, (Single val)) <- map splitAspect as]-    in	as'------ | Gather a list of pairs on the first element---	gather [(0, 1), (0, 2), (3, 2), (4, 5), (3, 1)] ---			= [(0, [1, 2]), (3, [2, 1]), (4, [5])]-gather :: Ord a => [(a, b)] -> [(a, [b])]-gather	xx	- 	= Map.toList -	$ foldr (\(k, v) m -> -			Map.insertWith -				(\x xs -> x ++ xs) -				k [v] m) -		Map.empty -		xx----- Stats --------------------------------------------------------------------------------------------- | Compute statistics for many-valued aspects.-makeAspectStats :: Aspect [] units -> Aspect Stats units-makeAspectStats aspect- = case aspect of-	Time timed dat	-> Time timed (makeStats dat)-	Size sized dat	-> Size sized (makeStats dat)-	Used used  dat	-> Used used  (makeStats dat)----- Comparison ---------------------------------------------------------------------------------------- | Compare lists of aspects. The first argument is the baseline.-makeAspectComparisons -	:: Real units -	=> [Aspect Stats units] -> [Aspect Stats units] -> [Aspect StatsComparison units]-	-makeAspectComparisons base new-	= map (makeAspectComparison base) new----- | Lookup the baseline result for some aspect and produce a comparison.-makeAspectComparison-	:: Real units-	=> [Aspect Stats units] -> Aspect Stats units -> Aspect StatsComparison units--makeAspectComparison base aspect- = case lookupAspect base aspect of-	Just aspectBase	-> liftAspect2 makeStatsComparison    aspectBase aspect-	Nothing		-> liftAspect  makeStatsComparisonNew aspect---lookupAspect :: [Aspect Stats units] -> Aspect Stats units -> Maybe (Aspect Stats units)-lookupAspect base aspect- = let	detail	= fst $ splitAspect aspect-   in	find (\a -> (fst $ splitAspect a) == detail) base------ Application --------------------------------------------------------------------------------------- | Apply a function to the data in an aspect-appAspect -	:: Real units -	=> (c units -> b) -> Aspect c units -> b--appAspect f aa = f (snd $ splitAspect aa)-	---- | Apply a function to the data in a wrapped aspect.-appAspectWithUnits -	:: (forall units. Real units => c units -> b) -	-> WithUnits (Aspect c) -> b--appAspectWithUnits f-	= appWithUnits (appAspect f)---- | Transform the data in an aspect, possibly changing the carrier type.-liftAspect -	:: (c1 units -> c2 units)-	-> Aspect c1 units -> Aspect c2 units--liftAspect f aspect- = case aspect of-	Time timed dat	-> Time timed (f dat)-	Size sized dat	-> Size sized (f dat)-	Used used dat	-> Used used  (f dat)----- Lifting ------------------------------------------------------------------------------------------- | Apply a function to the aspect data, producing a new aspect.---   If the aspect details don't match then `error`.-liftAspect2-	:: (c1 units -> c1 units -> c2 units) -	-> Aspect c1 units -> Aspect c1 units -> Aspect c2 units-	-liftAspect2 f a1 a2- = case (a1, a2) of-	(Time timed1 dat1, Time timed2 dat2)-	 | timed1 == timed2	-> Time timed1 (f dat1 dat2)--	(Size sized1 dat1, Size sized2 dat2)-	 | sized1 == sized2	-> Size sized1 (f dat1 dat2)--	(Used used1 dat1,  Used used2 dat2)-	 | used1  == used2	-> Used used1 (f dat1 dat2)--	_ -> error "liftAspect2: aspects don't match"

@@ -1,91 +0,0 @@--module BuildBox.Aspect.Comparison-	( -	-- * Comparisons-	  Comparison	(..)-	, makeComparison-	, appSwing-	-	-- * Comparisons of Statistics-	, StatsComparison(..)-	, makeStatsComparison-	, makeStatsComparisonNew-	, predSwingStatsComparison)-where-import BuildBox.Aspect.Stats-import BuildBox.Pretty-import Text.Printf----- | The comparison of two values.-data Comparison a	-	-- | Comparison of a recent value with a baseline.-	= Comparison-	{ comparisonBaseline	:: a-	, comparisonRecent	:: a-	, comparisonSwing	:: Double }-	-	-- | A new value that doesn't have a baseline.-	| ComparisonNew-	{ comparisonNew		:: a }-	-	deriving (Read, Show)--instance Pretty a => Pretty (Comparison a) where-	ppr (Comparison _ recent ratio)-		| abs ratio < 0.01	-		= text $ printf "%s (----)"-				(render $ ppr recent)--		| otherwise		-		= text $ printf "%s (%+4.0f)"-				(render $ ppr recent)-				(ratio * 100)--	ppr (ComparisonNew new)-		= (padL 10 $ ppr new)-		---- | Make a comparison from two values.-makeComparison :: Real a => a -> a -> Comparison a-makeComparison base recent-	= Comparison base recent swing-	-	where	dBase	= fromRational $ toRational base-		dRecent	= fromRational $ toRational recent-		swing = ((dRecent - dBase) / dBase)----- | Apply a function to the swing of a comparison.-appSwing :: a -> (Double -> a) -> Comparison b -> a-appSwing def f aa- = case aa of-	Comparison _ _ swing	-> f swing-	ComparisonNew{}		-> def-	---- StatsComparison ----------------------------------------------------------------------------------- | Comparisons of statistics-data StatsComparison a-	= StatsComparison (Stats (Comparison a))-	deriving (Read, Show)--instance Pretty a => Pretty (StatsComparison a) where-	ppr (StatsComparison stats) = ppr stats---- | Make a comparison of two `Stats`.-makeStatsComparison :: Real a => Stats a -> Stats a -> StatsComparison a-makeStatsComparison x y = StatsComparison (liftStats2 makeComparison x y)-	---- | Make a `ComparisonNew`.-makeStatsComparisonNew :: Stats a -> StatsComparison a-makeStatsComparisonNew x-	= StatsComparison (liftStats ComparisonNew x)-	---- | Return `True` if any of the swings in the `StatsComparison` match the given function.-predSwingStatsComparison :: (Double -> Bool) -> StatsComparison a -> Bool-predSwingStatsComparison f (StatsComparison ss)-	= (predStats . (appSwing False)) f ss-	

@@ -1,63 +0,0 @@---- | The detail is the name of an `Aspect` seprate from its data.-module BuildBox.Aspect.Detail-	( Detail (..)-	, Timed	 (..)-	, Used	 (..)-	, Sized	 (..))-where-import BuildBox.Pretty--data Detail-	= DetailTimed Timed-	| DetailUsed   Used-	| DetailSized  Sized-	deriving (Eq, Ord, Show, Read)-	---- | Something that takes time to evaluate.-data Timed-	= TotalWall-	| TotalCpu-	| TotalSys-	| KernelWall-	| KernelCpu -	| KernelSys-	deriving (Eq, Ord, Show, Read, Enum)-	-instance Pretty Timed where- ppr timed-  = case timed of-	TotalWall	-> text "runtime        (wall clock)"-	TotalCpu	-> text "runtime        (cpu usage)"-	TotalSys	-> text "runtime        (sys usage)"--	KernelWall	-> text "kernel runtime (wall clock)"-	KernelCpu	-> text "kernel runtime (cpu usage)"-	KernelSys	-> text "kernel runtime (sys usage)"-		---- | Some resource used during execution.-data Used-	= HeapMax-	| HeapAlloc-	deriving (Eq, Ord, Show, Read, Enum)-	-instance Pretty Used where- ppr used-  = case used of-	HeapMax		-> text "maximum heap usage"-	HeapAlloc	-> text "heap allocation"-	-	--- | Some static size of the benchmark that isn't affected during the run.-data Sized-	= ExeSize-	deriving (Eq, Ord, Show, Read, Enum)-	-instance Pretty Sized where- ppr sized-  = case sized of-	ExeSize		-> text "executable size"-	-	

@@ -1,26 +0,0 @@--module BuildBox.Aspect.Single-	( Single (..))-where -import BuildBox.Pretty---- | A single valued piece of data.-data Single a -	= Single a-	deriving (Read, Show)--instance Num a => Num (Single a) where-	(+) (Single f1) (Single f2)	= Single (f1 + f2)-	(-) (Single f1) (Single f2)	= Single (f1 - f2)-	(*) (Single f1) (Single f2)	= Single (f1 * f2)-	abs (Single f1) 		= Single (abs f1)-	signum (Single f1)		= Single (signum f1)-	fromInteger i			= Single (fromInteger i)--instance Eq a => Eq (Single a) where-	(==) (Single f1) (Single f2)	= f1 == f2--instance Pretty a => Pretty (Single a) where-	ppr (Single x)	= ppr x--

@@ -1,54 +0,0 @@--module BuildBox.Aspect.Stats-	( Stats	(..)-	, makeStats-	, predStats-	, liftStats-	, liftStats2)-where-import BuildBox.Pretty-import BuildBox.Data.Dividable----- | Statistics extracted from many-valued data.-data Stats a	-	= Stats-	{ statsMin	:: a-	, statsAvg	:: a-	, statsMax	:: a }-	deriving (Read, Show)--instance Pretty a => Pretty (Stats a) where-	ppr (Stats mi av mx)-		=   (ppr mi) <+> text "/" -		<+> (ppr av) <+> text "/"-		<+> (ppr mx)----- | Make statistics from a list of values.-makeStats :: (Real a, Dividable a) => [a] -> Stats a-makeStats xs-	= Stats (minimum xs)-		(sum xs `divide` (fromIntegral $ length xs)) -		(maximum xs)----- | Return `True` if the predicate matches any of the min, avg, max values.-predStats :: (a -> Bool) -> Stats a -> Bool-predStats f (Stats mi av mx) -	= or [f mi, f av, f mx]----- | Lift a function to each component of a `Stats`-liftStats :: (a -> b) -> Stats a -> Stats b-liftStats f (Stats mi av mx)-	= Stats (f mi) (f av) (f mx)----- | Lift a binary function to each component of a `Stats`-liftStats2 :: (a -> b -> c) -> Stats a -> Stats b -> Stats c-liftStats2 f (Stats min1 avg1 max1) (Stats min2 avg2 max2)-	= Stats (f min1 min2) (f avg1 avg2) (f max1 max2)---	

@@ -1,237 +0,0 @@-{-# LANGUAGE StandaloneDeriving, GADTs, MultiParamTypeClasses, FunctionalDependencies, -	     FlexibleInstances,  RankNTypes, UndecidableInstances #-}---- | Physical units of measure.-module BuildBox.Aspect.Units-	( -	  -- * The unit types-	  Seconds	(..)-	, Bytes		(..)--	  -- * IsUnits-	, IsUnits 	(..)--	  -- * HasUnits-	, HasUnits 	(..)-	-	  -- * WithUnits wrappers-	, WithUnits	(..)-	, secs-	, bytes-	, appWithUnits-	, liftWithUnits-	, liftsWithUnits-	, liftsWithUnits2--	  -- * Unit-preserving collation-	, Collatable	(..)-	, collateWithUnits)-	-where-import BuildBox.Aspect.Single-import BuildBox.Aspect.Stats-import BuildBox.Data.Dividable-import BuildBox.Pretty-import Data.Maybe----- Unit types ---------------------------------------------------------------------------------------- | Seconds of time.-data Seconds	= Seconds Double-		deriving (Read, Show, Ord, Eq)--instance Real Seconds where-	toRational (Seconds s1) 	= toRational s1--instance Dividable Seconds where-	divide (Seconds s1) (Seconds s2) = Seconds (s1 / s2)	--instance Num Seconds where-	(+) (Seconds f1) (Seconds f2)	= Seconds (f1 + f2)-	(-) (Seconds f1) (Seconds f2)	= Seconds (f1 - f2)-	(*) (Seconds f1) (Seconds f2)	= Seconds (f1 * f2)-	abs (Seconds f1) 		= Seconds (abs f1)-	signum (Seconds f1)		= Seconds (signum f1)-	fromInteger i			= Seconds (fromInteger i)-	-instance Pretty Seconds where-	ppr (Seconds f)			-		= fromMaybe (text (show f))-		$ pprEngDouble "s" f----- | Bytes of data.-data Bytes	= Bytes	  Integer-		deriving (Read, Show, Ord, Eq)--instance Real Bytes where-	toRational (Bytes b1)		= toRational b1--instance Dividable Bytes where-	divide (Bytes s1) (Bytes s2)	= Bytes (s1 `div` s2)--instance Num Bytes where-	(+) (Bytes f1) (Bytes f2)	= Bytes (f1 + f2)-	(-) (Bytes f1) (Bytes f2)	= Bytes (f1 - f2)-	(*) (Bytes f1) (Bytes f2)	= Bytes (f1 * f2)-	abs (Bytes f1) 			= Bytes (abs f1)-	signum (Bytes f1)		= Bytes (signum f1)-	fromInteger i			= Bytes (fromInteger i)--instance Pretty Bytes where-	ppr (Bytes b)			-		= fromMaybe (text (show b))-		$ pprEngInteger "B" b-	---- Type classes -------------------------------------------------------------------------------------- | Represents the units used for some thing.-data IsUnits a where-	IsSeconds 	:: IsUnits Seconds-	IsBytes		:: IsUnits Bytes	--class HasUnits a a => Units a where-	isUnits :: a -> Maybe (IsUnits a)--instance Units Seconds where-	isUnits s		= hasUnits s--instance Units Bytes where-	isUnits s		= hasUnits s----- | Determine the units used by the elements of some collection, ---   by inspecting the elements directly.---   Returns `Nothing` when applied to empty collections, as they have no units.-class HasUnits a b | a -> b where-	hasUnits :: a -> Maybe (IsUnits b)--instance HasUnits Seconds Seconds where-	hasUnits _		= Just IsSeconds--instance HasUnits Bytes Bytes where-	hasUnits _		= Just IsBytes--instance HasUnits a a => HasUnits (Single a) a where-	hasUnits (Single x)	= hasUnits x--instance HasUnits a a => HasUnits (Stats a) a where-	hasUnits (Stats x _ _)	= hasUnits x--instance HasUnits a a => HasUnits [a] a where-	hasUnits []		= Nothing-	hasUnits (x : _)	= hasUnits x----- WithUnits ----------------------------------------------------------------------------------------- | A wrapper type used to store data of varying physical units in a homogenous collection structure.-data WithUnits t where-	WithSeconds	:: t Seconds	-> WithUnits t-	WithBytes	:: t Bytes	-> WithUnits t-	-deriving instance (Show (t Bytes), Show (t Seconds)) => Show (WithUnits t)-deriving instance (Read (t Bytes), Read (t Seconds)) => Read (WithUnits t)--instance  (Pretty (t Bytes), Pretty (t Seconds))-	=> Pretty (WithUnits t) where- ppr withUnits-  = case withUnits of-	WithSeconds s	-> ppr s-	WithBytes   b	-> ppr b---- | Helpful wrapper for constructing seconds-valued aspect data. Examples:--- ---   @Time TotalWall \`secs\` 10  ::  WithUnits (Aspect Single)@--- -secs 	:: (Single Seconds -> c Single Seconds) -	-> Double -> WithUnits (c Single)-secs mk f  = WithSeconds (mk (Single (Seconds f)))----- | Similar to `secs`.-bytes 	:: (Single Bytes -> c Single Bytes) -	-> Integer -> WithUnits (c Single)-bytes mk b = WithBytes   (mk (Single (Bytes b)))----- | Apply a function to unit-wrapped data-appWithUnits-	:: (forall units. Real units => t1 units -> b)-	-> WithUnits t1 -> b-	-appWithUnits f withUnits- = case withUnits of-	WithSeconds dat	-> f dat-	WithBytes   dat	-> f dat----- | Apply a function to unit-wrapped data.-liftWithUnits -	:: (forall units. Real units => t1 units -> t2 units)-	-> WithUnits t1 -> WithUnits t2--liftWithUnits f withUnits- = case withUnits of-	WithSeconds dat	-> WithSeconds (f dat)-	WithBytes   dat -> WithBytes   (f dat)----- | Transform values of each unit type as a group.-liftsWithUnits -	:: (forall units. Real units => [t1 units] -> [t2 units]) -	-> [WithUnits t1] -> [WithUnits t2]--liftsWithUnits f us-  = let	asSeconds	= [a | WithSeconds a	<- us]-	asBytes		= [a | WithBytes   a	<- us]--    in	   (map WithSeconds $ f asSeconds)-	++ (map WithBytes   $ f asBytes)-	---- | Transform values of each unit type as a group-liftsWithUnits2-	:: (forall units. Real units => [t1 units] -> [t2 units] -> [t3 units])-	-> [WithUnits t1] -> [WithUnits t2] -> [WithUnits t3]-	-liftsWithUnits2 f as bs- = let	asSeconds	= [a | WithSeconds a	<- as]-	bsSeconds	= [b | WithSeconds b	<- bs]--	asBytes		= [a | WithBytes   a	<- as]-	bsBytes		= [b | WithBytes   b	<- bs]-	-   in	(map WithSeconds $ f asSeconds bsSeconds)-    ++	(map WithBytes   $ f asBytes   bsBytes)------ Unit-safe collation ------------------------------------------------------------------------------- | Collate some data, while preserving units.-class Collatable t where-	collate :: forall a. HasUnits a a -		=> [t Single a] -> [t [] a]----- | Collate some data.------  @--- collateWithUnits  [ Time KernelCpu \`secs\`  5---                   , Time KernelCpu \`secs\`  10---                   , Time TotalWall \`secs\`  55---                   , Size ExeSize   \`bytes\` 100884---                   , Time TotalWall \`secs\`  52 ]--- =>---                   [ WithSeconds (Time KernelCpu [Seconds 5.0,  Seconds 10.0])---                   , WithSeconds (Time TotalWall [Seconds 55.0, Seconds 52.0])---                   , WithBytes   (Size ExeSize [Bytes 1024])]---  @--- -collateWithUnits :: Collatable c => [WithUnits (c Single)] -> [WithUnits (c [])]-collateWithUnits as-  = let	asSeconds	= [a | WithSeconds a	<- as]-	asBytes		= [a | WithBytes   a	<- as]--    in	   (map WithSeconds $ collate asSeconds)-	++ (map WithBytes   $ collate asBytes)-

@@ -1,94 +0,0 @@--module BuildBox.Benchmark-	( module BuildBox.Benchmark.BenchResult-	, Benchmark(..)-	, runTimedCommand-	, runBenchmarkOnce-	, outRunBenchmarkOnce-	, outRunBenchmarkWith)-where-import BuildBox.Build	-import BuildBox.Aspect-import BuildBox.Benchmark.Benchmark-import BuildBox.Benchmark.BenchResult-import Data.Time---- Running Commands ---------------------------------------------------------------------------------- | Run a command, returning its elapsed time.-runTimedCommand -	:: Build a-	-> Build (NominalDiffTime, a) -		-runTimedCommand cmd- = do	start	<- io $ getCurrentTime-	result	<- cmd-	finish	<- io $ getCurrentTime-	return (diffUTCTime finish start, result)----- | Run a benchmark once.-runBenchmarkOnce-	:: Integer		-- ^ Iteration number to tag results with.-	-> Benchmark 		-- ^ Benchmark to run.-	-> Build (BenchRunResult Single)-	-runBenchmarkOnce iteration bench- = do	-- Run the setup command-	benchmarkSetup bench--	(diffTime, asRun)	-		<- runTimedCommand -		$  benchmarkCommand bench-	-	asCheck	<- benchmarkCheck bench-	-	return	$ BenchRunResult-		{ benchRunResultIndex		= iteration--		-- Combine the aspects reported by the benchmark directly,-		-- also include our total runtime.-		, benchRunResultAspects		-			= Time TotalWall `secs` (fromRational $ toRational diffTime)-			: asRun ++ asCheck-			-		, benchRunResultQuirks		= [] }-			-			--- | Run a benchmark once, logging activity and timings to the console.-outRunBenchmarkOnce-	:: Integer 		-- ^ Iteration number to tag results with-	-> Benchmark		-- ^ Benchmark to run.-	-> Build (BenchRunResult Single)-	-outRunBenchmarkOnce iteration bench- = do	out $ "Running " ++ benchmarkName bench ++ "..."-	result	<- runBenchmarkOnce iteration bench-	outLn "ok"-	outLn result-	outBlank	-	return result--	--- | Run a benchmark serveral times, logging activity to the console.---   Also lookup prior results and print comparisons during the run.-outRunBenchmarkWith-	:: Int				-- ^ Number of times to run each benchmark to get averages.-	-> [BenchResult Stats]		-- ^ List of prior results.-	-> Benchmark			-- ^ The benchmark to run.-	-> Build (BenchResult Single)--outRunBenchmarkWith iterations priors bench- = do	out $ "Running " ++ benchmarkName bench ++ " " ++ show iterations ++ " times..."-	runResults	<- mapM ((flip runBenchmarkOnce) bench) $ take iterations [1..]-	outLn "ok"--	let result	= BenchResult-			{ benchResultName	= benchmarkName bench-			, benchResultRuns	= runResults }--	outLn 	$ compareBenchResultWith priors -		$ statBenchResult result-	-	outBlank-	return result-	

@@ -1,369 +0,0 @@-{-# LANGUAGE PatternGuards, StandaloneDeriving, FlexibleContexts, UndecidableInstances, RankNTypes #-}-module BuildBox.Benchmark.BenchResult-	( -	-- * Benchmark results	-	  BenchResult (..)-	, BenchRunResult (..)--	-- * Concatenation-	, concatBenchResult-	-	-- * Collation-	, collateBenchResult--	-- * Statistics-	, statCollatedBenchResult-	, statBenchResult--	-- * Comparison-	, compareBenchResults-	, compareBenchResultWith-	, compareManyBenchResults-	, predBenchResult-	, swungBenchResult--	-- * Merging-	, mergeBenchResults--	-- * Advancement-	, splitBenchResults-	, advanceBenchResults-	-	-- * Application functions-	, appBenchRunResult-	, appRunResultAspects--	-- * Lifting functions-	, liftBenchRunResult-	, liftBenchRunResult2-	, liftToAspectsOfBenchResult-	, liftToAspectsOfBenchResult2-	, liftRunResultAspects-	, liftRunResultAspects2)-where-import BuildBox.Aspect-import BuildBox.Quirk-import BuildBox.Pretty-import Data.List-import qualified Data.Set	as Set-import qualified Data.Map	as Map---- BenchResult --------------------------------------------------------------------------------------- | We include the name of the original benchmark to it's easy to lookup the results.---   If the `BenchResult` is carrying data derived directly by running a benchmark, ---   there will be an element of the `benchResultRuns` for each iteration. On the other hand,---   If the `BenchResult` is carrying statistics or comparison data there should---   be a single element with an index of 0. This is suggested usage, and  adhered to by---   the functions in this module, but not required.-data BenchResult c-	= BenchResult-	{ benchResultName	:: String-	, benchResultRuns	:: [BenchRunResult c] }--deriving instance -	(  Show (c Seconds), Show (c Bytes)) -	=> Show (BenchResult c)--deriving instance-	(  HasUnits (c Bytes) Bytes-	,  Read (c Bytes)-	,  HasUnits (c Seconds) Seconds-	,  Read (c Seconds))-	=> Read (BenchResult c)---instance  ( Pretty (c Seconds), Pretty (c Bytes))-	 => Pretty (BenchResult c) where- ppr result-	= text (benchResultName result)-	$+$ nest 4 (vcat $ map ppr $ benchResultRuns result)----- BenchRunResult ------------------------------------------------------------------------------------ | Holds the result of running a benchmark once.-data BenchRunResult c-	= BenchRunResult-	{ -- | What iteration this run was.-	  --   Use 1 for the first ''real'' iteration derived by running a program.-	  --   Use 0 for ''fake'' iterations computed by statistics or comparisons.-	  benchRunResultIndex	:: Integer--	  -- | Information about the run that doesn't carry units, -	  --   eg whether it timed out or segfaulted.-	, benchRunResultQuirks	:: [Quirk] --	  -- | Aspects of the benchmark run that carry units and can have statistics-	  --   extracted from them.-	, benchRunResultAspects	:: [WithUnits (Aspect c)] }-	---deriving instance -	(  Show (c Seconds), Show (c Bytes)) -	=> Show (BenchRunResult c)--deriving instance-	(  HasUnits (c Bytes) Bytes-	,  Read (c Bytes)-	,  HasUnits (c Seconds) Seconds-	,  Read (c Seconds))-	=> Read (BenchRunResult c)---instance  ( Pretty (c Seconds), Pretty (c Bytes)) -	 => Pretty (BenchRunResult c) where- ppr result-	| benchRunResultIndex result == 0-	=  (nest 2 $ vcat $ map ppr $ benchRunResultAspects result)--	| otherwise-	= ppr (benchRunResultIndex result) -	$$ (nest 2 $ vcat $ map ppr $ benchRunResultAspects result)----- Concat -------------------------------------------------------------------------------------------- | Concatenate the results of all runs.---   The the resulting `BenchResult` has a single `BenchRunResult` with an index of 0, containing all aspects.-concatBenchResult :: BenchResult c1 -> BenchResult c1-concatBenchResult -	= liftBenchRunResult -	$ \bsResults -> [BenchRunResult 0 -				(concatMap benchRunResultQuirks  bsResults) -				(concatMap benchRunResultAspects bsResults) ]----- | Collate the aspects of each run. See `collateWithUnits` for an explanation and example.-collateBenchResult :: BenchResult Single -> BenchResult []-collateBenchResult-	= liftToAspectsOfBenchResult collateWithUnits----- | Compute statistics from collated aspects of a run.-statCollatedBenchResult :: BenchResult [] -> BenchResult Stats-statCollatedBenchResult-	= liftToAspectsOfBenchResult (map (liftWithUnits makeAspectStats))----- | Collate the aspects, then compute statistics of a run.-statBenchResult :: BenchResult Single -> BenchResult Stats-statBenchResult -	= statCollatedBenchResult . collateBenchResult . concatBenchResult----- | Compute comparisons of benchmark results.---	Both results must have the same `benchResultName` else `error`.-compareBenchResults-	:: BenchResult Stats -> BenchResult Stats -> BenchResult StatsComparison--compareBenchResults -	= liftBenchRunResult2 (zipWith (liftRunResultAspects2 (liftsWithUnits2 makeAspectComparisons)))----- | Compute comparisons of benchmark result, looking up the baseline results from a given list.---	If there are no matching baseline results then this creates a `ComparisonNew` in the output.-compareBenchResultWith -	:: [BenchResult Stats] -> BenchResult Stats -> BenchResult StatsComparison--compareBenchResultWith base result-	| Just baseResult	<- find (\baseResult -> benchResultName baseResult == benchResultName result) base-	= compareBenchResults baseResult result-	-	| otherwise-	= liftToAspectsOfBenchResult (liftsWithUnits (map (liftAspect makeStatsComparisonNew))) result----- | Compare some baseline results against new results.---	If there are no matching baseline results then this creates a `ComparisonNew` in the output.-compareManyBenchResults -	:: [BenchResult Stats] -> [BenchResult Stats] -> [BenchResult StatsComparison]-	-compareManyBenchResults base new-	= map (compareBenchResultWith base) new----- | Return true if any of the aspect data in a result matches a given predicate.-predBenchResult-	:: (forall units. Real units => c units -> Bool)-	-> BenchResult c -> Bool--predBenchResult f-	= appBenchRunResult $ or . map (appRunResultAspects $ or . map (appAspectWithUnits f))----- | Return true if any of the aspects have swung by more than a given fraction since last time.---   For example, use @0.1@ for 10 percent.-swungBenchResult :: Double -> BenchResult StatsComparison -> Bool-swungBenchResult limit-	= predBenchResult (predSwingStatsComparison (\x -> abs x > limit)) ----- Merging ------------------------------------------------------------------------------------------- | Merge lists of `BenchResult`s, preferring results from earlier lists.---   In the output list there is one result for every named benchmark in the input.-mergeBenchResults :: [[BenchResult c]] -> [BenchResult c]-mergeBenchResults resultss- = let	-	-- All the available benchResults from all files.-	results	= concat resultss--	-- Get a the names of all the available benchmarks.-	names	= sort $ nub-		$ map benchResultName results--	-- Merge all the results-	Just newBenchResults-		= sequence -		$ [ find (\br -> benchResultName br == name) results-				| name <- names]-				-   in	newBenchResults----- Advancement -------------------------------------------------------------------------------------- | Given a fraction (like 0.1 for 10 percent), split some results into three---	groups: ''winners'', ''losers'' and ''others''.---   The losers are benchmarks had any aspect increase by more than the fraction.---   Winners    are non-losers, where any aspect decreased by the fraction.---   Others     are not winners or losers.----splitBenchResults -	:: Double -	-> [BenchResult StatsComparison]	-	-> ([BenchResult StatsComparison], [BenchResult StatsComparison], [BenchResult StatsComparison])--splitBenchResults swing comparisons- = let-	resultLosers-	 = filter	(predBenchResult (predSwingStatsComparison (\x -> x > swing)))-			comparisons--	resultWinners_-	 = filter 	(predBenchResult (predSwingStatsComparison (\x -> x < (- swing)))) -			comparisons--	-- losers can't be winners-	sameName r1 r2	= benchResultName r1 == benchResultName r2-	resultWinners 	= deleteFirstsBy sameName resultWinners_  resultLosers--	-- others aren't either winners or losers-	resultOthers	= deleteFirstsBy sameName-	 			(deleteFirstsBy sameName comparisons resultLosers)-				resultWinners-	-  in	(resultWinners, resultLosers, resultOthers)----- | Create a new baseline from original baseline, and recent results.---   If any of the recent results are winners then use them, otherwise use results---   from the old baseline.-advanceBenchResults -	:: Double-	-> [BenchResult StatsComparison]	-- ^ Comparisons to guide the advancement.-	-> [BenchResult Single]			-- ^ Baseline results.-	-> [BenchResult Single] 		-- ^ Recent results.-	-> [BenchResult Single]			-- ^ New baseline.--advanceBenchResults swing comparisons baselines recents- = let	allNames	= map benchResultName (baselines ++ recents)--	rsBaseline	= Map.fromList [ (benchResultName r, r) | r <- baselines]-	rsRecent	= Map.fromList [ (benchResultName r, r) | r <- recents]-	rsAll		= Map.union rsBaseline rsRecent--	-- Do the comparison, note that we only get a comparison back-	-- if the benchmark was in both the original lists.-	(winners, losers, others)-			= splitBenchResults swing comparisons--	nsWinners	= Set.fromList $ map benchResultName winners-	nsLosers	= Set.fromList $ map benchResultName losers-	nsOthers	= Set.fromList $ map benchResultName others--	getResult name-	 | Set.member name nsWinners-	 = let Just r	= Map.lookup name rsRecent-	   in  r-	-	 | Set.member name nsLosers || Set.member name nsOthers-	 = let Just r	= Map.lookup name rsBaseline-	   in  r-	-	 -- benchmark wasn't in both input lists, so we have no comparison.-	 -- just find the data and pass it through-	 | otherwise-  	 = let Just r	= Map.lookup name rsAll-           in  r--   in	map getResult allNames------ Lifting ------------------------------------------------------------------------------------------- | Apply a function to the aspects of a `BenchRunResult`-appBenchRunResult :: ([BenchRunResult c1] -> b) -> BenchResult c1 -> b-appBenchRunResult f (BenchResult _ runs) = f runs----- | Lift a function to the `BenchRunResult` in a `BenchResult`-liftBenchRunResult -	:: ([BenchRunResult c1] -> [BenchRunResult  c2])-	-> (BenchResult     c1  -> BenchResult      c2)--liftBenchRunResult f (BenchResult name runs)	-	= BenchResult name (f runs)----- | Lift a binary function to the `BenchResults` in a `BenchResult`-liftBenchRunResult2-	:: ([BenchRunResult c1] -> [BenchRunResult c2] -> [BenchRunResult c3])-	->  BenchResult c1      ->  BenchResult c2     ->  BenchResult c3--liftBenchRunResult2 f (BenchResult name1 runs1) (BenchResult name2 runs2)-	| name1 == name2	= BenchResult name1 (f runs1 runs2)-	| otherwise		= error "liftBenchRunResult2: names don't match"-	---- | Lift a function to the aspects of each `BenchRunResult`.-liftToAspectsOfBenchResult -	:: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)])-	-> BenchResult c1           -> BenchResult c2--liftToAspectsOfBenchResult -	= liftBenchRunResult . map . liftRunResultAspects----- | Lift a binary function to the aspects of each `BenchRunResult`.-liftToAspectsOfBenchResult2-	:: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)] -> [WithUnits (Aspect c3)])-	-> BenchResult c1           -> BenchResult c2          -> BenchResult c3--liftToAspectsOfBenchResult2-	= liftBenchRunResult2 . zipWith . liftRunResultAspects2----- Lifting ------------------------------------------------------------------------------------------- | Apply a function to the aspects of a `BenchRunResult`-appRunResultAspects :: ([WithUnits (Aspect c1)] -> b) -> BenchRunResult c1 -> b-appRunResultAspects f (BenchRunResult _ _ aspects) -	= f aspects----- | Lift a function to the aspects of a `BenchRunResult`-liftRunResultAspects-	:: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)])-	-> BenchRunResult c1        -> BenchRunResult c2-	-liftRunResultAspects f (BenchRunResult ix quirks as)-	= BenchRunResult ix quirks (f as) ----- | Lift a binary function to the aspects of two `BenchRunResult`s.---   The resulting `BenchRunResult` gets all the quirks from both.-liftRunResultAspects2-	:: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)] -> [WithUnits (Aspect c3)])-	-> BenchRunResult c1        -> BenchRunResult c2       -> BenchRunResult c3-	-liftRunResultAspects2 f (BenchRunResult ix1 quirks1 as) (BenchRunResult ix2 quirks2 bs)-	| ix1 == ix2		= BenchRunResult ix1 (quirks1 ++ quirks2) (f as bs) -	| otherwise		= error "liftRunResultAspects2: indices don't match"-

@@ -1,25 +0,0 @@--module BuildBox.Benchmark.Benchmark-	(Benchmark(..))-where-import BuildBox.Build-import BuildBox.Aspect---- | Describes a benchmark that we can run.-data Benchmark-	= Benchmark-	{ -- | A unique name for the benchmark.-	  benchmarkName		:: String--	  -- | Setup command to run before the main benchmark.-	, benchmarkSetup	:: Build ()--	  -- | The benchmark command to run. -	  --   The time taken to run this part is automatically measured and added to the overall results.-	, benchmarkCommand	:: Build [WithUnits (Aspect Single)]--	  -- | Check \/ cleanup command to run after the main benchmark.-	, benchmarkCheck	:: Build [WithUnits (Aspect Single)]-	}--

@@ -0,0 +1,66 @@++module BuildBox.Build.Benchmark+        ( Benchmark     (..)+        , BenchResult   (..)+        , runBenchmark+        , iterateBenchmark+        , timeBuild)+where+import BuildBox.Build.Base+import BuildBox.Data.Physical+import Data.Time++-- | Benchmark definition.+data Benchmark result+        = forall a. Benchmark+        { -- | A unique name for the benchmark+          benchmarkName         :: String++          -- | Setup command to run before the main benchmark.+          --   This does not contribute to the reported time of the overall result.+        , benchmarkSetup        :: Build ()++          -- | The main command to benchmark.+        , benchmarkCommand      :: Build a++          -- | Check and post-process the result of the main command.+          --   This does not contribute to the reported time of the overall result.+        , benchmarkCheck        :: a -> Build result }+++-- | Benchmark result.+data BenchResult result+        = BenchResult+        { benchResultName       :: String+        , benchResultIteration  :: Int+        , benchResultTime       :: Seconds+        , benchResultValue      :: result }+++-- | Run a benchmark a single time.+runBenchmark :: Benchmark result -> Int -> Build (BenchResult result)+runBenchmark (Benchmark name setup cmd check) i+ = do   setup +        (secs, x)       <- timeBuild cmd+        r               <- check x+        return  $ BenchResult name i secs r+++-- | Run a benchmark the given number of times.+iterateBenchmark :: Int -> Benchmark result -> Build [BenchResult result]+iterateBenchmark 0 _ = return []+iterateBenchmark count bench+ = do   result  <- runBenchmark bench count+        rest    <- iterateBenchmark (count - 1) bench+        return  $ result : rest+++-- | Run a command, returning its elapsed time.+timeBuild :: Build a -> Build (Seconds, a) +timeBuild cmd+ = do   start     <- io $ getCurrentTime+        result    <- cmd+        finish    <- io $ getCurrentTime+        let time  = fromRational $ toRational $ diffUTCTime finish start+        return (Seconds time, result)+

@@ -70,10 +70,10 @@ 	-- Make sure a dir with this name doesn't already exist. 	checkFalse $ HasDir name -	ssystem $ "mkdir -p " ++ name+	ssystem $ "mkdir -p " ++ name                                          -- TODO: rewrite without shell options 	x	<- inDir name build -	ssystem $ "rm -Rf " ++ name+	ssystem $ "rm -Rf " ++ name                                            -- TODO: rewrite without shell opts 	return x  @@ -82,7 +82,7 @@ --   not follow symlinks, it just deletes them. clobberDir :: FilePath -> Build () clobberDir path- = 	ssystem $ "rm -Rf " ++ path+ = 	ssystem $ "rm -Rf " ++ path                                         -- TODO: rewrite without shell opts   -- | Create a new directory if it isn't already there, or return successfully if it is.@@ -91,7 +91,7 @@  = do	already	<- io $ doesDirectoryExist path 	if already 	 then return ()-	 else ssystem $ "mkdir -p " ++ path+	 else ssystem $ "mkdir -p " ++ path                                    -- TODO: rewrite without shell opts   -- | Create a temp file, pass it to some command, then delete the file after the command finishes.@@ -122,7 +122,7 @@         ensureDir buildDir  	-- Build the file name we'll try to use.-	let fileName	 = buildDir ++ "/buildbox-" ++ show buildId ++ "-" ++ show buildSeq+	let fileName	 = buildDir ++ "/buildbox-" ++ show buildId ++ "-" ++ show buildSeq       -- TODO: normalise path  	-- If it already exists then something has gone badly wrong. 	--   Maybe the unique Id for the process wasn't as unique as we thought.

@@ -100,7 +100,8 @@ 	 = 	streamOuts' False [] prev  	streamOuts' False prev []-	 = do	threadDelay 100000+	 = do   threadDelay 1000+                yield 		streamOuts' False [] prev   	-- try to read from the current chan.

@@ -0,0 +1,43 @@+{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}+{-# OPTIONS -fno-warn-orphans #-}++-- | A simple ''cron'' loop. Used for running commands according to a given schedule.+module BuildBox.Control.Cron+	( module BuildBox.Data.Schedule+	, cronLoop )+where+import BuildBox.Build+import BuildBox.Data.Schedule+import BuildBox.Command.Sleep+import Data.Time++-- | Given a schedule of commands, run them when their time is due.+--   Only one command is run at a time. If several commands could be started at a specific+--   moment, then we take the one with the earliest potential start time. If any command throws+--   an error in the `Build` monad then the whole loop does.+--+cronLoop :: Schedule (Build ())-> Build ()+cronLoop schedule+ = do	startTime	<- io $ getCurrentTime++	case earliestEventToStartAt startTime $ eventsOfSchedule schedule of+	 Nothing +	  -> do	sleep 1+		cronLoop schedule+		+	 Just event +	  -> do	let Just build	= lookupCommandOfSchedule (eventName event) schedule+		build+		endTime		<- io $ getCurrentTime++		let event'	= event+				{ eventLastStarted	= Just startTime+				, eventLastEnded	= Just endTime }++		let schedule'	= adjustEventOfSchedule event' schedule+	+		cronLoop schedule'+				+		+		+	

@@ -65,7 +65,7 @@ 	if state == GangFinished || state == GangKilled 	 then return () 	 else do-		threadDelay 10000+		threadDelay 1000 		joinGang gang  @@ -108,7 +108,7 @@ 	if state == waitState 	 then return () 	 else do-		threadDelay 10000+		threadDelay 1000 		waitForGangState gang waitState  @@ -161,7 +161,7 @@ 		gangLoop_withWorker gang action actionsRest  	 GangPaused-	  -> do	threadDelay 10000+	  -> do	threadDelay 1000 	 	gangLoop gang actions 			 	 GangFlushing@@ -169,7 +169,7 @@ 		if actionsRunning == 0 		 then	writeIORef (gangState gang) GangFinished 		 else do	-			threadDelay 10000+			threadDelay 1000 			gangLoop gang []  	 GangFinished	-> return ()

@@ -1,43 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}-{-# OPTIONS -fno-warn-orphans #-}---- | A simple ''cron'' loop. Used for running commands according to a given schedule.-module BuildBox.Cron-	( module BuildBox.Cron.Schedule-	, cronLoop )-where-import BuildBox.Build-import BuildBox.Cron.Schedule-import BuildBox.Command.Sleep-import Data.Time---- | Given a schedule of commands, run them when their time is due.---   Only one command is run at a time. If several commands could be started at a specific---   moment, then we take the one with the earliest potential start time. If any command throws---   an error in the `Build` monad then the whole loop does.----cronLoop :: Schedule (Build ())-> Build ()-cronLoop schedule- = do	startTime	<- io $ getCurrentTime--	case earliestEventToStartAt startTime $ eventsOfSchedule schedule of-	 Nothing -	  -> do	sleep 1-		cronLoop schedule-		-	 Just event -	  -> do	let Just build	= lookupCommandOfSchedule (eventName event) schedule-		build-		endTime		<- io $ getCurrentTime--		let event'	= event-				{ eventLastStarted	= Just startTime-				, eventLastEnded	= Just endTime }--		let schedule'	= adjustEventOfSchedule event' schedule-	-		cronLoop schedule'-				-		-		-	

@@ -1,210 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}-{-# OPTIONS -fno-warn-orphans #-}---- | A schedule of commands that should be run at a certain time.-module BuildBox.Cron.Schedule-	( -	-- * Time Periods-	  second, minute, hour, day--	-- * When-	, When		(..)-	, WhenModifier	(..)--	-- * Events-	, EventName-	, Event		(..)-	, earliestEventToStartAt-	, eventCouldStartAt--	-- * Schedules-	, Schedule	(..)-	, makeSchedule-	, lookupEventOfSchedule-	, lookupCommandOfSchedule-	, adjustEventOfSchedule-	, eventsOfSchedule)-where-import Data.Time-import Data.List-import Data.Function-import Data.Maybe-import Control.Monad-import Data.Map			(Map)-import qualified Data.Map	as Map--instance Read NominalDiffTime where- readsPrec n str-  = let	[(secs :: Double, rest)] = readsPrec n str-    in	case rest of-		's' : rest'	-> [(fromRational $ toRational secs, rest')]-		_		-> []--second, minute, hour, day :: NominalDiffTime-second	= 1-minute  = 60-hour	= 60 * minute-day	= 24 * hour----- When ---------------------------------------------------------------------------------------------- | When to invoke some event.-data When-	-- | Just keep doing it.-	= Always--	-- | Don't do it, ever.-	| Never--	-- | Do it some time after we last started it.-	| Every NominalDiffTime-	-	-- | Do it some time after it last finished.-	| After NominalDiffTime-	-	-- | Do it each day at this time. The ''days'' are UTC days, not local ones.-	| Daily TimeOfDay-	deriving (Read, Show, Eq)----- | Modifier to when.-data WhenModifier-	-- | If the event hasn't been invoked before then do it immediately-	--   when we start the cron process.-	= Immediate--	-- | Wait until after this time before doing it first.-	| WaitUntil UTCTime-	deriving (Read, Show, Eq)----- Event -------------------------------------------------------------------------------------------type EventName	= String---- | Records when an event should start, and when it last ran.-data Event-	= Event-	{ -- | A unique name for this event.-	  --   Used when writing the schedule to a file.-	  eventName		:: EventName--	  -- | When to run the command.-	, eventWhen		:: When--	  -- | Modifier to the previous.-	, eventWhenModifier	:: Maybe WhenModifier--	  -- | When the event was last started, if any.-	, eventLastStarted	:: Maybe UTCTime-		-	  -- | When the event last finished, if any.-	, eventLastEnded	:: Maybe UTCTime }-	deriving (Read, Show, Eq)-	---- | Given the current time and a list of events, determine which one should be started now.---   If several events are avaliable then take the one with the earliest start time.-earliestEventToStartAt :: UTCTime -> [Event] -> Maybe Event-earliestEventToStartAt curTime events- = let	eventsStartable	= filter (eventCouldStartAt curTime)   events-	eventsSorted	= sortBy (compare `on` eventLastStarted) eventsStartable-   in	listToMaybe eventsSorted----- | Given the current time, decide whether an event could be started.---   If the `WhenModifier` is `Immediate` this always returns true.---   The `SkipFirst` modifier is ignored, as this is handled separately.-eventCouldStartAt :: UTCTime -> Event -> Bool-eventCouldStartAt curTime event-	-- If the event has never started or ended, and is marked as immediate,-	-- then start it right away.-	| Nothing		<- eventLastStarted  event-	, Nothing		<- eventLastEnded    event-	, Just Immediate	<- eventWhenModifier event-	= True--	-- If the current end time is before the start time, then the most-	-- recent iteration is still running, so don't start it again.-	| Just lastStarted	<- eventLastStarted event- 	, Just lastEnded	<- eventLastEnded   event- 	, lastEnded < lastStarted-	= False--	-- Keep waiting if there's a seconday wait modifier.-	| Just (WaitUntil waitTime)	<- eventWhenModifier event-	, curTime < waitTime-	= False--	-- Otherwise we have to look at the real schedule.-	| otherwise-	= case eventWhen event of-		Always		-> True-		Never		-> False--		Every diffTime	-	 	 -> maybe True-			(\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime)-			(eventLastStarted event)--		After diffTime	-	 	 -> maybe True-			(\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime)-			(eventLastEnded event)-	-		Daily timeOfDay-		 -- If it's been less than a day since we last started it, then don't do it yet.-		 | Just lastStarted	<- eventLastStarted event-		 , (curTime `diffUTCTime` lastStarted) < day-		 -> False-		-		 | otherwise-		 -> let	-- If we were going to run it today, this is when it would be.-			startTimeToday-				= curTime-				{ utctDayTime	= timeOfDayToTime timeOfDay }-				-			-- If it's after that time then quit fooling around..-		    in	curTime > startTimeToday----- Schedule ------------------------------------------------------------------------------------------ | Map of event names to their details and build commands.	-data Schedule cmd-	= Schedule (Map EventName (Event, cmd))----- | Get the list of events in a schedule, ignoring the build commands.-eventsOfSchedule :: Schedule cmd -> [Event]-eventsOfSchedule (Schedule sched)-	= map fst $ Map.elems sched----- | A nice way to produce a schedule.-makeSchedule :: [(EventName, When, Maybe WhenModifier, cmd)] -> Schedule cmd-makeSchedule tuples- = let	makeSched (name, whn, mMod, cmd)-	  =	(name, (Event name whn mMod Nothing Nothing, cmd))-   in	Schedule $ Map.fromList $ map makeSched tuples----- | Given an event name, lookup the associated event from a schedule.-lookupEventOfSchedule :: EventName -> Schedule cmd -> Maybe Event-lookupEventOfSchedule name (Schedule sched)-	= liftM fst $ Map.lookup name sched-	-	--- | Given an event name, lookup the associated build command from a schedule.-lookupCommandOfSchedule :: EventName -> Schedule cmd -> Maybe cmd-lookupCommandOfSchedule name (Schedule sched)-	= liftM snd $ Map.lookup name sched----- | Given a new version of an event, update any matching event in the schedule.---   If the event not already there then return the original schedule.-adjustEventOfSchedule :: Event -> Schedule cmd -> Schedule cmd-adjustEventOfSchedule event (Schedule sched)-	= Schedule -	$ Map.adjust -		(\(_, build) -> (event, build))-		(eventName event) -		sched

@@ -0,0 +1,46 @@++module BuildBox.Data.Comparison+	( -- * Comparisons+	  Comparison	(..)+	, makeComparison)+where+import BuildBox.Pretty+import Text.Printf+++-- | The comparison of two values.+data Comparison a	+	-- | Comparison of a recent value with a baseline.+	= Comparison+	{ comparisonBaseline	:: a+	, comparisonRecent	:: a+	, comparisonSwing	:: Double }+	+	-- | A new value that doesn't have a baseline.+	| ComparisonNew+	{ comparisonNew		:: a }+	+	deriving (Read, Show)++instance Pretty a => Pretty (Comparison a) where+	ppr (Comparison _ recent ratio)+		| abs ratio < 0.01	+		= text $ printf "%s (----)"+				(render $ ppr recent)++		| otherwise		+		= text $ printf "%s (%+4.0f)"+				(render $ ppr recent)+				(ratio * 100)++	ppr (ComparisonNew new)+		= (padL 10 $ ppr new)+		++-- | Make a comparison from two values.+makeComparison :: Real a => a -> a -> Comparison a+makeComparison base recent+	= Comparison base recent swing+	where	dBase	= fromRational $ toRational base+		dRecent	= fromRational $ toRational recent+		swing = ((dRecent - dBase) / dBase)

@@ -0,0 +1,63 @@++-- | The detail is the name of an `Aspect` seprate from its data.+module BuildBox.Data.Detail+	( Detail (..)+	, Timed	 (..)+	, Used	 (..)+	, Sized	 (..))+where+import BuildBox.Pretty++data Detail+	= DetailTimed Timed+	| DetailUsed   Used+	| DetailSized  Sized+	deriving (Eq, Ord, Show, Read)+	++-- | Something that takes time to evaluate.+data Timed+	= TotalWall+	| TotalCpu+	| TotalSys+	| KernelWall+	| KernelCpu +	| KernelSys+	deriving (Eq, Ord, Show, Read, Enum)+	+instance Pretty Timed where+ ppr timed+  = case timed of+	TotalWall	-> text "runtime        (wall clock)"+	TotalCpu	-> text "runtime        (cpu usage)"+	TotalSys	-> text "runtime        (sys usage)"++	KernelWall	-> text "kernel runtime (wall clock)"+	KernelCpu	-> text "kernel runtime (cpu usage)"+	KernelSys	-> text "kernel runtime (sys usage)"+		++-- | Some resource used during execution.+data Used+	= HeapMax+	| HeapAlloc+	deriving (Eq, Ord, Show, Read, Enum)+	+instance Pretty Used where+ ppr used+  = case used of+	HeapMax		-> text "maximum heap usage"+	HeapAlloc	-> text "heap allocation"+	+	+-- | Some static size of the benchmark that isn't affected during the run.+data Sized+	= ExeSize+	deriving (Eq, Ord, Show, Read, Enum)+	+instance Pretty Sized where+ ppr sized+  = case sized of+	ExeSize		-> text "executable size"+	+	

@@ -0,0 +1,55 @@++module BuildBox.Data.Physical+        ( Seconds       (..)+        , Bytes         (..))+where+import BuildBox.Data.Dividable+import BuildBox.Pretty+import Data.Maybe++-- | Seconds of time, pretty printed in engineering format.+data Seconds    = Seconds Double+                deriving (Read, Show, Ord, Eq)++instance Real Seconds where+        toRational (Seconds s1)         = toRational s1++instance Dividable Seconds where+        divide (Seconds s1) (Seconds s2) = Seconds (s1 / s2)    ++instance Num Seconds where+        (+) (Seconds f1) (Seconds f2)   = Seconds (f1 + f2)+        (-) (Seconds f1) (Seconds f2)   = Seconds (f1 - f2)+        (*) (Seconds f1) (Seconds f2)   = Seconds (f1 * f2)+        abs (Seconds f1)                = Seconds (abs f1)+        signum (Seconds f1)             = Seconds (signum f1)+        fromInteger i                   = Seconds (fromInteger i)+        +instance Pretty Seconds where+        ppr (Seconds f)                 +                = fromMaybe (text (show f))+                $ pprEngDouble "s" f+++-- | Bytes of data, pretty printed in engineering format.+data Bytes      = Bytes   Integer+                deriving (Read, Show, Ord, Eq)++instance Real Bytes where+        toRational (Bytes b1)           = toRational b1++instance Dividable Bytes where+        divide (Bytes s1) (Bytes s2)    = Bytes (s1 `div` s2)++instance Num Bytes where+        (+) (Bytes f1) (Bytes f2)       = Bytes (f1 + f2)+        (-) (Bytes f1) (Bytes f2)       = Bytes (f1 - f2)+        (*) (Bytes f1) (Bytes f2)       = Bytes (f1 * f2)+        abs (Bytes f1)                  = Bytes (abs f1)+        signum (Bytes f1)               = Bytes (signum f1)+        fromInteger i                   = Bytes (fromInteger i)++instance Pretty Bytes where+        ppr (Bytes b)                   +                = fromMaybe (text (show b))+                $ pprEngInteger "B" b

@@ -0,0 +1,40 @@++module BuildBox.Data.Range+	( Range	(..)+	, makeRange+	, flattenRange)+where+import BuildBox.Pretty+import BuildBox.Data.Dividable++-- | A range extracted from many-valued data.+data Range a	+	= Range+	{ rangeMin	:: a+	, rangeAvg	:: a+	, rangeMax	:: a }+	deriving (Read, Show)++instance Pretty a => Pretty (Range a) where+	ppr (Range mi av mx)+		=   (ppr mi) <+> text "/" +		<+> (ppr av) <+> text "/"+		<+> (ppr mx)++instance Functor Range where+ fmap f (Range mi av mx)+        = Range (f mi) (f av) (f mx)+++-- | Make statistics from a list of values.+makeRange :: (Real a, Dividable a) => [a] -> Range a+makeRange xs+	= Range (minimum xs)+		(sum xs `divide` (fromIntegral $ length xs)) +		(maximum xs)+++-- | Flatten a `Range` into a list of its min, avg and max values.+flattenRange :: Range a -> [a]+flattenRange (Range mi av mx)+        = [mi, av, mx]

@@ -0,0 +1,210 @@+{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}+{-# OPTIONS -fno-warn-orphans #-}++-- | A schedule of commands that should be run at a certain time.+module BuildBox.Data.Schedule+	( +	-- * Time Periods+	  second, minute, hour, day++	-- * When+	, When		(..)+	, WhenModifier	(..)++	-- * Events+	, EventName+	, Event		(..)+	, earliestEventToStartAt+	, eventCouldStartAt++	-- * Schedules+	, Schedule	(..)+	, makeSchedule+	, lookupEventOfSchedule+	, lookupCommandOfSchedule+	, adjustEventOfSchedule+	, eventsOfSchedule)+where+import Data.Time+import Data.List+import Data.Function+import Data.Maybe+import Control.Monad+import Data.Map			(Map)+import qualified Data.Map	as Map++instance Read NominalDiffTime where+ readsPrec n str+  = let	[(secs :: Double, rest)] = readsPrec n str+    in	case rest of+		's' : rest'	-> [(fromRational $ toRational secs, rest')]+		_		-> []++second, minute, hour, day :: NominalDiffTime+second	= 1+minute  = 60+hour	= 60 * minute+day	= 24 * hour+++-- When -------------------------------------------------------------------------------------------+-- | When to invoke some event.+data When+	-- | Just keep doing it.+	= Always++	-- | Don't do it, ever.+	| Never++	-- | Do it some time after we last started it.+	| Every NominalDiffTime+	+	-- | Do it some time after it last finished.+	| After NominalDiffTime+	+	-- | Do it each day at this time. The ''days'' are UTC days, not local ones.+	| Daily TimeOfDay+	deriving (Read, Show, Eq)+++-- | Modifier to when.+data WhenModifier+	-- | If the event hasn't been invoked before then do it immediately+	--   when we start the cron process.+	= Immediate++	-- | Wait until after this time before doing it first.+	| WaitUntil UTCTime+	deriving (Read, Show, Eq)+++-- Event ------------------------------------------------------------------------------------------+type EventName	= String++-- | Records when an event should start, and when it last ran.+data Event+	= Event+	{ -- | A unique name for this event.+	  --   Used when writing the schedule to a file.+	  eventName		:: EventName++	  -- | When to run the command.+	, eventWhen		:: When++	  -- | Modifier to the previous.+	, eventWhenModifier	:: Maybe WhenModifier++	  -- | When the event was last started, if any.+	, eventLastStarted	:: Maybe UTCTime+		+	  -- | When the event last finished, if any.+	, eventLastEnded	:: Maybe UTCTime }+	deriving (Read, Show, Eq)+	++-- | Given the current time and a list of events, determine which one should be started now.+--   If several events are avaliable then take the one with the earliest start time.+earliestEventToStartAt :: UTCTime -> [Event] -> Maybe Event+earliestEventToStartAt curTime events+ = let	eventsStartable	= filter (eventCouldStartAt curTime)   events+	eventsSorted	= sortBy (compare `on` eventLastStarted) eventsStartable+   in	listToMaybe eventsSorted+++-- | Given the current time, decide whether an event could be started.+--   If the `WhenModifier` is `Immediate` this always returns true.+--   The `SkipFirst` modifier is ignored, as this is handled separately.+eventCouldStartAt :: UTCTime -> Event -> Bool+eventCouldStartAt curTime event+	-- If the event has never started or ended, and is marked as immediate,+	-- then start it right away.+	| Nothing		<- eventLastStarted  event+	, Nothing		<- eventLastEnded    event+	, Just Immediate	<- eventWhenModifier event+	= True++	-- If the current end time is before the start time, then the most+	-- recent iteration is still running, so don't start it again.+	| Just lastStarted	<- eventLastStarted event+ 	, Just lastEnded	<- eventLastEnded   event+ 	, lastEnded < lastStarted+	= False++	-- Keep waiting if there's a seconday wait modifier.+	| Just (WaitUntil waitTime)	<- eventWhenModifier event+	, curTime < waitTime+	= False++	-- Otherwise we have to look at the real schedule.+	| otherwise+	= case eventWhen event of+		Always		-> True+		Never		-> False++		Every diffTime	+	 	 -> maybe True+			(\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime)+			(eventLastStarted event)++		After diffTime	+	 	 -> maybe True+			(\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime)+			(eventLastEnded event)+	+		Daily timeOfDay+		 -- If it's been less than a day since we last started it, then don't do it yet.+		 | Just lastStarted	<- eventLastStarted event+		 , (curTime `diffUTCTime` lastStarted) < day+		 -> False+		+		 | otherwise+		 -> let	-- If we were going to run it today, this is when it would be.+			startTimeToday+				= curTime+				{ utctDayTime	= timeOfDayToTime timeOfDay }+				+			-- If it's after that time then quit fooling around..+		    in	curTime > startTimeToday+++-- Schedule ---------------------------------------------------------------------------------------+-- | Map of event names to their details and build commands.	+data Schedule cmd+	= Schedule (Map EventName (Event, cmd))+++-- | Get the list of events in a schedule, ignoring the build commands.+eventsOfSchedule :: Schedule cmd -> [Event]+eventsOfSchedule (Schedule sched)+	= map fst $ Map.elems sched+++-- | A nice way to produce a schedule.+makeSchedule :: [(EventName, When, Maybe WhenModifier, cmd)] -> Schedule cmd+makeSchedule tuples+ = let	makeSched (name, whn, mMod, cmd)+	  =	(name, (Event name whn mMod Nothing Nothing, cmd))+   in	Schedule $ Map.fromList $ map makeSched tuples+++-- | Given an event name, lookup the associated event from a schedule.+lookupEventOfSchedule :: EventName -> Schedule cmd -> Maybe Event+lookupEventOfSchedule name (Schedule sched)+	= liftM fst $ Map.lookup name sched+	+	+-- | Given an event name, lookup the associated build command from a schedule.+lookupCommandOfSchedule :: EventName -> Schedule cmd -> Maybe cmd+lookupCommandOfSchedule name (Schedule sched)+	= liftM snd $ Map.lookup name sched+++-- | Given a new version of an event, update any matching event in the schedule.+--   If the event not already there then return the original schedule.+adjustEventOfSchedule :: Event -> Schedule cmd -> Schedule cmd+adjustEventOfSchedule event (Schedule sched)+	= Schedule +	$ Map.adjust +		(\(_, build) -> (event, build))+		(eventName event) +		sched

@@ -1,112 +0,0 @@-{-# LANGUAGE PatternGuards #-}--module BuildBox.FileFormat.BuildResults-	( BuildResults(..)-	, mergeResults-	, acceptResult-	, advanceResults)-where-import BuildBox.Time-import BuildBox.Benchmark-import BuildBox.Command.Environment-import BuildBox.Pretty-import BuildBox.Aspect-import Data.List-import Data.Function----- | A simple build results file format.-data BuildResults-	= BuildResults-	{ buildResultTime		:: UTCTime-	, buildResultEnvironment	:: Environment-	, buildResultBench		:: [BenchResult Single] }-	deriving (Show, Read)--instance Pretty BuildResults where- ppr results-	= hang (ppr "BuildResults") 2 $ vcat-	[ ppr "time: " <> (ppr $ buildResultTime results)-	, ppr $ buildResultEnvironment results-	, ppr ""-	, vcat 	$ punctuate (ppr "\n") -		$ map ppr -		$ buildResultBench results ]----- | Merge some BuildResults.---   If we have data for a named benchmark in multiple `BuildResults`,---   then we take the first one in the list.---   The resultTime and environment is taken from the last `BuildResults`,---   in the list.-mergeResults :: [BuildResults] -> BuildResults-mergeResults results- = let	-	-- All the available benchResults from all files.-	benchResults	= concatMap buildResultBench results--	-- Get a the names of all the available benchmarks.-	benchNames -		= sort $ nub-		$ map benchResultName-		$ concatMap buildResultBench results --	-- Merge all the results-	Just newBenchResults-		= sequence -		$ [ find (\br -> benchResultName br == name) benchResults	-				| name <- benchNames]-			-	-- Use the timestamp and environment from the last one.-	(lastResults : _) = reverse results-		-   in BuildResults-		{ buildResultTime	 = buildResultTime lastResults-		, buildResultEnvironment = buildResultEnvironment lastResults-		, buildResultBench	 = newBenchResults }----- | Take test results from the first `BuildResults`, except for the named---   one which we take from the second. If the named test is not in the second---   then take it from the first. If it's not anywhere then Nothing.-acceptResult :: String -> BuildResults -> BuildResults -> Maybe BuildResults-acceptResult nameAccept baseline recent-- | Just resultAccept	-	<- find (\br -> benchResultName br == nameAccept)-	$  buildResultBench recent-	- = let	resultsBaseline	-	  	= filter (\br -> benchResultName br /= nameAccept)-		$ buildResultBench baseline-		-	-- use the timestamp from the last one.	-   in	Just $ BuildResults- 	 { buildResultTime		= buildResultTime recent-	 , buildResultEnvironment	= buildResultEnvironment recent-	 , buildResultBench		= sortBy (compare `on` benchResultName) -					$ resultAccept : resultsBaseline }-	- | otherwise- = Nothing-		---- | Advance benchmark results as per `advanceBenchResults`.---   The resultTime and environment is taken from the second `BuildResults`.-advanceResults :: Double -> BuildResults -> BuildResults -> BuildResults-advanceResults swing baseline recent- = let	comparisons = compareManyBenchResults -			(map statBenchResult $ buildResultBench baseline)-			(map statBenchResult $ buildResultBench recent)-			-	results	    = advanceBenchResults swing -			comparisons -			(buildResultBench baseline)-			(buildResultBench recent)-	-   in	BuildResults-		{ buildResultTime		= buildResultTime recent-		, buildResultEnvironment	= buildResultEnvironment recent-		, buildResultBench		= results }--

@@ -1,37 +0,0 @@--module BuildBox.Quirk-	(Quirk	(..))-where-import System.Exit-import BuildBox.Aspect.Units-import BuildBox.Pretty----- | A Quirk is some extended information about a benchmark or test that isn't represented---   by an `Aspect`. These are singleton pieces of data where it doesn't make sense to ---   average them or compute other statistics.-data Quirk-	= QuirkSucceeded-	| QuirkFailed-	| QuirkExitCode	ExitCode-	| QuirkTimeout	Seconds-	deriving (Eq, Ord, Read, Show)-	-instance Pretty Quirk where- ppr quirk-  = case quirk of-	QuirkSucceeded	-	 -> text "succeeded"--	QuirkFailed-	 -> text "failed"--	QuirkExitCode ExitSuccess-	 -> text "exited successfully"--	QuirkExitCode (ExitFailure code)-	 -> text "exited with failure code " <> int code-	-	QuirkTimeout seconds-	 -> text "timed out after " <> ppr seconds-

@@ -1,58 +0,0 @@-{-# LANGUAGE PatternGuards #-}-{-# OPTIONS -fno-warn-missing-signatures #-}--module BuildBox.Reports.BenchResult-	(reportBenchResults)-where-import BuildBox.Pretty-import BuildBox.Aspect-import BuildBox.Benchmark.BenchResult-import Text.Printf---- | Produce a human readable report of benchmark results.------   If you only want the results within a fractional swing from the baseline---   then pass something like @(Just 0.1)@ as the first parameter for a 10\% swing, ---   otherwise all results are printed.---      -reportBenchResults :: Maybe Double -> [BenchResult StatsComparison] -> Doc---- no swing specified, just report all the results.-reportBenchResults Nothing comparisons-	= vcat $ punctuate (text "\n") $ map ppr comparisons-	-reportBenchResults (Just swing) comparisons- = let	(resultWinners, resultLosers, _)-		= splitBenchResults swing comparisons-		-   in	vcat $	[ text "Total tests = " <> int (length comparisons)-		, blank] ++ [reportBenchResults' swing resultWinners resultLosers]--reportBenchResults' swing resultWinners resultLosers- 	| []	<- resultWinners-	, []	<- resultLosers-	= text "ALL GOOD\n"-	-	| otherwise-	= let	docWinners -			| []	<- resultWinners-			= []-				-			| otherwise-			= [text "-- WINNERS (had a swing of < "-					<> text (printf "%+2.0f" (negate (swing * 100))) <> text "%)"-			$$ (vcat $ punctuate (text "\n") $ map ppr resultWinners) -			<> text "\n"]-				-		docLosers-			| []	<- resultLosers-			= []-				-			| otherwise-			= [text "-- LOSERS  (had a swing of > " -					<> text (printf "%+2.0f" (swing * 100)) <> text "%)"-			$$ (vcat $ punctuate (text "\n") $ map ppr resultLosers) -			<> text "\n"]-		-	  in	vcat $ docWinners ++ docLosers-		

@@ -1,4 +1,4 @@-Copyright (c) 2010, University of New South Wales.+Copyright (c) 2010-2012, University of New South Wales. All rights reserved.  Redistribution and use in source and binary forms, with or without@@ -11,14 +11,3 @@     * Neither the name of the University of New South Wales nor the       names of its contributors may be used to endorse or promote products       derived from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY-EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY-DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND-ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,5 +1,5 @@ Name:                buildbox-Version:             1.5.3.1+Version:             2.0.0.1 License:             BSD3 License-file:        LICENSE Author:              Ben Lippmeier@@ -12,9 +12,6 @@ Description:         Includes utilities for checking the host platform, running tests, capturing output,         handling errors, comparing runtimes against a baseline, sending mail, running events to a schedule etc.--	Some of the Command functions are just wrappers around shell commands, so be careful about passing-	them weirdly formed arguments. 	 Synopsis:         Rehackable components for writing buildbots and test harnesses.@@ -40,40 +37,35 @@         -Wall    Exposed-modules:-        BuildBox-        BuildBox.Aspect.Detail-        BuildBox.Aspect.Stats-        BuildBox.Aspect.Units-        BuildBox.Aspect.Single-        BuildBox.Aspect.Comparison-        BuildBox.Aspect-        BuildBox.Benchmark.BenchResult-        BuildBox.Benchmark-        BuildBox.Reports.BenchResult-        BuildBox.Build.Testable+        BuildBox.Build.Benchmark         BuildBox.Build.BuildError         BuildBox.Build.BuildState-        BuildBox.Build+        BuildBox.Build.Testable         BuildBox.Command.Darcs         BuildBox.Command.Environment         BuildBox.Command.File         BuildBox.Command.Mail         BuildBox.Command.Network-        BuildBox.Command.System         BuildBox.Command.Sleep+        BuildBox.Command.System+        BuildBox.Control.Cron         BuildBox.Control.Gang-        BuildBox.Cron.Schedule-        BuildBox.Cron-        BuildBox.Data.Log+        BuildBox.Data.Comparison+        BuildBox.Data.Detail         BuildBox.Data.Dividable-        BuildBox.FileFormat.BuildResults+        BuildBox.Data.Log+        BuildBox.Data.Physical+        BuildBox.Data.Range+        BuildBox.Data.Schedule         BuildBox.IO.Directory+        BuildBox.Build         BuildBox.Pretty-        BuildBox.Quirk         BuildBox.Time+        BuildBox    Other-modules:         BuildBox.Command.System.Internals         BuildBox.Build.Base-        BuildBox.Aspect.Aspect-        BuildBox.Benchmark.Benchmark++  Extensions:+        ExistentialQuantification