yesod/yesod-core/bench/th.hs
2014-09-07 17:34:37 +03:00

69 lines
1.8 KiB
Haskell

{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings, TupleSections, ViewPatterns #-}
import Yesod.Routes.TH
import Yesod.Routes.Parse
import THHelper
import Language.Haskell.TH.Syntax
import Criterion.Main
import Data.Text (words)
import Prelude hiding (words)
import Control.DeepSeq
import Yesod.Routes.TH.Simple
import Test.Hspec
import Control.Monad (forM_, unless)
$(do
let (cons, decs) = mkRouteCons $ map (fmap parseType) resources
clause1 <- mkDispatchClause settings resources
clause2 <- mkSimpleDispatchClause settings resources
return $ concat
[ [FunD (mkName "dispatch1") [clause1]]
, [FunD (mkName "dispatch2") [clause2]]
, decs
, [DataD [] (mkName "Route") [] cons [''Show, ''Eq]]
]
)
instance NFData Route where
rnf HomeR = ()
rnf FooR = ()
rnf (BarR i) = i `seq` ()
rnf BazR = ()
getHomeR :: Maybe Int
getHomeR = Just 1
getFooR :: Maybe Int
getFooR = Just 2
getBarR :: Int -> Maybe Int
getBarR i = Just (i + 3)
getBazR :: Maybe Int
getBazR = Just 4
samples = take 10000 $ cycle
[ words "foo"
, words "foo bar"
, words ""
, words "bar baz"
, words "bar 4"
, words "bar 1234566789"
, words "baz"
, words "baz 4"
, words "something else"
]
dispatch2a = dispatch2 `asTypeOf` dispatch1
main :: IO ()
main = do
forM_ samples $ \sample ->
unless (dispatch1 True (sample, "GET") == dispatch2a True (sample, "GET"))
(error $ show sample)
defaultMain
[ bench "dispatch1" $ nf (map (dispatch1 True . (, "GET"))) samples
, bench "dispatch2" $ nf (map (dispatch2a True . (, "GET"))) samples
, bench "dispatch1a" $ nf (map (dispatch1 True . (, "GET"))) samples
, bench "dispatch2a" $ nf (map (dispatch2a True . (, "GET"))) samples
]