1{-# LANGUAGE CPP #-} 2{-# LANGUAGE OverloadedStrings #-} 3{-# LANGUAGE ScopedTypeVariables #-} 4import Criterion.Main 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 defaultMainWith defaultConfig 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