json: adding some JSON Lines support

diff --git a/basis/json/json-docs.factor b/basis/json/json-docs.factor
index cac485a25bf9bbe2881648e42bd8946dd87d48a9..6591849fd76a3351182b051e94cec3d36ff90393 100644 (file)
--- a/basis/json/json-docs.factor
+++ b/basis/json/json-docs.factor
@@ -9,12 +9,15 @@ 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." } ;
 
+{ json> read-json } related-words
+
 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
@@ -26,10 +29,9 @@ HELP: path>jsons
 
 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 } ;
+{ $description "Serializes the object into a JSON formatted string." } ;
 
-HELP: json-print
+HELP: write-json
 { $values { "obj" object } }
 { $description "Serializes the object into a JSON formatted string and outputs it to the standard output stream."
 $nl
@@ -44,6 +46,8 @@ $nl
 }
 { $see-also >json } ;
 
+{ >json write-json } related-words
+
 { json-fp-special-error json-allow-fp-special? } related-words
 
 HELP: json-fp-special-error
@@ -52,17 +56,17 @@ HELP: json-fp-special-error
 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."
+"Parsing strings in JSON format:"
 { $subsections
     json>
     read-json
     path>json
     path>jsons
 }
-"Converting objects to JSON format."
+"Converting objects to JSON format:"
 { $subsections
     >json
-    json-print
+    write-json
 }
 "Working with JSON null values:"
 { $subsections
@@ -71,6 +75,13 @@ $nl
     when-json-null
     unless-json-null
 }
+"Working with JSON Lines format:"
+{ $subsections
+    jsonlines>
+    read-jsonlines
+    >jsonlines
+    write-jsonlines
+}
 "For more information, see " { $url "https://en.wikipedia.org/wiki/JSON" } "." ;
 
 ABOUT: "json"

diff --git a/basis/json/json-tests.factor b/basis/json/json-tests.factor
index efaa3163f77872397f034c03aa5361a13b017bf5..214de3fe6c9680a7333edfe6c613f08f0986adc0 100644 (file)
--- a/basis/json/json-tests.factor
+++ b/basis/json/json-tests.factor
@@ -175,3 +175,11 @@ TUPLE: person first-name age ;
 
 { "\"\\ud800\\udc01\"" }
 [ t json-escape-unicode? [ "𐀁" >json ] with-variable ] unit-test
+
+
+{ t } [
+    {
+        H{ { "foo" 1 } { "bar" 2 } }
+        H{ { "baz" 3 } { "qux" 4 } }
+    } dup >jsonlines jsonlines> =
+] unit-test

diff --git a/basis/json/json.factor b/basis/json/json.factor
index 0a73dad4668a30d4fa0707f94a935a57b87f2708..e0d1030faa9be9e56ac22726b6ce178c582f7f7e 100644 (file)
--- a/basis/json/json.factor
+++ b/basis/json/json.factor
@@ -2,7 +2,7 @@
 
 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
+io.streams.string kernel kernel.private make math math.order
 math.parser mirrors namespaces sbufs sequences sequences.private
 strings summary tr words ;
 
@@ -140,19 +140,19 @@ DEFER: (read-json-string)
         [ 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>
 
+: stream-read-json ( stream -- objects )
+    0 json-depth [
+        V{ } clone over '[ _ stream-read1 ] [ scan ] while* nip
+        json-depth get zero? [ json-error ] unless
+    ] with-variable ;
+
 : read-json ( -- objects )
-    input-stream get json-read-input ;
+    input-stream get stream-read-json ;
 
 GENERIC: json> ( string -- object )
 
@@ -181,43 +181,43 @@ 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 -- )
+GENERIC#: stream-write-json 1 ( obj stream -- )
 
-: json-print ( obj -- )
-    output-stream get stream-json-print ;
+: write-json ( obj -- )
+    output-stream get stream-write-json ;
 
 : >json ( obj -- string )
     ! Returns a string representing the factor object in JSON format
-    [ json-print ] with-string-writer ;
+    [ write-json ] with-string-writer ;
 
-M: f stream-json-print
+M: f stream-write-json
     [ drop "false" ] [ stream-write ] bi* ;
 
-M: t stream-json-print
+M: t stream-write-json
     [ drop "true" ] [ stream-write ] bi* ;
 
-M: json-null stream-json-print
+M: json-null stream-write-json
     [ drop "null" ] [ stream-write ] bi* ;
 
 <PRIVATE
 
-: json-print-generic-escape-surrogate-pair ( stream char -- stream )
+: write-json-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 )
+: write-json-generic-escape-bmp ( stream char -- stream )
     "\\u%04x" sprintf over stream-write ;
 
-: json-print-generic-escape ( stream char -- stream )
+: write-json-generic-escape ( stream char -- stream )
     dup 0xffff > [
-        json-print-generic-escape-surrogate-pair
+        write-json-generic-escape-surrogate-pair
     ] [
-        json-print-generic-escape-bmp
+        write-json-generic-escape-bmp
     ] if ;
 
 PRIVATE>
 
-M: string stream-json-print
+M: string stream-write-json
     CHAR: \" over stream-write1 swap [
         {
             { CHAR: \" [ "\\\"" over stream-write ] }
@@ -240,7 +240,7 @@ M: string stream-json-print
                     { [ dup control? ] [ t ] }
                     [ json-escape-unicode? get ]
                 } cond [
-                    json-print-generic-escape
+                    write-json-generic-escape
                 ] [
                     over stream-write1
                 ] if
@@ -248,7 +248,7 @@ M: string stream-json-print
         } case
     ] each CHAR: \" swap stream-write1 ;
 
-M: integer stream-json-print
+M: integer stream-write-json
     [ number>string ] [ stream-write ] bi* ;
 
 : float>json ( float -- string )
@@ -263,16 +263,16 @@ M: integer stream-json-print
         number>string
     ] if ;
 
-M: float stream-json-print
+M: float stream-write-json
     [ float>json ] [ stream-write ] bi* ;
 
-M: real stream-json-print
+M: real stream-write-json
     [ >float number>string ] [ stream-write ] bi* ;
 
-M: sequence stream-json-print
+M: sequence stream-write-json
     CHAR: [ over stream-write1 swap
     over '[ CHAR: , _ stream-write1 ]
-    pick '[ _ stream-json-print ] interleave
+    pick '[ _ stream-write-json ] interleave
     CHAR: ] swap stream-write1 ;
 
 <PRIVATE
@@ -288,7 +288,7 @@ M: integer json-coerce number>string ;
 M: float json-coerce float>json ;
 M: real json-coerce >float number>string ;
 
-:: json-print-assoc ( obj stream -- )
+:: write-json-assoc ( obj stream -- )
     CHAR: { stream stream-write1 obj >alist
     [ CHAR: , stream stream-write1 ]
     json-friendly-keys? get
@@ -297,23 +297,43 @@ M: real json-coerce >float number>string ;
             dup string?
             [ _ [ json-friendly ] when ]
             [ _ [ json-coerce ] when ] if
-            stream stream-json-print
+            stream stream-write-json
         ] [
             CHAR: : stream stream-write1
-            stream stream-json-print
+            stream stream-write-json
         ] bi*
     ] interleave
     CHAR: } stream stream-write1 ;
 
 PRIVATE>
 
-M: tuple stream-json-print
-    [ <mirror> ] dip json-print-assoc ;
+M: tuple stream-write-json
+    [ <mirror> ] dip write-json-assoc ;
 
-M: hashtable stream-json-print json-print-assoc ;
+M: hashtable stream-write-json write-json-assoc ;
 
-M: word stream-json-print
-    [ name>> ] dip stream-json-print ;
+M: word stream-write-json
+    [ name>> ] dip stream-write-json ;
 
 : ?>json ( obj -- json ) dup string? [ >json ] unless ;
 : ?json> ( obj -- json/f ) f like [ json> ] ?call ;
+
+: stream-read-jsonlines ( stream -- objects )
+    [ [ json> , ] each-stream-line ] { } make ;
+
+: read-jsonlines ( -- objects )
+    input-stream get stream-read-jsonlines ;
+
+GENERIC: jsonlines> ( string -- objects )
+
+M: string jsonlines>
+    [ read-jsonlines ] with-string-reader ;
+
+: stream-write-jsonlines ( objects stream -- )
+    [ stream-nl ] [ stream-write-json ] bi-curry interleave ;
+
+: write-jsonlines ( objects -- )
+    output-stream get stream-write-jsonlines ;
+
+: >jsonlines ( objects -- string )
+    [ write-jsonlines ] with-string-writer ;