cbor: read bignums, read/write timestamps and urls.

diff --git a/extra/cbor/cbor-tests.factor b/extra/cbor/cbor-tests.factor
index 6f39b7c41b1b4a8c24fee82ee806dd68bfb08f18..4df5a3f7df05e16cd1d59b5b855ab7361783be94 100644 (file)
--- a/extra/cbor/cbor-tests.factor
+++ b/extra/cbor/cbor-tests.factor
@@ -1,5 +1,5 @@
-USING: arrays cbor literals math math.parser math.ranges
-tools.test ;
+USING: arrays calendar cbor literals math math.parser
+math.ranges tools.test urls ;
 
 { 500 } [ B{ 0b000,11001 0x01 0xf4 } cbor> ] unit-test
 
@@ -56,12 +56,12 @@ tools.test ;
 { T{ cbor-simple f 16 } } [ B{ 0xf0 } cbor> ] unit-test
 { T{ cbor-simple f 24 } } [ B{ 0xf8 0x18 } cbor> ] unit-test
 { T{ cbor-simple f 255 } } [ B{ 0xf8 0xff } cbor> ] unit-test
-{ T{ cbor-tagged f 0 "2013-03-21T20:04:00Z" } } [ "c074323031332d30332d32315432303a30343a30305a" hex-string>bytes cbor> ] unit-test
-{ T{ cbor-tagged f 1 1363896240 } } [ "c11a514b67b0" hex-string>bytes cbor> ] unit-test
-{ T{ cbor-tagged f 1 1363896240.5 } } [ "c1fb41d452d9ec200000" hex-string>bytes cbor> ] unit-test
+{ T{ timestamp { year 2013 } { month 3 } { day 21 } { hour 20 } { minute 4 } } } [ "c074323031332d30332d32315432303a30343a30305a" hex-string>bytes cbor> ] unit-test
+{ T{ timestamp { year 2013 } { month 3 } { day 21 } { hour 20 } { minute 4 } } } [ "c11a514b67b0" hex-string>bytes cbor> ] unit-test
+{ T{ timestamp { year 2013 } { month 3 } { day 21 } { hour 20 } { minute 4 } { second 0.5 } } } [ "c1fb41d452d9ec200000" hex-string>bytes cbor> ] unit-test
 { T{ cbor-tagged f 23 B{ 0x01 0x02 0x03 0x04 } } } [ "d74401020304" hex-string>bytes cbor> ] unit-test
 { T{ cbor-tagged f 24 B{ 0x64 0x49 0x45 0x54 0x46 } } } [ "d818456449455446" hex-string>bytes cbor> ] unit-test
-{ T{ cbor-tagged f 32 "http://www.example.com" } } [ "d82076687474703a2f2f7777772e6578616d706c652e636f6d" hex-string>bytes cbor> ] unit-test
+{ URL" http://www.example.com" } [ "d82076687474703a2f2f7777772e6578616d706c652e636f6d" hex-string>bytes cbor> ] unit-test
 { B{ } } [ B{ 0x40 } cbor> ] unit-test
 { B{ 1 2 3 4 } } [ B{ 0x44 0x01 0x02 0x03 0x04 } cbor> ] unit-test
 { "" } [ B{ 0x60 } cbor> ] unit-test

diff --git a/extra/cbor/cbor.factor b/extra/cbor/cbor.factor
index aec3a09876c54546152d3cf1985e45963d5d749e..2ec03417579042dece8c9467639c56b46c9ba7f9 100644 (file)
--- a/extra/cbor/cbor.factor
+++ b/extra/cbor/cbor.factor
@@ -1,10 +1,11 @@
 ! Copyright (C) 2019 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: accessors arrays assocs byte-arrays combinators io
-io.binary io.encodings.binary io.encodings.string
-io.encodings.utf8 io.streams.byte-array io.streams.string kernel
-math math.bitwise math.floats.half sequences strings ;
+USING: accessors arrays assocs base64 byte-arrays calendar
+calendar.format calendar.parser combinators io io.binary
+io.encodings.binary io.encodings.string io.encodings.utf8
+io.streams.byte-array io.streams.string kernel math math.bitwise
+math.floats.half present sequences strings urls ;
 
 IN: cbor
 
@@ -61,7 +62,15 @@ TUPLE: cbor-simple value ;
     ] if ;
 
 : read-tagged ( info -- tagged )
-    read-unsigned read-cbor cbor-tagged boa ;
+    read-unsigned read-cbor swap {
+        { 0 [ rfc3339>timestamp ] }
+        { 1 [ unix-time>timestamp ] }
+        { 2 [ be> ] }
+        { 3 [ be> neg 1 - ] }
+        { 32 [ >url ] }
+        { 33 [ base64> ] }
+        [ swap cbor-tagged boa ]
+    } case ;
 
 : read-float ( info -- float )
     dup 20 < [ cbor-simple boa ] [
@@ -133,6 +142,12 @@ M: sequence write-cbor
 M: assoc write-cbor
     dup length 5 write-integer [ [ write-cbor ] bi@ ] assoc-each ;
 
+M: timestamp write-cbor
+    0 6 write-integer timestamp>rfc3339 write-cbor ;
+
+M: url write-cbor
+    32 6 write-integer present write-cbor ;
+
 M: cbor-tagged write-cbor
     dup tag>> 6 write-integer item>> write-cbor ;