extra/mason/report/report.factor

   1 ! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs combinators.smart debugger formatting
   4 io.encodings.utf8 io.files io.streams.string kernel literals
   5 mason.common mason.config mason.disk math namespaces sequences
   6 splitting xml.syntax xml.writer ;
   7 IN: mason.report
   8
   9 : git-link ( id -- link )
  10     [ "http://github.com/factor/factor/commit/" "" prepend-as ] keep
  11     [XML <a href=<->><-></a> XML] ;
  12
  13 : common-report ( -- xml )
  14     target-os get
  15     target-cpu get
  16     short-host-name
  17     disk-usage
  18     build-dir
  19     current-git-id get git-link
  20     [XML
  21     <h1>Build report for <->/<-></h1>
  22     <table>
  23     <tr><td>Build machine:</td><td><-></td></tr>
  24     <tr><td>Disk usage:</td><td><-></td></tr>
  25     <tr><td>Build directory:</td><td><-></td></tr>
  26     <tr><td>GIT ID:</td><td><-></td></tr>
  27     </table>
  28     XML] ;
  29
  30 : with-report ( quot: ( -- xml ) -- )
  31     [ "report" utf8 ] dip
  32     '[
  33         common-report
  34         _ call( -- xml )
  35         [XML <div><-><-></div> XML]
  36         write-xml
  37     ] with-file-writer ; inline
  38
  39 : file-tail ( file encoding lines -- seq )
  40     [ file-lines ] dip cramp tail* join-lines ;
  41
  42 :: failed-report ( error file what -- status )
  43     [
  44         error [ error. ] with-string-writer :> error
  45         file utf8 400 file-tail :> output
  46
  47         [XML
  48         <h2><-what-></h2>
  49         Build output:
  50         <pre><-output-></pre>
  51         Launcher error:
  52         <pre><-error-></pre>
  53         XML]
  54     ] with-report
  55     status-error ;
  56
  57 : compile-failed ( error -- status )
  58     "compile-log" "VM compilation failed" failed-report ;
  59
  60 : boot-failed ( error -- status )
  61     "boot-log" "Bootstrap failed" failed-report ;
  62
  63 : test-failed ( error -- status )
  64     "test-log" "Tests failed" failed-report ;
  65
  66 : timings-table ( -- xml )
  67     ${
  68         boot-time-file
  69         load-time-file
  70         test-time-file
  71         help-lint-time-file
  72         benchmark-time-file
  73         html-help-time-file
  74     } [
  75         dup eval-file nanos>time
  76         [XML <tr><td><-></td><td><-></td></tr> XML]
  77     ] map [XML <h2>Timings</h2> <table><-></table> XML] ;
  78
  79 : error-dump ( heading vocabs-file messages-file -- xml )
  80     [ eval-file ] dip over empty? [ 3drop f ] [
  81         [ ]
  82         [ [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ]
  83         [ utf8 file-contents ]
  84         tri*
  85         [XML <h1><-></h1> <-> Details: <pre><-></pre> XML]
  86     ] if ;
  87
  88 : benchmarks-table ( assoc -- xml )
  89     [
  90         1,000,000,000 /f "%.3f" sprintf
  91         [XML <tr><td><-></td><td><-></td></tr> XML]
  92     ] { } assoc>map
  93     [XML
  94         <h2>Benchmarks</h2>
  95         <table>
  96             <tr><th>Benchmark</th><th>Time (seconds)</th></tr>
  97             <->
  98         </table>
  99     XML] ;
 100
 101 : successful-report ( -- )
 102     [
 103         [
 104             timings-table
 105
 106             "Load failures"
 107             load-all-vocabs-file
 108             load-all-errors-file
 109             error-dump
 110
 111             "Compiler errors"
 112             compiler-errors-file
 113             compiler-error-messages-file
 114             error-dump
 115
 116             "Unit test failures"
 117             test-all-vocabs-file
 118             test-all-errors-file
 119             error-dump
 120
 121             "Help lint failures"
 122             help-lint-vocabs-file
 123             help-lint-errors-file
 124             error-dump
 125
 126             "Benchmark errors"
 127             benchmark-error-vocabs-file
 128             benchmark-error-messages-file
 129             error-dump
 130
 131             benchmarks-file eval-file benchmarks-table
 132         ] output>array sift
 133     ] with-report ;
 134
 135 : build-clean? ( -- ? )
 136     ${
 137         load-all-vocabs-file
 138         test-all-vocabs-file
 139         help-lint-vocabs-file
 140         compiler-errors-file
 141         benchmark-error-vocabs-file
 142     } [ eval-file empty? ] all? ;
 143
 144 : success ( -- status )
 145     successful-report build-clean? status-clean status-dirty ? ;