module Hyperion.Internal where
import Control.Monad.State.Strict (State, execState)
import Data.Function (on)
import Data.Hashable (Hashable(..))
import Data.Int
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text
newtype Batch a = Batch { unBatch :: State (Int64 -> IO ()) a }
deriving (Functor, Applicative, Monad)
runBatch :: Batch () -> Int64 -> IO ()
runBatch bk = execState (unBatch bk) mempty
data Env r = Empty | Resource r
use :: Env r -> Batch r
use Empty = error "use called on empty environment."
use (Resource x) = return x
data Parameter = forall a. (Show a, Enum a) => Parameter a
instance Eq Parameter where
(==) = (==) `on` \(Parameter x) -> fromEnum x
instance Ord Parameter where
compare = compare `on` \(Parameter x) -> fromEnum x
data Component
= BenchC Text
| GroupC Text
| SeriesC Parameter
deriving (Eq, Ord)
newtype BenchmarkId = BenchmarkId [Component]
deriving (Eq, Ord)
instance Hashable BenchmarkId where
hashWithSalt s = hashWithSalt s . renderBenchmarkId
instance Show BenchmarkId where
show = Text.unpack . renderBenchmarkId
renderBenchmarkId :: BenchmarkId -> Text
renderBenchmarkId (BenchmarkId comps0) = go "" comps0
where
go index [BenchC txt] = txt <> index
go index (GroupC txt : comps) = txt <> index <> "/" <> go "" comps
go index (SeriesC (Parameter x) : comps) =
go (index <> ":" <> Text.pack (show x)) comps
go _ _ = error "renderBenchmarkId: Impossible"
benchmarkParameters :: BenchmarkId -> [Parameter]
benchmarkParameters (BenchmarkId comps) =
concatMap (\case SeriesC x -> [x]; _ -> []) comps