YAML: add output configuration options

extra/yaml/config/config-docs.factor

@@ -30,7 +30,8 @@ HELP: emitter-width
 { $var-description "If set, " { $link yaml_emitter_set_width } " is called with the value of this variable at the beginning of each document." } ;
 
 ARTICLE: "yaml-config" "YAML control variables"
-"The following variables control the YAML serialization/deserialization: "
+"The following variables control the YAML serialization/deserialization"
+{ $heading "LibYAML's emitter:" }
 { $subsections
   emitter-canonical
   emitter-indent
@@ -39,6 +40,33 @@ ARTICLE: "yaml-config" "YAML control variables"
   emitter-width
 }
 "Using libyaml's default values: " { $link +libyaml-default+ }
+{ $heading "Tags" }
+{ $subsections
+  implicit-tags
+}
+{ $heading "Document markers" }
+{ $subsections
+  implicit-start
+  implicit-end
+}
 ;
 
+HELP: implicit-tags
+{ $var-description """When this is set, tags are omitted during serialization when it safe to do so. For example, 42 can be safely serialized as "42", but "42" must be serialized as "'42'" or ""42"" or "!!str 42". This uses the """
+{ $snippet "implicit" } " parameter of "
+{ $link yaml_scalar_event_initialize } ", " { $link yaml_sequence_start_event_initialize } " and " { $link yaml_mapping_start_event_initialize } "."
+ } ;
+
+HELP: implicit-start
+{ $var-description "The \""
+{ $snippet "implicit" } "\" parameter of " { $link yaml_document_start_event_initialize } ". Changing this variable is always safe and produces valid YAML documents because LibYAML ignores it when it would be invalid (for example, when there are multiple documents in a stream)." }
+;
+
+HELP: implicit-end
+{ $var-description "The \""
+{ $snippet "implicit" } "\" parameter of " { $link yaml_document_end_event_initialize } ". Changing this variable is always safe and produces valid YAML documents because LibYAML ignores it when it would be invalid (for example, when there are multiple documents in a stream)." }
+;
+
+{ implicit-start implicit-end } related-words
+
 ABOUT: "yaml-config"

extra/yaml/config/config.factor

@@ -22,3 +22,11 @@ SYMBOL: +libyaml-default+
 } [ +libyaml-default+ swap set-global ] each
 ! But Factor is unicode-friendly by default
 t emitter-unicode set-global
+
+SYMBOL: implicit-tags
+t implicit-tags set-global
+
+SYMBOL: implicit-start
+SYMBOL: implicit-end
+t implicit-start set-global
+t implicit-end set-global

extra/yaml/yaml-tests.factor

@@ -1,11 +1,21 @@
 ! Copyright (C) 2014 Jon Harper.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs kernel linked-assocs literals locals sequences
-tools.test yaml yaml.private grouping ;
+tools.test yaml yaml.private yaml.config grouping namespaces ;
 IN: yaml.tests
 
 ! TODO real conformance tests here
 
+! Config
+f implicit-tags set
+f implicit-start set
+f implicit-end set
++libyaml-default+ emitter-canonical set
++libyaml-default+ emitter-indent set
++libyaml-default+ emitter-width set
++libyaml-default+ emitter-line-break set
+t emitter-unicode set
+
 ! Basic test
 CONSTANT: test-string """--- # Favorite movies
  - Casablanca
@@ -570,3 +580,57 @@ ${ construct-value-obj } [ $ construct-value-obj >yaml-docs yaml-docs> ] unit-te
 
 ! Don't use aliases/anchors for equal fixnums
 { f } [ CHAR: & { 0 0 } >yaml member? ] unit-test
+
+! !!!!!!!!!!!!!!!
+! Config
+t implicit-tags set
+t implicit-start set
+t implicit-end set
+
+! unicode on
+  t emitter-unicode
+[
+{ "- Hello
+- Grüß dich
+- здравствуйте
+- こんにちは
+- 안녕하세요
+- 'שָׁלוֹם '
+- გამარჯობა
+" } [ { "Hello" "Grüß dich" "здравствуйте" "こんにちは" "안녕하세요" "שָׁלוֹם " "გამარჯობა" } >yaml ] unit-test
+] with-variable
+
+! unicode off
+f emitter-unicode
+[
+{ """- Hello
+- "Gr\\xFC\\xDF dich"
+- "\\u0437\\u0434\\u0440\\u0430\\u0432\\u0441\\u0442\\u0432\\u0443\\u0439\\u0442\\u0435"
+- "\\u3053\\u3093\\u306B\\u3061\\u306F"
+- "\\uC548\\uB155\\uD558\\uC138\\uC694"
+- "\\u05E9\\u05B8\\u05C1\\u05DC\\u05D5\\u05B9\\u05DD "
+- "\\u10D2\\u10D0\\u10DB\\u10D0\\u10E0\\u10EF\\u10DD\\u10D1\\u10D0"
+""" } [ { "Hello" "Grüß dich" "здравствуйте" "こんにちは" "안녕하세요" "שָׁלוֹם " "გამარჯობა" } >yaml ] unit-test
+] with-variable
+
+! canonical
+t emitter-canonical [
+{ """---
+!!seq [
+  !!int "1",
+  !!float "2.0",
+  !!bool "false",
+]
+""" } [ { 1 2.0 f } >yaml ] unit-test
+] with-variable
+
+{
+  { emitter-indent 6 }
+  { emitter-width 32 }
+}
+[
+{ "-     - a string that can be split
+            in lots of places
+"
+ } [ { { "a string that can be split in lots of places" } } >yaml ] unit-test
+] with-variables

extra/yaml/yaml.factor

@@ -345,10 +345,15 @@ GENERIC: emit-value ( emitter event anchor obj -- )
 
 : emit-object ( emitter event obj -- ) [ f ] dip emit-value ;
 
+: scalar-implicit-tag? ( tag str -- plain_implicit quoted_implicit )
+    implicit-tags get [
+        resolve-plain-scalar = t
+    ] [ 2drop f f ] if ;
+
 :: emit-scalar ( emitter event anchor obj -- )
     event anchor
     obj [ yaml-tag ] [ represent-scalar ] bi
-    -1 f f YAML_ANY_SCALAR_STYLE
+    -1 2over scalar-implicit-tag? YAML_ANY_SCALAR_STYLE
     yaml_scalar_event_initialize yaml-initialize-assert-ok
     emitter event yaml_emitter_emit_asserted ;
 
@@ -361,8 +366,8 @@ M:: yaml-alias emit-value ( emitter event unused obj -- )
     event obj anchor>> yaml_alias_event_initialize yaml-initialize-assert-ok
     emitter event yaml_emitter_emit_asserted ;
 
-:: emit-sequence-start ( emitter event anchor tag -- )
-    event anchor tag f YAML_ANY_SEQUENCE_STYLE
+:: emit-sequence-start ( emitter event anchor tag implicit -- )
+    event anchor tag implicit YAML_ANY_SEQUENCE_STYLE
     yaml_sequence_start_event_initialize yaml-initialize-assert-ok
     emitter event yaml_emitter_emit_asserted ;
 
@@ -389,17 +394,17 @@ M: string emit-value ( emitter event anchor string -- ) emit-scalar ;
 M: byte-array emit-value ( emitter event anchor byte-array -- ) emit-scalar ;
 
 M: sequence emit-value ( emitter event anchor seq -- )
-    [ drop YAML_SEQ_TAG emit-sequence-start ]
+    [ drop YAML_SEQ_TAG implicit-tags get emit-sequence-start ]
     [ nip emit-sequence-body ]
     [ 2drop emit-sequence-end ] 4tri ;
 
 M: linked-assoc emit-value ( emitter event anchor assoc -- )
-    [ drop YAML_OMAP_TAG emit-sequence-start ]
+    [ drop YAML_OMAP_TAG f emit-sequence-start ]
     [ nip emit-linked-assoc-body ]
     [ 2drop emit-sequence-end ] 4tri ;
 
-:: emit-assoc-start ( emitter event anchor tag -- )
-    event anchor tag f YAML_ANY_MAPPING_STYLE
+:: emit-assoc-start ( emitter event anchor tag implicit -- )
+    event anchor tag implicit YAML_ANY_MAPPING_STYLE
     yaml_mapping_start_event_initialize yaml-initialize-assert-ok
     emitter event yaml_emitter_emit_asserted ;
 
@@ -408,12 +413,12 @@ M: linked-assoc emit-value ( emitter event anchor assoc -- )
     yaml_emitter_emit_asserted ;
 
 M: assoc emit-value ( emitter event anchor assoc -- )
-    [ drop YAML_MAP_TAG emit-assoc-start ]
+    [ drop YAML_MAP_TAG implicit-tags get emit-assoc-start ]
     [ nip emit-assoc-body ]
     [ 2drop emit-assoc-end ] 4tri ;
 
 M: set emit-value ( emitter event anchor set -- )
-    [ drop YAML_SET_TAG emit-assoc-start ]
+    [ drop YAML_SET_TAG f emit-assoc-start ]
     [ nip emit-set-body ]
     [ 2drop emit-assoc-end ] 4tri ;
 
@@ -450,12 +455,12 @@ M: set emit-value ( emitter event anchor set -- )
     emitter event ;
 
 :: emit-doc ( emitter event obj -- )
-    event f f f f yaml_document_start_event_initialize yaml-initialize-assert-ok
+    event f f f implicit-start get yaml_document_start_event_initialize yaml-initialize-assert-ok
     emitter event yaml_emitter_emit_asserted
 
     emitter event obj emit-object
 
-    event f yaml_document_end_event_initialize yaml-initialize-assert-ok
+    event implicit-end get yaml_document_end_event_initialize yaml-initialize-assert-ok
     emitter event yaml_emitter_emit_asserted ;
 
 :: flush-emitter ( emitter event -- str )