! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs combinators.smart debugger fry io.encodings.utf8
io.files io.streams.string kernel literals locals mason.common
mason.config mason.disk mason.test math namespaces sequences
xml.syntax xml.writer ;
IN: mason.report

: git-link ( id -- link )
    [ "http://github.com/factor/factor/commit/" "" prepend-as ] keep
    [XML <a href=<->><-></a> XML] ;

: common-report ( -- xml )
    target-os get
    target-cpu get
    short-host-name
    disk-usage
    build-dir
    current-git-id get git-link
    [XML
    <h1>Build report for <->/<-></h1>
    <table>
    <tr><td>Build machine:</td><td><-></td></tr>
    <tr><td>Disk usage:</td><td><-></td></tr>
    <tr><td>Build directory:</td><td><-></td></tr>
    <tr><td>GIT ID:</td><td><-></td></tr>
    </table>
    XML] ;

: with-report ( quot: ( -- xml ) -- )
    [ "report" utf8 ] dip
    '[
        common-report
        _ call( -- xml )
        [XML <div><-><-></div> XML]
        write-xml
    ] with-file-writer ; inline

: file-tail ( file encoding lines -- seq )
    [ file-lines ] dip short tail* "\n" join ;

:: failed-report ( error file what -- status )
    [
        error [ error. ] with-string-writer :> error
        file utf8 400 file-tail :> output

        [XML
        <h2><-what-></h2>
        Build output:
        <pre><-output-></pre>
        Launcher error:
        <pre><-error-></pre>
        XML]
    ] with-report
    status-error ;

: compile-failed ( error -- status )
    "compile-log" "VM compilation failed" failed-report ;

: boot-failed ( error -- status )
    "boot-log" "Bootstrap failed" failed-report ;

: test-failed ( error -- status )
    "test-log" "Tests failed" failed-report ;

: timings-table ( -- xml )
    ${
        boot-time-file
        load-time-file
        test-time-file
        help-lint-time-file
        benchmark-time-file
        html-help-time-file
    } [
        dup eval-file nanos>time
        [XML <tr><td><-></td><td><-></td></tr> XML]
    ] map [XML <h2>Timings</h2> <table><-></table> XML] ;

: error-dump ( heading vocabs-file messages-file -- xml )
    [ eval-file ] dip over empty? [ 3drop f ] [
        [ ]
        [ [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ]
        [ utf8 file-contents ]
        tri*
        [XML <h1><-></h1> <-> Details: <pre><-></pre> XML]
    ] if ;

: benchmarks-table ( assoc -- xml )
    [
        1,000,000,000 /f
        [XML <tr><td><-></td><td><-></td></tr> XML]
    ] { } assoc>map
    [XML
        <h2>Benchmarks</h2>
        <table>
            <tr><th>Benchmark</th><th>Time (seconds)</th></tr>
            <->
        </table>
    XML] ;

: successful-report ( -- )
    [
        [
            timings-table

            "Load failures"
            load-all-vocabs-file
            load-all-errors-file
            error-dump

            "Compiler errors"
            compiler-errors-file
            compiler-error-messages-file
            error-dump

            "Unit test failures"
            test-all-vocabs-file
            test-all-errors-file
            error-dump

            "Help lint failures"
            help-lint-vocabs-file
            help-lint-errors-file
            error-dump

            "Benchmark errors"
            benchmark-error-vocabs-file
            benchmark-error-messages-file
            error-dump

            benchmarks-file eval-file benchmarks-table
        ] output>array sift
    ] with-report ;

: build-clean? ( -- ? )
    ${
        load-all-vocabs-file
        test-all-vocabs-file
        help-lint-vocabs-file
        compiler-errors-file
        benchmark-error-vocabs-file
    } [ eval-file empty? ] all? ;

: success ( -- status )
    successful-report build-clean? status-clean status-dirty ? ;