git.iko.soy/reflex
on 7bb5ff4 help sign in
reflex/bench/RunAll.hs
86 lines 3.0 kB history raw
1{-# LANGUAGE ConstraintKinds, TypeSynonymInstances, BangPatterns, ScopedTypeVariables, TupleSections, GADTs, RankNTypes, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
4module Main where
6import Criterion.Main
7import Criterion.Types
9import Reflex
10import Reflex.Host.Class
12import Reflex.TestPlan
13import Reflex.Plan.Reflex
15import Reflex.Spider.Internal (SpiderEventHandle)
16import qualified Reflex.Bench.Focused as Focused
18import Control.Applicative
19import Control.DeepSeq (NFData (..))
21import System.IO
22import System.Mem
23import Prelude
25type MonadReflexHost' t m = (MonadReflexHost t m, MonadIORef m, MonadIORef (HostFrame t))
28setupFiring :: (MonadReflexHost t m, MonadIORef m) => Plan t (Event t a) -> m (Ignore (EventHandle t a), Schedule t)
29setupFiring p = do
30 (e, s) <- runPlan p
31 h <- subscribeEvent e
32 return (Ignore h, s)
34-- Hack to avoid the NFData constraint for EventHandle which is a synonym
35newtype Ignore a = Ignore a
36instance NFData (Ignore a) where
37 rnf !_ = ()
39instance NFData (SpiderEventHandle a) where
40 rnf !_ = ()
42instance NFData (Behavior t a) where
43 rnf !_ = ()
45instance NFData (Firing t) where
46 rnf !(Firing _ _) = ()
48-- Measure the running time
49benchFiring :: (MonadReflexHost' t m, MonadSample t m) => (forall a. m a -> IO a) -> (String, TestCase) -> Benchmark
50benchFiring runHost (name, TestE p) = env setup (\e -> bench name $ whnfIO $ run e) where
51 run (Ignore h, s) = runHost (readSchedule s (readEvent' h)) >> performGC
52 setup = runHost $ setupFiring p
54benchFiring runHost (name, TestB p) = env setup (\e -> bench name $ whnfIO $ run e) where
55 run (b, s) = runHost (readSchedule s (sample b)) >> performGC
56 setup = runHost $ do
57 (b, s) <- runPlan p
58 return (b, makeDense s)
60main :: IO ()
61main = do
62 hSetBuffering stdout LineBuffering
63 defaultMainWith (defaultConfig { timeLimit = 10, csvFile = Just "dmap-original.csv" })
64 [ benchImpl "spider" runSpiderHost
65 ]
67benchImpl :: (MonadReflexHost' t m, MonadSample t m) => String -> (forall a. m a -> IO a) -> Benchmark
68benchImpl name runHost = bgroup name [ sub 100 40
69 , dynamics 100
70 , dynamics 1000
71 , firing 1000
72 , firing 10000
73 , merging 10
74 , merging 50
75 , merging 100
76 , merging 200]
77 where
78 sub n frames = runGroup ("subscribing " ++ show (n, frames)) $ Focused.subscribing n frames
79 firing n = runGroup ("firing " ++ show n) $ Focused.firing n
80 merging n = runGroup ("merging " ++ show n) $ Focused.merging n
81 dynamics n = runGroup ("dynamics " ++ show n) $ Focused.dynamics n
83 runGroup name' benchmarks = bgroup name' (benchFiring runHost <$> benchmarks)