diff --git a/extra/yaml/conversion/conversion.factor b/extra/yaml/conversion/conversion.factor index d14846ad28..daee389da7 100644 --- a/extra/yaml/conversion/conversion.factor +++ b/extra/yaml/conversion/conversion.factor @@ -8,6 +8,7 @@ IN: yaml.conversion ! http://yaml.org/type/ CONSTANT: YAML_MERGE_TAG "tag:yaml.org,2002:merge" +CONSTANT: YAML_VALUE_TAG "tag:yaml.org,2002:value" ! !!!!!!!!!!!!!! ! tag resolution @@ -41,9 +42,11 @@ CONSTANT: re-timestamp R/ [0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]|[0-9][0-9][ } cond-case ; CONSTANT: re-merge R/ < yaml-merge +TUPLE: yaml-value ; +C: yaml-value : construct-scalar ( scalar-event mapping-key? -- scalar ) [ drop value>> ] [ resolve-scalar ] 2bi { @@ -126,6 +131,7 @@ C: yaml-merge { YAML_BINARY_TAG [ base64> ] } { YAML_TIMESTAMP_TAG [ construct-timestamp ] } { YAML_MERGE_TAG [ drop ] } + { YAML_VALUE_TAG [ drop ] } { YAML_STR_TAG [ ] } } case ; @@ -176,3 +182,6 @@ M: timestamp yaml-tag ( obj -- str ) drop YAML_TIMESTAMP_TAG ; M: yaml-merge represent-scalar ( obj -- str ) drop "<<" ; M: yaml-merge yaml-tag ( obj -- str ) drop YAML_MERGE_TAG ; + +M: yaml-value represent-scalar ( obj -- str ) drop "=" ; +M: yaml-value yaml-tag ( obj -- str ) drop YAML_VALUE_TAG ; diff --git a/extra/yaml/yaml-tests.factor b/extra/yaml/yaml-tests.factor index 7a8d5fea74..566ab49a37 100644 --- a/extra/yaml/yaml-tests.factor +++ b/extra/yaml/yaml-tests.factor @@ -679,9 +679,7 @@ ${ construct-timestamp-obj } [ $ construct-timestamp-obj >yaml yaml> ] unit-test ! !!!!!!!!!!!!!!! ! construct-value -! TODO: find something better to do with '=' ? see http://yaml.org/type/value.html -! Maybe a global parameter to replace all maps with their default values ? See pyyaml SafeConstructor -CONSTANT: construct-value-obj { +CONSTANT: construct-value-unsafe-obj { H{ { "link with" { "library1.dll" "library2.dll" } } } H{ { "link with" { @@ -690,6 +688,10 @@ CONSTANT: construct-value-obj { } } } } +CONSTANT: construct-value-safe-obj { + H{ { "link with" { "library1.dll" "library2.dll" } } } + H{ { "link with" { "library1.dll" "library2.dll" } } } +} CONSTANT: construct-value-str """--- # Old schema link with: @@ -703,8 +705,8 @@ link with: version: 2.3 """ -${ construct-value-obj } [ $ construct-value-str yaml-docs> ] unit-test -${ construct-value-obj } [ $ construct-value-obj >yaml-docs yaml-docs> ] unit-test +${ 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 ! !!!!!!!!!!!!!!! ! errors diff --git a/extra/yaml/yaml.factor b/extra/yaml/yaml.factor index 8774023363..f990cbd9c3 100644 --- a/extra/yaml/yaml.factor +++ b/extra/yaml/yaml.factor @@ -232,9 +232,11 @@ M: string apply-merge-keys nip ; : ?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-merge-key ?apply-default-key ; :: parse-yaml-doc ( parser event -- obj ) H{ } clone anchors [ @@ -394,7 +396,7 @@ GENERIC: emit-value ( emitter event anchor obj -- ) ! strings and special keys are the only things that need special treatment ! because they can have the same representation : emit-mapping-key ( emitter event obj -- ) - dup [ string? ] [ yaml-merge? ] bi or + dup { [ string? ] [ yaml-merge? ] [ yaml-value? ] } 1|| [ [ f ] dip emit-mapping-key-scalar ] [ emit-object ] if ; M: object emit-value ( emitter event anchor obj -- ) emit-scalar ;