]> gitweb.factorcode.org Git - factor.git/commitdiff
json: add rewrite-json words and tests
authorDoug Coleman <doug.coleman@gmail.com>
Wed, 6 Sep 2023 16:05:42 +0000 (11:05 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Mon, 2 Oct 2023 15:11:02 +0000 (10:11 -0500)
basis/json/json-docs.factor
basis/json/json-tests.factor
basis/json/json.factor

index 6591849fd76a3351182b051e94cec3d36ff90393..e745a3b9e1a1708d8a8baafb3de86797f9aa3a4b 100644 (file)
@@ -3,13 +3,14 @@ IN: json
 
 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." } ;
+{ $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." }
+{ $notes "The full name of this word could be " { $snippet "json-string>object" } "." } ;
 
 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
+{ >json json> read-json write-json } related-words
 
 HELP: path>json
 { $values
@@ -18,7 +19,7 @@ HELP: path>json
 }
 { $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
+{ path>json path>jsons json>path jsons>path } related-words
 
 HELP: path>jsons
 { $values
@@ -29,7 +30,8 @@ HELP: path>jsons
 
 HELP: >json
 { $values { "obj" object } { "string" "the object converted to JSON format" } }
-{ $description "Serializes the object into a JSON formatted string." } ;
+{ $description "Serializes the object into a JSON formatted string." }
+{ $notes "The full name of this word could be " { $snippet "object>json-string" } "." } ;
 
 HELP: write-json
 { $values { "obj" object } }
@@ -46,8 +48,6 @@ $nl
 }
 { $see-also >json } ;
 
-{ >json write-json } related-words
-
 { json-fp-special-error json-allow-fp-special? } related-words
 
 HELP: json-fp-special-error
index 8197ae527a392353fa2ba513e024b88373415123..0f8225d109191172e2a136861b2b13b7836ef556 100644 (file)
@@ -1,5 +1,6 @@
-USING: hashtables io.streams.string json json.private kernel
-linked-assocs literals math namespaces strings tools.test ;
+USING: hashtables io.encodings.utf8 io.files io.files.unique
+io.streams.string json json.private kernel linked-assocs
+literals math namespaces sequences strings tools.test ;
 IN: json.tests
 
 ! !!!!!!!!!!!!
@@ -183,3 +184,24 @@ TUPLE: person first-name age ;
         LH{ { "baz" 3 } { "qux" 4 } }
     } dup >jsonlines jsonlines> =
 ] unit-test
+
+{ "6" } [ "[1,2,3]" [ sum ] rewrite-json-string ] unit-test
+{ "9\n81" } [ "3\n9" [ [ sq ] map ] rewrite-jsons-string ] unit-test
+
+{ "[1,2]" } [
+    [
+        "[1]" "test-json"
+        [ utf8 set-file-contents ]
+        [ [ { 2 } append ] rewrite-json-path ]
+        [ utf8 file-contents ] tri
+    ] cleanup-unique-directory
+] unit-test
+
+{ "121\n144" } [
+    [
+        "11\n12" "test-jsons"
+        [ utf8 set-file-contents ]
+        [ [ [ sq ] map ] rewrite-jsons-path ]
+        [ utf8 file-contents ] tri
+    ] cleanup-unique-directory
+] unit-test
index aaebd9353ace7f031b07c73259925f88a560cec8..77619cd85a5b38b5d3b703439c3b87430fb2b48f 100644 (file)
@@ -159,12 +159,6 @@ 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
 
@@ -337,3 +331,27 @@ M: string jsonlines>
 
 : >jsonlines ( objects -- string )
     [ write-jsonlines ] with-string-writer ;
+
+: path>json ( path -- json )
+    utf8 [ read-json get-json ] with-file-reader ;
+
+: path>jsons ( path -- jsons )
+    utf8 [ read-json ] with-file-reader ;
+
+: json>path ( json path -- )
+    utf8 [ write-json ] with-file-writer ;
+
+: jsons>path ( jsons path -- )
+    utf8 [ write-jsonlines ] with-file-writer ;
+
+: rewrite-json-string ( string quot: ( json -- json' ) -- string )
+    [ json> ] dip call >json ; inline
+
+: rewrite-jsons-string ( string quot: ( jsons -- jsons' ) -- string )
+    [ jsonlines> ] dip call >jsonlines ; inline
+
+: rewrite-json-path ( path quot: ( json -- json' ) -- )
+    [ [ path>json ] dip call ] keepd json>path ; inline
+
+: rewrite-jsons-path ( path quot: ( jsons -- jsons' ) -- )
+    [ [ path>jsons ] dip call ] keepd jsons>path ; inline