Add beginnings of a benchmark suite

This commit is contained in:
Jonathan Daugherty 2015-06-28 21:00:46 -07:00
parent 3027120a4e
commit e2cfcb3b9f
3 changed files with 103 additions and 0 deletions

View File

@ -58,6 +58,33 @@ executable brick
lens,
text
Flag bench
Description: whether to build benchmarks
Default: False
executable brick-bench
hs-source-dirs: programs,src
if !flag(bench)
buildable: False
ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3
default-language: Haskell2010
main-is: Bench.hs
CPP-Options: -DBENCH
build-depends: base,
transformers,
vty >= 5.2.9,
data-default,
lens,
text,
criterion,
deepseq,
contravariant,
template-haskell,
containers,
vector
executable brick-markup-demo
hs-source-dirs: programs
ghc-options: -threaded -Wall -fno-warn-unused-do-bind

70
programs/Bench.hs Normal file
View File

@ -0,0 +1,70 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
import Criterion.Main
import Control.DeepSeq (NFData(..))
import Data.Monoid
import Data.Default
import Graphics.Vty
import qualified Data.Text as T
import Brick.AttrMap
import Brick.Widgets.Core
import Brick.Widgets.Border
instance NFData Widget where
rnf w = (hSize w) `seq` (vSize w) `seq` (render w) `seq` ()
aMap :: AttrMap
aMap = attrMap def []
sz :: DisplayRegion
sz = (100, 100)
renderBench :: Widget -> Picture
renderBench w = pic
where
(_, pic, _) = renderFinal aMap [w] sz (const Nothing) (RS mempty mempty)
mkBench :: String -> Widget -> Benchmark
mkBench s w = bench s (nf renderBench w)
allGroups :: [Benchmark]
allGroups =
[ bgroup "widgets"
[ mkBench "str" (str "testing")
, mkBench "txt" (txt $ T.pack "testing")
, mkBench "hBorder" hBorder
, mkBench "hBorderWithLabel" (hBorderWithLabel (str "label"))
, mkBench "vBorder" vBorder
, mkBench "border" (border $ str "testing")
, mkBench "fill" (fill ' ')
, mkBench "hFill" (hFill ' ')
, mkBench "vFill" (vFill ' ')
, mkBench "hBox" (hBox [str "testing", str "testing"])
, mkBench "vBox" (vBox [str "testing", str "testing"])
, mkBench "empty" emptyWidget
, mkBench "hLimit" (hLimit 1 $ str "t")
, mkBench "vLimit" (vLimit 1 $ str "testing")
-- withDefaultAttr
-- withDefaultAttrName
-- withAttrName
-- withAttrMappings
-- forceAttr
-- raw
-- withBorderStyle
-- translateBy
-- cropLeftBy
-- cropRightBy
-- cropTopBy
-- cropBottomBy
-- showCursor
-- viewport
-- visible
-- visibleRegion
]
]
main :: IO ()
main = defaultMain allGroups

View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
module Brick.Widgets.Core
( Widget(..)
, Size(..)
@ -47,6 +48,11 @@ module Brick.Widgets.Core
, viewport
, visible
, visibleRegion
#ifdef BENCH
, renderFinal
, RenderState(..)
#endif
)
where