YAML: indent/docs

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"

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 )
@@ -23,34 +30,44 @@ DEFER: parse-mapping
         { 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 ) [
+:: parse-mapping ( parser event -- map )
+    [
         f :> done!
-  [ done ] [ [
+        [ done ] [
+            [
                 parser event next-event type>>
                 YAML_MAPPING_END_EVENT = [
                     t done! f f
                 ] [
                     event ?scalar-value
                 ] if
-  ] with-destructors 2dup or [
+            ] with-destructors
+            2dup or [
                 [ nip [ parser event ] dip next-complex-value ] when*
                 parser event next-value swap ,,
-  ] [ 2drop ] if ] until
+            ] [ 2drop ] if
+        ] until
     ] H{ } make ;
-:: parse-sequence ( parser event -- seq ) [
+
+:: parse-sequence ( parser event -- seq )
+    [
         f :> done!
-  [ 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
+            ] with-destructors
+            [ [ parser event ] dip next-complex-value , ] when*
+        ] until
     ] { } make ;
 
 : expect-event ( parser event type -- )
@@ -60,12 +77,15 @@ DEFER: parse-mapping
     ] with-destructors ;
 
 :: ?parse-yaml-doc ( parser event -- obj/f ? )
-  [ parser event next-event type>> {
+    [
+        parser event next-event type>> {
             { YAML_DOCUMENT_START_EVENT [ t ] }
             { YAML_STREAM_END_EVENT [ f ] }
             [ "wrong event" throw ]
-  } case ] with-destructors
+        } case
-  [ parser event next-value t
+    ] with-destructors
+    [
+        parser event next-value t
         parser event YAML_DOCUMENT_END_EVENT expect-event
     ] [ f f ] if ;
 
@@ -75,27 +95,30 @@ DEFER: parse-mapping
     parser yaml_parser_initialize yaml-assert-ok
     parser &yaml_parser_delete drop
 
-  str utf8 encode [ malloc-byte-array &free ] [ length ] bi :> ( input length )
+    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
+    parser event ;
-;
 
+PRIVATE>
 
-: yaml> ( str -- obj ) [
+: yaml> ( str -- obj )
+    [
         init-parser
         [ YAML_STREAM_START_EVENT expect-event ]
         [ ?parse-yaml-doc [ "No Document" throw ] unless ] 2bi
-] with-destructors
+    ] with-destructors ;
-;
 
-: yaml-docs> ( str -- seq ) [
+: yaml-docs> ( str -- arr )
+    [
         init-parser
         [ YAML_STREAM_START_EVENT expect-event ]
         [ [ ?parse-yaml-doc ] 2curry [ ] produce nip ] 2bi
-] with-destructors
+    ] 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.
@@ -109,17 +132,27 @@ SYMBOL: yaml-write-buffer
     ] 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 )
+        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
+
+        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
+
+        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 -- )
@@ -130,12 +163,17 @@ M:: string emit-value ( emitter event string -- )
     [ 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
+
+        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 -- )
@@ -146,7 +184,9 @@ M: sequence emit-value ( emitter event seq -- )
     [ [ 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 )
@@ -160,10 +200,11 @@ emitter yaml-write-handler f yaml_emitter_set_output
 
     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 ;
-;
 
 :: emit-doc ( emitter event obj -- )
     event f f f 0 yaml_document_start_event_initialize yaml-assert-ok
@@ -172,8 +213,7 @@ emitter event yaml_emitter_emit yaml-assert-ok
     emitter event obj emit-value
 
     event 0 yaml_document_end_event_initialize yaml-assert-ok
-emitter event yaml_emitter_emit yaml-assert-ok
+    emitter event yaml_emitter_emit yaml-assert-ok ;
-;
 
 ! registers destructors (use with with-destructors)
 :: flush-emitter ( emitter event -- str )
@@ -181,17 +221,18 @@ 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-write-buffer get utf8 decode ;
-;
 
-: >yaml ( obj -- str ) [
+PRIVATE>
+
+: >yaml ( obj -- str )
+    [
         [ init-emitter ] dip
         [ emit-doc ] [ drop flush-emitter ] 3bi
-] with-destructors
+    ] with-destructors ;
-;
 
-: >yaml-docs ( seq -- str ) [
+: >yaml-docs ( seq -- str )
+    [
         [ init-emitter ] dip
         [ [ emit-doc ] with with each ] [ drop flush-emitter ] 3bi
-] with-destructors
+    ] with-destructors ;
-;