-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.2 2000/03/01 18:38:45 keithw Exp $
+-- $Id: Main.hs,v 1.5 2001/02/21 16:24:34 simonmar Exp $
-- (c) Simon Marlow 1997-1999
-----------------------------------------------------------------------------
import GenUtils
import Printf
import Slurp
-import DataHtml
import CmdLine
+import Html hiding ((!))
import GlaExts
import FiniteMap
import GetOpt
import System
import List
+(<!) = (Html.!)
+
-----------------------------------------------------------------------------
-- Top level stuff
-----------------------------------------------------------------------------
-- HTML page generation
+--htmlPage :: Results -> [String] -> Html
htmlPage results args
- = header [] (theTitle [] (htmlStr "NoFib Results"))
- +++ bar []
+ = header << thetitle << reportTitle
+ +++ hr
+ +++ h1 << reportTitle
+++ gen_menu
- +++ bar []
- +++ body [] (gen_tables results args)
+ +++ hr
+ +++ body (gen_tables results args)
-gen_menu = ul [] (foldr1 (+++) (map (li [] +++)
- (map (prog_menu_item) per_prog_result_tab
- ++ map (module_menu_item) per_module_result_tab)))
+gen_menu = unordList (map (prog_menu_item) per_prog_result_tab
+ ++ map (module_menu_item) per_module_result_tab)
-prog_menu_item (SpecP name anc _ _ _) = anchor [href ('#':anc)] (htmlStr name)
-module_menu_item (SpecM name anc _ _) = anchor [href ('#':anc)] (htmlStr name)
+prog_menu_item (SpecP name anc _ _ _) = anchor <! [href ('#':anc)] << name
+module_menu_item (SpecM name anc _ _) = anchor <! [href ('#':anc)] << name
gen_tables results args =
foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab)
+++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab)
htmlGenProgTable results args (SpecP title anc get_result get_status result_ok)
- = sectHeading title anc
- +++ font [size 1] (
- mkTable (htmlShowResults results args get_result get_status result_ok))
- +++ bar []
+ = sectHeading title anc
+ +++ font <! [size "1"]
+ << mkTable (htmlShowResults results args get_result get_status result_ok)
+ +++ hr
htmlGenModTable results args (SpecM title anc get_result result_ok)
= sectHeading title anc
- +++ font [size 1] (
- mkTable (htmlShowMultiResults results args get_result result_ok))
- +++ bar []
+ +++ font <![size "1"]
+ << mkTable (htmlShowMultiResults results args get_result result_ok)
+ +++ hr
sectHeading :: String -> String -> Html
-sectHeading s nm
- = h2 [] (anchor [name nm] (htmlStr s))
+sectHeading s nm = h2 << anchor <! [name nm] << s
htmlShowResults
:: Result a
htmlShowResults (r:rs) ss f stat result_ok
= tabHeader ss
- +/+ foldr1 (+/+) (zipWith tableRow [1..] results_per_prog)
- +/+ foldr1 (+/+) (tableRow (-1) ("Average", gms)
- : if nodevs then []
- else [tableRow (-1) ("-1 s.d.", lows),
- tableRow (-1) ("+1 s.d.", highs)])
+ </> aboves (zipWith tableRow [1..] results_per_prog)
+ </> aboves ((if nodevs then []
+ else [tableRow (-1) ("-1 s.d.", lows),
+ tableRow (-1) ("+1 s.d.", highs)])
+ ++ [tableRow (-1) ("Average", gms)])
where
-- results_per_prog :: [ (String,[BoxValue a]) ]
results_per_prog = map (calc_result rs f stat result_ok) (fmToList r)
htmlShowMultiResults (r:rs) ss f result_ok =
multiTabHeader ss
- +/+ foldr1 (+/+) (map show_results_for_prog results_per_prog_mod_run)
- +/+ foldr1 (+/+) ((cellHtml [] (bold [] (htmlStr "Average"))
- +-+ tableRow (-1) ("", gms))
- : if nodevs then []
- else [(cellHtml [] (bold [] (htmlStr "-1 s.d.")))
- +-+ tableRow (-1) ("", lows),
- (cellHtml [] (bold [] (htmlStr "+1 s.d.")))
- +-+ tableRow (-1) ("", highs)])
+ </> aboves (map show_results_for_prog results_per_prog_mod_run)
+ </> aboves ((if nodevs then []
+ else [td << bold << "-1 s.d."
+ <-> tableRow (-1) ("", lows),
+ td << bold << "+1 s.d."
+ <-> tableRow (-1) ("", highs)])
+ ++ [td << bold << "Average"
+ <-> tableRow (-1) ("", gms)])
+
where
base_results = fmToList r :: [(String,Results)]
result_ok (id,attr)
show_results_for_prog (prog,mrs) =
- cellHtml [valign "top"] (bold [] (htmlStr prog))
- +-+ (if null mrs then
- cellHtml [] (htmlStr "(no modules compiled)")
+ td <! [valign "top"] << bold << prog
+ <-> (if null mrs then
+ td << "(no modules compiled)"
else
- foldr1 (+/+) (map (tableRow 0) mrs))
+ toHtml (aboves (map (tableRow 0) mrs)))
results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run,
(_,xs) <- mods]
tableRow :: Result a => Int -> (String, [BoxValue a]) -> HtmlTable
tableRow row_no (prog, results)
- = cellHtml [bgcolor left_column_color] (htmlStr prog)
- +-+ foldr1 (+-+) (map (cellHtml [align "right", clr]
- . htmlStr . show_box) results)
+ = td <! [bgcolor left_column_color] << prog
+ <-> besides (map (\s -> td <! [align "right", clr] << show_box s)
+ results)
where clr | row_no < 0 = bgcolor average_row_color
| even row_no = bgcolor even_row_color
| otherwise = bgcolor odd_row_color
-}
logHeaders ss
- = foldr1 (+-+) (map (\s -> cellHtml [align "right", width "100"]
- (bold [] (htmlStr s))) ss)
+ = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss)
-mkTable :: HtmlTable -> Html
-mkTable = renderTable [cellspacing 0, cellpadding 0, border 0]
+mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
tabHeader ss
- = cellHtml [align "left", width "100"] (bold [] (htmlStr "Program"))
- +-+ logHeaders ss
+ = (td <! [align "left", width "100"] << bold << "Program")
+ <-> logHeaders ss
multiTabHeader ss
- = cellHtml [align "left", width "100"] (bold [] (htmlStr "Program"))
- +-+ cellHtml [align "left", width "100"] (bold [] (htmlStr "Module"))
- +-+ logHeaders ss
+ = (td <! [align "left", width "100"] << bold << "Program")
+ <-> (td <! [align "left", width "100"] << bold << "Module")
+ <-> logHeaders ss
-- Calculate a color ranging from bright blue for -100% to bright red for +100%.
-- ASCII page generation
asciiPage results args =
- ( interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab)
+ ( str reportTitle
+ . str "\n\n"
+ . interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab)
. str "\n"
. interleave "\n\n" (map (asciiGenModTable results args) per_module_result_tab)
) "\n"
ascii_show_results (r:rs) ss f stat result_ok
= ascii_header ss
. interleave "\n" (map show_per_prog_results results_per_prog)
- . str "\n"
- . show_per_prog_results ("Average",gms)
. if nodevs then id
else str "\n"
. show_per_prog_results ("-1 s.d.",lows)
. str "\n"
. show_per_prog_results ("+1 s.d.",highs)
+ . str "\n"
+ . show_per_prog_results ("Average",gms)
where
-- results_per_prog :: [ (String,[BoxValue a]) ]
results_per_prog = map (calc_result rs f stat result_ok) (fmToList r)
= ascii_header ss
. interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
. str "\n"
- . str "\n"
- . show_per_prog_results ("Average",gms)
. if nodevs then id
else str "\n"
. show_per_prog_results ("-1 s.d.",lows)
. str "\n"
. show_per_prog_results ("+1 s.d.",highs)
+ . str "\n"
+ . show_per_prog_results ("Average",gms)
where
base_results = fmToList r :: [(String,Results)]