Skip to content
Newer
Older
100644 92 lines (82 sloc) 2.75 KB
dd330f7 @snoyberg create-graph added
snoyberg authored Mar 20, 2011
1 {-# LANGUAGE OverloadedStrings #-}
2 import Data.XML.Types
3 import Text.XML.Enumerator.Document (writeFile)
4 import qualified Data.Map as Map
5 import Prelude hiding (writeFile)
6 import Data.Text (pack)
7
8 largest = 900
9
10 results =
11 [ ("warp", 81700.9)
12 , ("yesod", 64027.8)
13 , ("happstack", 35810.8)
14 , ("snap", 35272.2)
15 , ("node", 18654.4)
16 , ("winstone", 4659.6)
17 , ("php", 3416.9)
18 , ("tornado", 3416.0)
19 , ("goliath", 3236.9)
20 ]
21 {-
22 [ ("warp", 53924.6)
23 , ("yesod", 49355.3)
24 , ("happstack", 29696.2)
25 , ("snap", 27987.8)
26 , ("node", 13610.1)
27 , ("winstone", 4551.7)
28 , ("tornado", 3321.7)
29 , ("goliath", 3007.9)
30 , ("php", 2728.1)
31 ]
32 -}
33
34 doctype = Doctype "svg" (Just $ PublicID "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd") []
35
36 svg = Element "{http://www.w3.org/2000/svg}svg" (Map.fromList
37 [ ("version", [ContentText "1.1"])
38 , ("font-family", [ContentText "DejaVu Sans"])
39 , ("font-size", [ContentText "16pt"])
40 ]) $ map NodeElement $ concat $ zipWith mkResult [0..] $ reverse results
41
42 mkResult i (name, val) =
43 [ Element "{http://www.w3.org/2000/svg}rect" (Map.fromList
44 [ ("width", [ContentText "50"])
45 , ("height", [ContentText $ pack $ show $ normalize val'])
46 , ("x", [ContentText $ pack $ show $ i * 60])
47 , ("y", [ContentText $ pack $ show $ normalize $ largest - val'])
48 , ("style", [ContentText $ pack $ concat
49 [ "fill:#"
50 , (cycle colors) !! i
51 , ";stroke-width:1;stroke:black"
52 ]])
53 ]) []
54 , Element "{http://www.w3.org/2000/svg}text" (Map.fromList
55 [ ("x", [ContentText $ pack $ show x])
56 , ("y", [ContentText $ pack $ show y])
57 , ("transform", [ContentText $ pack $ concat ["rotate(45, ", show x, ", ", show y, ")"]])
58 ]) [NodeContent $ ContentText $ pack name]
59 , Element "{http://www.w3.org/2000/svg}text" (Map.fromList
60 [ ("x", [ContentText $ pack $ show $ x - 10])
61 , ("y", [ContentText $ pack $ show $ normalize (largest - val') - 5])
62 , ("font-size", [ContentText "8pt"])
63 ]) [NodeContent $ ContentText $ pack $ prettyNum val]
64 ]
65 where
66 y = normalize largest + 20
67 x = 20 + i * 60
68 val' = val / 100
69 normalize = (*) 0.4
70
71 prettyNum = prettyInt . round
72
73 prettyInt x
74 | x < 1000 = show x
75 | otherwise =
76 let (y, z) = x `divMod` 1000
77 in prettyInt y ++ ',' : showLead z
78 where
79 showLead a
80 | a < 10 = '0' : '0' : show a
81 | a < 100 = '0' : show a
82 | otherwise = show a
83
84 main = writeFile "benchmark2.svg" $ Document (Prologue [] (Just doctype) []) svg []
85
86 colors =
87 [ "990033"
88 , "336699"
89 , "FFFF00"
90 , "669966"
91 ]
Something went wrong with that request. Please try again.