YAML: indent/docs

diff --git a/extra/yaml/yaml-docs.factor b/extra/yaml/yaml-docs.factor
new file mode 100644 (file)
index 0000000..3619f66
--- /dev/null
+++ b/extra/yaml/yaml-docs.factor
@@ -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"

diff --git a/extra/yaml/yaml.factor b/extra/yaml/yaml.factor
index c580f877d958788e31acef38d7bd77597708102c..8784304761fd8a6da963e7a17364675cb724cf12 100644 (file)
--- a/extra/yaml/yaml.factor
+++ b/extra/yaml/yaml.factor
@@ -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 ;
+    {
+        { 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* ;
-
-:: 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 ;
+    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 -- arr )
+    [
+        init-parser
+        [ YAML_STREAM_START_EVENT expect-event ]
+        [ [ ?parse-yaml-doc ] 2curry [ ] produce nip ] 2bi
+    ] with-destructors ;
 
-: yaml-docs> ( str -- seq ) [
-  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
 
-event YAML_UTF8_ENCODING yaml_stream_start_event_initialize yaml-assert-ok
-emitter event yaml_emitter_emit yaml-assert-ok
-emitter event
-;
+    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
-
-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
-;
+    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 ;
+
+PRIVATE>
+
+: >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 ;