; The root adapters: a tree's events with the root the target needs.
;
; A render that writes from a tree may need the root to be an object
; (TOML, INI: a document is a table) or an array (JSON Lines, and a
; records target: the rows are its elements). `wrap-object name input`
; passes an object root through, and wraps an array or a scalar as the
; one member `name` of an object; `wrap-array input` passes an array root
; through, and wraps an object or a scalar as the one element of an
; array. Each decides at the first event and retains one marker and, while
; it wraps a container, a stack of one marker per open container, so that
; the wrap closes when the wrapped root does: nothing grows with the
; document's width or length, only with its nesting. The events are a
; tree's: a stream that begins with an end or a key, ends inside a
; container, or holds more after the root is refused as no tree's
; (PROTOCOL_ORDER_ERROR), where the adapter can see it; what it passes
; through unexamined is the host's tree contract to hold.
;
; The state is [:start] before the first event, [:pass] while a matching
; root passes through, [:wrap stack] while a container is wrapped, with
; one marker per open container, and [:done] once a wrapped root has
; closed.
def wrap-object-close [stack event]
let [rest (pop stack)]
match (count rest)
case 0 (transition [:done] [event object-end])
case _ (transition [:wrap rest] [event])
def wrap-object-step [name state event]
match state
case [:start]
match event
case object-start (transition [:pass] [event])
case array-start (transition [:wrap [:open]] [object-start (key name) event])
case (scalar value) (transition [:done] [object-start (key name) event object-end])
case _ (fail :protocol-order "the events begin with an end or a key, which a tree's never do")
case [:pass] (transition state [event])
case [:wrap stack]
match event
case array-start (transition [:wrap (push :open stack)] [event])
case object-start (transition [:wrap (push :open stack)] [event])
case array-end (wrap-object-close stack event)
case object-end (wrap-object-close stack event)
case _ (transition state [event])
case _ (fail :protocol-order "the events hold more after the root value, which a tree's never do")
def wrap-finish [state]
match state
case [:start] (fail :protocol-order "the events hold no value, where a tree's hold one")
case [:pass] []
case [:done] []
case _ (fail :protocol-order "the events ended inside a container, which a tree's never do")
; An object root as it is; an array or a scalar root as the member `name`
; of an object.
def wrap-object [name input]
as-events (scan-emit [:start] (partial wrap-object-step name) wrap-finish (events input))
def wrap-array-close [stack event]
let [rest (pop stack)]
match (count rest)
case 0 (transition [:done] [event array-end])
case _ (transition [:wrap rest] [event])
def wrap-array-step [state event]
match state
case [:start]
match event
case array-start (transition [:pass] [event])
case object-start (transition [:wrap [:open]] [array-start event])
case (scalar value) (transition [:done] [array-start event array-end])
case _ (fail :protocol-order "the events begin with an end or a key, which a tree's never do")
case [:pass] (transition state [event])
case [:wrap stack]
match event
case array-start (transition [:wrap (push :open stack)] [event])
case object-start (transition [:wrap (push :open stack)] [event])
case array-end (wrap-array-close stack event)
case object-end (wrap-array-close stack event)
case _ (transition state [event])
case _ (fail :protocol-order "the events hold more after the root value, which a tree's never do")
; An array root as it is; an object or a scalar root as the one element
; of an array.
def wrap-array [input]
as-events (scan-emit [:start] wrap-array-step wrap-finish (events input))