1{-# LANGUAGE CPP                 #-}
2{-# LANGUAGE OverloadedStrings   #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4import Test.Tasty.Bench
5import Data.Text (Text)
6import Data.Functor.Identity  -- base >= 4.8
7import Commonmark
8import qualified Data.Text as T
9import qualified Data.Text.IO as TIO
10#if !MIN_VERSION_base(4,11,0)
11import Data.Monoid
12#endif
13
14main :: IO ()
15main = do
16  sample <- T.replicate 10 <$> TIO.readFile "benchmark/sample.md"
17  defaultMain
18    [ bgroup "tokenize"
19      [ benchTokenize ("sample.md", sample) ]
20    , bgroup "parse sample.md"
21      [ benchCommonmark defaultSyntaxSpec ("commonmark default", sample)
22      ]
23    , bgroup "pathological"
24      (map toPathBench pathtests)
25    ]
26
27toPathBench :: (String, Int -> T.Text) -> Benchmark
28toPathBench (name, ptest) =
29  bgroup name
30  [ bgroup "commonmark"
31    (map (\n -> benchCommonmark defaultSyntaxSpec (show n, ptest n))
32      [1000, 2000, 3000, 4000])
33  ]
34
35pathtests :: [(String, Int -> T.Text)]
36pathtests =
37  [ ("nested strong emph", \n ->
38     let num = n `div` 14 in
39     T.replicate num "*a **a " <> "b" <>
40     T.replicate num " a** a*")
41  , ("many emph closers with no openers", \n ->
42     let num = n `div` 3 in
43     T.replicate num "a_ ")
44  , ("many emph openers with no closers", \n ->
45     let num = n `div` 3 in
46     T.replicate num "_a ")
47  , ("many link closers with no openers", \n ->
48    let num = n `div` 2 in
49     T.replicate num "a]")
50  , ("many link openers with no closers", \n ->
51    let num = n `div` 2 in
52     T.replicate num "[a")
53  , ("mismatched openers and closers", \n ->
54    let num = n `div` 3 in
55     T.replicate num "*a_ ")
56  , ("openers and closers multiple of 3", \n ->
57    let num = n `div` 7 in
58     T.replicate num "a**b" <> T.replicate num "c* ")
59  , ("link openers and emph closers", \n ->
60    let num = n `div` 4 in
61     mconcat (replicate num "[ a_"))
62  , ("nested brackets", \n ->
63    let num = n `div` 2 in
64     T.replicate num "[" <> "a" <> T.replicate num "]")
65  , ("inline link openers without closers", \n ->
66    let num = n `div` 3 in
67    T.replicate num "[](")
68  , ("repeated pattern '[ (]('" , \n ->
69    let num = n `div` 5 in
70    T.replicate num "[ (](")
71  , ("nested block quotes", \n ->
72    let num = n `div` 2 in
73     T.replicate num "> " <> "a")
74  , ("nested list", \n ->
75    let num = floor (sqrt (fromIntegral n :: Double)) in
76    mconcat (map (\ind -> T.replicate ind " " <> "- a\n") [0..(num - 1)]))
77  , ("nested list 2", \n ->
78    let num = n `div` 2 in
79    T.replicate num "* " <> "a\n")
80  , ("backticks", \n ->
81    let num = floor (sqrt (9 + (8 * (fromIntegral n :: Double))) / 2) in
82    mconcat $ map (\x -> "e" <> T.replicate x "`") [1..num])
83  , ("CDATA", \n ->
84    let num = n `div` 11 in
85    T.replicate num "a <![CDATA[")
86  , ("<?", \n ->
87    let num = n `div` 2 in
88    ("a" <> T.replicate num "<?"))
89  , ("<!A ", \n ->
90    let num = n `div` 4 in
91    ("a" <> T.replicate num "<!A "))
92  ]
93
94benchCommonmark :: SyntaxSpec Identity (Html ()) (Html ())
95                -> (String, Text)
96                -> Benchmark
97benchCommonmark spec (name, contents) =
98  bench name $
99    nf (either (error . show) renderHtml
100        . runIdentity . parseCommonmarkWith spec . tokenize name)
101    contents
102
103benchTokenize :: (String, Text) -> Benchmark
104benchTokenize (name, contents) =
105  bench ("tokenize " ++ name) $ nf (length . tokenize name) contents
106