(module taglib racket/base

  (require "taglib-ffi.rkt"
           "private/utils.rkt"
           ffi/unsafe
           racket/class
           racket/draw
           racket/string)

  (provide id3-tags
           call-with-id3-tags

           tags-valid?
           tags-read-write?
           tags-closed?
           tags-close!
           tags-save!

           tags-title
           tags-album
           tags-artist
           tags-comment
           tags-year
           tags-genre
           tags-track
           tags-composer
           tags-disc-number
           tags-album-artist

           tags-title!
           tags-album!
           tags-artist!
           tags-comment!
           tags-year!
           tags-genre!
           tags-track!
           tags-composer!
           tags-disc-number!
           tags-album-artist!

           tags-length
           tags-sample-rate
           tags-bit-rate
           tags-channels

           tags-keys
           tags-ref
           tags-set!
           tags-set-values!
           tags-append!
           tags-clear!

           tags-picture
           tags-picture!
           tags-append-picture!
           tags-clear-picture!
           tags-picture->bitmap
           tags-picture->file
           tags-picture->kind
           tags-picture->mimetype
           tags-picture->description
           tags-picture->size
           tags-picture->ext

           tags->hash

           make-tags-picture
           make-tags-picture-from-bitmap
           id3-picture?
           id3-picture-mimetype
           id3-picture-kind
           id3-picture-size
           id3-picture-bytes
           id3-picture-description)

  (define-struct id3-tag-struct (handle))
  (define-struct id3-picture (mimetype kind size bytes description))

  (define clear-tag-value 'clear)

  (define (normal-mode mode)
    (cond
      [(or (eq? mode 'read) (eq? mode 'read-only)) 'read]
      [(or (eq? mode 'write) (eq? mode 'read-write)) 'read-write]
      [else (raise-argument-error 'id3-tags "(or/c 'read 'read-only 'read-write 'write)" mode)]))

  (define (file->string file*)
    (if (path? file*) (path->string file*) file*))

  (define (copy-string s)
    (if (eq? s #f) "" (string-append s "")))

  (define (property-name k)
    (cond
      [(symbol? k) (string-upcase (symbol->string k))]
      [(string? k) k]
      [else (raise-argument-error 'tag-property "(or/c symbol? string?)" k)]))

  (define (property-symbol k)
    (string->symbol (string-downcase (property-name k))))

  (define (first-property h key [default ""])
    (let ((v (hash-ref h key #f)))
      (cond
        [(and (pair? v) (string? (car v))) (car v)]
        [(string? v) v]
        [else default])))

  (define (first-property-number h key [default -1])
    (let ((n (string->number (first-property h key (number->string default)))))
      (if n n default)))

  (define (string-list? v)
    (and (list? v) (andmap string? v)))

  (define (bitmap->encoded-bytes bm mimetype)
    (define kind
      (cond
        [(or (string-ci=? mimetype "image/jpeg") (string-ci=? mimetype "image/jpg")) 'jpeg]
        [(string-ci=? mimetype "image/png") 'png]
        [else (error 'make-tags-picture-from-bitmap
                     "unsupported bitmap mimetype: ~a; use image/png or image/jpeg" mimetype)]))
    (define out (open-output-bytes))
    (unless (send bm save-file out kind)
      (error 'make-tags-picture-from-bitmap "could not encode bitmap as ~a" mimetype))
    (get-output-bytes out))

  (define (make-tags-picture mimetype kind data #:description [description ""])
    (define bytes
      (cond
        [(bytes? data) data]
        [(is-a? data bitmap%) (bitmap->encoded-bytes data mimetype)]
        [else (raise-argument-error 'make-tags-picture "(or/c bytes? (is-a?/c bitmap%))" data)]))
    (make-id3-picture mimetype kind (bytes-length bytes) bytes description))

  (define (make-tags-picture-from-bitmap bm kind #:mimetype [mimetype "image/png"] #:description [description ""])
    (make-tags-picture mimetype kind bm #:description description))

  (define (open-tag-file file)
    (let ((tag-file (taglib_file_new file)))
      (if (and tag-file (taglib_file_is_valid tag-file))
          tag-file
          (begin
            (when (and tag-file (not (eq? tag-file #f))) (taglib_file_free tag-file))
            (if (eq? (system-type 'os) 'windows)
                (begin
                  (dbg-sound "Could not open file ~a, trying wchar version on windows" file)
                  (let ((wtag-file (taglib_file_new_wchar file)))
                    (if (and wtag-file (taglib_file_is_valid wtag-file)) wtag-file
                        (begin
                          (when (and wtag-file (not (eq? wtag-file #f))) (taglib_file_free wtag-file))
                          #f))))
                #f)))))

  (define (read-property-map tag-file)
    (define key-store (make-hash))
    (let* ((keys (taglib_property_keys tag-file))
           (i 0)
           (key (and keys (taglib_property_key keys i)))
           (key-list '()))
      (while (not (eq? key #f))
             (set! key-list (append key-list (list (copy-string key))))
             (set! i (+ i 1))
             (set! key (taglib_property_key keys i)))
      (for-each
       (lambda (key)
         (let ((props (taglib_property_get tag-file key)))
           (let* ((vals '())
                  (i 0)
                  (val (and props (taglib_property_val props i))))
             (while (not (eq? val #f))
                    (set! vals (append vals (list (copy-string val))))
                    (set! i (+ i 1))
                    (set! val (taglib_property_val props i)))
             (when props (taglib_property_free props))
             (hash-set! key-store (string->symbol (string-downcase key)) vals))))
       key-list))
    key-store)

  (define (read-picture tag-file)
    (let ((p (taglib-get-picture tag-file)))
      (if (eq? p #f)
          #f
          (let ((mimetype (car p))
                (description (cadr p))
                (kind (caddr p))
                (size (cadddr p))
                (bytes (car (cddddr p))))
            (make-id3-picture mimetype kind size bytes description)))))

  (define (id3-tags file* #:mode [mode 'read])
    (define file (file->string file*))
    (define actual-mode (normal-mode mode))
    (define read-write? (eq? actual-mode 'read-write))
    (define valid? #f)
    (define closed? #t)
    (define tag-file #f)
    (define tag #f)
    (define title "")
    (define album "")
    (define artist "")
    (define comment "")
    (define year -1)
    (define genre "")
    (define track -1)
    (define length -1)
    (define sample-rate -1)
    (define bit-rate -1)
    (define channels -1)
    (define key-store (make-hash))
    (define composer "")
    (define album-artist "")
    (define disc-number -1)
    (define picture #f)

    (define (refresh-derived!)
      (set! composer (first-property key-store 'composer ""))
      (set! album-artist (first-property key-store 'albumartist ""))
      (set! disc-number (first-property-number key-store 'discnumber -1)))

    (define (open-and-read!)
      (set! tag-file (open-tag-file file))
      (if (eq? tag-file #f)
          (begin
            (set! valid? #f)
            (warn-sound "Could not open file ~a" file))
          (begin
            (set! valid? #t)
            (set! closed? #f)
            (set! tag (taglib_file_tag tag-file))
            (let ((ap (taglib_file_audioproperties tag-file)))
              (set! title (copy-string (taglib_tag_title tag)))
              (set! album (copy-string (taglib_tag_album tag)))
              (set! artist (copy-string (taglib_tag_artist tag)))
              (set! comment (copy-string (taglib_tag_comment tag)))
              (set! genre (copy-string (taglib_tag_genre tag)))
              (set! year (let ((v (taglib_tag_year tag))) (if (zero? v) -1 v)))
              (set! track (let ((v (taglib_tag_track tag))) (if (zero? v) -1 v)))
              (set! length (taglib_audioproperties_length ap))
              (set! sample-rate (taglib_audioproperties_samplerate ap))
              (set! bit-rate (taglib_audioproperties_bitrate ap))
              (set! channels (taglib_audioproperties_channels ap))
              (set! key-store (read-property-map tag-file))
              (refresh-derived!)
              (set! picture (read-picture tag-file))
              (taglib_tag_free_strings)
              (unless read-write? (close!))))))

    (define (close!)
      (unless closed?
        (taglib_file_free tag-file)
        (set! tag-file #f)
        (set! tag #f)
        (set! closed? #t))
      (void))

    (define (ensure-open! who)
      (unless valid? (error who "tag handle is invalid: ~a" file))
      (unless read-write?
        (error who "tag handle is read-only for ~a; open with #:mode 'read-write" file))
      (when closed? (error who "tag handle is closed: ~a" file)))

    (define (set-property-cache! key vals)
      (define sym (property-symbol key))
      (if (null? vals) (hash-remove! key-store sym) (hash-set! key-store sym vals))
      (refresh-derived!))

    (define (string->cptr s)
      (define bs (string->bytes/utf-8 s))
      (define len (bytes-length bs))
      (define ptr (malloc _byte (+ len 1) 'atomic-interior))
      (for ([i (in-range len)]) (ptr-set! ptr _byte i (bytes-ref bs i)))
      (ptr-set! ptr _byte len 0)
      ptr)

    (define (apply-string! who value setter cache!)
      (ensure-open! who)
      (cond
        [(eq? value clear-tag-value) (setter tag "") (cache! "")]
        [(string? value) (setter tag value) (cache! value)]
        [else (raise-argument-error who "(or/c string? 'clear)" value)]))

    (define (apply-uint! who value setter cache!)
      (ensure-open! who)
      (cond
        [(eq? value clear-tag-value) (setter tag 0) (cache! -1)]
        [(and (exact-nonnegative-integer? value) (<= value #xffffffff))
         (setter tag value) (cache! value)]
        [else (raise-argument-error who "(or/c exact-nonnegative-integer? 'clear)" value)]))

    (define (set-one-property! who key value #:append? [append? #f])
      (ensure-open! who)
      (cond
        [(eq? value clear-tag-value)
         (if append?
             (taglib_property_set_append tag-file (property-name key) #f)
             (taglib_property_set tag-file (property-name key) #f))
         (set-property-cache! key '())]
        [(string? value)
         (if append?
             (taglib_property_set_append tag-file (property-name key) (string->cptr value))
             (taglib_property_set tag-file (property-name key) (string->cptr value)))
         (if append?
             (set-property-cache! key (append (hash-ref key-store (property-symbol key) '()) (list value)))
             (set-property-cache! key (list value)))]
        [else (raise-argument-error who "(or/c string? 'clear)" value)]))

    (define (set-values-property! key values)
      (ensure-open! 'tags-set-values!)
      (cond
        [(eq? values clear-tag-value)
         (taglib_property_set tag-file (property-name key) #f)
         (set-property-cache! key '())]
        [(string-list? values)
         (taglib_property_set tag-file (property-name key) #f)
         (for ([v values]) (taglib_property_set_append tag-file (property-name key) (string->cptr v)))
         (set-property-cache! key values)]
        [else (raise-argument-error 'tags-set-values! "(or/c (listof string?) 'clear)" values)]))

    (define (set-picture! value #:append? [append? #f])
      (ensure-open! (if append? 'tags-append-picture! 'tags-picture!))
      (cond
        [(eq? value clear-tag-value)
         (unless (taglib-clear-picture tag-file)
           (error 'tags-picture! "could not clear picture for file: ~a" file))
         (set! picture #f)]
        [(id3-picture? value)
         (define ok?
           (if append?
               (taglib-append-picture tag-file
                                      (id3-picture-mimetype value)
                                      (id3-picture-kind value)
                                      (id3-picture-description value)
                                      (id3-picture-bytes value))
               (taglib-set-picture tag-file
                                   (id3-picture-mimetype value)
                                   (id3-picture-kind value)
                                   (id3-picture-description value)
                                   (id3-picture-bytes value))))
         (unless ok? (error (if append? 'tags-append-picture! 'tags-picture!)
                            "could not set picture for file: ~a" file))
         (unless append? (set! picture value))]
        [else (raise-argument-error (if append? 'tags-append-picture! 'tags-picture!)
                                    "(or/c id3-picture? 'clear)" value)]))

    (define (save!)
      (ensure-open! 'tags-save!)
      (taglib_file_save tag-file))

    (define (to-hash)
      (let ((h (make-hash)))
        (hash-set! h 'valid? valid?)
        (hash-set! h 'read-write? read-write?)
        (hash-set! h 'closed? closed?)
        (hash-set! h 'title title)
        (hash-set! h 'album album)
        (hash-set! h 'artist artist)
        (hash-set! h 'comment comment)
        (hash-set! h 'composer composer)
        (hash-set! h 'genre genre)
        (hash-set! h 'year year)
        (hash-set! h 'track track)
        (hash-set! h 'length length)
        (hash-set! h 'sample-rate sample-rate)
        (hash-set! h 'bit-rate bit-rate)
        (hash-set! h 'channels channels)
        (hash-set! h 'picture picture)
        (hash-set! h 'keys (hash-keys key-store))
        h))

    (define (handle v . args)
      (cond
        [(eq? v 'valid?) valid?]
        [(eq? v 'read-write?) read-write?]
        [(eq? v 'closed?) closed?]
        [(eq? v 'close!) (close!)]
        [(eq? v 'save!) (save!)]
        [(eq? v 'title) title]
        [(eq? v 'album) album]
        [(eq? v 'artist) artist]
        [(eq? v 'comment) comment]
        [(eq? v 'composer) composer]
        [(eq? v 'genre) genre]
        [(eq? v 'year) year]
        [(eq? v 'track) track]
        [(eq? v 'length) length]
        [(eq? v 'sample-rate) sample-rate]
        [(eq? v 'bit-rate) bit-rate]
        [(eq? v 'channels) channels]
        [(eq? v 'keys) (hash-keys key-store)]
        [(eq? v 'album-artist) album-artist]
        [(eq? v 'disc-number) disc-number]
        [(eq? v 'val) (if (null? args) #f (hash-ref key-store (property-symbol (car args)) #f))]
        [(eq? v 'picture) picture]
        [(eq? v 'to-hash) (to-hash)]
        [(eq? v 'set-title!) (apply-string! 'tags-title! (car args) taglib_tag_set_title (lambda (x) (set! title x)))]
        [(eq? v 'set-album!) (apply-string! 'tags-album! (car args) taglib_tag_set_album (lambda (x) (set! album x)))]
        [(eq? v 'set-artist!) (apply-string! 'tags-artist! (car args) taglib_tag_set_artist (lambda (x) (set! artist x)))]
        [(eq? v 'set-comment!) (apply-string! 'tags-comment! (car args) taglib_tag_set_comment (lambda (x) (set! comment x)))]
        [(eq? v 'set-genre!) (apply-string! 'tags-genre! (car args) taglib_tag_set_genre (lambda (x) (set! genre x)))]
        [(eq? v 'set-year!) (apply-uint! 'tags-year! (car args) taglib_tag_set_year (lambda (x) (set! year x)))]
        [(eq? v 'set-track!) (apply-uint! 'tags-track! (car args) taglib_tag_set_track (lambda (x) (set! track x)))]
        [(eq? v 'set-composer!) (set-one-property! 'tags-composer! 'composer (car args))]
        [(eq? v 'set-album-artist!) (set-one-property! 'tags-album-artist! 'albumartist (car args))]
        [(eq? v 'set-disc-number!)
         (let ((x (car args)))
           (cond
             [(eq? x clear-tag-value) (set-one-property! 'tags-disc-number! 'discnumber clear-tag-value)]
             [(and (exact-nonnegative-integer? x) (<= x #xffffffff)) (set-one-property! 'tags-disc-number! 'discnumber (number->string x))]
             [(string? x) (set-one-property! 'tags-disc-number! 'discnumber x)]
             [else (raise-argument-error 'tags-disc-number! "(or/c exact-nonnegative-integer? string? 'clear)" x)]))]
        [(eq? v 'set!) (set-one-property! 'tags-set! (car args) (cadr args))]
        [(eq? v 'set-values!) (set-values-property! (car args) (cadr args))]
        [(eq? v 'append!) (set-one-property! 'tags-append! (car args) (cadr args) #:append? #t)]
        [(eq? v 'clear!) (set-one-property! 'tags-clear! (car args) clear-tag-value)]
        [(eq? v 'set-picture!) (set-picture! (car args))]
        [(eq? v 'append-picture!) (set-picture! (car args) #:append? #t)]
        [(eq? v 'clear-picture!) (set-picture! clear-tag-value)]
        [else (error (format "Unknown tag-cmd '~a'" v))]))

    (open-and-read!)
    (make-id3-tag-struct handle))

  (define (call-with-id3-tags file proc #:mode [mode 'read])
    (define tags (id3-tags file #:mode mode))
    (dynamic-wind
      void
      (lambda () (proc tags))
      (lambda () (tags-close! tags))))

  (define-syntax def
    (syntax-rules ()
      ((_ (fun v))
       (define (fun tags . args)
         (apply (id3-tag-struct-handle tags) (cons v args))))))

  (define-syntax defs
    (syntax-rules ()
      ((_ f1) (def f1))
      ((_ f1 f2 ...) (begin (def f1) (def f2) ...))))

  (defs
    (tags-valid? 'valid?)
    (tags-read-write? 'read-write?)
    (tags-closed? 'closed?)
    (tags-close! 'close!)
    (tags-save! 'save!)

    (tags-title 'title)
    (tags-album 'album)
    (tags-artist 'artist)
    (tags-comment 'comment)
    (tags-genre 'genre)
    (tags-composer 'composer)
    (tags-album-artist 'album-artist)
    (tags-disc-number 'disc-number)
    (tags-year 'year)
    (tags-track 'track)

    (tags-title! 'set-title!)
    (tags-album! 'set-album!)
    (tags-artist! 'set-artist!)
    (tags-comment! 'set-comment!)
    (tags-genre! 'set-genre!)
    (tags-composer! 'set-composer!)
    (tags-album-artist! 'set-album-artist!)
    (tags-disc-number! 'set-disc-number!)
    (tags-year! 'set-year!)
    (tags-track! 'set-track!)

    (tags-length 'length)
    (tags-sample-rate 'sample-rate)
    (tags-bit-rate 'bit-rate)
    (tags-channels 'channels)

    (tags-keys 'keys)
    (tags-ref 'val)
    (tags-set! 'set!)
    (tags-set-values! 'set-values!)
    (tags-append! 'append!)
    (tags-clear! 'clear!)

    (tags-picture 'picture)
    (tags-picture! 'set-picture!)
    (tags-append-picture! 'append-picture!)
    (tags-clear-picture! 'clear-picture!)
    (tags->hash 'to-hash))

  (define (tags-picture->bitmap tags)
    (let ((p (tags-picture tags)))
      (if (eq? p #f)
          #f
          (let* ((in (open-input-bytes (id3-picture-bytes p)))
                 (btm (read-bitmap in)))
            (close-input-port in)
            btm))))

  (define (tags-picture->kind tags)
    (let ((p (tags-picture tags)))
      (if (eq? p #f) #f (id3-picture-kind p))))

  (define (tags-picture->mimetype tags)
    (let ((p (tags-picture tags)))
      (if (eq? p #f) #f (id3-picture-mimetype p))))

  (define (tags-picture->description tags)
    (let ((p (tags-picture tags)))
      (if (eq? p #f) #f (id3-picture-description p))))

  (define (tags-picture->ext tags)
    (let ((mt (tags-picture->mimetype tags)))
      (cond
        [(eq? mt #f) #f]
        [(or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg")) 'jpg]
        [(string-suffix? mt "/png") 'png]
        [else #f])))

  (define (tags-picture->size tags)
    (let ((p (tags-picture tags)))
      (if (eq? p #f) #f (id3-picture-size p))))

  (define (tags-picture->file tags path)
    (let ((p (tags-picture tags)))
      (if (eq? p #f)
          #f
          (let* ((in (open-input-bytes (id3-picture-bytes p)))
                 (fh (open-output-file path #:mode 'binary #:exists 'replace)))
            (let ((bytes (read-bytes 16384 in)))
              (while (and (not (eof-object? bytes)) (> (bytes-length bytes) 0))
                     (write-bytes bytes fh)
                     (set! bytes (read-bytes 16384 in))))
            (close-output-port fh)
            (close-input-port in)
            #t))))

  )