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 combinators.short-circuit
   7 literals ;
   8 IN: mason.report
   9
  10 : common-report ( -- xml )
  11     target-os get
  12     target-cpu get
  13     host-name
  14     build-dir
  15     current-git-id get
  16     [XML
  17     <h1>Build report for <->/<-></h1>
  18     <table>
  19     <tr><td>Build machine:</td><td><-></td></tr>
  20     <tr><td>Build directory:</td><td><-></td></tr>
  21     <tr><td>GIT ID:</td><td><-></td></tr>
  22     </table>
  23     XML] ;
  24
  25 : with-report ( quot -- )
  26     [ "report" utf8 ] dip
  27     '[
  28         common-report
  29         _ call( -- xml )
  30         [XML <html><body><-><-></body></html> XML]
  31         write-xml
  32     ] with-file-writer ; inline
  33
  34 : file-tail ( file encoding lines -- seq )
  35     [ file-lines ] dip short tail* "\n" join ;
  36
  37 :: failed-report ( error file what -- status )
  38     [
  39         error [ error. ] with-string-writer :> error
  40         file utf8 400 file-tail :> output
  41
  42         [XML
  43         <h2><-what-></h2>
  44         Build output:
  45         <pre><-output-></pre>
  46         Launcher error:
  47         <pre><-error-></pre>
  48         XML]
  49     ] with-report
  50     status-error ;
  51
  52 : compile-failed ( error -- status )
  53     "compile-log" "VM compilation failed" failed-report ;
  54
  55 : boot-failed ( error -- status )
  56     "boot-log" "Bootstrap failed" failed-report ;
  57
  58 : test-failed ( error -- status )
  59     "test-log" "Tests failed" failed-report ;
  60
  61 : timings-table ( -- xml )
  62     ${
  63         boot-time-file
  64         load-time-file
  65         test-time-file
  66         help-lint-time-file
  67         benchmark-time-file
  68         html-help-time-file
  69     } [
  70         dup eval-file milli-seconds>time
  71         [XML <tr><td><-></td><td><-></td></tr> XML]
  72     ] map [XML <h2>Timings</h2> <table><-></table> XML] ;
  73
  74 : error-dump ( heading vocabs-file messages-file -- xml )
  75     [ eval-file ] dip over empty? [ 3drop f ] [
  76         [ ]
  77         [ [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ]
  78         [ utf8 file-contents ]
  79         tri*
  80         [XML <h1><-></h1> <-> Details: <pre><-></pre> XML]
  81     ] if ;
  82
  83 : benchmarks-table ( assoc -- xml )
  84     [
  85         1000000 /f
  86         [XML <tr><td><-></td><td><-></td></tr> XML]
  87     ] { } assoc>map [XML <h2>Benchmarks</h2> <table><-></table> XML] ;
  88
  89 : successful-report ( -- )
  90     [
  91         [
  92             timings-table
  93
  94             "Load failures"
  95             load-all-vocabs-file
  96             load-all-errors-file
  97             error-dump
  98
  99             "Compiler errors"
 100             compiler-errors-file
 101             compiler-error-messages-file
 102             error-dump
 103
 104             "Unit test failures"
 105             test-all-vocabs-file
 106             test-all-errors-file
 107             error-dump
 108
 109             "Help lint failures"
 110             help-lint-vocabs-file
 111             help-lint-errors-file
 112             error-dump
 113
 114             "Benchmark errors"
 115             benchmark-error-vocabs-file
 116             benchmark-error-messages-file
 117             error-dump
 118
 119             benchmarks-file eval-file benchmarks-table
 120         ] output>array
 121     ] with-report ;
 122
 123 : build-clean? ( -- ? )
 124     ${
 125         load-all-vocabs-file
 126         test-all-vocabs-file
 127         help-lint-vocabs-file
 128         compiler-errors-file
 129         benchmark-error-vocabs-file
 130     } [ eval-file empty? ] all? ;
 131
 132 : success ( -- status )
 133     successful-report build-clean? status-clean status-dirty ? ;