private/nodes.rkt
;;;;;; nodes.rkt - YAML nodes.    -*- Mode: Racket -*-

#lang typed/racket

(require "errors.rkt" "struct.rkt")

(provide (all-defined-out))

(yaml-struct: node ([start : (Option mark)] [end : (Option mark)]) #:mutable)

(node: scalar
       ([tag : (Option String)]
        [value : String]
        [style : (Option Char)])
       #:mutable)

(node: sequence
       ([tag : (Option String)]
        [value : (Listof node)]
        [flow-style : Boolean])
       #:mutable)

(node: mapping
       ([tag : (Option String)]
        [value : (Listof (Pairof node node))]
        [flow-style : Boolean])
       #:mutable)

(: node-tag (node -> (Option String)))
(define (node-tag node)
  (cond
    [(scalar-node? node) (scalar-node-tag node)]
    [(sequence-node? node) (sequence-node-tag node)]
    [(mapping-node? node) (mapping-node-tag node)]
    [else (error 'node-tag "unexpected node: ~a" (node->string node))]))

(: set-node-tag! (node (Option String) -> Void))
(define (set-node-tag! node tag)
  (cond
    [(scalar-node? node) (set-scalar-node-tag! node tag)]
    [(sequence-node? node) (set-sequence-node-tag! node tag)]
    [(mapping-node? node) (set-mapping-node-tag! node tag)]
    [else (error 'node-tag "unexpected node: ~a" (node->string node))]))

(: node->string-rec (node -> String))
(define (node->string-rec n)
  (cond
    [(scalar-node? n)
     (node->string n)]
    [(sequence-node? n)
     (format
      "sequence-node(flow-style=~s, tag=~s, value=~a)"
      (sequence-node-flow-style n)
      (sequence-node-tag n)
      (map node->string-rec (sequence-node-value n)))]
    [(mapping-node? n)
     (format
      "mapping-node(flow-style=~s, tag=~s, value=~a)"
      (mapping-node-flow-style n)
      (mapping-node-tag n)
      (map (λ: ([p : (Pairof node node)])
             (cons (node->string-rec (car p))
                   (node->string-rec (cdr p))))
           (mapping-node-value n)))]
    [else (error 'node->string-rec "unexpected node: ~a" (node->string n))]))

(: print-node-rec
   (case-> (node -> Void) (node Output-Port -> Void)))
(define (print-node-rec node [out (current-output-port)])
  (fprintf out "~a\n" (node->string-rec node)))