Basic types.

These are heavily inspired by Criterion. The main difference is that
unlike Criterion, the `Benchmarkable` type is a monad. This makes it
possible to reduce the function space for `env` significantly, avoiding
exotic functions that return a different set of benchmarks by inspecting
the resource value. Exotic functions are not just a theoretical problem
in Criterion: the framework passes `undefined` to get the list of all
benchmarks. So being strict on the argument in any way makes the whole
thing go boom.

Author: mboes

.gitignore

@@ -0,0 +1 @@
+.stack-work/

README.md

@@ -0,0 +1 @@
+# hyperion

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

hyperion.cabal

@@ -0,0 +1,25 @@
+name:                hyperion
+version:             0.1.0.0
+synopsis:            Next generation microbenchmarking.
+description:         Please see README.md
+homepage:            https://github.com/tweag/hyperion#readme
+author:              Tweag I/O
+maintainer:          m@tweag.io
+category:            Benchmarking
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs: src
+  exposed-modules: Hyperion
+  build-depends:
+    base >= 4.9 && < 5,
+    deepseq >= 1.4,
+    mtl >= 2.2,
+    vector >= 0.11
+  default-language: Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/tweag/hyperion

shell.nix

@@ -0,0 +1,12 @@
+{ghc ? abort "ghc argument missing. Use Stack >= 1.2."}:
+
+with (import <nixpkgs> {});
+
+haskell.lib.buildStackProject {
+  name = "hyperion";
+  buildInputs =
+    [ ncurses5 # For Intero
+    ];
+  inherit ghc;
+  LANG = "en_US.utf8";
+}

src/Hyperion.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ExistentialQuantification #-}
+
+module Hyperion where
+
+import Control.Applicative
+import Control.Exception (evaluate)
+import Control.Monad.State (State, modify')
+import Data.Monoid ((<>))
+import Data.Vector (Vector)
+import Data.Int (Int64)
+import Control.DeepSeq
+
+newtype Benchmarkable a = Benchmarkable { unBenchmarkable :: State (Int64 -> IO ()) a }
+  deriving (Functor, Applicative, Monad)
+
+data Resource r = Resource r
+
+use :: Resource r -> Benchmarkable r
+use (Resource x) = return x
+
+data Benchmark where
+  Bench :: String -> Benchmarkable () -> Benchmark
+  Group :: String -> [Benchmark] -> Benchmark
+  Shared :: NFData r => IO r -> (Resource r -> Benchmark) -> Benchmark
+  Index :: Vector a -> Benchmark -> Benchmark
+
+bench :: String -> Benchmarkable () -> Benchmark
+bench = Bench
+
+bgroup :: String -> [Benchmark] -> Benchmark
+bgroup = Group
+
+env :: NFData r => IO r -> (Resource r -> Benchmark) -> Benchmark
+env = Shared
+
+-- | Apply an argument to a function, and evaluate the result to weak
+-- head normal form (WHNF).
+whnf :: (a -> b) -> a -> Benchmarkable ()
+whnf f x = Benchmarkable $ modify' (<> pureFunc id f x)
+{-# INLINE whnf #-}
+
+-- | Apply an argument to a function, and evaluate the result to head
+-- normal form (NF).
+nf :: NFData b => (a -> b) -> a -> Benchmarkable ()
+nf f x = Benchmarkable $ modify' (<> pureFunc rnf f x)
+{-# INLINE nf #-}
+
+pureFunc :: (b -> c) -> (a -> b) -> a -> Int64 -> IO ()
+pureFunc reduce f0 x0 = go f0 x0
+  where go f x n
+          | n <= 0    = return ()
+          | otherwise = evaluate (reduce (f x)) >> go f x (n-1)
+{-# INLINE pureFunc #-}
+
+-- | Perform an action, then evaluate its result to head normal form.
+-- This is particularly useful for forcing a lazy 'IO' action to be
+-- completely performed.
+nfIO :: NFData a => IO a -> Benchmarkable ()
+nfIO m = Benchmarkable $ modify' (<> impure rnf m)
+{-# INLINE nfIO #-}
+
+-- | Perform an action, then evaluate its result to weak head normal
+-- form (WHNF).  This is useful for forcing an 'IO' action whose result
+-- is an expression to be evaluated down to a more useful value.
+whnfIO :: IO a -> Benchmarkable ()
+whnfIO m = Benchmarkable $ modify' (<> impure id m)
+{-# INLINE whnfIO #-}
+
+impure :: (a -> b) -> IO a -> Int64 -> IO ()
+impure strategy a = go
+  where go n
+          | n <= 0    = return ()
+          | otherwise = a >>= (evaluate . strategy) >> go (n-1)
+{-# INLINE impure #-}

stack.yaml

@@ -0,0 +1,6 @@
+resolver: lts-7.14
+packages:
+- '.'
+
+nix:
+  shell-file: shell.nix