1
1
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
semantic/bench/Main.hs
2016-06-06 13:06:04 -04:00

42 lines
1.5 KiB
Haskell
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{-# LANGUAGE DeriveAnyClass, DeriveGeneric, FlexibleInstances, StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
import Alignment
import Criterion.Main
import Data.Bifunctor.Join
import Data.Bifunctor.Join.Arbitrary ()
import Data.Functor.Foldable
import Data.String
import Data.Text.Arbitrary ()
import Data.These
import Data.These.Arbitrary ()
import Patch.Arbitrary ()
import Prologue
import Term.Arbitrary
import Test.QuickCheck hiding (Fixed)
main :: IO ()
main = do
benchmarks <- sequenceA []
defaultMain benchmarks
-- | Defines a named group of n benchmarks over inputs generated by an `Arbitrary` instance.
-- |
-- | The inputs sizes at each iteration are measured by a metric function, which gives the name of the benchmark. This makes it convenient to correlate a benchmark of some function over lists with e.g. input `length`.
generativeBenchmark :: (Arbitrary a, Show m, Ord m) => String -> Int -> (a -> m) -> (a -> Benchmarkable) -> IO Benchmark
generativeBenchmark name n metric benchmark = do
benchmarks <- traverse measure (replicate n defaultSize)
pure $! bgroup name (snd <$> (sortOn fst benchmarks))
where measure n = do
input <- generate (resize n arbitrary)
let measurement = metric input
pure $! (measurement, bench (show measurement) (benchmark input))
defaultSize = 100
-- Instances
deriving instance (NFData a, NFData b) => NFData (These a b)
deriving instance NFData a => NFData (Join These a)