extra/mason/report/report.factor

   1 ! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: benchmark combinators.smart debugger fry io assocs
   4 io.encodings.utf8 io.files io.sockets io.streams.string kernel
   5 locals mason.common mason.config mason.platform math namespaces
   6 prettyprint sequences xml.syntax xml.writer ;
   7 IN: mason.report
   8
   9 : common-report ( -- xml )
  10     target-os get
  11     target-cpu get
  12     host-name
  13     build-dir
  14     "git-id" eval-file
  15     [XML
  16     <h1>Build report for <->/<-></h1>
  17     <table>
  18     <tr><td>Build machine:</td><td><-></td></tr>
  19     <tr><td>Build directory:</td><td><-></td></tr>
  20     <tr><td>GIT ID:</td><td><-></td></tr>
  21     </table>
  22     XML] ;
  23
  24 : with-report ( quot -- )
  25     [ "report" utf8 ] dip
  26     '[
  27         common-report
  28         _ call( -- xml )
  29         [XML <html><body><-><-></body></html> XML]
  30         pprint-xml
  31     ] with-file-writer ; inline
  32
  33 :: failed-report ( error file what -- )
  34     [
  35         error [ error. ] with-string-writer :> error
  36         file utf8 file-contents 400 short tail* :> output
  37
  38         [XML
  39         <h2><-what-></h2>
  40         Build output:
  41         <pre><-output-></pre>
  42         Launcher error:
  43         <pre><-error-></pre>
  44         XML]
  45     ] with-report ;
  46
  47 : compile-failed-report ( error -- )
  48     "compile-log" "VM compilation failed" failed-report ;
  49
  50 : boot-failed-report ( error -- )
  51     "boot-log" "Bootstrap failed" failed-report ;
  52
  53 : test-failed-report ( error -- )
  54     "test-log" "Tests failed" failed-report ;
  55
  56 : timings-table ( -- xml )
  57     {
  58         boot-time-file
  59         load-time-file
  60         test-time-file
  61         help-lint-time-file
  62         benchmark-time-file
  63         html-help-time-file
  64     } [
  65         dup utf8 file-contents milli-seconds>time
  66         [XML <tr><td><-></td><td><-></td></tr> XML]
  67     ] map [XML <h2>Timings</h2> <table><-></table> XML] ;
  68
  69 : fail-dump ( heading vocabs-file messages-file -- xml )
  70     [ eval-file ] dip over empty? [ 3drop f ] [
  71         [ ]
  72         [ [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ]
  73         [ utf8 file-contents ]
  74         tri*
  75         [XML <h1><-></h1> <-> Details: <pre><-></pre> XML]
  76     ] if ;
  77
  78 : benchmarks-table ( assoc -- xml )
  79     [
  80         1000000 /f
  81         [XML <tr><td><-></td><td><-></td></tr> XML]
  82     ] { } assoc>map [XML <h2>Benchmarks</h2> <table><-></table> XML] ;
  83
  84 : successful-report ( -- )
  85     [
  86         [
  87             timings-table
  88
  89             "Load failures"
  90             load-everything-vocabs-file
  91             load-everything-errors-file
  92             fail-dump
  93
  94             "Compiler warnings and errors"
  95             compiler-errors-file
  96             compiler-error-messages-file
  97             fail-dump
  98
  99             "Unit test failures"
 100             test-all-vocabs-file
 101             test-all-errors-file
 102             fail-dump
 103
 104             "Help lint failures"
 105             help-lint-vocabs-file
 106             help-lint-errors-file
 107             fail-dump
 108
 109             "Benchmark errors"
 110             benchmark-error-vocabs-file
 111             benchmark-error-messages-file
 112             fail-dump
 113
 114             "Benchmark timings"
 115             benchmarks-file eval-file benchmarks-table
 116         ] output>array
 117     ] with-report ;