Rework Benchmarkable from a typeclass to a newtype

The typeclass gave us no expressivity, but complicated the code
somewhat. The new arrangement is quite a bit simpler.

Criterion.hs

@@ -14,7 +14,6 @@ module Criterion
     (
       Benchmarkable(..)
     , Benchmark
-    , Pure
     , nf
     , whnf
     , nfIO

Criterion/Internal.hs

@@ -46,11 +46,11 @@ import Text.Printf (printf)
 
 -- | Run a single benchmark, and return timings measured when
 -- executing it.
-runBenchmark :: Benchmarkable b => Environment -> b -> Criterion Sample
-runBenchmark env b = do
+runBenchmark :: Environment -> Benchmarkable -> Criterion Sample
+runBenchmark env (Benchmarkable run) = do
   _ <- liftIO $ runForAtLeast 0.1 10000 (`replicateM_` getTime)
   let minTime = envClockResolution env * 1000
-  (testTime, testIters, _) <- liftIO $ runForAtLeast (min minTime 0.1) 1 (run b)
+  (testTime, testIters, _) <- liftIO $ runForAtLeast (min minTime 0.1) 1 run
   _ <- prolix "ran %d iterations in %s\n" testIters (secs testTime)
   cfg <- getConfig
   let newIters    = ceiling $ minTime * testItersD / testTime
@@ -68,11 +68,11 @@ runBenchmark env b = do
   times <- liftIO . fmap (U.map ((/ newItersD) . subtract (envClockCost env))) .
            U.replicateM sampleCount $ do
              when (fromLJ cfgPerformGC cfg) $ performGC
-             time_ (run b newIters)
+             time_ (run newIters)
   return times
 
 -- | Run a single benchmark and analyse its performance.
-runAndAnalyseOne :: Benchmarkable b => Environment -> String -> b
+runAndAnalyseOne :: Environment -> String -> Benchmarkable
                  -> Criterion (Sample,SampleAnalysis,Outliers)
 runAndAnalyseOne env _desc b = do
   times <- runBenchmark env b
@@ -183,9 +183,9 @@ runNotAnalyse p bs' = goQuickly "" bs'
             mapM_ (goQuickly (prefix pfx desc)) bs
         goQuickly pfx (BenchCompare bs) = mapM_ (goQuickly pfx) bs
 
-        runOne b = do
+        runOne (Benchmarkable run) = do
             samples <- getConfigItem $ fromLJ cfgSamples
-            liftIO $ run b samples
+            liftIO $ run samples
 
 prefix :: String -> String -> String
 prefix ""  desc = desc

Criterion/Main.hs

@@ -27,7 +27,6 @@ module Criterion.Main
     -- * Types
       Benchmarkable(..)
     , Benchmark
-    , Pure
     -- * Constructing benchmarks
     , bench
     , bgroup
@@ -52,7 +51,7 @@ import Criterion.Config
 import Criterion.Environment (measureEnvironment)
 import Criterion.IO.Printf (note, printError)
 import Criterion.Monad (Criterion, withConfig)
-import Criterion.Types (Benchmarkable(..), Benchmark(..), Pure, bench,
+import Criterion.Types (Benchmarkable(..), Benchmark(..), bench,
                         benchNames, bgroup, bcompare, nf, nfIO, whnf, whnfIO)
 import Data.Char (toLower)
 import Data.List (isPrefixOf, sort, stripPrefix)

Criterion/Types.hs

@@ -30,7 +30,6 @@ module Criterion.Types
     -- * Benchmark descriptions
       Benchmarkable(..)
     , Benchmark(..)
-    , Pure
     , whnf
     , nf
     , nfIO
@@ -53,76 +52,62 @@ import Data.Data (Data, Typeable)
 import GHC.Generics (Generic)
 import Statistics.Types (Sample)
 
--- | A benchmarkable function or action.
-class Benchmarkable a where
-    -- | Run a function or action the specified number of times.
-    run :: a                    -- ^ The function or action to benchmark.
-        -> Int                  -- ^ The number of times to run or evaluate it.
-        -> IO ()
-
--- | A container for a pure function to benchmark, and an argument to
--- supply to it each time it is evaluated.
-data Pure where
-    WHNF :: (a -> b) -> a -> Pure
-    NF :: NFData b => (a -> b) -> a -> Pure
+-- | A pure function or impure action that can be benchmarked. The
+-- 'Int' parameter indicates the number of times to run the given
+-- function or action.
+newtype Benchmarkable = Benchmarkable (Int -> IO ())
 
 -- | Apply an argument to a function, and evaluate the result to weak
 -- head normal form (WHNF).
-whnf :: (a -> b) -> a -> Pure
-whnf = WHNF
+whnf :: (a -> b) -> a -> Benchmarkable
+whnf = pure id
 {-# INLINE whnf #-}
 
 -- | Apply an argument to a function, and evaluate the result to head
 -- normal form (NF).
-nf :: NFData b => (a -> b) -> a -> Pure
-nf = NF
+nf :: NFData b => (a -> b) -> a -> Benchmarkable
+nf = pure rnf
 {-# INLINE nf #-}
 
+pure :: (b -> c) -> (a -> b) -> a -> Benchmarkable
+pure reduce f0 x0 = Benchmarkable $ go f0 x0
+  where go f x n
+          | n <= 0    = return ()
+          | otherwise = evaluate (reduce (f x)) >> go f x (n-1)
+{-# INLINE pure #-}
+
 -- | 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 -> IO ()
-nfIO a = evaluate . rnf =<< a
+nfIO :: NFData a => IO a -> Benchmarkable
+nfIO = impure rnf
 {-# 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 -> IO ()
-whnfIO a = a >>= evaluate >> return ()
+whnfIO :: IO a -> Benchmarkable
+whnfIO = impure id
 {-# INLINE whnfIO #-}
 
-instance Benchmarkable Pure where
-    run p@(WHNF _ _) = go p
-      where
-        go fx@(WHNF f x) n
-            | n <= 0    = return ()
-            | otherwise = evaluate (f x) >> go fx (n-1)
-    run p@(NF _ _) = go p
-      where
-        go fx@(NF f x) n
-            | n <= 0    = return ()
-            | otherwise = evaluate (rnf (f x)) >> go fx (n-1)
-    {-# INLINE run #-}
-
-instance Benchmarkable (IO a) where
-    run a n
-        | n <= 0    = return ()
-        | otherwise = a >> run a (n-1)
-    {-# INLINE run #-}
+impure :: (a -> b) -> IO a -> Benchmarkable
+impure strategy a = Benchmarkable go
+  where go n
+          | n <= 0    = return ()
+          | otherwise = a >>= (evaluate . strategy) >> go (n-1)
+{-# INLINE impure #-}
 
 -- | A benchmark may consist of either a single 'Benchmarkable' item
 -- with a name, created with 'bench', or a (possibly nested) group of
 -- 'Benchmark's, created with 'bgroup'.
 data Benchmark where
-    Benchmark    :: Benchmarkable b => String -> b -> Benchmark
+    Benchmark    :: String -> Benchmarkable -> Benchmark
     BenchGroup   :: String -> [Benchmark] -> Benchmark
     BenchCompare :: [Benchmark] -> Benchmark
 
 -- | Create a single benchmark.
-bench :: Benchmarkable b =>
-         String                 -- ^ A name to identify the benchmark.
-      -> b
+bench :: String                 -- ^ A name to identify the benchmark.
+      -> Benchmarkable
       -> Benchmark
 bench = Benchmark