YAML: indent/docs
Jon Harper
John Benediktsson
parent
4ccb1a9e54
commit
d1b1a40e6d
|
|
@ -0,0 +1,48 @@
|
|||
! Copyright (C) 2014 Jon Harper.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs help.markup help.syntax kernel sequences
|
||||
strings ;
|
||||
IN: yaml
|
||||
|
||||
HELP: >yaml
|
||||
{ $values
|
||||
{ "obj" object }
|
||||
{ "str" string }
|
||||
}
|
||||
{ $description "Serializes the object into a YAML formatted string." } ;
|
||||
|
||||
HELP: >yaml-docs
|
||||
{ $values
|
||||
{ "seq" sequence }
|
||||
{ "str" string }
|
||||
}
|
||||
{ $description "Serializes the sequence into a YAML formatted string. Each element is outputted as a YAML document" } ;
|
||||
|
||||
HELP: yaml-docs>
|
||||
{ $values
|
||||
{ "str" string }
|
||||
{ "arr" array }
|
||||
}
|
||||
{ $description "Deserializes the YAML formatted string into a Factor array. Each document becomes an element of the array" } ;
|
||||
|
||||
HELP: yaml>
|
||||
{ $values
|
||||
{ "str" string }
|
||||
{ "obj" object }
|
||||
}
|
||||
{ $description "Deserializes the YAML formatted string into a Factor object." } ;
|
||||
|
||||
ARTICLE: "yaml" "YAML serialization"
|
||||
"The " { $vocab-link "yaml" } " vocabulary implements YAML serialization/deserialization."
|
||||
{ $subsections
|
||||
>yaml
|
||||
>yaml-docs
|
||||
yaml>
|
||||
yaml-docs>
|
||||
}
|
||||
;
|
||||
|
||||
{ >yaml >yaml-docs } related-words
|
||||
{ yaml> yaml-docs> } related-words
|
||||
|
||||
ABOUT: "yaml"
|
||||
|
|
@ -6,10 +6,17 @@ io.encodings.string io.encodings.utf8 kernel libc locals make
|
|||
math namespaces prettyprint sequences strings yaml.ffi ;
|
||||
IN: yaml
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: yaml-assert-ok ( n -- ) 0 = [ "yaml error" throw ] when ;
|
||||
: event>scalar ( event -- obj ) data>> scalar>> [ value>> ] [ length>> ] bi memory>byte-array utf8 decode ;
|
||||
|
||||
: event>scalar ( event -- obj )
|
||||
data>> scalar>> [ value>> ] [ length>> ] bi
|
||||
memory>byte-array utf8 decode ;
|
||||
|
||||
: ?scalar-value ( event -- scalar/f f/type )
|
||||
dup type>> YAML_SCALAR_EVENT = [ event>scalar f ] [ type>> clone f swap ] if ;
|
||||
dup type>> YAML_SCALAR_EVENT =
|
||||
[ event>scalar f ] [ type>> clone f swap ] if ;
|
||||
|
||||
! Must not reuse the event struct before with-destructors scope ends
|
||||
: next-event ( parser event -- event )
|
||||
|
|
@ -18,84 +25,100 @@ IN: yaml
|
|||
DEFER: parse-sequence
|
||||
DEFER: parse-mapping
|
||||
: next-complex-value ( parser event type -- obj )
|
||||
{
|
||||
{ YAML_SEQUENCE_START_EVENT [ parse-sequence ] }
|
||||
{ YAML_MAPPING_START_EVENT [ parse-mapping ] }
|
||||
[ throw ]
|
||||
} case ;
|
||||
:: next-value ( parser event -- obj )
|
||||
parser event [ next-event ?scalar-value ] with-destructors
|
||||
[ [ drop parser event ] dip next-complex-value ] when* ;
|
||||
{
|
||||
{ YAML_SEQUENCE_START_EVENT [ parse-sequence ] }
|
||||
{ YAML_MAPPING_START_EVENT [ parse-mapping ] }
|
||||
[ throw ]
|
||||
} case ;
|
||||
|
||||
:: parse-mapping ( parser event -- map ) [
|
||||
f :> done!
|
||||
[ done ] [ [
|
||||
parser event next-event type>>
|
||||
YAML_MAPPING_END_EVENT = [
|
||||
t done! f f
|
||||
] [
|
||||
event ?scalar-value
|
||||
] if
|
||||
] with-destructors 2dup or [
|
||||
[ nip [ parser event ] dip next-complex-value ] when*
|
||||
parser event next-value swap ,,
|
||||
] [ 2drop ] if ] until
|
||||
] H{ } make ;
|
||||
:: parse-sequence ( parser event -- seq ) [
|
||||
f :> done!
|
||||
[ done ] [ [
|
||||
parser event next-event type>>
|
||||
YAML_SEQUENCE_END_EVENT = [
|
||||
t done! f
|
||||
] [
|
||||
event ?scalar-value dup [ nip ] [ [ , ] dip ] if
|
||||
] if
|
||||
] with-destructors [ [ parser event ] dip next-complex-value , ] when* ] until
|
||||
] { } make ;
|
||||
:: next-value ( parser event -- obj )
|
||||
parser event [ next-event ?scalar-value ] with-destructors
|
||||
[ [ drop parser event ] dip next-complex-value ] when* ;
|
||||
|
||||
:: parse-mapping ( parser event -- map )
|
||||
[
|
||||
f :> done!
|
||||
[ done ] [
|
||||
[
|
||||
parser event next-event type>>
|
||||
YAML_MAPPING_END_EVENT = [
|
||||
t done! f f
|
||||
] [
|
||||
event ?scalar-value
|
||||
] if
|
||||
] with-destructors
|
||||
2dup or [
|
||||
[ nip [ parser event ] dip next-complex-value ] when*
|
||||
parser event next-value swap ,,
|
||||
] [ 2drop ] if
|
||||
] until
|
||||
] H{ } make ;
|
||||
|
||||
:: parse-sequence ( parser event -- seq )
|
||||
[
|
||||
f :> done!
|
||||
[ done ] [
|
||||
[
|
||||
parser event next-event type>>
|
||||
YAML_SEQUENCE_END_EVENT = [
|
||||
t done! f
|
||||
] [
|
||||
event ?scalar-value dup [ nip ] [ [ , ] dip ] if
|
||||
] if
|
||||
] with-destructors
|
||||
[ [ parser event ] dip next-complex-value , ] when*
|
||||
] until
|
||||
] { } make ;
|
||||
|
||||
: expect-event ( parser event type -- )
|
||||
[
|
||||
[ next-event type>> ] dip =
|
||||
[ "wrong event" throw ] unless
|
||||
] with-destructors ;
|
||||
[
|
||||
[ next-event type>> ] dip =
|
||||
[ "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 ;
|
||||
[
|
||||
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
|
||||
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
|
||||
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_event_t (malloc-struct) &free :> event
|
||||
parser event ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: yaml> ( str -- obj ) [
|
||||
init-parser
|
||||
[ YAML_STREAM_START_EVENT expect-event ]
|
||||
[ ?parse-yaml-doc [ "No Document" throw ] unless ] 2bi
|
||||
] with-destructors
|
||||
;
|
||||
: 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
|
||||
;
|
||||
: yaml-docs> ( str -- arr )
|
||||
[
|
||||
init-parser
|
||||
[ YAML_STREAM_START_EVENT expect-event ]
|
||||
[ [ ?parse-yaml-doc ] 2curry [ ] produce nip ] 2bi
|
||||
] with-destructors ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! TODO We can also pass some data when registering the write handler,
|
||||
! use this to have several buffers if it can be interrupted.
|
||||
|
|
@ -103,95 +126,113 @@ DEFER: parse-mapping
|
|||
! so we don't need to be reentrant.
|
||||
SYMBOL: yaml-write-buffer
|
||||
: yaml-write-handler ( -- alien )
|
||||
[
|
||||
memory>byte-array yaml-write-buffer get-global
|
||||
push-all drop 1
|
||||
] yaml_write_handler_t ;
|
||||
[
|
||||
memory>byte-array yaml-write-buffer get-global
|
||||
push-all drop 1
|
||||
] yaml_write_handler_t ;
|
||||
|
||||
GENERIC: emit-value ( emitter event obj -- )
|
||||
|
||||
M:: string emit-value ( emitter event string -- )
|
||||
[
|
||||
string utf8 encode [ malloc-byte-array &free ] [ length ] bi :> ( value length )
|
||||
"tag:yaml.org,2002:str" utf8 malloc-string &free :> tag
|
||||
event f tag value length 0 0 0 yaml_scalar_event_initialize yaml-assert-ok
|
||||
emitter event yaml_emitter_emit yaml-assert-ok
|
||||
] with-destructors ;
|
||||
[
|
||||
string utf8 encode
|
||||
[ malloc-byte-array &free ] [ length ] bi :> ( value length )
|
||||
|
||||
"tag:yaml.org,2002:str" utf8 malloc-string &free :> tag
|
||||
|
||||
event f tag value length 0 0 0
|
||||
yaml_scalar_event_initialize yaml-assert-ok
|
||||
|
||||
emitter event yaml_emitter_emit yaml-assert-ok
|
||||
] with-destructors ;
|
||||
|
||||
:: emit-sequence-start ( emitter event -- )
|
||||
[
|
||||
"tag:yaml.org,2002:seq" utf8 malloc-string &free :> tag
|
||||
event f tag 0 0 yaml_sequence_start_event_initialize yaml-assert-ok
|
||||
emitter event yaml_emitter_emit yaml-assert-ok
|
||||
] with-destructors ;
|
||||
[
|
||||
"tag:yaml.org,2002:seq" utf8 malloc-string &free :> tag
|
||||
|
||||
event f tag 0 0
|
||||
yaml_sequence_start_event_initialize yaml-assert-ok
|
||||
|
||||
emitter event yaml_emitter_emit yaml-assert-ok
|
||||
] with-destructors ;
|
||||
: emit-sequence-end ( emitter event -- )
|
||||
dup yaml_sequence_end_event_initialize yaml-assert-ok
|
||||
yaml_emitter_emit yaml-assert-ok ;
|
||||
dup yaml_sequence_end_event_initialize yaml-assert-ok
|
||||
yaml_emitter_emit yaml-assert-ok ;
|
||||
|
||||
: emit-sequence ( emitter event seq -- )
|
||||
[ emit-value ] with with each ;
|
||||
[ emit-value ] with with each ;
|
||||
|
||||
M: sequence emit-value ( emitter event seq -- )
|
||||
[ drop emit-sequence-start ] [ emit-sequence ] [ drop emit-sequence-end ] 3tri ;
|
||||
[ drop emit-sequence-start ]
|
||||
[ emit-sequence ]
|
||||
[ drop emit-sequence-end ] 3tri ;
|
||||
|
||||
:: emit-assoc-start ( emitter event -- )
|
||||
[
|
||||
"tag:yaml.org,2002:map" utf8 malloc-string &free :> tag
|
||||
event f tag 0 0 yaml_mapping_start_event_initialize yaml-assert-ok
|
||||
emitter event yaml_emitter_emit yaml-assert-ok
|
||||
] with-destructors ;
|
||||
[
|
||||
"tag:yaml.org,2002:map" utf8 malloc-string &free :> tag
|
||||
|
||||
event f tag 0 0
|
||||
yaml_mapping_start_event_initialize yaml-assert-ok
|
||||
|
||||
emitter event yaml_emitter_emit yaml-assert-ok
|
||||
] with-destructors ;
|
||||
: emit-assoc-end ( emitter event -- )
|
||||
dup yaml_mapping_end_event_initialize yaml-assert-ok
|
||||
yaml_emitter_emit yaml-assert-ok ;
|
||||
dup yaml_mapping_end_event_initialize yaml-assert-ok
|
||||
yaml_emitter_emit yaml-assert-ok ;
|
||||
|
||||
: emit-assoc ( emitter event assoc -- )
|
||||
[ [ emit-value ] with with bi@ ] with with assoc-each ;
|
||||
[ [ emit-value ] with with bi@ ] with with assoc-each ;
|
||||
|
||||
M: assoc emit-value ( emitter event seq -- )
|
||||
[ drop emit-assoc-start ] [ emit-assoc ] [ drop emit-assoc-end ] 3tri ;
|
||||
[ drop emit-assoc-start ]
|
||||
[ emit-assoc ]
|
||||
[ drop emit-assoc-end ] 3tri ;
|
||||
|
||||
! 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
|
||||
yaml_emitter_t (malloc-struct) &free :> emitter
|
||||
emitter yaml_emitter_initialize yaml-assert-ok
|
||||
emitter &yaml_emitter_delete drop
|
||||
|
||||
BV{ } clone :> output
|
||||
output yaml-write-buffer set-global
|
||||
emitter yaml-write-handler f yaml_emitter_set_output
|
||||
BV{ } clone :> output
|
||||
output yaml-write-buffer set-global
|
||||
emitter yaml-write-handler f yaml_emitter_set_output
|
||||
|
||||
yaml_event_t (malloc-struct) &free :> event
|
||||
yaml_event_t (malloc-struct) &free :> event
|
||||
|
||||
event YAML_UTF8_ENCODING yaml_stream_start_event_initialize yaml-assert-ok
|
||||
emitter event yaml_emitter_emit yaml-assert-ok
|
||||
emitter event
|
||||
;
|
||||
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 f f f 0 yaml_document_start_event_initialize yaml-assert-ok
|
||||
emitter event yaml_emitter_emit yaml-assert-ok
|
||||
|
||||
emitter event obj emit-value
|
||||
emitter event obj emit-value
|
||||
|
||||
event 0 yaml_document_end_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
|
||||
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
|
||||
;
|
||||
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
|
||||
;
|
||||
PRIVATE>
|
||||
|
||||
: >yaml-docs ( seq -- str ) [
|
||||
[ init-emitter ] dip
|
||||
[ [ emit-doc ] with with each ] [ drop flush-emitter ] 3bi
|
||||
] with-destructors
|
||||
;
|
||||
: >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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue