#lang scheme

(require "engine-interface.ss")
(require (planet schematics/schemeunit))

; network-byte order, size is automatically the number of bytes and always signed, right?
(define (decode-integer bytes) (integer-bytes->integer bytes #t #t))
(define (encode-int8 integer) (integer->integer-bytes integer 8 #t #t))
(define (encode-int4 integer) (integer->integer-bytes integer 4 #t #t))
(define (encode-int2 integer) (integer->integer-bytes integer 2 #t #t))
(define (decode-boolean bytes) (when (not (= 1 (bytes-length bytes))) (error (format "boolean is 1 byte? ~s" bytes)))
  (= (bytes-ref bytes 0) 1))
(define (encode-boolean boolean) (if boolean #"\x01" #"\x00"))
(define (decode-bytea bytes) bytes) ; we use a weak value:result hash table in main.ss, so no need to copy
(define (encode-bytea bytes) bytes)
(define (decode-text bytes) (bytes->string/utf-8 bytes)) ; kind of need to copy T_T
(define (encode-text string) (string->bytes/utf-8 string))
(define (encode-name symbol) 
  ; validate symbol here as postgresqly
  (string->bytes/utf-8 (symbol->string symbol)))
(define (decode-name bytes)
  (string->symbol
   ; process string to form sensible symbol here
   (bytes->string/utf-8 bytes)))
(define (decode-real bytes) (floating-point-bytes->real bytes #t))
(define (encode-real8 number) (real->floating-point-bytes number 8 #t))
(define (encode-real4 number) (real->floating-point-bytes number 4 #t))
(define (decode-char bytes) (when (not (= 1 (bytes-length bytes))) (error "char is 1 byte?"))
  (integer->char (bytes-ref bytes 0)))
(define (encode-char c) (bytes (char->integer c)))

(define (bytes-extract-header sizes bytes)
  (let loop ([bytes bytes] [sizes sizes] [result null])
    (if (null? sizes) (apply values bytes (reverse result))
        (let ([size (car sizes)])
          (loop (subbytes bytes size) (cdr sizes) (cons (decode-integer (subbytes bytes 0 size)) result))))))

(define-struct unknown (oid bytes) #:transparent) ; to ensure we're not fooled

(define (decode-unknown oid bytes)
  (make-unknown oid bytes))

; this probably will work because we already looked up by OID (and failed)
(define (encode-unknown unknown)
  (when (not (unknown? unknown)) (error "This must be a special 'unknown' structure"))
  (unknown-bytes unknown))

(define (small-integer? how-small)
  (let* ([upper-bound (expt #x100 how-small)]
         [lower-bound (- 0 upper-bound)])
;    (display (format "for ~a ~a:~a~n" how-small lower-bound upper-bound))
    (λ (i)
      (and (integer? i) (< i upper-bound) (> i lower-bound)))))

(define-for-syntax (symbol-append . rest)
  (string->symbol (apply string-append (map symbol->string rest))))

; it's syntax DAMMIT
(define-for-syntax typecast-item 
  (let ([process
         (λ (name to from) 
           (list 'quasiquote 
                 (list name 
                       (list 'unquote (symbol-append 'decode- to)) 
                       (list 'unquote (symbol-append 'encode- from)))))])
    (λ (form)
      (syntax-case form ()
        [(a : b) (let ([datum (syntax->datum form)]) (process (car datum) (caddr datum) (caddr datum)))]
        [(a : b c) (let ([datum (syntax->datum form)]) (process (car datum) (caddr datum) (cadddr datum)))]
        [_ (begin (error (format "The form must be (oid : bidi) or (oid : to from) got ~s instead" (syntax->datum form))))]))))
                             
(define-syntax (make-typecast form)
  (syntax-case form ()
    [(_ ...) 
     (datum->syntax
      form
      (cons 'list (map typecast-item (cdr (syntax->list form))))
      form)]
    [(_) (error "You probably want to supply some typecasts...")]))

; oid is about as likely to change for builtins as their textual name, so...
(define default-codecs
  (make-immutable-hash
   (make-typecast
    (16 : boolean)
    (17 : bytea)
    (18 : char)
    (19 : name)
    (20 : integer int8)
    (21 : integer int2)
    (23 : integer int4)
    (25 : text)
     ; oid
    (26 : integer int4)
    (27 : integer int4)
    (28 : integer int4)
    (29 : integer int4)
    (700 : real real8)
    (701 : real real4))))

(define (number-and-inexact? v)
  (and (number? v) (inexact? v)))

(define default-diviners
  `((,(small-integer? 2) . 21)
    (,(small-integer? 4) . 23)
    (,(small-integer? 8) . 20)
    ; not sure probably should be 700 since scheme floats are 32bit always
    (,number-and-inexact? . 701)
    (,bytes? . 17)
    (,string? . 25)
    (,char? . 18)
    (,boolean? . 16)
    (,symbol? . 19)
    ))

(define default-sizes
  ; this is just a WILD guess :p
  (make-immutable-hash
   `((16 . 1)
     (18 . 1)
     (21 . 2)
     (23 . 4)
     (20 . 8)
     (700 . 4)
     (701 . 8))))

(define (set-info! engine)
;  (hash-for-each
;   (λ (oid size)
;     (send engine set-size! oid size))
;   default-sizes)
  (hash-for-each
   default-codecs
   (λ (oid codec)
     (send/apply engine set-codec! oid (reverse codec))))
  (dict-for-each
   default-diviners
   (λ (test? oid)
     (send engine add-diviner! (λ (value) (if (test? value) oid #f))))))

(provide/contract
 ; both numeric and vector use this:
 [bytes-extract-header ((listof integer?) bytes? . -> . any)] ;(values (cons/c bytes? (listof integer?))))]

 ; for times.scm T_T
 [decode-integer (bytes? . -> . integer?)]
 [decode-real (bytes? . -> . real?)]
 [encode-int8 (integer? . -> . bytes?)]
 [encode-real8 (real? . -> . bytes?)]
 
 ; for vector.scm
 [encode-int4 (integer? . -> . bytes?)]
 
 ; if we want to process totally unknown oid formats...
 ; possibly to display an error.
 ; at least we have a definite bytes size!
 [unknown? (any/c . -> . boolean?)]
 [unknown-oid (unknown? . -> . integer?)]
 [unknown-bytes (unknown? . -> . bytes?)]
 
 ; for the connection
 [set-info! (engine? . -> . void?)]
 )