#lang racket/base
;; Copyright Neil Van Dyke.  See file "info.rkt".

(module+ test
  (require "planet-overeasy.rkt"))

(provide log-mediafile-fatal
         log-mediafile-error
         log-mediafile-warning
         log-mediafile-info
         log-mediafile-debug)
(define-logger mediafile)

(provide %mediafile:attrs-add)
(define (%mediafile:attrs-add attrs key val)
  (if (assq key attrs)
      (let loop-find-key ((attrs attrs))
        (if (null? attrs)
            (error '%mediafile:attrs-add
                   "internal error: key ~S disappeared"
                   key)
            (let ((pair (car attrs)))
              (if (eq? (car pair) key)
                  (cons (cons key
                              (let ((old-val (cdr pair)))
                                (if (pair? old-val)
                                    (cons val old-val)
                                    (list val old-val))))
                        (cdr attrs))
                  (cons pair (loop-find-key (cdr attrs)))))))
      (cons (cons key val) attrs)))

(module+ test
  (test (%mediafile:attrs-add '() 'a 1)
        '((a . 1)))
  (test (%mediafile:attrs-add '((a . 1) (b . 2)) 'c 3)
        '((c . 3) (a . 1) (b . 2)))
  (test (%mediafile:attrs-add '((a . 1) (b . 2) '(c . 3)) 'b 4)
        '((a . 1) (b . (4 2)) '(c . 3)))
  (test (%mediafile:attrs-add '((a . 1) (b . (4 2)) (c . 3)) 'b 5)
        '((a . 1) (b . (5 4 2)) (c . 3))))

;; (attrs-add-many attrs (K1 V1) (K2 V2) (K3 V3))
;; =expand=>
;; (attrs-add (attrs-add (attrs-add attrs K1 V1) K2 V2) K3 V3)

(provide %mediafile:attrs-add-many)
(define-syntax %mediafile:attrs-add-many
  (syntax-rules ()
    ((_ ATTRS)
     ATTRS)
    ((_ ATTRS (K0 V0) KVn ...)
     (%mediafile:attrs-add-many (%mediafile:attrs-add ATTRS K0 V0)
                                KVn ...))))

(module+ test
  (test (%mediafile:attrs-add-many '((a . 1)) ('b 2) ('c 3) ('d 4) ('c 5))
        '((d . 4) (c . (5 3)) (b . 2) (a . 1))))

(provide %mediafile:attrs-reverse)
(define (%mediafile:attrs-reverse attrs)
  (let loop ((attrs  attrs)
             (result '()))
    (if (null? attrs)
        result
        (loop (cdr attrs)
              (let* ((pair (car attrs))
                     (val  (cdr pair)))
                (cons (if (pair? val)
                          (cons (car pair) (reverse val))
                          pair)
                      result))))))

(module+ test
  (test (%mediafile:attrs-reverse '())
        '())
  (test (%mediafile:attrs-reverse '((c . 3) (b . (5 4 2)) (a . 1)))
        '((a . 1) (b . (2 4 5)) (c . 3))))

;;EOF