steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Update JSON writer for inheritance

db4
Slava Pestov 2008-03-30 08:16:19 -05:00
parent 8bc2589a7a
commit df8dabaf5e
1 changed files with 6 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
extra/json/writer/writer.factor
View File

@ -26,32 +26,27 @@ M: number json-print ( num -- )
M: integer json-print ( num -- ) M: integer json-print ( num -- )
number>string write ; number>string write ;
M: sequence json-print ( array -- string ) M: sequence json-print ( array -- )
CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ; CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ;
: (jsvar-encode) ( char -- char )
#! Convert the given character to a character usable in
#! javascript variable names.
dup H{ { CHAR: - CHAR: _ } } at dup [ nip ] [ drop ] if ;
: jsvar-encode ( string -- string ) : jsvar-encode ( string -- string )
#! Convert the string so that it contains characters usable within #! Convert the string so that it contains characters usable within
#! javascript variable names. #! javascript variable names.
[ (jsvar-encode) ] map ; { { CHAR: - CHAR: _ } } substitute ;
: tuple>fields ( object -- string ) : tuple>fields ( object -- seq )
<mirror> [ <mirror> [
[ swap jsvar-encode >json % " : " % >json % ] "" make [ swap jsvar-encode >json % " : " % >json % ] "" make
] { } assoc>map ; ] { } assoc>map ;
M: tuple json-print ( tuple -- string ) M: tuple json-print ( tuple -- )
CHAR: { write1 tuple>fields "," join write CHAR: } write1 ; CHAR: { write1 tuple>fields "," join write CHAR: } write1 ;
M: hashtable json-print ( hashtable -- string ) M: hashtable json-print ( hashtable -- )
CHAR: { write1 CHAR: { write1
[ [ swap jsvar-encode >json % CHAR: : , >json % ] "" make ] [ [ swap jsvar-encode >json % CHAR: : , >json % ] "" make ]
{ } assoc>map "," join write { } assoc>map "," join write
CHAR: } write1 ; CHAR: } write1 ;
M: object json-print ( object -- string ) M: object json-print ( object -- )
unparse json-print ; unparse json-print ;