]> gitweb.factorcode.org Git - factor.git/commitdiff
YAML: allow configuration of !!merge and !!value
authorJon Harper <jon.harper87@gmail.com>
Sun, 29 Jun 2014 15:47:49 +0000 (17:47 +0200)
committerJohn Benediktsson <mrjbq7@gmail.com>
Tue, 8 Jul 2014 22:53:52 +0000 (15:53 -0700)
extra/yaml/config/config-docs.factor
extra/yaml/config/config.factor
extra/yaml/conversion/conversion-docs.factor [new file with mode: 0644]
extra/yaml/yaml-docs.factor
extra/yaml/yaml-tests.factor
extra/yaml/yaml.factor

index 025bfe56bf1f0e04a37beee97215d0a2633f4424..ffa2fc28ba60ad317c4865db260f1c7a37281f02 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2014 Jon Harper.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax yaml.ffi ;
+USING: help.markup help.syntax yaml.ffi yaml.conversion ;
 IN: yaml.config
 
 HELP: +libyaml-default+
@@ -30,7 +30,21 @@ 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"
+{ $subsections
+  "yaml-input"
+  "yaml-output"
+}
+;
+
+ARTICLE: "yaml-input" "YAML deserialization control"
+"The following variables control the YAML deserialization process:"
+{ $heading "Special Keys" }
+{ $subsections
+  value
+  merge
+} ;
+ARTICLE: "yaml-output" "YAML serialization control"
+"The following variables control the YAML serialization process:"
 { $heading "LibYAML's emitter:" }
 { $subsections
   emitter-canonical
@@ -69,4 +83,11 @@ HELP: implicit-end
 
 { implicit-start implicit-end } related-words
 
+HELP: merge
+{ $var-description "If false, deserialized yaml documents will contain instances of " { $link yaml-merge } " for !!merge keys and the value associated with this key will not be merged into the enclosing mapping. You can then call ?apply-merge-key on such a mapping to perform the merge."  } ;
+
+HELP: value
+{ $var-description "If false, deserialized yaml documents will contain instances of " { $link yaml-value } " for !!value keys and the value associated with this key will replace the enclosing mapping. You can then call scalar-value on such a mapping to get the default value."  } ;
 ABOUT: "yaml-config"
+{ yaml-merge merge } related-words
+{ yaml-value value } related-words
index e5a15bbd80257895c751e019b76c7d0fa21bc7c1..079f840f0211b468f0642964c82eac6b375ffa03 100644 (file)
@@ -30,3 +30,9 @@ SYMBOL: implicit-start
 SYMBOL: implicit-end
 t implicit-start set-global
 t implicit-end set-global
+
+! By default, give the simplest representation of the document
+SYMBOL: merge
+SYMBOL: value
+t merge set-global
+t value set-global
diff --git a/extra/yaml/conversion/conversion-docs.factor b/extra/yaml/conversion/conversion-docs.factor
new file mode 100644 (file)
index 0000000..c2d38bd
--- /dev/null
@@ -0,0 +1,10 @@
+! Copyright (C) 2014 Jon Harper.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel strings ;
+IN: yaml.conversion
+
+HELP: yaml-merge
+{ $var-description "Represents a !!merge key in a yaml document." } ;
+
+HELP: yaml-value
+{ $var-description "Represents a !!value key in a yaml document." } ;
index 62a95b41848705f12a603cf0520d06a723fe15a8..a96f516787ce073a3651387fb60ffae6fbb31c9f 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs byte-arrays hash-sets hashtables calendar
 help.markup help.syntax kernel linked-assocs math sequences sets
-strings yaml.ffi yaml.config ;
+strings yaml.ffi yaml.config yaml.conversion ;
 IN: yaml
 
 HELP: >yaml
@@ -73,6 +73,22 @@ HELP: yaml-unexpected-event
 }
 { $description "LibYAML produced the unexpected event " { $snippet "actual" } ", but the list of expected events is " { $snippet "expected" } "." } ;
 
+HELP: ?apply-merge-key
+{ $values
+    { "assoc" assoc }
+    { "assoc'" assoc }
+}
+{ $description "Merges the value of the !!merge key in " { $snippet "assoc" } } ;
+{ merge ?apply-merge-key } related-words
+{ value scalar-value } related-words
+
+HELP: scalar-value
+{ $values
+    { "obj" object }
+    { "obj'" object }
+}
+{ $description "If " { $snippet "obj" } " is hashtable, returns it's default value, else return " { $snippet "obj" } " itself."  } ;
+
 ARTICLE: "yaml-mapping" "Mapping between Factor and YAML types"
 { $heading "Types mapping" }
 "The rules in the table below are used to convert between yaml and factor objects."
@@ -94,6 +110,9 @@ ARTICLE: "yaml-mapping" "Mapping between Factor and YAML types"
   { { $snippet "mappings" } "" }
   { "!!map" { $link hashtable } }
   { "!!set" { $link hash-set } }
+  { { $snippet "special keys" } "" }
+  { "!!merge" { $link yaml-merge } }
+  { "!!value" { $link yaml-value } }
 }
 
 { $heading "YAML to Factor Round Tripping" }
@@ -112,24 +131,6 @@ ARTICLE: "yaml-mapping" "Mapping between Factor and YAML types"
 "Examples of type precedence which preserves type: " { $link byte-array } " over " { $link sequence } "."
 ;
 
-ARTICLE: "yaml-output" "Serialization control"
-"TODO allow to control the serialization details, for example"
-{ $list
-  "force explicit/implicit types"
-  "force flow/block styles"
-  "etc."
-}
-;
-ARTICLE: "yaml-input" "Deserialization control"
-"TODO, implement or drop the following features:"
-{ $list
-  "Activate/deactivate !!value"
-  "Activate/deactivate !!merge ?"
-  "Activate/deactivate YAML1.1 compatibility (ie boolean as On, OFF etc)"
-  "select schema: \"failsafe\", \"JSON\", \"Core\" ?"
-  "etc."
-}
-;
 ARTICLE: "yaml-errors" "YAML errors"
 { $heading "libYAML's errors" }
 "LibYAML exposes error when parsing/emitting yaml. See " { $url "http://pyyaml.org/wiki/LibYAML" } ". More information is available directly in pyyaml's source code in their C interface. They are groupped in the following errors:"
@@ -149,6 +150,43 @@ ARTICLE: "yaml-errors" "YAML errors"
 "The following error probably means that there is a bug in the implementation: " { $link yaml-unexpected-event }
 ;
 
+ARTICLE: "yaml-keys" "Special mapping keys"
+"The following special keys have been implemented for !!map. By default, these keys will be taken into account when deserializing yaml documents. To keep the original document structure, configuration variables can be set. See " { $link "yaml-config" } "."
+{ $heading "!!merge" }
+"See " { $url "http://yaml.org/type/merge.html" } $nl
+"As per " { $url "http://sourceforge.net/p/yaml/mailman/message/12308050" }
+", the merge key is implemented bottom up:" $nl
+{ $example """USING: yaml prettyprint ;
+"
+foo: 1
+<<:
+  bar: 2
+  <<:
+    baz: 3
+" yaml> ."""
+"""H{ { "bar" 2 } { "foo" 1 } { "baz" 3 } }""" }
+{ $heading "!!value" }
+"See " { $url "http://yaml.org/type/value.html" } $nl
+{ $example """USING: yaml prettyprint ;
+"
+---     # Old schema
+link with:
+  - library1.dll
+  - library2.dll
+---     # New schema
+link with:
+  - = : library1.dll
+    version: 1.2
+  - = : library2.dll
+    version: 2.3
+" yaml-docs> ."""
+"""{
+    H{ { "link with" { "library1.dll" "library2.dll" } } }
+    H{ { "link with" { "library1.dll" "library2.dll" } } }
+}"""
+}
+
+;
 ARTICLE: "yaml" "YAML serialization"
 "The " { $vocab-link "yaml" } " vocabulary implements YAML serialization/deserialization. It uses LibYAML, a YAML parser and emitter written in C (" { $url "http://pyyaml.org/wiki/LibYAML" } ")."
 { $heading "Main conversion words" }
@@ -161,8 +199,7 @@ ARTICLE: "yaml" "YAML serialization"
 { $heading "Next topics:" }
 { $subsections
 "yaml-mapping"
-"yaml-output"
-"yaml-input"
+"yaml-keys"
 "yaml-errors"
 "yaml-config"
 }
index 566ab49a37d31f9b08897625742c201ea7d5b0e8..e567815f6f8c74194111323e2cdc7405360deb21 100644 (file)
@@ -521,6 +521,16 @@ CONSTANT: recursive-merge-obj3 H{
 ${ recursive-merge-obj3 } [ $ recursive-merge-str3 yaml> ] unit-test
 ${ recursive-merge-obj3 } [ $ recursive-merge-obj3 >yaml yaml> ] unit-test
 
+! Serializing merge
+CONSTANT: serialize-merge-obj H{
+  { T{ yaml-merge } H{ { 1 2 } } }
+}
+CONSTANT: serialize-merge-obj2 H{ { 1 2 } }
+${ serialize-merge-obj2 } [ $ serialize-merge-obj >yaml yaml> ] unit-test
+f merge [
+  ${ serialize-merge-obj } [ $ serialize-merge-obj >yaml yaml> ] unit-test
+] with-variable
+
 ! !!!!!!!!!!!!!!!
 ! construct-omap
 CONSTANT: construct-omap-obj H{
@@ -683,8 +693,8 @@ CONSTANT: construct-value-unsafe-obj {
     H{ { "link with" { "library1.dll" "library2.dll" } } }
     H{ {
         "link with" {
-            H{ { "=" "library1.dll" } { "version" 1.2 } }
-            H{ { "=" "library2.dll" } { "version" 2.3 } }
+            H{ { T{ yaml-value } "library1.dll" } { "version" 1.2 } }
+            H{ { T{ yaml-value } "library2.dll" } { "version" 2.3 } }
         }
     } }
 }
@@ -707,6 +717,25 @@ link with:
 
 ${ construct-value-safe-obj } [ $ construct-value-str yaml-docs> ] unit-test
 ${ construct-value-safe-obj } [ $ construct-value-safe-obj >yaml-docs yaml-docs> ] unit-test
+f value [
+  ${ construct-value-unsafe-obj } [ $ construct-value-str yaml-docs> ] unit-test
+  ${ construct-value-unsafe-obj } [ $ construct-value-unsafe-obj >yaml-docs yaml-docs> ] unit-test
+  ${ construct-value-safe-obj } [
+    $ construct-value-str yaml-docs> [
+     dup "link with" swap [ [ scalar-value ] map ] change-at
+    ] map
+  ] unit-test
+] with-variable
+
+! Serializing value
+CONSTANT: serialize-value-obj H{
+  { T{ yaml-value } 1 }
+}
+CONSTANT: serialize-value-obj2 1
+${ serialize-value-obj2 } [ $ serialize-value-obj >yaml yaml> ] unit-test
+f value [
+  ${ serialize-value-obj } [ $ serialize-value-obj >yaml yaml> ] unit-test
+] with-variable
 
 ! !!!!!!!!!!!!!!!
 ! errors
index f990cbd9c32f50cecf4bde9d9bbaa14859bbc27d..8cb22aec7a00f21f796ac1751ffaa8e8b873da7f 100644 (file)
@@ -218,6 +218,20 @@ M: assoc (deref-aliases)
 GENERIC: merge-value ( assoc value -- assoc' )
 M: sequence merge-value merge-values merge-value ;
 M: assoc merge-value over assoc-diff assoc-union! ;
+: pop-at* ( key assoc -- value/f ? )
+    [ at* ] 2keep pick [ delete-at ] [ 2drop ] if ;
+
+: ?apply-default-key ( assoc -- obj' )
+    T{ yaml-value } over pop-at* [ nip ] [ drop ] if ;
+PRIVATE>
+
+: ?apply-merge-key ( assoc -- assoc' )
+    T{ yaml-merge } over pop-at*
+    [ merge-value ] [ drop ] if ;
+: scalar-value ( obj -- obj' )
+    dup hashtable? [ ?apply-default-key ] when ;
+
+<PRIVATE
 
 GENERIC: apply-merge-keys ( already-applied-set obj -- obj' )
 : ?apply-merge-keys ( set obj -- obj' )
@@ -227,22 +241,16 @@ M: sequence apply-merge-keys
 M: object apply-merge-keys nip ;
 M: byte-array apply-merge-keys nip ;
 M: string apply-merge-keys nip ;
-: pop-at* ( key assoc -- value/f ? )
-    [ at* ] 2keep pick [ delete-at ] [ 2drop ] if ;
-: ?apply-merge-key ( assoc -- assoc' )
-    T{ yaml-merge } over pop-at*
-    [ merge-value ] [ drop ] if ;
-: ?apply-default-key ( assoc -- obj' )
-    T{ yaml-value } over pop-at* [ nip ] [ drop ] if ;
 M: assoc apply-merge-keys
     [ [ ?apply-merge-keys ] bi-curry@ bi ] with2 assoc-map!
-    ?apply-merge-key ?apply-default-key ;
+    merge get [ ?apply-merge-key ] when
+    value get [ ?apply-default-key ] when ;
 
 :: parse-yaml-doc ( parser event -- obj )
     H{ } clone anchors [
         parser event next-value
         anchors get swap (deref-aliases)
-        IHS{ } clone swap ?apply-merge-keys
+        merge get value get or [ IHS{ } clone swap ?apply-merge-keys ] when
     ] with-variable ;
 
 :: ?parse-yaml-doc ( parser event -- obj/f ? )