YAML: support !!timestamp

diff --git a/extra/yaml/conversion/conversion-tests.factor b/extra/yaml/conversion/conversion-tests.factor
index 65a3455be1bc779044ecefd662182adaa780c713..9eba0e21f284ea307e0c34b1b513de4dc0750657 100644 (file)
--- a/extra/yaml/conversion/conversion-tests.factor
+++ b/extra/yaml/conversion/conversion-tests.factor
@@ -16,3 +16,11 @@ ${ YAML_BOOL_TAG } { "true" "True" "false" "FALSE" } resolve-tests
 ${ YAML_INT_TAG } { "0" "0o7" "0x3A" "-19" } resolve-tests
 ${ YAML_FLOAT_TAG } { "0." "-0.0" ".5" "+12e03" "-2E+05" } resolve-tests
 ${ YAML_FLOAT_TAG } { ".inf" "-.Inf" "+.INF" ".NAN" } resolve-tests
+${ YAML_TIMESTAMP_TAG } {
+  "2001-12-15T02:59:43.1Z"
+  "2001-12-14t21:59:43.10-05:00"
+  "2001-12-14 21:59:43.10 -5"
+  "2001-12-15 2:59:43.10"
+  "2002-12-14"
+  "2001-2-4   \t\t  1:59:43.10  \t\t   -5:00"
+} resolve-tests

diff --git a/extra/yaml/conversion/conversion.factor b/extra/yaml/conversion/conversion.factor
index 308a42f73d6a0e506d28702312d93afc666b197e..73745faca75fdf72388ab983b17f6f2d39e5bc08 100644 (file)
--- a/extra/yaml/conversion/conversion.factor
+++ b/extra/yaml/conversion/conversion.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs base64 byte-arrays combinators
 combinators.extras hash-sets kernel linked-assocs math
-math.parser regexp sequences strings yaml.ffi ;
+math.parser regexp sequences strings yaml.ffi
+calendar calendar.format ;
 IN: yaml.conversion
 
 ! !!!!!!!!!!!!!!
@@ -19,6 +20,7 @@ CONSTANT: re-int16 R/ 0x[0-9a-fA-F]+/
 CONSTANT: re-number R/ [-+]?(\.[0-9]+|[0-9]+(\.[0-9]*)?)([eE][-+]?[0-9]+)?/
 CONSTANT: re-infinity R/ [-+]?\.(inf|Inf|INF)/
 CONSTANT: re-nan R/ \.(nan|NaN|NAN)/
+CONSTANT: re-timestamp R/ [0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]|[0-9][0-9][0-9][0-9]-[0-9][0-9]?-[0-9][0-9]?([Tt]|[ \t]+)[0-9][0-9]?:[0-9][0-9]:[0-9][0-9](\.[0-9]*)?([ \t]*(Z|[-+][0-9][0-9]?(:[0-9][0-9])?))?/
 
 : resolve-plain-scalar ( str -- tag )
     {
@@ -31,6 +33,7 @@ CONSTANT: re-nan R/ \.(nan|NaN|NAN)/
         { [ re-number matches? ] [ YAML_FLOAT_TAG ] }
         { [ re-infinity matches? ] [ YAML_FLOAT_TAG ] }
         { [ re-nan matches? ] [ YAML_FLOAT_TAG ] }
+        { [ re-timestamp matches? ] [ YAML_TIMESTAMP_TAG ] }
         [ drop YAML_STR_TAG ]
     } cond-case ;
 
@@ -77,6 +80,22 @@ CONSTANT: YAML_SET_TAG "tag:yaml.org,2002:set"
         [ string>number ]
     } cond ;
 
+! YAML allows
+! - multiple whitespaces between date and time
+! - multiple whitespaces between time and offset
+! - months, days and hours on 1 digit
+! preprocess to fix this mess...
+: yaml>rfc3339 ( str -- str' )
+    R/ -[0-9][^0-9]/ [ [ CHAR: 0 1 ] dip insert-nth ] re-replace-with
+    R/ -[0-9][^0-9]/ [ [ CHAR: 0 1 ] dip insert-nth ] re-replace-with
+    R/ [^0-9][0-9]:/ [ [ CHAR: 0 1 ] dip insert-nth ] re-replace-with
+    R/ [ \t]+/ " " re-replace
+    CHAR: : over index cut CHAR: space swap remove append ;
+
+: construct-timestamp ( obj -- obj' )
+    dup R/ [0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]/ matches?
+    [ ymd>timestamp ] [ yaml>rfc3339 rfc3339>timestamp ] if ;
+
 : construct-scalar ( scalar-event -- scalar )
     [ value>> ] [ resolve-scalar ] bi {
         { YAML_NULL_TAG [ drop f ] }
@@ -84,6 +103,7 @@ CONSTANT: YAML_SET_TAG "tag:yaml.org,2002:set"
         { YAML_INT_TAG [ construct-int ] }
         { YAML_FLOAT_TAG [ construct-float ] }
         { YAML_BINARY_TAG [ base64> ] }
+        { YAML_TIMESTAMP_TAG [ construct-timestamp ] }
         { YAML_STR_TAG [ ] }
     } case ;
 
@@ -128,3 +148,6 @@ M: float yaml-tag ( obj -- tag ) drop YAML_FLOAT_TAG ;
 
 M: byte-array represent-scalar ( obj -- str ) >base64 "" like ;
 M: byte-array yaml-tag ( obj -- tag ) drop YAML_BINARY_TAG ;
+
+M: timestamp represent-scalar ( obj -- str ) timestamp>rfc3339 ;
+M: timestamp yaml-tag ( obj -- str ) drop YAML_TIMESTAMP_TAG ;

diff --git a/extra/yaml/yaml-docs.factor b/extra/yaml/yaml-docs.factor
index 5a02f9da29594f5a4e50282e2728892ddd82b653..62a95b41848705f12a603cf0520d06a723fe15a8 100644 (file)
--- a/extra/yaml/yaml-docs.factor
+++ b/extra/yaml/yaml-docs.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2014 Jon Harper.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs byte-arrays hash-sets hashtables
+USING: arrays assocs byte-arrays hash-sets hashtables calendar
 help.markup help.syntax kernel linked-assocs math sequences sets
 strings yaml.ffi yaml.config ;
 IN: yaml
@@ -86,7 +86,7 @@ ARTICLE: "yaml-mapping" "Mapping between Factor and YAML types"
   { "!!float" { $link float } }
   { "!!str" { $link string } }
   { "!!binary" { $link byte-array } }
-  { "!!timestamp" "Not supported yet" }
+  { "!!timestamp" { $link timestamp } }
   { { $snippet "sequences" } "" }
   { "!!seq" { $link array } }
   { "!!omap" { $link linked-assoc } }

diff --git a/extra/yaml/yaml-tests.factor b/extra/yaml/yaml-tests.factor
index 6d194b6610b63b4d2ca3097de8e2094926852bf5..2d086232b93da9a6ba2056a155e9776c9c8207bc 100644 (file)
--- a/extra/yaml/yaml-tests.factor
+++ b/extra/yaml/yaml-tests.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs grouping kernel linked-assocs literals locals
 namespaces sequences tools.test yaml yaml.config yaml.ffi
-yaml.private ;
+yaml.private calendar ;
 IN: yaml.tests
 
 ! TODO real conformance tests here
@@ -526,18 +526,82 @@ ${ construct-pairs-obj } [ $ construct-pairs-obj >yaml yaml> ] unit-test
 
 ! !!!!!!!!!!!!!!!
 ! construct-timestamp
-! TODO what to do with timestamp ?
-! CONSTANT: construct-timestamp-obj f
-! 
-! CONSTANT: construct-timestamp-str """canonical:        2001-12-15T02:59:43.1Z
-! valid iso8601:    2001-12-14t21:59:43.10-05:00
-! space separated:  2001-12-14 21:59:43.10 -5
-! no time zone (Z): 2001-12-15 2:59:43.10
-! date (00:00:00Z): 2002-12-14
-! """
-! 
-! ${ construct-timestamp-obj } [ $ construct-timestamp-str yaml> ] unit-test
-! ${ construct-timestamp-obj } [ $ construct-timestamp-obj >yaml yaml> ] unit-test
+CONSTANT: construct-timestamp-obj H{
+    {
+        "space separated"
+        T{ timestamp
+            { year 2001 }
+            { month 12 }
+            { day 14 }
+            { hour 21 }
+            { minute 59 }
+            { second 43+1/10 }
+            { gmt-offset T{ duration { hour -5 } } }
+        }
+    }
+    {
+        "canonical"
+        T{ timestamp
+            { year 2001 }
+            { month 12 }
+            { day 15 }
+            { hour 2 }
+            { minute 59 }
+            { second 43+1/10 }
+        }
+    }
+    {
+        "date (00:00:00Z)"
+        T{ timestamp { year 2002 } { month 12 } { day 14 } }
+    }
+    {
+        "no time zone (Z)"
+        T{ timestamp
+            { year 2001 }
+            { month 12 }
+            { day 15 }
+            { hour 2 }
+            { minute 59 }
+            { second 43+1/10 }
+        }
+    }
+    {
+        "valid iso8601"
+        T{ timestamp
+            { year 2001 }
+            { month 12 }
+            { day 14 }
+            { hour 21 }
+            { minute 59 }
+            { second 43+1/10 }
+            { gmt-offset T{ duration { hour -5 } } }
+        }
+    }
+    {
+        "crazy"
+        T{ timestamp
+            { year 2002 }
+            { month 2 }
+            { day 4 }
+            { hour 1 }
+            { minute 2 }
+            { second 59+123/1000 }
+            { gmt-offset
+                T{ duration { hour 10 } { minute 23 } }
+            }
+        }
+    }
+}
+CONSTANT: construct-timestamp-str """canonical:        2001-12-15T02:59:43.1Z
+valid iso8601:    2001-12-14t21:59:43.10-05:00
+space separated:  2001-12-14 21:59:43.10 -5
+no time zone (Z): 2001-12-15 2:59:43.10
+date (00:00:00Z): 2002-12-14
+crazy: 2002-2-4   \t\t \t 1:02:59.123 \t\t +10:23
+"""
+
+${ construct-timestamp-obj } [ $ construct-timestamp-str yaml> ] unit-test
+${ construct-timestamp-obj } [ $ construct-timestamp-obj >yaml yaml> ] unit-test
 
 ! !!!!!!!!!!!!!!!
 ! construct-value