1{-# LANGUAGE BangPatterns               #-}
2{-# LANGUAGE ExistentialQuantification  #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4
5module Criterion.Collection.Internal.Types
6  ( Workload(..)
7  , WorkloadGenerator
8  , WorkloadMonad(..)
9  , runWorkloadMonad
10  , getRNG
11  , DataStructure(..)
12  , setupData
13  , setupDataIO
14  ) where
15
16------------------------------------------------------------------------------
17import           Control.DeepSeq
18import           Control.Monad.Reader
19import           Data.Vector (Vector)
20import           System.Random.MWC
21
22------------------------------------------------------------------------------
23-- Some thoughts on benchmarking modes
24--
25-- * pre-fill data structure, test an operation workload without modifying the
26--   data structure, measure time for each operation
27--
28--   ---> allows you to get fine-grained per-operation times with distributions
29--
30-- * pre-fill data structure, get a bunch of work to do (cumulatively modifying
31--   the data structure), measure time per-operation OR for the whole batch and
32--   divide out
33--
34--
35-- Maybe it will look like this?
36-- > data MeasurementMode = PerBatch | PerOperation
37-- > data WorkloadMode = Pure | Mutating
38
39------------------------------------------------------------------------------
40newtype WorkloadMonad a = WM (ReaderT GenIO IO a)
41  deriving (Functor, Applicative, Monad, MonadIO)
42
43
44------------------------------------------------------------------------------
45runWorkloadMonad :: WorkloadMonad a -> GenIO -> IO a
46runWorkloadMonad (WM m) gen = runReaderT m gen
47
48
49------------------------------------------------------------------------------
50getRNG :: WorkloadMonad GenIO
51getRNG = WM ask
52
53
54------------------------------------------------------------------------------
55-- | Given an 'Int' representing \"input size\", a 'WorkloadGenerator' makes a
56-- 'Workload'. @Workload@s generate operations to prepopulate data structures
57-- with /O(n)/ data items, then generate operations on-demand to benchmark your
58-- data structure according to some interesting distribution.
59type WorkloadGenerator op = Int -> WorkloadMonad (Workload op)
60
61
62------------------------------------------------------------------------------
63data Workload op = Workload {
64      -- | \"Setup work\" is work that you do to prepopulate a data structure
65      -- to a certain size before testing begins.
66      setupWork             :: !(Vector op)
67
68      -- | Given the number of operations to produce, 'genWorkload' spits out a
69      -- randomly-distributed workload simulation to be used in the benchmark.
70      --
71      -- | Some kinds of skewed workload distributions (the canonical example
72      -- being \"frequent lookups for a small set of keys and infrequent
73      -- lookups for the others\") need a certain minimum number of operations
74      -- to be generated to be statistically valid, which only the
75      -- 'WorkloadGenerator' would know how to decide. In these cases, you are
76      -- free to return more than @N@ samples from 'genWorkload', and
77      -- @criterion-collection@ will run them all for you.
78      --
79      -- Otherwise, @criterion-collection@ is free to bootstrap your benchmark
80      -- using as many sample points as it would take to make the results
81      -- statistically relevant.
82    , genWorkload           :: !(Int -> WorkloadMonad (Vector op))
83}
84
85
86------------------------------------------------------------------------------
87data DataStructure op = forall m . DataStructure {
88      emptyData    :: !(Int -> IO m)
89    , runOperation :: !(m -> op -> IO m)
90}
91
92
93------------------------------------------------------------------------------
94setupData :: m -> (m -> op -> m) -> DataStructure op
95setupData e r = DataStructure (const $ return e) (\m o -> return $ r m o)
96
97
98------------------------------------------------------------------------------
99setupDataIO :: (Int -> IO m) -> (m -> op -> IO m) -> DataStructure op
100setupDataIO = DataStructure
101