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
|
import Criterion.Main
import Criterion.Types (Config (..))
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text
import Skylighting.Core
import System.FilePath
-- import System.Directory
main :: IO ()
main = do
let inputs = ["abc.haskell", "abc.java", "abc.c", "archive.rhtml",
"life.lua", "abc.javascript"]
let getCase fp = do
let fp' = "test" </> "cases" </> fp
contents <- readFile fp'
let format = drop 1 $ takeExtension fp
return (Text.pack format, Text.pack contents)
cases <- mapM getCase inputs
-- xmlfiles <- filter (\x -> takeExtension x == ".xml") <$>
-- getDirectoryContents "xml"
let xmlfiles = ["haskell.xml"]
Right syntaxmap <- loadSyntaxesFromDir "xml"
defaultMainWith defaultConfig{ timeLimit = 10.0 }
$ parseBench xmlfiles : map (testBench syntaxmap) cases
parseBench :: [String] -> Benchmark
parseBench xmls =
bench "parse syntax definitions" $
nfIO ((Map.size . foldr addSyntaxDefinition mempty) <$> mapM addFile xmls)
where addFile f = do
result <- parseSyntaxDefinition ("xml" </> f)
case result of
Left e -> error e
Right r -> return r
testBench :: SyntaxMap -> (Text, Text) -> Benchmark
testBench syntaxmap (format, contents) =
bench (Text.unpack format) $ nf
(sum . map length . either (error "tokenize failed") id .
tokenize TokenizerConfig{ traceOutput = False
, syntaxMap = syntaxmap } syntax) contents
where syntax = maybe (error "could not find syntax") id
(lookupSyntax format syntaxmap)
|
