#lang racket/base
(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))))
(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))))