mirror of
https://github.com/github/semantic.git
synced 2024-12-22 22:31:36 +03:00
75 lines
3.0 KiB
Haskell
75 lines
3.0 KiB
Haskell
{-# LANGUAGE DeriveAnyClass, DeriveGeneric, FlexibleInstances, StandaloneDeriving #-}
|
||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||
module Main where
|
||
|
||
import Criterion.Main
|
||
import Data.Function
|
||
import Data.List (genericLength)
|
||
import Data.String
|
||
import Patch
|
||
import Prologue
|
||
import SES
|
||
import Test.QuickCheck hiding (Fixed)
|
||
import Arguments
|
||
import SemanticDiff (fetchDiffs)
|
||
import qualified Renderer as R
|
||
import qualified SemanticDiffPar
|
||
import System.Directory (makeAbsolute)
|
||
|
||
main :: IO ()
|
||
main = do
|
||
benchmarks <- sequenceA [ generativeBenchmarkWith "ses" 10 arbitrarySESInputs (uncurry ((*) `on` length)) (nf (uncurry benchmarkSES)) ]
|
||
defaultMain (syncAsyncBenchmark : benchmarks)
|
||
where arbitrarySESInputs = (,) <$> sized (`vectorOf` arbitrary) <*> sized (`vectorOf` arbitrary)
|
||
|
||
benchmarkSES :: [String] -> [String] -> [Either String (Patch String)]
|
||
benchmarkSES as bs = ses compare cost as bs
|
||
where compare a b = if a == b then Just (Left a) else Nothing
|
||
cost = either (const 0) (sum . fmap genericLength)
|
||
|
||
instance NFData a => NFData (Patch a)
|
||
|
||
-- | 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 = generativeBenchmarkWith name n arbitrary metric benchmark
|
||
|
||
generativeBenchmarkWith :: (Show m, Ord m) => String -> Int -> Gen a -> (a -> m) -> (a -> Benchmarkable) -> IO Benchmark
|
||
generativeBenchmarkWith name n generator metric benchmark = do
|
||
benchmarks <- traverse measure (take n [0,(defaultSize `div` n)..defaultSize])
|
||
pure $! bgroup name (snd <$> (sortOn fst benchmarks))
|
||
where measure n = do
|
||
input <- generate (resize n generator)
|
||
let measurement = metric input
|
||
pure $! (measurement, bench (show measurement) (benchmark input))
|
||
defaultSize = 100
|
||
|
||
syncAsyncBenchmark :: Benchmark
|
||
syncAsyncBenchmark =
|
||
bgroup "async vs par" [
|
||
bench "async" . whnfIO $ SemanticDiff.fetchDiffs =<< theArgs,
|
||
bench "par" . whnfIO $ SemanticDiffPar.fetchDiffs =<< theArgs
|
||
]
|
||
|
||
theArgs :: IO Arguments
|
||
theArgs = do
|
||
jqueryPath <- makeAbsolute "test/repos/jquery"
|
||
pure $ args jqueryPath sha1 sha2 files R.Patch
|
||
where
|
||
sha1 = "70526981916945dc4093e116a3de61b1777d4718"
|
||
sha2 = "e5ffcb0838c894e26f4ff32dfec162cf624d8d7d"
|
||
files = [
|
||
"src/manipulation/getAll.js",
|
||
"src/manipulation/support.js",
|
||
"src/manipulation/wrapMap.js",
|
||
"src/offset.js",
|
||
"test/unit/css.js",
|
||
"test/unit/deferred.js",
|
||
"test/unit/deprecated.js",
|
||
"test/unit/effects.js",
|
||
"test/unit/event.js",
|
||
"test/unit/offset.js",
|
||
"test/unit/wrap.js"
|
||
]
|