File: Benchmark.hs

package info (click to toggle)
haskell-heist 1.1.1.2-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 732 kB
  • sloc: haskell: 3,759; makefile: 9; sh: 5
file content (118 lines) | stat: -rw-r--r-- 4,069 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

------------------------------------------------------------------------------
import           Blaze.ByteString.Builder
import           Control.Concurrent
import           Control.Exception        (evaluate)
import           Control.Monad
import           Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
import           Criterion
import           Criterion.Main
import           Criterion.Measurement    hiding (getTime)
import qualified Data.ByteString          as B
import qualified Data.DList               as DL
import           Data.Maybe
import           Data.Monoid
import qualified Data.Text                as T
import           Data.Text.Encoding
import           Data.Time.Clock
import           System.Environment
import qualified Text.XmlHtml             as X
------------------------------------------------------------------------------
import           Heist
import           Heist.Common
import qualified Heist.Compiled           as C
import qualified Heist.Compiled.Internal  as CI
import qualified Heist.Interpreted        as I
import           Heist.TestCommon
import           Heist.Internal.Types
------------------------------------------------------------------------------

loadWithCache baseDir = do
    etm <- runExceptT $ do
        let sc = SpliceConfig mempty defaultLoadTimeSplices mempty mempty
                              [loadTemplates baseDir] (const True)
        ExceptT $ initHeistWithCacheTag $ HeistConfig sc "" False
    either (error . unlines) (return . fst) etm

main = do
    (dir:file:_) <- getArgs
    applyComparison dir file

justRender dir = do
    let page = "faq"
        pageStr = T.unpack $ decodeUtf8 page
    hs <- loadWithCache dir
    let !compiledTemplate = fst $! fromJust $! C.renderTemplate hs page
        compiledAction = do
            res <- compiledTemplate
            return $! toByteString $! res
    out <- compiledAction
    putStrLn $ "Rendered ByteString of length "++(show $ B.length out)
    B.writeFile (pageStr++".out.compiled."++dir) $ out

    defaultMain
       [ bench (pageStr++"-compiled (just render)") (whnfIO compiledAction)
       ]

------------------------------------------------------------------------------
applyComparison :: FilePath -> String -> IO ()
applyComparison dir pageStr = do
    let page = encodeUtf8 $ T.pack pageStr
    hs <- loadWithCache dir
    let compiledAction = do
            res <- fst $ fromJust $ C.renderTemplate hs page
            return $! toByteString $! res
    out <- compiledAction
    B.writeFile (pageStr++".out.compiled."++dir) $ out

    let interpretedAction = do
            res <- I.renderTemplate hs page
            return $! toByteString $! fst $! fromJust res
    out2 <- interpretedAction
    B.writeFile (pageStr++".out.interpreted."++dir) $ out

    defaultMain
       [ bench (pageStr++"-compiled") (whnfIO compiledAction)
       , bench (pageStr++"-interpreted") (whnfIO interpretedAction)
       ]

cmdLineTemplate :: String -> String -> IO ()
cmdLineTemplate dir page = do
--    args <- getArgs
--    let page = head args
--    let dir = "test/snap-website"
    hs <- loadHS dir
    let action = fst $ fromJust $ C.renderTemplate hs
            (encodeUtf8 $ T.pack page)
    out <- action
    B.writeFile (page++".out.cur") $ toByteString out

--    reference <- B.readFile "faq.out"
--    if False
--      then do
--        putStrLn "Template didn't render properly"
--        error "Aborting"
--      else
--        putStrLn "Template rendered correctly"

    defaultMain [
         bench (page++"-speed") (whnfIO action)
       ]


testNode =
  X.Element "div" [("foo", "aoeu"), ("bar", "euid")]
    [X.Element "b" [] [X.TextNode "bolded text"]
    ,X.TextNode " not bolded"
    ,X.Element "a" [("href", "/path/to/page")] [X.TextNode "link"]
    ]

getChunks templateName = do
    hs <- loadHS "snap-website-nocache"
    let (Just t) = lookupTemplate templateName hs _compiledTemplateMap
    return $! fst $! fst t