! TODO real conformance tests here
+! Basic test
CONSTANT: test-string """--- # Favorite movies
- Casablanca
- North by Northwest
${ test-represented-string } [ $ test-obj >yaml ] unit-test
${ test-represented-string } [ $ test-represented-string yaml> >yaml ] unit-test
+! Non-scalar key
CONSTANT: complex-key H{ { { "4" } "3" } }
CONSTANT: complex-key-represented """--- !!map
? !!seq
"""
${ complex-key } [ $ complex-key-represented yaml> ] unit-test
+
+! Multiple docs
+CONSTANT: test-docs """--- !!str a
+...
+--- !!seq
+- !!str b
+- !!str c
+...
+--- !!map
+!!str d: !!str e
+...
+"""
+CONSTANT: test-objs { "a" { "b" "c" } H{ { "d" "e" } } }
+
+${ test-objs } [ $ test-docs yaml-docs> ] unit-test
+${ test-docs } [ $ test-objs >yaml-docs ] unit-test
+${ test-docs } [ $ test-docs yaml-docs> >yaml-docs ] unit-test
[ "wrong event" throw ] unless
] with-destructors ;
+:: ?parse-yaml-doc ( parser event -- obj/f ? )
+ [ parser event next-event type>> {
+ { YAML_DOCUMENT_START_EVENT [ t ] }
+ { YAML_STREAM_END_EVENT [ f ] }
+ [ "wrong event" throw ]
+ } case ] with-destructors
+ [ parser event next-value t
+ parser event YAML_DOCUMENT_END_EVENT expect-event
+ ] [ f f ] if ;
+
+! registers destructors (use with with-destructors)
+:: init-parser ( str -- parser event )
+ yaml_parser_t (malloc-struct) &free :> parser
+ parser yaml_parser_initialize yaml-assert-ok
+ parser &yaml_parser_delete drop
+
+ str utf8 encode [ malloc-byte-array &free ] [ length ] bi :> ( input length )
+ parser input length yaml_parser_set_input_string
+
+ yaml_event_t (malloc-struct) &free :> event
+ parser event
+;
-:: yaml> ( str -- obj )
-[
-yaml_parser_t (malloc-struct) &free :> parser
-parser yaml_parser_initialize yaml-assert-ok
-parser &yaml_parser_delete drop
-
-str utf8 encode [ malloc-byte-array &free ] [ length ] bi :> ( input length )
-parser input length yaml_parser_set_input_string
-
-yaml_event_t (malloc-struct) &free :> event
-
-parser event YAML_STREAM_START_EVENT expect-event
-parser event YAML_DOCUMENT_START_EVENT expect-event
-
-parser event next-value
-
-parser event YAML_DOCUMENT_END_EVENT expect-event
-parser event YAML_STREAM_END_EVENT expect-event
+: yaml> ( str -- obj ) [
+ init-parser
+ [ YAML_STREAM_START_EVENT expect-event ]
+ [ ?parse-yaml-doc [ "No Document" throw ] unless ] 2bi
] with-destructors
+;
+: yaml-docs> ( str -- seq ) [
+ init-parser
+ [ YAML_STREAM_START_EVENT expect-event ]
+ [ [ ?parse-yaml-doc ] 2curry [ ] produce nip ] 2bi
+] with-destructors
;
! TODO We can also pass some data when registering the write handler,
M: assoc emit-value ( emitter event seq -- )
[ drop emit-assoc-start ] [ emit-assoc ] [ drop emit-assoc-end ] 3tri ;
-:: >yaml ( obj -- str )
-[
+! registers destructors (use with with-destructors)
+:: init-emitter ( -- emitter event )
yaml_emitter_t (malloc-struct) &free :> emitter
emitter yaml_emitter_initialize yaml-assert-ok
emitter &yaml_emitter_delete drop
event YAML_UTF8_ENCODING yaml_stream_start_event_initialize yaml-assert-ok
emitter event yaml_emitter_emit yaml-assert-ok
+emitter event
+;
+
+:: emit-doc ( emitter event obj -- )
event f f f 0 yaml_document_start_event_initialize yaml-assert-ok
emitter event yaml_emitter_emit yaml-assert-ok
event 0 yaml_document_end_event_initialize yaml-assert-ok
emitter event yaml_emitter_emit yaml-assert-ok
+;
+
+! registers destructors (use with with-destructors)
+:: flush-emitter ( emitter event -- str )
event yaml_stream_end_event_initialize yaml-assert-ok
emitter event yaml_emitter_emit yaml-assert-ok
emitter yaml_emitter_flush yaml-assert-ok
yaml-write-buffer get utf8 decode
+;
+: >yaml ( obj -- str ) [
+[ init-emitter ] dip
+[ emit-doc ] [ drop flush-emitter ] 3bi
] with-destructors
+;
+: >yaml-docs ( seq -- str ) [
+[ init-emitter ] dip
+[ [ emit-doc ] with with each ] [ drop flush-emitter ] 3bi
+] with-destructors
;