#lang racket/base
(require
 (only-in srfi/13 string-trim-both)
 ffi/vector
 ffi/unsafe
 ffi/unsafe/alloc
 ffi/unsafe/define)

(define udunits-lib
  (ffi-lib "libudunits2"))

(define-ffi-definer define-udunits
  udunits-lib)

(define-cpointer-type _unit-system)

(define-udunits free-unit-system
  (_fun (system : _unit-system)
        -> _void)
  #:wrap (deallocator)
  #:c-id ut_free_system)

(define-udunits read-unit-system/xml
  (_fun (filename : _string*/locale)
        -> (system : _unit-system))
  #:wrap (allocator free-unit-system)
  #:c-id ut_read_xml)

(define current-unit-system
  (make-parameter (read-unit-system/xml #f)))

(provide
 read-unit-system/xml free-unit-system
 current-unit-system)

(define-cpointer-type _unit)

(define-udunits free-unit
  (_fun (unit : _unit)
        -> _void)
  #:wrap (deallocator)
  #:c-id ut_free)

(define UTF-8
  2)

(define-udunits string->unit
  (_fun (str [system (current-unit-system)])
        :: (system : _unit-system)
           (str : _string/utf-8 = (string-trim-both str))
           (encoding : _int = UTF-8)
        -> (unit : _unit))
  #:wrap (allocator free-unit)
  #:c-id ut_parse)

(define-udunits unit->string
  (_fun (unit)
        :: (unit : _unit)
           (buffer : _bytes = (make-bytes 1024))
           (size : _ulong = (bytes-length buffer))
           (encoding : _int = UTF-8)
        -> (size : _int)
        -> (if (not (negative? size))
               (bytes->string/utf-8 (subbytes buffer 0 size))
               (error 'unit->string "could not format unit")))
  #:c-id ut_format)

(provide
 string->unit unit->string free-unit)

(define-cpointer-type _converter)

(define-udunits free-converter
  (_fun (converter : _converter)
        -> _void)
  #:wrap (deallocator)
  #:c-id cv_free)

(define-udunits make-converter
  (_fun (from : _unit)
        (to : _unit)
        -> _converter)
  #:wrap (allocator free-converter)
  #:c-id ut_get_converter)

(define-udunits convert-f64vector
  (_fun (converter : _converter)
        (in : (_f64vector i))
        (size : _ulong = (f64vector-length in))
        (out : (_f64vector o size))
        -> _void
        -> out)
  #:c-id cv_convert_doubles)

(provide
 make-converter free-converter
 convert-f64vector)

(define (convert-units value from to [system (current-unit-system)])
  (f64vector-ref
   (convert-f64vector
    (make-converter
     (if (string? from) (string->unit from system) from)
     (if (string? to) (string->unit to system) to))
    (f64vector value))
   0))

(provide
 convert-units)