! Copyright (C) 2008, 2009 Alex Chapman
! See https://factorcode.org/license.txt for BSD license.
USING: accessors assocs continuations debugger hashtables http
-http.client io io.encodings.string io.encodings.utf8 json.reader
-json.writer kernel make math math.parser namespaces sequences
-strings urls.encoding vectors ;
+http.client io io.encodings.string io.encodings.utf8 json kernel
+make math math.parser namespaces sequences strings urls.encoding
+vectors ;
IN: couchdb
-! NOTE: This code only works with the latest couchdb (0.9.*), because old
-! versions didn't provide the /_uuids feature which this code relies on when
-! creating new documents.
+! NOTE: This code only works with the latest couchdb (0.9.*),
+! because old versions didn't provide the /_uuids feature which
+! this code relies on when creating new documents.
SYMBOL: couch
: with-couch ( db quot -- )
{ "substitute" { "regexp.classes:(substitute)" "0.99" } }
{ "combine" { "sets:union-all" "0.99" } }
{ "refine" { "sets:intersect-all" "0.99" } }
- { "read-json-objects" { "json.reader:read-json" "0.99" } }
+ { "read-json-objects" { "json:read-json" "0.99" } }
{ "init-namespaces" { "namespaces:init-namestack" "0.99" } }
{ "iota" { "sequences:<iota>" ".98" } }
{ "git-checkout-existing-branch" { "git-checkout-existing" "0.99" } }
USING: accessors assocs furnace.actions furnace.conversations
html.forms html.templates.chloe.compiler
html.templates.chloe.syntax http.client http.server
-http.server.filters io.sockets json.reader kernel namespaces
-urls validators xml.syntax ;
+http.server.filters io.sockets json kernel namespaces urls
+validators xml.syntax ;
IN: furnace.recaptcha
TUPLE: recaptcha < filter-responder domain secret-key site-key ;
Chris Double
Peter Burns
+Philipp Winkler
+USING: help.markup help.syntax kernel ;
IN: json
-USING: help.markup help.syntax ;
+
+HELP: json>
+{ $values { "string" "a string in JSON format" } { "object" "a deserialized object" } }
+{ $description "Deserializes the JSON formatted string into a Factor object. JSON objects are converted to Factor hashtables. All other JSON objects convert to their obvious Factor equivalents." } ;
+
+HELP: read-json
+{ $values { "objects" { $sequence "deserialized objects" } } }
+{ $description "Reads JSON formatted strings into a vector of Factor object until the end of the stream is reached. JSON objects are converted to Factor hashtables. All other JSON objects convert to their obvious Factor equivalents." } ;
+
+HELP: path>json
+{ $values
+ { "path" "a pathname string" }
+ { "json" "a JSON object" }
+}
+{ $description "Reads a file into a single JSON object. Throws an error if the file contains more than one json." } ;
+{ path>json path>jsons } related-words
+
+HELP: path>jsons
+{ $values
+ { "path" "a pathname string" }
+ { "jsons" { $sequence "JSON objects" } }
+}
+{ $description "Reads a file into a sequence of JSON objects and returns them all." } ;
+
+HELP: >json
+{ $values { "obj" object } { "string" "the object converted to JSON format" } }
+{ $description "Serializes the object into a JSON formatted string." }
+{ $see-also json-print } ;
+
+HELP: json-print
+{ $values { "obj" object } }
+{ $description "Serializes the object into a JSON formatted string and outputs it to the standard output stream."
+$nl
+"Some options can control the formatting of the result:"
+{ $table
+ { { $link json-allow-fp-special? } "Allow special floating-points: NaN, Infinity, -Infinity" }
+ { { $link json-friendly-keys? } { "Convert " { $snippet "-" } " to " { $snippet "_" } " in tuple slots and hashtable keys" } }
+ { { $link json-coerce-keys? } "Coerce hashtable keys into strings" }
+ { { $link json-escape-slashes? } "Escape forward slashes inside strings" }
+ { { $link json-escape-unicode? } "Escape unicode values inside strings" }
+}
+}
+{ $see-also >json } ;
+
+{ json-fp-special-error json-allow-fp-special? } related-words
+
+HELP: json-fp-special-error
+{ $error-description "Thrown by " { $link "json" } " when attempting to serialize -1/0. or +1/0. or NaN when " { $link json-allow-fp-special? } " is not enabled." } ;
ARTICLE: "json" "JSON serialization"
+"The " { $vocab-link "json" } " vocabulary defines words for working with JSON (JavaScript Object Notation) formats."
+$nl
+"Parsing strings in JSON format."
+{ $subsections
+ json>
+ read-json
+ path>json
+ path>jsons
+}
+"Converting objects to JSON format."
+{ $subsections
+ >json
+ json-print
+}
+"Working with JSON null values:"
{ $subsections
- "json.reader"
- "json.writer"
-} ;
+ json-null?
+ if-json-null
+ when-json-null
+ unless-json-null
+}
+"For more information, see " { $url "https://en.wikipedia.org/wiki/JSON" } "." ;
ABOUT: "json"
-USING: kernel summary vocabs ;
+! Copyright (C) 2006 Chris Double, 2008 Peter Burns, 2009 Philipp Winkler
+
+USING: accessors ascii assocs combinators formatting hashtables
+io io.encodings.utf16.private io.encodings.utf8 io.files
+io.streams.string kernel kernel.private math math.order
+math.parser mirrors namespaces sbufs sequences sequences.private
+strings summary tr words ;
+
IN: json
SINGLETON: json-null
ERROR: json-error ;
ERROR: json-fp-special-error value ;
-M: json-fp-special-error summary drop "JSON serialization: illegal float:" ;
+
+M: json-fp-special-error summary
+ drop "JSON serialization: illegal float:" ;
: if-json-null ( x if-null else -- )
[ dup json-null? ]
: unless-json-null ( x else -- ) [ ] swap if-json-null ; inline
-"json.reader" require
-"json.writer" require
+<PRIVATE
+
+ERROR: not-a-json-number string ;
+
+SYMBOL: json-depth
+
+: json-number ( char stream -- num char )
+ [ 1string ] [ "\s\t\r\n,:}]" swap stream-read-until ] bi*
+ [
+ append {
+ { "Infinity" [ 1/0. ] }
+ { "-Infinity" [ -1/0. ] }
+ { "NaN" [ 0/0. ] }
+ [ dup string>number [ ] [ not-a-json-number ] ?if ]
+ } case
+ ] dip ;
+
+: json-expect ( token stream -- )
+ [ dup length ] [ stream-read ] bi* = [ json-error ] unless ; inline
+
+DEFER: (read-json-string)
+
+: decode-utf16-surrogate-pair ( hex1 hex2 -- char )
+ [ 0x3ff bitand ] bi@ [ 10 shift ] dip bitor 0x10000 + ;
+
+: stream-read-4hex ( stream -- hex ) 4 swap stream-read hex> ;
+
+: first-surrogate? ( hex -- ? ) 0xd800 0xdbff between? ;
+
+: read-second-surrogate ( stream -- hex )
+ "\\u" over json-expect stream-read-4hex ;
+
+: read-json-escape-unicode ( stream -- char )
+ [ stream-read-4hex ] keep over first-surrogate? [
+ read-second-surrogate decode-utf16-surrogate-pair
+ ] [ drop ] if ;
+
+: (read-json-escape) ( stream accum -- accum )
+ { sbuf } declare
+ over stream-read1 {
+ { CHAR: \" [ CHAR: \" ] }
+ { CHAR: \\ [ CHAR: \\ ] }
+ { CHAR: / [ CHAR: / ] }
+ { CHAR: b [ CHAR: \b ] }
+ { CHAR: f [ CHAR: \f ] }
+ { CHAR: n [ CHAR: \n ] }
+ { CHAR: r [ CHAR: \r ] }
+ { CHAR: t [ CHAR: \t ] }
+ { CHAR: u [ over read-json-escape-unicode ] }
+ [ ]
+ } case [ suffix! (read-json-string) ] [ json-error ] if* ;
+
+: (read-json-string) ( stream accum -- accum )
+ { sbuf } declare
+ "\\\"" pick stream-read-until [ append! ] dip
+ CHAR: \" = [ nip ] [ (read-json-escape) ] if ;
+
+: read-json-string ( stream -- str )
+ "\\\"" over stream-read-until CHAR: \" =
+ [ nip ] [ >sbuf (read-json-escape) "" like ] if ;
+
+: second-last-unsafe ( seq -- second-last )
+ [ length 2 - ] [ nth-unsafe ] bi ; inline
+
+: pop-unsafe ( seq -- elt )
+ index-of-last [ nth-unsafe ] [ shorten ] 2bi ; inline
+
+: check-length ( seq n -- seq )
+ [ dup length ] [ >= ] bi* [ json-error ] unless ; inline
+
+: v-over-push ( accum -- accum )
+ 2 check-length dup [ pop-unsafe ] [ last-unsafe ] bi push ;
+
+: v-pick-push ( accum -- accum )
+ 3 check-length dup [ pop-unsafe ] [ second-last-unsafe ] bi push ;
+
+: v-close ( accum -- accum )
+ dup last V{ } = not [ v-over-push ] when ;
+
+: json-open-array ( accum -- accum )
+ V{ } clone suffix! ;
+
+: json-open-hash ( accum -- accum )
+ V{ } clone suffix! V{ } clone suffix! ;
+
+: json-close-array ( accum -- accum )
+ v-close dup pop { } like suffix! ;
+
+: json-close-hash ( accum -- accum )
+ v-close dup dup [ pop ] bi@ swap H{ } zip-as suffix! ;
+
+: scan ( stream accum char -- stream accum )
+ ! 2dup 1string swap . . ! Great for debug...
+ {
+ { CHAR: \" [ over read-json-string suffix! ] }
+ { CHAR: [ [ 1 json-depth +@ json-open-array ] }
+ { CHAR: , [ v-over-push ] }
+ { CHAR: ] [ -1 json-depth +@ json-close-array ] }
+ { CHAR: { [ json-open-hash ] }
+ { CHAR: : [ v-pick-push ] }
+ { CHAR: } [ json-close-hash ] }
+ { CHAR: \s [ ] }
+ { CHAR: \t [ ] }
+ { CHAR: \r [ ] }
+ { CHAR: \n [ ] }
+ { CHAR: t [ "rue" pick json-expect t suffix! ] }
+ { CHAR: f [ "alse" pick json-expect f suffix! ] }
+ { CHAR: n [ "ull" pick json-expect json-null suffix! ] }
+ [ pick json-number [ suffix! ] dip [ scan ] when* ]
+ } case ;
+
+: json-read-input ( stream -- objects )
+ 0 json-depth [
+ V{ } clone over '[ _ stream-read1 ] [ scan ] while* nip
+ json-depth get zero? [ json-error ] unless
+ ] with-variable ;
+
+: get-json ( objects -- obj )
+ dup length 1 = [ first ] [ json-error ] if ;
+
+PRIVATE>
+
+: read-json ( -- objects )
+ input-stream get json-read-input ;
+
+GENERIC: json> ( string -- object )
+
+M: string json>
+ [ read-json get-json ] with-string-reader ;
+
+: path>json ( path -- json )
+ utf8 [ read-json get-json ] with-file-reader ;
+
+: path>jsons ( path -- jsons )
+ utf8 [ read-json ] with-file-reader ;
+
+SYMBOL: json-allow-fp-special?
+f json-allow-fp-special? set-global
+
+SYMBOL: json-friendly-keys?
+t json-friendly-keys? set-global
+
+SYMBOL: json-coerce-keys?
+t json-coerce-keys? set-global
+
+SYMBOL: json-escape-slashes?
+f json-escape-slashes? set-global
+
+SYMBOL: json-escape-unicode?
+f json-escape-unicode? set-global
+
+! Writes the object out to a stream in JSON format
+GENERIC#: stream-json-print 1 ( obj stream -- )
+
+: json-print ( obj -- )
+ output-stream get stream-json-print ;
+
+: >json ( obj -- string )
+ ! Returns a string representing the factor object in JSON format
+ [ json-print ] with-string-writer ;
+
+M: f stream-json-print
+ [ drop "false" ] [ stream-write ] bi* ;
+
+M: t stream-json-print
+ [ drop "true" ] [ stream-write ] bi* ;
+
+M: json-null stream-json-print
+ [ drop "null" ] [ stream-write ] bi* ;
+
+<PRIVATE
+
+: json-print-generic-escape-surrogate-pair ( stream char -- stream )
+ 0x10000 - [ encode-first ] [ encode-second ] bi
+ "\\u%02x%02x\\u%02x%02x" sprintf over stream-write ;
+
+: json-print-generic-escape-bmp ( stream char -- stream )
+ "\\u%04x" sprintf 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
+ CHAR: \" over stream-write1 swap [
+ {
+ { CHAR: \" [ "\\\"" over stream-write ] }
+ { CHAR: \\ [ "\\\\" over stream-write ] }
+ { CHAR: / [
+ json-escape-slashes? get
+ [ "\\/" over stream-write ]
+ [ CHAR: / over stream-write1 ] if
+ ] }
+ { CHAR: \b [ "\\b" over stream-write ] }
+ { CHAR: \f [ "\\f" over stream-write ] }
+ { CHAR: \n [ "\\n" over stream-write ] }
+ { CHAR: \r [ "\\r" over stream-write ] }
+ { CHAR: \t [ "\\t" over stream-write ] }
+ { 0x2028 [ "\\u2028" over stream-write ] }
+ { 0x2029 [ "\\u2029" over stream-write ] }
+ [
+ {
+ { [ dup printable? ] [ f ] }
+ { [ dup control? ] [ t ] }
+ [ json-escape-unicode? get ]
+ } cond [
+ json-print-generic-escape
+ ] [
+ over stream-write1
+ ] if
+ ]
+ } case
+ ] each CHAR: \" swap stream-write1 ;
+
+M: integer stream-json-print
+ [ number>string ] [ stream-write ] bi* ;
+
+: float>json ( float -- string )
+ dup fp-special? [
+ json-allow-fp-special? get [ json-fp-special-error ] unless
+ {
+ { [ dup fp-nan? ] [ drop "NaN" ] }
+ { [ dup 1/0. = ] [ drop "Infinity" ] }
+ { [ dup -1/0. = ] [ drop "-Infinity" ] }
+ } cond
+ ] [
+ number>string
+ ] if ;
+
+M: float stream-json-print
+ [ float>json ] [ stream-write ] bi* ;
+
+M: real stream-json-print
+ [ >float number>string ] [ stream-write ] bi* ;
+
+M: sequence stream-json-print
+ CHAR: [ over stream-write1 swap
+ over '[ CHAR: , _ stream-write1 ]
+ pick '[ _ stream-json-print ] interleave
+ CHAR: ] swap stream-write1 ;
+
+<PRIVATE
+
+TR: json-friendly "-" "_" ;
+
+GENERIC: json-coerce ( obj -- str )
+M: f json-coerce drop "false" ;
+M: t json-coerce drop "true" ;
+M: json-null json-coerce drop "null" ;
+M: string json-coerce ;
+M: integer json-coerce number>string ;
+M: float json-coerce float>json ;
+M: real json-coerce >float number>string ;
+
+:: json-print-assoc ( obj stream -- )
+ CHAR: { stream stream-write1 obj >alist
+ [ CHAR: , stream stream-write1 ]
+ json-friendly-keys? get
+ json-coerce-keys? get '[
+ first2 [
+ dup string?
+ [ _ [ json-friendly ] when ]
+ [ _ [ json-coerce ] when ] if
+ stream stream-json-print
+ ] [
+ CHAR: : stream stream-write1
+ stream stream-json-print
+ ] bi*
+ ] interleave
+ CHAR: } stream stream-write1 ;
+
+PRIVATE>
+
+M: tuple stream-json-print
+ [ <mirror> ] dip json-print-assoc ;
+
+M: hashtable stream-json-print json-print-assoc ;
+
+M: word stream-json-print
+ [ name>> ] dip stream-json-print ;
! Copyright (C) 2016 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
-USING: io.streams.string json.prettyprint json.reader tools.test ;
+USING: io.streams.string json json.prettyprint tools.test ;
{
"{
! Copyright (C) 2016 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
USING: assocs hashtables io io.encodings.utf8 io.files
-io.streams.string json.reader json.writer kernel math namespaces
-sequences strings ;
+io.streams.string json kernel math namespaces sequences strings
+;
IN: json.prettyprint
<PRIVATE
+++ /dev/null
-Chris Double
-Peter Burns
-Philipp Winkler
+++ /dev/null
-! Copyright (C) 2006 Chris Double.
-! See https://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax ;
-IN: json.reader
-
-HELP: json>
-{ $values { "string" "a string in JSON format" } { "object" "a deserialized object" } }
-{ $description "Deserializes the JSON formatted string into a Factor object. JSON objects are converted to Factor hashtables. All other JSON objects convert to their obvious Factor equivalents." } ;
-
-HELP: read-json
-{ $values { "objects" { $sequence "deserialized objects" } } }
-{ $description "Reads JSON formatted strings into a vector of Factor object until the end of the stream is reached. JSON objects are converted to Factor hashtables. All other JSON objects convert to their obvious Factor equivalents." } ;
-
-HELP: path>json
-{ $values
- { "path" "a pathname string" }
- { "json" "a JSON object" }
-}
-{ $description "Reads a file into a single JSON object. Throws an error if the file contains more than one json." } ;
-{ path>json path>jsons } related-words
-
-HELP: path>jsons
-{ $values
- { "path" "a pathname string" }
- { "jsons" { $sequence "JSON objects" } }
-}
-{ $description "Reads a file into a sequence of JSON objects and returns them all." } ;
-
-ARTICLE: "json.reader" "JSON reader"
-"The " { $vocab-link "json.reader" } " vocabulary defines a word for parsing strings in JSON format."
-"For more information, see " { $url "https://en.wikipedia.org/wiki/JSON" } "."
-{ $subsections json> read-json path>json path>jsons } ;
-
-ABOUT: "json.reader"
+++ /dev/null
-USING: hashtables io.streams.string json json.reader
-json.reader.private kernel literals math strings tools.test ;
-
-{ f } [ "false" json> ] unit-test
-{ t } [ "true" json> ] unit-test
-{ json-null } [ "null" json> ] unit-test
-{ 0 } [ "0" json> ] unit-test
-{ 0 } [ "-0" json> ] unit-test
-{ 102 } [ "102" json> ] unit-test
-{ -102 } [ "-102" json> ] unit-test
-{ 102 } [ "+102" json> ] unit-test
-{ 1000.0 } [ "1.0e3" json> ] unit-test
-{ 1000.0 } [ "10e2" json> ] unit-test
-{ 102.0 } [ "102.0" json> ] unit-test
-{ 102.5 } [ "102.5" json> ] unit-test
-{ 102.5 } [ "102.50" json> ] unit-test
-{ -10250.0 } [ "-102.5e2" json> ] unit-test
-{ -10250.0 } [ "-102.5E+2" json> ] unit-test
-{ -1.025 } [ "-102.5E-2" json> ] unit-test
-{ 10.25 } [ "1025e-2" json> ] unit-test
-{ 0.125 } [ "0.125" json> ] unit-test
-{ -0.125 } [ "-0.125" json> ] unit-test
-{ -0.00125 } [ "-0.125e-2" json> ] unit-test
-{ -012.5 } [ "-0.125e+2" json> ] unit-test
-{ 0.0 } [ "123e-10000000" json> ] unit-test
-
-! not widely supported by javascript, but allowed in the grammar, and a nice
-! feature to get
-{ -0.0 } [ "-0.0" json> ] unit-test
-
-{ " fuzzy pickles " } [ " \" fuzzy pickles \" " json> ] unit-test
-{ "while 1:\n\tpass" } [ " \"while 1:\n\tpass\" " json> ] unit-test
-! unicode is allowed in json
-{ "ß∂¬ƒ˚∆" } [ " \"ß∂¬ƒ˚∆\"" json> ] unit-test
-${ { 8 9 10 12 13 34 47 92 } >string } [ " \"\\b\\t\\n\\f\\r\\\"\\/\\\\\" " json> ] unit-test
-${ { 0xabcd } >string } [ " \"\\uaBCd\" " json> ] unit-test
-{ "𝄞" } [ "\"\\ud834\\udd1e\"" json> ] unit-test
-
-{ H{ { "a" { } } { "b" 123 } } } [ "{\"a\":[],\"b\":123}" json> ] unit-test
-{ { } } [ "[]" json> ] unit-test
-{ { 1 "two" 3.0 } } [ " [1, \"two\", 3.0] " json> ] unit-test
-{ H{ } } [ "{}" json> ] unit-test
-
-! the returned hashtable should be different every time
-{ H{ } } [ "key" "value" "{}" json> ?set-at "{}" json> nip ] unit-test
-
-{ H{ { "US$" 1.0 } { "EU€" 1.5 } } } [ " { \"US$\":1.00, \"EU\\u20AC\":1.50 } " json> ] unit-test
-{ H{
- { "fib" { 1 1 2 3 5 8 H{ { "etc" "etc" } } } }
- { "prime" { 2 3 5 7 11 13 } }
-} } [ " {
- \"fib\": [1, 1, 2, 3, 5, 8,
- { \"etc\":\"etc\" } ],
- \"prime\":
- [ 2,3, 5,7,
-11,
-13
-] }
-" json> ] unit-test
-
-{ 0 } [ " 0" json> ] unit-test
-{ 0 } [ "0 " json> ] unit-test
-{ 0 } [ " 0 " json> ] unit-test
-
-{ V{ H{ { "a" "b" } } H{ { "c" "d" } } } }
-[ "{\"a\": \"b\"} {\"c\": \"d\"}" [ read-json ] with-string-reader ] unit-test
-
-! empty objects are allowed as values in objects
-{ H{ { "foo" H{ } } } } [ "{ \"foo\" : {}}" json> ] unit-test
-! And arrays
-{ { H{ } } } [ "[{}]" json> ] unit-test
-
-{
- "\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"
-} [
- "\"\\u0000\\u0001\\u0002\\u0003\\u0004\\u0005\\u0006\\u0007\\b\\t\\n\\u000b\\f\\r\\u000e\\u000f\\u0010\\u0011\\u0012\\u0013\\u0014\\u0015\\u0016\\u0017\\u0018\\u0019\\u001a\\u001b\\u001c\\u001d\\u001e\\u001f\""
- json>
-] unit-test
-
-{ 1/0. } [ "Infinity" json> ] unit-test
-{ -1/0. } [ "-Infinity" json> ] unit-test
-{ t } [ "NaN" json> fp-nan? ] unit-test
-
-[ "<!doctype html>\n<html>\n<head>\n " json> ]
-[ not-a-json-number? ] must-fail-with
-
-! unclosed objects and mismatched brackets are not allowed
-[ "[\"a\",
-4
-,1," json> ] must-fail
-
-[ "[]]]" json> ] must-fail
-
-[ "{[: \"x\"}" json> ] must-fail
+++ /dev/null
-! Copyright (C) 2008 Peter Burns, 2009 Philipp Winkler
-! See https://factorcode.org/license.txt for BSD license.
-USING: assocs combinators io io.encodings.utf8 io.files
-io.streams.string json kernel kernel.private math math.order
-math.parser namespaces sbufs sequences sequences.private strings ;
-IN: json.reader
-
-<PRIVATE
-
-ERROR: not-a-json-number string ;
-
-SYMBOL: json-depth
-
-: json-number ( char stream -- num char )
- [ 1string ] [ "\s\t\r\n,:}]" swap stream-read-until ] bi*
- [
- append {
- { "Infinity" [ 1/0. ] }
- { "-Infinity" [ -1/0. ] }
- { "NaN" [ 0/0. ] }
- [ dup string>number [ ] [ not-a-json-number ] ?if ]
- } case
- ] dip ;
-
-: json-expect ( token stream -- )
- [ dup length ] [ stream-read ] bi* = [ json-error ] unless ; inline
-
-DEFER: (read-json-string)
-
-: decode-utf16-surrogate-pair ( hex1 hex2 -- char )
- [ 0x3ff bitand ] bi@ [ 10 shift ] dip bitor 0x10000 + ;
-
-: stream-read-4hex ( stream -- hex ) 4 swap stream-read hex> ;
-
-: first-surrogate? ( hex -- ? ) 0xd800 0xdbff between? ;
-
-: read-second-surrogate ( stream -- hex )
- "\\u" over json-expect stream-read-4hex ;
-
-: read-json-escape-unicode ( stream -- char )
- [ stream-read-4hex ] keep over first-surrogate? [
- read-second-surrogate decode-utf16-surrogate-pair
- ] [ drop ] if ;
-
-: (read-json-escape) ( stream accum -- accum )
- { sbuf } declare
- over stream-read1 {
- { CHAR: \" [ CHAR: \" ] }
- { CHAR: \\ [ CHAR: \\ ] }
- { CHAR: / [ CHAR: / ] }
- { CHAR: b [ CHAR: \b ] }
- { CHAR: f [ CHAR: \f ] }
- { CHAR: n [ CHAR: \n ] }
- { CHAR: r [ CHAR: \r ] }
- { CHAR: t [ CHAR: \t ] }
- { CHAR: u [ over read-json-escape-unicode ] }
- [ ]
- } case [ suffix! (read-json-string) ] [ json-error ] if* ;
-
-: (read-json-string) ( stream accum -- accum )
- { sbuf } declare
- "\\\"" pick stream-read-until [ append! ] dip
- CHAR: \" = [ nip ] [ (read-json-escape) ] if ;
-
-: read-json-string ( stream -- str )
- "\\\"" over stream-read-until CHAR: \" =
- [ nip ] [ >sbuf (read-json-escape) "" like ] if ;
-
-: second-last-unsafe ( seq -- second-last )
- [ length 2 - ] [ nth-unsafe ] bi ; inline
-
-: pop-unsafe ( seq -- elt )
- index-of-last [ nth-unsafe ] [ shorten ] 2bi ; inline
-
-: check-length ( seq n -- seq )
- [ dup length ] [ >= ] bi* [ json-error ] unless ; inline
-
-: v-over-push ( accum -- accum )
- 2 check-length dup [ pop-unsafe ] [ last-unsafe ] bi push ;
-
-: v-pick-push ( accum -- accum )
- 3 check-length dup [ pop-unsafe ] [ second-last-unsafe ] bi push ;
-
-: v-close ( accum -- accum )
- dup last V{ } = not [ v-over-push ] when ;
-
-: json-open-array ( accum -- accum )
- V{ } clone suffix! ;
-
-: json-open-hash ( accum -- accum )
- V{ } clone suffix! V{ } clone suffix! ;
-
-: json-close-array ( accum -- accum )
- v-close dup pop { } like suffix! ;
-
-: json-close-hash ( accum -- accum )
- v-close dup dup [ pop ] bi@ swap H{ } zip-as suffix! ;
-
-: scan ( stream accum char -- stream accum )
- ! 2dup 1string swap . . ! Great for debug...
- {
- { CHAR: \" [ over read-json-string suffix! ] }
- { CHAR: [ [ 1 json-depth +@ json-open-array ] }
- { CHAR: , [ v-over-push ] }
- { CHAR: ] [ -1 json-depth +@ json-close-array ] }
- { CHAR: { [ json-open-hash ] }
- { CHAR: : [ v-pick-push ] }
- { CHAR: } [ json-close-hash ] }
- { CHAR: \s [ ] }
- { CHAR: \t [ ] }
- { CHAR: \r [ ] }
- { CHAR: \n [ ] }
- { CHAR: t [ "rue" pick json-expect t suffix! ] }
- { CHAR: f [ "alse" pick json-expect f suffix! ] }
- { CHAR: n [ "ull" pick json-expect json-null suffix! ] }
- [ pick json-number [ suffix! ] dip [ scan ] when* ]
- } case ;
-
-: json-read-input ( stream -- objects )
- 0 json-depth [
- V{ } clone over '[ _ stream-read1 ] [ scan ] while* nip
- json-depth get zero? [ json-error ] unless
- ] with-variable ;
-
-: get-json ( objects -- obj )
- dup length 1 = [ first ] [ json-error ] if ;
-
-PRIVATE>
-
-: read-json ( -- objects )
- input-stream get json-read-input ;
-
-GENERIC: json> ( string -- object )
-
-M: string json>
- [ read-json get-json ] with-string-reader ;
-
-: path>json ( path -- json )
- utf8 [ read-json get-json ] with-file-reader ;
-
-: path>jsons ( path -- jsons )
- utf8 [ read-json ] with-file-reader ;
+++ /dev/null
-JSON to Factor serializer
+++ /dev/null
-Chris Double
+++ /dev/null
-Factor to JSON serializer
+++ /dev/null
-! Copyright (C) 2006 Chris Double.
-! See https://factorcode.org/license.txt for BSD license.
-USING: json help.markup help.syntax kernel ;
-IN: json.writer
-
-HELP: >json
-{ $values { "obj" object } { "string" "the object converted to JSON format" } }
-{ $description "Serializes the object into a JSON formatted string." }
-{ $see-also json-print } ;
-
-HELP: json-print
-{ $values { "obj" object } }
-{ $description "Serializes the object into a JSON formatted string and outputs it to the standard output stream."
-$nl
-"Some options can control the formatting of the result:"
-{ $table
- { { $link json-allow-fp-special? } "Allow special floating-points: NaN, Infinity, -Infinity" }
- { { $link json-friendly-keys? } "Convert - to _ in tuple slots and hashtable keys" }
- { { $link json-coerce-keys? } "Coerce hashtable keys into strings" }
- { { $link json-escape-slashes? } "Escape forward slashes inside strings" }
- { { $link json-escape-unicode? } "Escape unicode values inside strings" }
-}
-}
-{ $see-also >json } ;
-
-{ json-fp-special-error json-allow-fp-special? } related-words
-
-HELP: json-fp-special-error
-{ $error-description "Thrown by " { $link "json.writer" } " when attempting to serialize -1/0. or +1/0. or NaN when " { $link json-allow-fp-special? } " is not enabled." } ;
-
-ARTICLE: "json.writer" "JSON writer"
-"The " { $vocab-link "json.writer" } " vocabulary defines words for converting objects to JSON format."
-{ $subsections
- >json
- json-print
-} ;
-
-ABOUT: "json.writer"
+++ /dev/null
-USING: hashtables json.writer tools.test json.reader json kernel namespaces ;
-IN: json.writer.tests
-
-{ "false" } [ f >json ] unit-test
-{ "true" } [ t >json ] unit-test
-{ "null" } [ json-null >json ] unit-test
-{ "0" } [ 0 >json ] unit-test
-{ "102" } [ 102 >json ] unit-test
-{ "-102" } [ -102 >json ] unit-test
-{ "102.0" } [ 102.0 >json ] unit-test
-{ "102.5" } [ 102.5 >json ] unit-test
-{ "0.5" } [ 1/2 >json ] unit-test
-{ "\"hello world\"" } [ "hello world" >json ] unit-test
-
-{ "[1,\"two\",3.0]" } [ { 1 "two" 3.0 } >json ] unit-test
-{ "{\"US$\":1.0,\"EU€\":1.5}" } [ H{ { "US$" 1.0 } { "EU€" 1.5 } } >json ] unit-test
-
-{ "\">json\"" } [ \ >json >json ] unit-test
-
-{ { 0.5 } } [ { 1/2 } >json json> ] unit-test
-
-TUPLE: person first-name age ;
-
-{ "{\"first-name\":\"David\",\"age\":32}" }
-[
- f json-friendly-keys?
- [ "David" 32 person boa >json ]
- with-variable
-] unit-test
-
-{ "{\"first_name\":\"David\",\"age\":32}" }
-[
- t json-friendly-keys?
- [ "David" 32 person boa >json ]
- with-variable
-] unit-test
-
-{ "{\"1\":2,\"3\":4}" }
-[ H{ { "1" 2 } { "3" 4 } } >json ] unit-test
-
-{ "{\"1\":2,\"3\":4}" }
-[ H{ { 1 2 } { 3 4 } } >json ] unit-test
-
-{ "{\"\":4}" }
-[ H{ { "" 2 } { "" 4 } } >json ] unit-test
-
-{ "{\"true\":4,\"false\":2,\"\":5}" }
-[ H{ { f 2 } { t 4 } { "" 5 } } >json ] unit-test
-
-{ "{\"3.1\":3}" }
-[ H{ { 3.1 3 } } >json ] unit-test
-
-{ "{\"null\":1}" }
-[ H{ { json-null 1 } } >json ] unit-test
-
-{ "{\"Infinity\":1}" }
-[ t json-allow-fp-special? [ H{ { 1/0. 1 } } >json ] with-variable ] unit-test
-
-{ "{\"-Infinity\":1}" }
-[ t json-allow-fp-special? [ H{ { -1/0. 1 } } >json ] with-variable ] unit-test
-
-{ "{\"NaN\":1}" }
-[ t json-allow-fp-special? [ H{ { NAN: 333 1 } } >json ] with-variable ] unit-test
-
-{
- "\"\\u0000\\u0001\\u0002\\u0003\\u0004\\u0005\\u0006\\u0007\\b\\t\\n\\u000b\\f\\r\\u000e\\u000f\\u0010\\u0011\\u0012\\u0013\\u0014\\u0015\\u0016\\u0017\\u0018\\u0019\\u001a\\u001b\\u001c\\u001d\\u001e\\u001f\""
-} [
- "\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
-] unit-test
-
-{ "\"\\ud834\\udd1e\"" }
-[ t json-escape-unicode? [ "𝄞" >json ] with-variable ] unit-test
-
-{ "\"\\ud800\\udc01\"" }
-[ t json-escape-unicode? [ "𐀁" >json ] with-variable ] unit-test
+++ /dev/null
-! Copyright (C) 2006 Chris Double.
-! See https://factorcode.org/license.txt for BSD license.
-USING: accessors ascii assocs combinators formatting hashtables
-io io.encodings.utf16.private io.streams.string json kernel math
-math.parser mirrors namespaces sequences strings tr words ;
-IN: json.writer
-
-SYMBOL: json-allow-fp-special?
-f json-allow-fp-special? set-global
-
-SYMBOL: json-friendly-keys?
-t json-friendly-keys? set-global
-
-SYMBOL: json-coerce-keys?
-t json-coerce-keys? set-global
-
-SYMBOL: json-escape-slashes?
-f json-escape-slashes? set-global
-
-SYMBOL: json-escape-unicode?
-f json-escape-unicode? set-global
-
-! Writes the object out to a stream in JSON format
-GENERIC#: stream-json-print 1 ( obj stream -- )
-
-: json-print ( obj -- )
- output-stream get stream-json-print ;
-
-: >json ( obj -- string )
- ! Returns a string representing the factor object in JSON format
- [ json-print ] with-string-writer ;
-
-M: f stream-json-print
- [ drop "false" ] [ stream-write ] bi* ;
-
-M: t stream-json-print
- [ drop "true" ] [ stream-write ] bi* ;
-
-M: json-null stream-json-print
- [ drop "null" ] [ stream-write ] bi* ;
-
-<PRIVATE
-
-: json-print-generic-escape-surrogate-pair ( stream char -- stream )
- 0x10000 - [ encode-first ] [ encode-second ] bi
- "\\u%02x%02x\\u%02x%02x" sprintf over stream-write ;
-
-: json-print-generic-escape-bmp ( stream char -- stream )
- "\\u%04x" sprintf 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
- CHAR: \" over stream-write1 swap [
- {
- { CHAR: \" [ "\\\"" over stream-write ] }
- { CHAR: \\ [ "\\\\" over stream-write ] }
- { CHAR: / [
- json-escape-slashes? get
- [ "\\/" over stream-write ]
- [ CHAR: / over stream-write1 ] if
- ] }
- { CHAR: \b [ "\\b" over stream-write ] }
- { CHAR: \f [ "\\f" over stream-write ] }
- { CHAR: \n [ "\\n" over stream-write ] }
- { CHAR: \r [ "\\r" over stream-write ] }
- { CHAR: \t [ "\\t" over stream-write ] }
- { 0x2028 [ "\\u2028" over stream-write ] }
- { 0x2029 [ "\\u2029" over stream-write ] }
- [
- {
- { [ dup printable? ] [ f ] }
- { [ dup control? ] [ t ] }
- [ json-escape-unicode? get ]
- } cond [
- json-print-generic-escape
- ] [
- over stream-write1
- ] if
- ]
- } case
- ] each CHAR: \" swap stream-write1 ;
-
-M: integer stream-json-print
- [ number>string ] [ stream-write ] bi* ;
-
-: float>json ( float -- string )
- dup fp-special? [
- json-allow-fp-special? get [ json-fp-special-error ] unless
- {
- { [ dup fp-nan? ] [ drop "NaN" ] }
- { [ dup 1/0. = ] [ drop "Infinity" ] }
- { [ dup -1/0. = ] [ drop "-Infinity" ] }
- } cond
- ] [
- number>string
- ] if ;
-
-M: float stream-json-print
- [ float>json ] [ stream-write ] bi* ;
-
-M: real stream-json-print
- [ >float number>string ] [ stream-write ] bi* ;
-
-M: sequence stream-json-print
- CHAR: [ over stream-write1 swap
- over '[ CHAR: , _ stream-write1 ]
- pick '[ _ stream-json-print ] interleave
- CHAR: ] swap stream-write1 ;
-
-<PRIVATE
-
-TR: json-friendly "-" "_" ;
-
-GENERIC: json-coerce ( obj -- str )
-M: f json-coerce drop "false" ;
-M: t json-coerce drop "true" ;
-M: json-null json-coerce drop "null" ;
-M: string json-coerce ;
-M: integer json-coerce number>string ;
-M: float json-coerce float>json ;
-M: real json-coerce >float number>string ;
-
-:: json-print-assoc ( obj stream -- )
- CHAR: { stream stream-write1 obj >alist
- [ CHAR: , stream stream-write1 ]
- json-friendly-keys? get
- json-coerce-keys? get '[
- first2 [
- dup string?
- [ _ [ json-friendly ] when ]
- [ _ [ json-coerce ] when ] if
- stream stream-json-print
- ] [
- CHAR: : stream stream-write1
- stream stream-json-print
- ] bi*
- ] interleave
- CHAR: } stream stream-write1 ;
-
-PRIVATE>
-
-M: tuple stream-json-print
- [ <mirror> ] dip json-print-assoc ;
-
-M: hashtable stream-json-print json-print-assoc ;
-
-M: word stream-json-print
- [ name>> ] dip stream-json-print ;
! Copyright (C) 2016 Björn Lindqvist.
! See https://factorcode.org/license.txt for BSD license.
USING: accessors assocs calendar combinators http.client io
-json.reader kernel make math.order sequences unicode urls
-webbrowser ;
+json kernel make math.order sequences unicode urls webbrowser ;
IN: oauth2
: console-prompt ( query -- str/f )
! Copyright (C) 2012 John Benediktsson
! See https://factorcode.org/license.txt for BSD license.
-USING: assocs json.reader json.writer kernel math math.parser
-sequences ;
+USING: assocs json kernel math math.parser sequences ;
IN: benchmark.json
: json-benchmark ( -- )
!
! Donations can be sent to the following bitcoin address:
! 1HVMkUcaPhCeCK3rrBm31EY2bf5r33VHsj
-!
-USING:
- accessors
- assocs
- base64
- byte-arrays
- http
- http.client
- io.encodings.binary
- json.reader
- json.writer
- kernel
- namespaces
- sequences
- strings
- urls
-;
+
+USING: accessors assocs base64 byte-arrays http http.client
+io.encodings.binary json kernel namespaces sequences strings
+urls ;
+
IN: bitcoin.client
: bitcoin-server ( -- string )
! Copyright (C) 2010-2012 Slava Pestov, John Benediktsson.
! See https://factorcode.org/license.txt for BSD license.
-USING: assocs http.client json.reader kernel namespaces
-sequences urls ;
+
+USING: assocs http.client json kernel namespaces sequences urls
+;
+
IN: bitly
SYMBOLS: bitly-api-user bitly-api-key ;
! Copyright (C) 2018 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
-USING: io.launcher io.standard-paths json.reader
-kernel literals namespaces sequences strings system ;
+
+USING: io.launcher io.standard-paths json kernel literals
+namespaces sequences strings system ;
+
IN: ci.docker
SYMBOL: docker-username
! Copyright (C) 2021 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
-USING: assocs base64 checksums.hmac checksums.sha json.reader
-json.writer kernel sequences splitting strings ;
+
+USING: assocs base64 checksums.hmac checksums.sha json kernel
+sequences splitting strings ;
+
IN: crypto.jwt
: jwt> ( jwt -- header payload signature )
! Copyright (C) 2017 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
-USING: assocs cli.git formatting http.client io.pathnames
-json.reader kernel math namespaces sequences ;
+USING: assocs cli.git formatting http.client io.pathnames json
+kernel math namespaces sequences ;
IN: github
SYMBOL: github-username
! Copyright (C) 2016 Björn Lindqvist.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors arrays json.reader kernel namespaces oauth2
-sequences urls ;
+
+USING: accessors arrays json kernel namespaces oauth2 sequences
+urls ;
+
IN: google.gmail
CONSTANT: api-base "https://www.googleapis.com/gmail/v1/users"
! See https://factorcode.org/license.txt for BSD license
USING: accessors assocs.extras classes.tuple colors combinators
-formatting http.client io io.styles json.reader kernel sequences
-urls wrap.strings ;
+formatting http.client io io.styles json kernel sequences urls
+wrap.strings ;
IN: google.search
! Copyright (C) 2010 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
+
USING: assocs combinators grouping http.client io io.files.temp
-io.files.unique json.reader kernel make sequences urls ;
+io.files.unique json kernel make sequences urls ;
+
IN: google.translate
CONSTANT: google-translate-url "https://ajax.googleapis.com/ajax/services/language/translate"
! See https://factorcode.org/license.txt for BSD license
USING: accessors ascii assocs checksums checksums.md5
-classes.tuple formatting http.client images.http json.reader
-kernel math.parser sequences strings ;
+classes.tuple formatting http.client images.http json kernel
+math.parser sequences strings ;
IN: gravatar
USING: accessors assocs calendar calendar.format
calendar.holidays.us colors combinators concurrency.combinators
-formatting hashtables http.client io io.styles json.reader
-kernel make math sequences ui ui.theme urls ;
+formatting hashtables http.client io io.styles json kernel make
+math sequences ui ui.theme urls ;
IN: hacker-news
! Copyright (C) 2022 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
+
USING: assocs assocs.extras formatting http http.client io
-io.encodings.string io.encodings.utf8 json.reader kernel
-namespaces sequences sequences.generalizations ;
+io.encodings.string io.encodings.utf8 json kernel namespaces
+sequences sequences.generalizations ;
+
IN: hetzner
SYMBOL: hetzner-access-token
! Copyright (C) 2020 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
+
USING: accessors arrays assocs combinators
-combinators.short-circuit io io.encodings.utf8 io.files
-json.reader kernel math math.order memoize modern.slices
-prettyprint sequences sequences.extras strings suffix-arrays
-words ;
+combinators.short-circuit io io.encodings.utf8 io.files json
+kernel math math.order memoize modern.slices prettyprint
+sequences sequences.extras strings suffix-arrays words ;
+
IN: html5
: 1sbuf ( ch -- sbuf ) [ SBUF" " clone ] dip over push ; inline
! Copyright (C) 2020 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
USING: accessors assocs biassocs combinators formatting
-http.client json.reader kernel literals sequences ;
+http.client json kernel literals sequences ;
IN: itunes
ERROR: http-get-error url res json ;
USING: accessors http http.client http.client.private
-io.encodings.string io.encodings.utf8 json.reader json.writer
-kernel strings ;
+io.encodings.string io.encodings.utf8 json kernel strings ;
IN: json.http
! Copyright (C) 2014 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
-USING: assocs checksums checksums.md5 http.client json.reader
-kernel math.parser namespaces sequences strings system urls ;
+USING: assocs checksums checksums.md5 http.client json kernel
+math.parser namespaces sequences strings system urls ;
IN: marvel
! https://developer.marvel.com/docs
! See https://factorcode.org/license.txt for BSD license.
USING: arrays accessors assocs assocs.extras calendar
combinators combinators.short-circuit continuations formatting
-http http.client io json.reader kernel locals make math
-math.parser namespaces oauth1 prettyprint sequences strings
-system threads ;
+http http.client io json kernel locals make math math.parser
+namespaces oauth1 prettyprint sequences strings system threads ;
IN: mediawiki.api
TUPLE: oauth-login consumer-token consumer-secret access-token
-! (c)2010 Joe Groff bsd license
+! Copyright (C) 2010 Joe Groff
+! See https://factorcode.org/license.txt for BSD license
+
USING: accessors alien assocs classes.struct combinators
combinators.short-circuit fry gpu.shaders images images.atlas
images.loader io.directories io.encodings.utf8 io.files
-io.pathnames json json.reader kernel locals math math.matrices.simd
-math.vectors.simd sequences sets specialized-arrays
-strings typed ;
+io.pathnames json kernel locals math math.matrices.simd
+math.vectors.simd sequences sets specialized-arrays strings
+typed ;
+
FROM: alien.c-types => float ;
SPECIALIZED-ARRAYS: float float-4 ;
IN: papier.map
! See https://factorcode.org/license.txt for BSD license
USING: accessors assocs calendar calendar.format colors
-combinators formatting http.client io io.styles json
-json.reader kernel make math sequences urls ;
+combinators formatting http.client io io.styles json kernel make
+math sequences urls ;
IN: reddit
USING: assocs combinators command-line http.client io
io.directories io.encodings.utf8 io.files io.files.temp
-io.launcher io.pathnames json.reader kernel namespaces regexp
-sequences splitting system urls wrap.strings ;
+io.launcher io.pathnames json kernel namespaces regexp sequences
+splitting system urls wrap.strings ;
IN: tldr
! Copyright (C) 2009, 2010 Joe Groff, Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
+
USING: accessors assocs combinators http.client
-io.sockets.secure json.reader kernel make namespaces oauth1
-sequences urls ;
+io.sockets.secure json kernel make namespaces oauth1 sequences
+urls ;
+
IN: twitter
! Configuration
USING: accessors assocs base64 calendar calendar.format
checksums.hmac checksums.sha combinators.smart formatting http
-http.client json.reader json.writer kernel make math.parser
-namespaces random sequences splitting ;
+http.client json kernel make math.parser namespaces random
+sequences splitting ;
IN: visionect
projects / factor.git / commitdiff