#lang racket/base

(require ffi/unsafe
         ffi/unsafe/define
         "private/utils.rkt"
         "private/downloader.rkt")

(provide TagLib_File_Type
         _TagLib_File-pointer
         _TagLib_Tag-pointer
         _TagLib_AudioProperties-pointer

         taglib_file_new
         taglib_file_new_wchar
         taglib_file_new_type
         taglib_file_is_valid
         taglib_file_free
         taglib_file_save

         taglib_file_tag
         taglib_file_audioproperties
         taglib_tag_free_strings

         taglib_tag_title
         taglib_tag_artist
         taglib_tag_album
         taglib_tag_comment
         taglib_tag_genre
         taglib_tag_year
         taglib_tag_track

         taglib_tag_set_title
         taglib_tag_set_artist
         taglib_tag_set_album
         taglib_tag_set_comment
         taglib_tag_set_genre
         taglib_tag_set_year
         taglib_tag_set_track

         taglib_audioproperties_length
         taglib_audioproperties_bitrate
         taglib_audioproperties_samplerate
         taglib_audioproperties_channels

         taglib_property_keys
         taglib_property_key
         taglib_property_get
         taglib_property_val
         taglib_property_set
         taglib_property_set_append
         taglib_property_free

         taglib_complex_property_set
         taglib_complex_property_set_append

         taglib-get-picture
         taglib-set-picture
         taglib-append-picture
         taglib-clear-picture)

(define zlib (get-lib '("zlib" "libz") '(#f)))
(define libtag (get-lib '("tag" "libtag") '("2" #f)))
(define libtag_c (get-lib '("tag_c" "libtag_c") '("#2" #f)))

(define-ffi-definer define-tag-c-lib libtag_c
  #:default-make-fail make-not-available)

(define TagLib_File_Type
  (_enum '(
           mpeg
           ogg-vorbis
           flac
           mpc
           ogg-flac
           wavpack
           speex
           true-audio
           mp4
           asf
           aiff
           wav
           ape
           it
           mod
           s3m
           xm
           opus
           dsf
           dsdiff
           shorten
           matroska)))

(define _TagLib_File-pointer (_cpointer/null 'taglib-file))
(define _TagLib_Tag-pointer (_cpointer/null 'taglib-tag))
(define _TagLib_AudioProperties-pointer (_cpointer/null 'taglib-audioproperties))

(define-tag-c-lib taglib_file_new
  (_fun _string/utf-8 -> _TagLib_File-pointer))

(define-tag-c-lib taglib_file_new_wchar
  (_fun _string/utf-16 -> _TagLib_File-pointer))

(define-tag-c-lib taglib_file_new_type
  (_fun _string/utf-8 TagLib_File_Type -> _TagLib_File-pointer))

(define-tag-c-lib taglib_file_new_type_wchar
  (_fun _string/utf-16 TagLib_File_Type -> _TagLib_File-pointer))

(define-tag-c-lib taglib_file_free
  (_fun _TagLib_File-pointer -> _void))

(define-tag-c-lib taglib_file_is_valid
  (_fun _TagLib_File-pointer -> _bool))

(define-tag-c-lib taglib_file_save
  (_fun _TagLib_File-pointer -> _bool))

(define-tag-c-lib taglib_file_tag
  (_fun _TagLib_File-pointer -> _TagLib_Tag-pointer))

(define-tag-c-lib taglib_file_audioproperties
  (_fun _TagLib_File-pointer -> _TagLib_AudioProperties-pointer))

(define-tag-c-lib taglib_tag_free_strings
  (_fun -> _void))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; tags
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-syntax tg
  (syntax-rules ()
    ((_ name)
     (define-tag-c-lib name
       (_fun _TagLib_Tag-pointer -> _string/utf-8)))
    ((_ name ret-type)
     (define-tag-c-lib name
       (_fun _TagLib_Tag-pointer -> ret-type)))))

(tg taglib_tag_title)
(tg taglib_tag_artist)
(tg taglib_tag_album)
(tg taglib_tag_comment)
(tg taglib_tag_genre)
(tg taglib_tag_year _uint)
(tg taglib_tag_track _uint)

(define-syntax tgs
  (syntax-rules ()
    ((_ name)
     (define-tag-c-lib name
       (_fun _TagLib_Tag-pointer _string/utf-8 -> _void)))
    ((_ name arg-type)
     (define-tag-c-lib name
       (_fun _TagLib_Tag-pointer arg-type -> _void)))))

(tgs taglib_tag_set_title)
(tgs taglib_tag_set_artist)
(tgs taglib_tag_set_album)
(tgs taglib_tag_set_comment)
(tgs taglib_tag_set_genre)
(tgs taglib_tag_set_year _uint)
(tgs taglib_tag_set_track _uint)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; audio properties
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-syntax ap
  (syntax-rules ()
    ((_ name)
     (define-tag-c-lib name
       (_fun _TagLib_AudioProperties-pointer -> _int)))))

(ap taglib_audioproperties_length)
(ap taglib_audioproperties_bitrate)
(ap taglib_audioproperties_samplerate)
(ap taglib_audioproperties_channels)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; property map
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-tag-c-lib taglib_property_keys
  (_fun _TagLib_File-pointer -> (_ptr i _string/utf-8)))

(define (taglib_property_key keys i)
  (ptr-ref keys _string/utf-8 i))

(define-tag-c-lib taglib_property_get
  (_fun _TagLib_File-pointer _string/utf-8 -> (_ptr i _string/utf-8)))

(define (taglib_property_val prop i)
  (ptr-ref prop _string/utf-8 i))

;; value may be NULL to clear the property.
(define-tag-c-lib taglib_property_set
  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _void))

;; value may be NULL to clear all values for the property.
(define-tag-c-lib taglib_property_set_append
  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _void))

(define-tag-c-lib taglib_property_free
  (_fun _pointer -> _void))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Picture data
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-cstruct _TagLib_Complex_Property_Picture_Data
  ([mimeType _string/utf-8]
   [description _string/utf-8]
   [pictureType _string/utf-8]
   [data _pointer]
   [size _uint]))

(define _Complex_Property_Attribute-pointer (_cpointer/null 'taglib-complex-property-attribute))

(define-tag-c-lib taglib_complex_property_get
  (_fun _TagLib_File-pointer _string/utf-8 -> _Complex_Property_Attribute-pointer))

(define-tag-c-lib taglib_picture_from_complex_property
  (_fun _Complex_Property_Attribute-pointer
        _TagLib_Complex_Property_Picture_Data-pointer
        -> _void))

(define-tag-c-lib taglib_complex_property_free
  (_fun _Complex_Property_Attribute-pointer -> _void))

(define-tag-c-lib taglib_complex_property_keys
  (_fun _TagLib_File-pointer -> (_ptr i _string/utf-8)))

(define-tag-c-lib taglib_complex_property_free_keys
  (_fun _pointer -> _void))

;; TagLib_Variant is { enum type; unsigned int size; union value; }.
;; For writing pictures we only use pointer-valued union members: stringValue
;; and byteVectorValue. A pointer-sized field has the same size/alignment as
;; the union on the supported ABIs.
(define TagLib_Variant_ByteVector 9)
(define TagLib_Variant_String 7)

(define-cstruct _TagLib_Variant
  ([type _int]
   [size _uint]
   [value _pointer]))

(define-cstruct _TagLib_Complex_Property_Attribute
  ([key _pointer]
   [value _TagLib_Variant]))

(define-tag-c-lib taglib_complex_property_set
  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _bool))

(define-tag-c-lib taglib_complex_property_set_append
  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _bool))

(define (bytes->malloc-ptr bs [nul? #f])
  (define len (bytes-length bs))
  (define ptr (malloc _byte (+ len (if nul? 1 0)) 'atomic-interior))
  (for ([i (in-range len)]) (ptr-set! ptr _byte i (bytes-ref bs i)))
  (when nul? (ptr-set! ptr _byte len 0))
  ptr)

(define (string->malloc-cstring s)
  (bytes->malloc-ptr (string->bytes/utf-8 s) #t))

(define (picture->complex-property data size description mimetype picture-type)
  (define data-ptr (bytes->malloc-ptr data #f))
  (define data-key (string->malloc-cstring "data"))
  (define mime-key (string->malloc-cstring "mimeType"))
  (define desc-key (string->malloc-cstring "description"))
  (define type-key (string->malloc-cstring "pictureType"))
  (define mime-ptr (string->malloc-cstring mimetype))
  (define desc-ptr (string->malloc-cstring description))
  (define type-ptr (string->malloc-cstring picture-type))
  (define data-attr (make-TagLib_Complex_Property_Attribute data-key (make-TagLib_Variant TagLib_Variant_ByteVector size data-ptr)))
  (define mime-attr (make-TagLib_Complex_Property_Attribute mime-key (make-TagLib_Variant TagLib_Variant_String 0 mime-ptr)))
  (define desc-attr (make-TagLib_Complex_Property_Attribute desc-key (make-TagLib_Variant TagLib_Variant_String 0 desc-ptr)))
  (define type-attr (make-TagLib_Complex_Property_Attribute type-key (make-TagLib_Variant TagLib_Variant_String 0 type-ptr)))
  (define propv (malloc _pointer 5 'atomic-interior))
  (ptr-set! propv _pointer 0 data-attr)
  (ptr-set! propv _pointer 1 mime-attr)
  (ptr-set! propv _pointer 2 desc-attr)
  (ptr-set! propv _pointer 3 type-attr)
  (ptr-set! propv _pointer 4 #f)
  ;; Return keepalive values as well as the pointer array. TagLib copies during
  ;; taglib_complex_property_set(), but all buffers must remain live for the call.
  (values propv (list data-ptr data-key mime-key desc-key type-key mime-ptr desc-ptr type-ptr
                      data-attr mime-attr desc-attr type-attr propv)))

(define (taglib-set-picture tag-file mimetype picture-type description data)
  (define-values (props keepalive)
    (picture->complex-property data (bytes-length data) description mimetype picture-type))
  (define ok? (taglib_complex_property_set tag-file "PICTURE" props))
  keepalive
  ok?)

(define (taglib-append-picture tag-file mimetype picture-type description data)
  (define-values (props keepalive)
    (picture->complex-property data (bytes-length data) description mimetype picture-type))
  (define ok? (taglib_complex_property_set_append tag-file "PICTURE" props))
  keepalive
  ok?)

(define (taglib-clear-picture tag-file)
  (taglib_complex_property_set tag-file "PICTURE" #f))

(define (taglib-get-picture tag-file)
  (define (cp s) (if (eq? s #f) "" (string-append s "")))
  (let ((props (taglib_complex_property_get tag-file "PICTURE")))
    (if (eq? props #f)
        #f
        (let ((pd (make-TagLib_Complex_Property_Picture_Data #f #f #f #f 0)))
          (taglib_picture_from_complex_property props pd)
          (let* ((mimetype (cp (TagLib_Complex_Property_Picture_Data-mimeType pd)))
                 (description (cp (TagLib_Complex_Property_Picture_Data-description pd)))
                 (type (cp (TagLib_Complex_Property_Picture_Data-pictureType pd)))
                 (size (TagLib_Complex_Property_Picture_Data-size pd))
                 (data (cast (TagLib_Complex_Property_Picture_Data-data pd) _pointer (_bytes o size))))
            (let ((r (list mimetype description type size data)))
              (taglib_complex_property_free props)
              r))))))