typesetting/pitfall/restructure/array.rkt

#lang restructure/racket
(require "number.rkt" (prefix-in utils- "utils.rkt") "stream.rkt")
(provide (all-defined-out))

#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
|#

(define-subclass Streamcoder (ArrayT type [length_ #f] [lengthType 'count])
          
  (define/augride (decode stream [parent #f])
    (define pos (send stream pos))

    (define res (make-object RestructureBase)) ; instead of empty list
    (define ctx parent)

    (define length__
      (and length_ (utils-resolveLength length_ stream parent)))

    (when (NumberT? length_)
      ;; define hidden properties
      (ref-set*! res 'parent parent
                 '_startOffset pos
                 '_currentOffset 0
                 '_length length_)
      (set! ctx res))

    (cond
      [(or (not length__) (eq? lengthType 'bytes))
       (define target (cond
                        [length__ (+ (send stream pos) length__)]
                        [(and parent (positive? (· parent _length)))
                         (+ (ref parent '_startOffset)
                            (ref parent '_length))]
                        [else (· stream length_)]))
       (ref-set! res '_list
                 (push-end res
                           (for/list ([i (in-naturals)]
                                      #:break (= (send stream pos) target))
                             (send type decode stream ctx))))]
      [else
       (ref-set! res '_list
                 (push-end res
                           (for/list ([i (in-range length__)])
                             (send type decode stream ctx))))])

    (countable->list res))

  (define/override (size [array #f] [ctx #f])
    (when array
      (unless (countable? array)
        (raise-argument-error 'Array:size "list or countable" array)))
    (cond
      [(not array)
       (* (send type size #f ctx) (utils-resolveLength length_ #f ctx))]
      [else
       (+ (cond
            [(NumberT? length_)
             (set! ctx (mhash 'parent ctx))
             (send length_ size)]
            [else 0])
          (for/sum ([item (in-list (countable->list array))])
            (send type size item ctx)))]))

  (define/augride (encode stream array [parent #f])
    (when array (unless (countable? array)
                  (raise-argument-error 'Array:encode "list or countable" array)))
    (define ctx parent)
    (when (NumberT? length_)
      (set! ctx (mhash 'pointers null
                       'startOffset (· stream pos)
                       'parent parent))
      (ref-set! ctx 'pointerOffset (+ (· stream pos) (size array ctx)))
      (send length_ encode stream (length array)))

    (for ([item (in-list (countable->list array))])
      (send type encode stream item ctx))

    (when (NumberT? length_)
      (for ([ptr (in-list (· ctx pointers))])
        (send (· ptr type) encode stream (· ptr val))))))

(define-values (Array Array? +Array) (values ArrayT ArrayT? +ArrayT))

(test-module
 (define stream (+DecodeStream #"ABCDEFG"))
 (define A (+Array uint16be 3))
 (check-equal? (send A decode stream) '(16706 17220 17734))
 (check-equal? (send A encode #f '(16706 17220 17734)) #"ABCDEF")
 (check-equal? (send (+Array uint16be) size '(1 2 3)) 6)
 (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40))