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

json.writer: support escaping unicode > 0x10000. Thanks @jonenst!

db4
John Benediktsson 2015-01-03 08:30:26 -08:00
parent ee8be0a8dd
commit 1ec43d7913
2 changed files with 28 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/json/writer/writer-tests.factor
View File

@ -68,3 +68,6 @@ TUPLE: person first-name age ;
"\0\x01\x02\x03\x04\x05\x06\a\b\t\n\v\f\r\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\e\x1c\x1d\x1e\x1f" "\0\x01\x02\x03\x04\x05\x06\a\b\t\n\v\f\r\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\e\x1c\x1d\x1e\x1f"
>json >json
] unit-test ] unit-test
{ "\"\\ud834\\udd1e\"" }
[ t json-escape-unicode? [ "𝄞" >json ] with-variable ] unit-test

32
basis/json/writer/writer.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors ascii assocs combinators fry hashtables io USING: accessors ascii assocs combinators formatting fry
io.streams.string json kernel locals math math.parser mirrors hashtables io io.encodings.utf16.private io.streams.string json
namespaces sequences strings tr words ; kernel locals math math.parser mirrors namespaces sequences
strings tr words ;
IN: json.writer IN: json.writer
SYMBOL: json-allow-fp-special? SYMBOL: json-allow-fp-special?
@ -39,6 +40,26 @@ M: t stream-json-print
M: json-null stream-json-print M: json-null stream-json-print
[ drop "null" ] [ stream-write ] bi* ; [ drop "null" ] [ stream-write ] bi* ;
<PRIVATE
: json-print-generic-escape-surrogate-pair ( stream char -- stream )
0x10000 - [ encode-first ] [ encode-second ] bi
"\\u%x%x\\u%x%x" sprintf over stream-write ;
: json-print-generic-escape-bmp ( stream char -- stream )
"\\u" pick stream-write
>hex 4 CHAR: 0 pad-head
over stream-write ;
: json-print-generic-escape ( stream char -- stream )
dup 0xffff > [
json-print-generic-escape-surrogate-pair
] [
json-print-generic-escape-bmp
] if ;
PRIVATE>
M: string stream-json-print M: string stream-json-print
CHAR: " over stream-write1 swap [ CHAR: " over stream-write1 swap [
{ {
@ -62,10 +83,7 @@ M: string stream-json-print
{ [ dup control? ] [ t ] } { [ dup control? ] [ t ] }
[ json-escape-unicode? get ] [ json-escape-unicode? get ]
} cond [ } cond [
dup 0xffff > [ json-error ] when json-print-generic-escape
"\\u" pick stream-write
>hex 4 CHAR: 0 pad-head
over stream-write
] [ ] [
over stream-write1 over stream-write1
] if ] if