HpcMarkup.hs 18.3 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
---------------------------------------------------------
-- The main program for the hpc-markup tool, part of HPC.
-- Andy Gill and Colin Runciman, June 2006
---------------------------------------------------------

module HpcMarkup (markup_plugin) where

import Trace.Hpc.Mix
import Trace.Hpc.Tix
import Trace.Hpc.Util

import HpcFlags
andy@galois.com's avatar
andy@galois.com committed
13
import HpcUtils
14

15
import System.Directory
16
import System.IO (localeEncoding)
17
18
19
import Data.List
import Data.Maybe(fromJust)
import Data.Array
20
import Data.Monoid
21
import Control.Monad
22
import qualified Data.Set as Set
23
24
25

------------------------------------------------------------------------------

Ian Lynagh's avatar
Ian Lynagh committed
26
markup_options :: FlagOptSeq
Ian Lynagh's avatar
Ian Lynagh committed
27
markup_options
28
29
30
31
32
33
34
        = excludeOpt
        . includeOpt
        . srcDirOpt
        . hpcDirOpt
        . funTotalsOpt
        . altHighlightOpt
        . destDirOpt
Ian Lynagh's avatar
Ian Lynagh committed
35
36

markup_plugin :: Plugin
37
markup_plugin = Plugin { name = "markup"
Ian Lynagh's avatar
Ian Lynagh committed
38
39
40
41
42
43
44
                       , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]"
                       , options = markup_options
                       , summary = "Markup Haskell source with program coverage"
                       , implementation = markup_main
                       , init_flags = default_flags
                       , final_flags = default_final_flags
                       }
45
46
47
48
49

------------------------------------------------------------------------------

markup_main :: Flags -> [String] -> IO ()
markup_main flags (prog:modNames) = do
Ian Lynagh's avatar
Ian Lynagh committed
50
51
52
53
  let hpcflags1 = flags
                { includeMods = Set.fromList modNames
                                   `Set.union`
                                includeMods flags }
54
  let Flags
55
       { funTotals = theFunTotals
56
57
58
59
60
61
       , altHighlight = invertOutput
       , destDir = dest_dir
       }  = hpcflags1

  mtix <- readTix (getTixFileName prog)
  Tix tixs <- case mtix of
62
    Nothing -> hpcError markup_plugin $ "unable to find tix file for: " ++ prog
63
64
65
    Just a -> return a

  mods <-
66
     sequence [ genHtmlFromMod dest_dir hpcflags1 tix theFunTotals invertOutput
Ian Lynagh's avatar
Ian Lynagh committed
67
68
69
              | tix <- tixs
              , allowModule hpcflags1 (tixModuleName tix)
              ]
70
71
72
73
74
75

  let index_name = "hpc_index"
      index_fun  = "hpc_index_fun"
      index_alt  = "hpc_index_alt"
      index_exp  = "hpc_index_exp"

Ian Lynagh's avatar
Ian Lynagh committed
76
  let writeSummary filename cmp = do
77
        let mods' = sortBy cmp mods
78

Ian Lynagh's avatar
Ian Lynagh committed
79
        putStrLn $ "Writing: " ++ (filename ++ ".html")
80

Ian Lynagh's avatar
Ian Lynagh committed
81
82
        writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $
            "<html>" ++
83
84
            "<head>" ++
            charEncodingTag ++
Ian Lynagh's avatar
Ian Lynagh committed
85
86
87
88
89
90
91
92
            "<style type=\"text/css\">" ++
            "table.bar { background-color: #f25913; }\n" ++
            "td.bar { background-color: #60de51;  }\n" ++
            "td.invbar { background-color: #f25913;  }\n" ++
            "table.dashboard { border-collapse: collapse  ; border: solid 1px black }\n" ++
            ".dashboard td { border: solid 1px black }\n" ++
            ".dashboard th { border: solid 1px black }\n" ++
            "</style>\n" ++
93
94
            "</head>" ++
            "<body>" ++
Ian Lynagh's avatar
Ian Lynagh committed
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
            "<table class=\"dashboard\" width=\"100%\" border=1>\n" ++
            "<tr>" ++
            "<th rowspan=2><a href=\"" ++ index_name ++ ".html\">module</a></th>" ++
            "<th colspan=3><a href=\"" ++ index_fun ++ ".html\">Top Level Definitions</a></th>" ++
            "<th colspan=3><a href=\"" ++ index_alt ++ ".html\">Alternatives</a></th>" ++
            "<th colspan=3><a href=\"" ++ index_exp ++ ".html\">Expressions</a></th>" ++
            "</tr>" ++
            "<tr>" ++
            "<th>%</th>" ++
            "<th colspan=2>covered / total</th>" ++
            "<th>%</th>" ++
            "<th colspan=2>covered / total</th>" ++
            "<th>%</th>" ++
            "<th colspan=2>covered / total</th>" ++
            "</tr>" ++
            concat [ showModuleSummary (modName,fileName,modSummary)
                   | (modName,fileName,modSummary) <- mods'
                   ] ++
            "<tr></tr>" ++
            showTotalSummary (mconcat
                                 [ modSummary
                                 | (_,_,modSummary) <- mods'
                                 ])
118
                   ++ "</table></body></html>\n"
119
120

  writeSummary index_name  $ \ (n1,_,_) (n2,_,_) -> compare n1 n2
Ian Lynagh's avatar
Ian Lynagh committed
121
122

  writeSummary index_fun $ \ (_,_,s1) (_,_,s2) ->
123
        compare (percent (topFunTicked s2) (topFunTotal s2))
Ian Lynagh's avatar
Ian Lynagh committed
124
                (percent (topFunTicked s1) (topFunTotal s1))
125

Ian Lynagh's avatar
Ian Lynagh committed
126
  writeSummary index_alt $ \ (_,_,s1) (_,_,s2) ->
127
        compare (percent (altTicked s2) (altTotal s2))
Ian Lynagh's avatar
Ian Lynagh committed
128
                (percent (altTicked s1) (altTotal s1))
129

Ian Lynagh's avatar
Ian Lynagh committed
130
  writeSummary index_exp $ \ (_,_,s1) (_,_,s2) ->
131
        compare (percent (expTicked s2) (expTotal s2))
Ian Lynagh's avatar
Ian Lynagh committed
132
                (percent (expTicked s1) (expTotal s1))
133
134


Ian Lynagh's avatar
Ian Lynagh committed
135
markup_main _ []
Ian Lynagh's avatar
Ian Lynagh committed
136
    = hpcError markup_plugin $ "no .tix file or executable name specified"
137

138
139
140
141
142
charEncodingTag :: String
charEncodingTag =
    "<meta http-equiv=\"Content-Type\" " ++
          "content=\"text/html; " ++ "charset=" ++ show localeEncoding ++ "\">"

143
144
genHtmlFromMod
  :: String
145
  -> Flags
146
147
148
149
  -> TixModule
  -> Bool
  -> Bool
  -> IO (String, [Char], ModuleSummary)
150
151
genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
  let theHsPath = srcDirs flags
Ian Lynagh's avatar
Ian Lynagh committed
152
  let modName0 = tixModuleName tix
153

Ian Lynagh's avatar
Ian Lynagh committed
154
  (Mix origFile _ _ tabStop mix') <- readMixWithFlags flags (Right tix)
155
156
157

  let arr_tix :: Array Int Integer
      arr_tix = listArray (0,length (tixModuleTixs tix) - 1)
Ian Lynagh's avatar
Ian Lynagh committed
158
              $ tixModuleTixs tix
159
160

  let tickedWith :: Int -> Integer
Ian Lynagh's avatar
Ian Lynagh committed
161
      tickedWith n = arr_tix ! n
162
163
164
165

      isTicked n = tickedWith n /= 0

  let info = [ (pos,theMarkup)
Ian Lynagh's avatar
Ian Lynagh committed
166
167
168
169
170
171
             | (gid,(pos,boxLabel)) <- zip [0 ..] mix'
             , let binBox = case (isTicked gid,isTicked (gid+1)) of
                               (False,False) -> []
                               (True,False)  -> [TickedOnlyTrue]
                               (False,True)  -> [TickedOnlyFalse]
                               (True,True)   -> []
172
             , let tickBox = if isTicked gid
Ian Lynagh's avatar
Ian Lynagh committed
173
174
175
176
177
178
179
180
181
                             then [IsTicked]
                             else [NotTicked]
             , theMarkup <- case boxLabel of
                                  ExpBox {} -> tickBox
                                  TopLevelBox {}
                                            -> TopLevelDecl theFunTotals (tickedWith gid) : tickBox
                                  LocalBox {}   -> tickBox
                                  BinBox _ True -> binBox
                                  _             -> []
182
183
184
             ]


Ian Lynagh's avatar
Ian Lynagh committed
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
  let modSummary = foldr (.) id
             [ \ st ->
               case boxLabel of
                 ExpBox False
                        -> st { expTicked = ticked (expTicked st)
                              , expTotal = succ (expTotal st)
                              }
                 ExpBox True
                        -> st { expTicked = ticked (expTicked st)
                              , expTotal = succ (expTotal st)
                              , altTicked = ticked (altTicked st)
                              , altTotal = succ (altTotal st)
                              }
                 TopLevelBox _ ->
                           st { topFunTicked = ticked (topFunTicked st)
                              , topFunTotal = succ (topFunTotal st)
                              }
202
                 _ -> st
Ian Lynagh's avatar
Ian Lynagh committed
203
             | (gid,(_pos,boxLabel)) <- zip [0 ..] mix'
204
             , let ticked = if isTicked gid
Ian Lynagh's avatar
Ian Lynagh committed
205
206
                            then succ
                            else id
207
             ] $ mempty
208
209

  -- add prefix to modName argument
andy@galois.com's avatar
andy@galois.com committed
210
  content <- readFileFromPath (hpcError markup_plugin) origFile theHsPath
211
212
213

  let content' = markup tabStop info content
  let show' = reverse . take 5 . (++ "       ") . reverse . show
Ian Lynagh's avatar
Ian Lynagh committed
214
  let addLine n xs = "<span class=\"lineno\">" ++ show' n ++ " </span>" ++ xs
215
216
217
  let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines
  let fileName = modName0 ++ ".hs.html"
  putStrLn $ "Writing: " ++ fileName
218
  writeFileUsing (dest_dir ++ "/" ++ fileName) $
219
220
221
222
            unlines ["<html>",
                     "<head>",
                     charEncodingTag,
                     "<style type=\"text/css\">",
Ian Lynagh's avatar
Ian Lynagh committed
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
                     "span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }",
                     if invertOutput
                     then "span.nottickedoff { color: #404040; background: white; font-style: oblique }"
                     else "span.nottickedoff { background: " ++ yellow ++ "}",
                     if invertOutput
                     then "span.istickedoff { color: black; background: #d0c0ff; font-style: normal; }"
                     else "span.istickedoff { background: white }",
                     "span.tickonlyfalse { margin: -1px; border: 1px solid " ++ red ++ "; background: " ++ red ++ " }",
                     "span.tickonlytrue  { margin: -1px; border: 1px solid " ++ green ++ "; background: " ++ green ++ " }",
                     "span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }",
                     if invertOutput
                     then "span.decl { font-weight: bold; background: #d0c0ff }"
                     else "span.decl { font-weight: bold }",
                     "span.spaces    { background: white }",
                     "</style>",
238
239
240
241
                     "</head>",
                     "<body>",
                     "<pre>"] ++ addLines content' ++ "\n</pre>\n</body>\n</html>\n";

242

Ian Lynagh's avatar
Ian Lynagh committed
243
  modSummary `seq` return (modName0,fileName,modSummary)
244
245

data Loc = Loc !Int !Int
Ian Lynagh's avatar
Ian Lynagh committed
246
         deriving (Eq,Ord,Show)
247

Ian Lynagh's avatar
Ian Lynagh committed
248
249
250
251
data Markup
     = NotTicked
     | TickedOnlyTrue
     | TickedOnlyFalse
252
     | IsTicked
Ian Lynagh's avatar
Ian Lynagh committed
253
254
255
     | TopLevelDecl
           Bool     -- display entry totals
           Integer
256
257
     deriving (Eq,Show)

Ian Lynagh's avatar
Ian Lynagh committed
258
259
260
261
262
markup    :: Int                -- ^tabStop
          -> [(HpcPos,Markup)]  -- random list of tick location pairs
          -> String             -- text to mark up
          -> String
markup tabStop mix str = addMarkup tabStop str (Loc 1 1) [] sortedTickLocs
263
264
  where
    tickLocs = [ (Loc ln1 c1,Loc ln2 c2,mark)
Ian Lynagh's avatar
Ian Lynagh committed
265
266
267
               | (pos,mark) <- mix
               , let (ln1,c1,ln2,c2) = fromHpcPos pos
               ]
268
269
270
    sortedTickLocs = sortBy (\(locA1,locZ1,_) (locA2,locZ2,_) ->
                              (locA1,locZ2) `compare` (locA2,locZ1)) tickLocs

Ian Lynagh's avatar
Ian Lynagh committed
271
272
273
274
275
276
addMarkup :: Int                -- tabStop
          -> String             -- text to mark up
          -> Loc                -- current location
          -> [(Loc,Markup)]     -- stack of open ticks, with closing location
          -> [(Loc,Loc,Markup)] -- sorted list of tick location pairs
          -> String
277
278

-- check the pre-condition.
Ian Lynagh's avatar
Ian Lynagh committed
279
--addMarkup tabStop cs loc os ticks
280
281
--   | not (isSorted (map fst os)) = error $ "addMarkup: bad closing ordering: " ++ show os

Ian Lynagh's avatar
Ian Lynagh committed
282
--addMarkup tabStop cs loc os@(_:_) ticks
283
284
285
286
--   | trace (show (loc,os,take 10 ticks)) False = undefined

-- close all open ticks, if we have reached the end
addMarkup _ [] _loc os [] =
Ian Lynagh's avatar
Ian Lynagh committed
287
  concatMap (const closeTick) os
288
289
290
291
292
293
294
295
addMarkup tabStop cs loc ((o,_):os) ticks | loc > o =
  closeTick ++ addMarkup tabStop cs loc os ticks

--addMarkup tabStop cs loc os ((t1,t2,tik@(TopLevelDecl {})):ticks) | loc == t1 =
--   openTick tik ++ closeTick ++ addMarkup tabStop cs loc os ticks

addMarkup tabStop cs loc os ((t1,t2,tik0):ticks) | loc == t1 =
  case os of
Ian Lynagh's avatar
Ian Lynagh committed
296
297
  ((_,tik'):_)
    | not (allowNesting tik0 tik')
298
299
    -> addMarkup tabStop cs loc os ticks -- already marked or bool within marked bool
  _ -> openTick tik0 ++ addMarkup tabStop cs loc (addTo (t2,tik0) os) ticks
300
 where
301
302

  addTo (t,tik) []             = [(t,tik)]
Ian Lynagh's avatar
Ian Lynagh committed
303
  addTo (t,tik) ((t',tik'):xs) | t <= t'   = (t,tik):(t',tik'):xs
Ian Lynagh's avatar
Ian Lynagh committed
304
                               | otherwise = (t',tik):(t',tik'):xs
305
306

addMarkup tabStop0 cs loc os ((t1,_t2,_tik):ticks) | loc > t1 =
Ian Lynagh's avatar
Ian Lynagh committed
307
308
          -- throw away this tick, because it is from a previous place ??
          addMarkup tabStop0 cs loc os ticks
309

Ian Lynagh's avatar
Ian Lynagh committed
310
311
312
addMarkup tabStop0 ('\n':cs) loc@(Loc ln col) os@((Loc ln2 col2,_):_) ticks
          | ln == ln2 && col < col2
          = addMarkup tabStop0 (' ':'\n':cs) loc os ticks
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
addMarkup tabStop0 (c0:cs) loc@(Loc _ p) os ticks =
  if c0=='\n' && os/=[] then
    concatMap (const closeTick) (downToTopLevel os) ++
    c0 : "<span class=\"spaces\">" ++ expand 1 w ++ "</span>" ++
    concatMap (openTick.snd) (reverse (downToTopLevel os)) ++
    addMarkup tabStop0 cs' loc' os ticks
  else if c0=='\t' then
    expand p "\t" ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks
  else
    escape c0 ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks
  where
  (w,cs') = span (`elem` " \t") cs
  loc' = foldl (flip incBy) loc (c0:w)
  escape '>' = "&gt;"
  escape '<' = "&lt;"
  escape '"' = "&quot;"
  escape '&' = "&amp;"
  escape c  = [c]

  expand :: Int -> String -> String
Ian Lynagh's avatar
Ian Lynagh committed
333
  expand _ ""       = ""
334
335
336
337
338
  expand c ('\t':s) = replicate (c' - c) ' ' ++ expand c' s
    where
    c' = tabStopAfter 8 c
  expand c (' ':s)  = ' ' : expand (c+1) s
  expand _ _        = error "bad character in string for expansion"
Ian Lynagh's avatar
Ian Lynagh committed
339

340
341
342
343
  incBy :: Char -> Loc -> Loc
  incBy '\n' (Loc ln _c) = Loc (succ ln) 1
  incBy '\t' (Loc ln c) = Loc ln (tabStopAfter tabStop0 c)
  incBy _    (Loc ln c) = Loc ln (succ c)
Ian Lynagh's avatar
Ian Lynagh committed
344

345
346
347
  tabStopAfter :: Int -> Int -> Int
  tabStopAfter tabStop c = fromJust (find (>c) [1,(tabStop + 1)..])

Ian Lynagh's avatar
Ian Lynagh committed
348

349
350
351
addMarkup tabStop cs loc os ticks = "ERROR: " ++ show (take 10 cs,tabStop,loc,take 10 os,take 10 ticks)

openTick :: Markup -> String
Ian Lynagh's avatar
Ian Lynagh committed
352
353
354
355
openTick NotTicked       = "<span class=\"nottickedoff\">"
openTick IsTicked        = "<span class=\"istickedoff\">"
openTick TickedOnlyTrue  = "<span class=\"tickonlytrue\">"
openTick TickedOnlyFalse = "<span class=\"tickonlyfalse\">"
356
openTick (TopLevelDecl False _) = openTopDecl
Ian Lynagh's avatar
Ian Lynagh committed
357
358
359
360
361
362
363
364
openTick (TopLevelDecl True 0)
         = "<span class=\"funcount\">-- never entered</span>" ++
           openTopDecl
openTick (TopLevelDecl True 1)
         = "<span class=\"funcount\">-- entered once</span>" ++
           openTopDecl
openTick (TopLevelDecl True n0)
         = "<span class=\"funcount\">-- entered " ++ showBigNum n0 ++ " times</span>" ++ openTopDecl
365
  where showBigNum n | n <= 9999 = show n
Ian Lynagh's avatar
Ian Lynagh committed
366
                     | otherwise = showBigNum' (n `div` 1000) ++ "," ++ showWith (n `mod` 1000)
367
        showBigNum' n | n <= 999 = show n
Ian Lynagh's avatar
Ian Lynagh committed
368
                      | otherwise = showBigNum' (n `div` 1000) ++ "," ++ showWith (n `mod` 1000)
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
        showWith n = take 3 $ reverse $ ("000" ++) $ reverse $ show n

closeTick :: String
closeTick = "</span>"

openTopDecl :: String
openTopDecl = "<span class=\"decl\">"

downToTopLevel :: [(Loc,Markup)] -> [(Loc,Markup)]
downToTopLevel ((_,TopLevelDecl {}):_) = []
downToTopLevel (o : os)               = o : downToTopLevel os
downToTopLevel []                     = []


-- build in logic for nesting bin boxes

Ian Lynagh's avatar
Ian Lynagh committed
385
386
387
388
allowNesting :: Markup  -- innermost
            -> Markup   -- outermost
            -> Bool
allowNesting n m               | n == m = False -- no need to double nest
389
390
allowNesting IsTicked TickedOnlyFalse   = False
allowNesting IsTicked TickedOnlyTrue    = False
Ian Lynagh's avatar
Ian Lynagh committed
391
allowNesting _ _                        = True
392
393
394

------------------------------------------------------------------------------

Ian Lynagh's avatar
Ian Lynagh committed
395
data ModuleSummary = ModuleSummary
396
397
398
399
400
401
402
403
404
405
406
     { expTicked :: !Int
     , expTotal  :: !Int
     , topFunTicked :: !Int
     , topFunTotal  :: !Int
     , altTicked :: !Int
     , altTotal  :: !Int
     }
     deriving (Show)


showModuleSummary :: (String, String, ModuleSummary) -> String
Ian Lynagh's avatar
Ian Lynagh committed
407
showModuleSummary (modName,fileName,modSummary) =
Ian Lynagh's avatar
Ian Lynagh committed
408
409
410
  "<tr>\n" ++
  "<td>&nbsp;&nbsp;<tt>module <a href=\"" ++ fileName ++ "\">"
                              ++ modName ++ "</a></tt></td>\n" ++
Ian Lynagh's avatar
Ian Lynagh committed
411
412
413
   showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++
   showSummary (altTicked modSummary) (altTotal modSummary) ++
   showSummary (expTicked modSummary) (expTotal modSummary) ++
414
415
416
  "</tr>\n"

showTotalSummary :: ModuleSummary -> String
Ian Lynagh's avatar
Ian Lynagh committed
417
showTotalSummary modSummary =
Ian Lynagh's avatar
Ian Lynagh committed
418
  "<tr style=\"background: #e0e0e0\">\n" ++
419
  "<th align=left>&nbsp;&nbsp;Program Coverage Total</tt></th>\n" ++
Ian Lynagh's avatar
Ian Lynagh committed
420
421
422
   showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++
   showSummary (altTicked modSummary) (altTotal modSummary) ++
   showSummary (expTicked modSummary) (expTotal modSummary) ++
423
424
  "</tr>\n"

425
showSummary :: (Integral t, Show t) => t -> t -> String
Ian Lynagh's avatar
Ian Lynagh committed
426
427
428
429
430
431
432
433
showSummary ticked total =
                "<td align=\"right\">" ++ showP (percent ticked total) ++ "</td>" ++
                "<td>" ++ show ticked ++ "/" ++ show total ++ "</td>" ++
                "<td width=100>" ++
                    (case percent ticked total of
                       Nothing -> "&nbsp;"
                       Just w -> bar w "bar"
                     )  ++ "</td>"
434
435
436
     where
        showP Nothing = "-&nbsp;"
        showP (Just x) = show x ++ "%"
Ian Lynagh's avatar
Ian Lynagh committed
437
        bar 0 _     = bar 100 "invbar"
438
        bar w inner = "<table cellpadding=0 cellspacing=0 width=\"100\" class=\"bar\">" ++
Ian Lynagh's avatar
Ian Lynagh committed
439
440
441
                         "<tr><td><table cellpadding=0 cellspacing=0 width=\"" ++ show w ++ "%\">" ++
                              "<tr><td height=12 class=" ++ show inner ++ "></td></tr>" ++
                              "</table></td></tr></table>"
442
443
444
445
446

percent :: (Integral a) => a -> a -> Maybe a
percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total)


447
448
instance Monoid ModuleSummary where
  mempty = ModuleSummary
Ian Lynagh's avatar
Ian Lynagh committed
449
450
                  { expTicked = 0
                  , expTotal  = 0
451
452
453
454
455
456
                  , topFunTicked = 0
                  , topFunTotal  = 0
                  , altTicked = 0
                  , altTotal  = 0
                  }
  mappend (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1)
Ian Lynagh's avatar
Ian Lynagh committed
457
          (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2)
458
459
     = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2)

460

461
462
463
464
465
466
467
468
469
470
471
------------------------------------------------------------------------------

writeFileUsing :: String -> String -> IO ()
writeFileUsing filename text = do
  let dest_dir = reverse . dropWhile (\ x -> x /= '/') . reverse $ filename

-- We need to check for the dest_dir each time, because we use sub-dirs for
-- packages, and a single .tix file might contain information about
-- many package.

  -- create the dest_dir if needed
472
473
  when (not (null dest_dir)) $
    createDirectoryIfMissing True dest_dir
474
475
476

  writeFile filename text

477
478
479
480
481
482
483
484
------------------------------------------------------------------------------
-- global color pallete

red,green,yellow :: String
red    = "#f20913"
green  = "#60de51"
yellow = "yellow"