R3 FORM/MOLD table generator.

form-mold-test-gen.r

REBOL []

; alphabetical datatype listing
; set 'datatype-single-test-values compose [
;     action!     (:add)
;     binary!     #{}
;     bitset!     #[bitset! #{}]
;     block!      []
;     char!       #"A"
;     closure!    (closure [a b] [])
;     datatype!   #[datatype! action!]
;     date!       1-jan-2000
;     decimal!    1.5
;     email!      [email protected]
;     end!        NA
;     error!      (make error! "") ;(disarm try [make error! ""])
;     event!      NA
;     file!       %""
;     frame!      NA
;     function!   (func [a b] [])
;     get-path!   :a/b/c
;     get-word!   :test
;     gob!        (make gob! [])
;     handle!     NA
;     image!      (make image! 1x1)
;     integer!    1
;     issue!      #abc
;     library!     NA
;     lit-path!   'a/b/c
;     lit-word!   'test
;     logic!      (false)
;     map!        (make map! [])
;     module!     NA
;     money!      $0.01
;     native!     NA
;     none!       #[none]
;     object!     (context [a: b: none])
;     op!         (:+)
;     pair!       1x1
;     paren!      (to paren! [])
;     path!       a/b/c
;     percent!    1%
;     port!       NA
;     rebcode!    NA
;     refinement! /test
;     routine!    NA
;     set-path!   a/b/c:
;     set-word!   test:
;     string!     "abc"
;     struct!     NA
;     tag!         <abc>
;     task!       NA
;     time!       0:0:1
;     tuple!      0.0.1
;     typeset!    (make typeset! [scalar! tag!])
;     unset!      (make unset! none)    'unset-placeholder ; compose eliminates the unset val
;     url!        http://abc
;     utype!      NA
;     vector!     (make vector! 10)
;     word!       test
; ]
;insert next find datatype-single-test-values 'unset! ()

; system/catalog/datatypes order
set 'datatype-single-test-values compose [
    end!        NA
    unset!      (make unset! none)    'unset-placeholder ; compose eliminates the unset val
    none!       #[none]
    logic!      (false)
    integer!    1
    decimal!    1.5
    percent!    1%
    money!      $0.01
    char!       #"A"
    pair!       1x1
    tuple!      0.0.1
    time!       0:0:1
    date!       1-jan-2000
    binary!     #{}
    string!     "abc"
    file!       %""
    email!      [email protected]
    url!        http://abc
    tag!         <abc>
    bitset!     #[bitset! #{}]
    image!      (make image! 1x1)
    vector!     (make vector! 10)
    block!      []
    paren!      (to paren! [])
    path!       a/b/c
    set-path!   a/b/c:
    get-path!   :a/b/c
    lit-path!   'a/b/c
    map!        (make map! [])
    datatype!   #[datatype! action!]
    typeset!    (make typeset! [scalar! tag!])
    word!       test
    set-word!   test:
    get-word!   :test
    lit-word!   'test
    refinement! /test
    issue!      #abc

    native!     NA
    action!     (:add)
    rebcode!    NA
    command!    NA
    op!         (:+)

    closure!    (closure [a b] [])
    function!   (func [a b] [])
    frame!      NA
    object!     (context [a: b: none])
    module!     NA
    error!      (make error! "") ;(disarm try [make error! ""])
    task!       NA
    port!       NA

    gob!        (make gob! [])
    event!      NA
    handle!     NA

    library!    NA
    struct!     NA
    utype!      NA
]


;---------------------------------------------------------------------------    
; replace didn't work correctly under R3 when this was first written, but 
; maybe it does now.
html-ize: func [value] [
    replace/all value "<" "&lt;"
    replace/all value ">" "&gt;"
]
;html-ize: func [value] [:value]

use [format-base mold-all ops op-names] [    

    format-val: func [value] [format [] :value]
    mold-all: func [value] [mold/all :value]
    
    ops: [to-string form mold mold-all format-val]
    op-names: [to-string form mold "mold/all" format]
    
    set 'generate-all-form-tables func [
        /local buff tbl file ops
    ][
        buff: copy ""
        if not exists? %form/ [make-dir/deep %form/]
;             foreach word ops [
;                 file: rejoin [%form/ file %.tbl]
;                 print [mold :word tab mold file]
;                 append buff tbl: generate-form-table word
;                 append buff crlf
;                 attempt [delete file]
;                 write file tbl
;             ] 
        append buff tbl: generate-form-table
        print ""
        attempt [delete %form/_all-tables.html]
        write %form/_all-tables.html buff
        buff
    ]
    
    set 'generate-form-table func [
        /local emit res buff test-val-avail? get-test-val
    ][
        test-val-avail?: func [type] [find/skip datatype-single-test-values to word! type 2]
        get-test-val: func [type] [select datatype-single-test-values to word! type]
        buff: copy ""
        emit: func [line] [append buff reform [line crlf]]
        
        emit reduce [<h3> "String conversions" </h3>]
        emit <table border=0 cellspacing=1 cellpadding=5 bgcolor=gray>
        emit <tr>
        emit [<th> </th>] ; cell at 0x0
        foreach op op-names [emit reduce [<th> form op </th>]]
        emit </tr>    
    
        ct: 0
        foreach [type val] datatype-single-test-values [
            emit <tr bgcolor=white>
            if test-val-avail? type [
                emit reduce [<th> form type </th>]
            ]
            foreach op ops [
                if test-val-avail? type [
                    error? set/any 'res try [do reduce [op first [:val]]]
                    emit reduce [<td> either error? get/any 'res [mold #ERR] [html-ize res] </td>]
                ]
            ]
            emit </tr>
        ]
        emit </table>
        emit <br>
        buff
    ]
    
]


generate-all-form-tables