#lang racket/base
(require racket/serialize
         racket/string
         db/private/generic/interfaces
         db/util/private/geometry)
(provide (all-defined-out))

  inet ,  = family : byte bits : byte is_cidr : byte addrlen : byte addr : be - integer
;;   is_cidr is ignored

  box = x1 y1 x2 y2 ( all  )
  circle = x y rad ( all  )
;; line = not yet implemented
  lseg = x1 y1 x2 y2 ( all  )
  path = closed?:byte # points : int4 ( x y :  ) *
  point = x y ( all  )
  polygon = # points : int4 ( x y :  ) *

(serializable-struct pg-box (ne sw)
  #:transparent
  #:guard (lambda (ne sw _n)
            (let ([x1 (point-x ne)]
                  [x2 (point-x sw)]
                  [y1 (point-y ne)]
                  [y2 (point-y sw)])
              (values (point (max x1 x2) (max y1 y2))
                      (point (min x1 x2) (min y1 y2))))))

(serializable-struct pg-circle (center radius)
  #:transparent
  #:guard (lambda (center radius _n)
            (values center (exact->inexact radius))))

(serializable-struct pg-path (closed? points)
  #:transparent
  #:guard (lambda (closed? points _n)
            (values (and closed? #t)
                    points)))

(serializable-struct pg-array (dimensions dimension-lengths dimension-lower-bounds contents)
  #:transparent
  #:guard (lambda (ndim counts lbounds vals _n)
            (unless (= (length counts) ndim)
              (error* 'pg-array "list for dimension lengths has wrong length"
                      "expected length" ndim
                      '("got" value) counts))
            (unless (= (length lbounds) ndim)
              (error* 'pg-array "list for dimension lower bounds has wrong length"
                      "expected length" ndim
                      '("got" value) lbounds))
            (when (zero? ndim)
              (unless (equal? vals '#())
                (error* 'pg-array
                        "bad array contents for zero-dimensional array"
                        '("contents" value) vals)))
            (let loop ([counts* counts] [vals* vals])
              (when (pair? counts*)
                (unless (and (vector? vals*)
                             (= (vector-length vals*) (car counts*)))
                  (error 'pg-array "bad array contents: ~e" vals))
                (for ([sub (in-vector vals*)])
                  (loop (cdr counts*) sub))))
            (values ndim counts lbounds vals)))

(define (pg-array-ref arr . indexes)
  (unless (= (pg-array-dimensions arr) (length indexes))
    (error* 'pg-array-ref "wrong number of indexes"
            "expected number" (pg-array-dimensions arr)
            '("got" value) indexes))
  (let* ([counts (pg-array-dimension-lengths arr)]
         [lbounds (pg-array-dimension-lower-bounds arr)]
         [ubounds (map (lambda (c lb) (+ c lb -1)) counts lbounds)])
    (unless (for/and ([index indexes] [lbound lbounds] [ubound ubounds])
              (<= lbound index ubound))
      (error* 'pg-array-ref "index out of range"
              '("index" value) indexes
              "valid range" (string-join (for/list ([lbound lbounds] [ubound ubounds])
                                           (format "[~a,~a]" lbound ubound))
                                         ", ")))
    (let loop ([indexes (map - indexes lbounds)]
               [vals (pg-array-contents arr)])
      (cond [(pair? indexes)
             (let ([index (car indexes)])
               (loop (cdr indexes)
                     (vector-ref vals index)))]
            [else vals]))))

(define (pg-array->list arr)
  (unless (member (pg-array-dimensions arr) '(0 1))
    (raise-type-error 'pg-array->list "pg-array of dimension 0 or 1" arr))
  (vector->list (pg-array-contents arr)))

(define (list->pg-array lst)
  (cond [(zero? (length lst))
         (pg-array 0 '() '() '#())]
        [else (pg-array 1 (list (length lst)) '(1) (list->vector lst))]))

(serializable-struct pg-empty-range () #:transparent)
(serializable-struct pg-range (lb includes-lb? ub includes-ub?) #:transparent)

(define (pg-range-or-empty? v)
  (or (pg-empty-range? v) (pg-range? v)))

(define (uuid? x)
  (define uuid-rx
    #px"^[[:xdigit:]]{8}-[[:xdigit:]]{4}-[[:xdigit:]]{4}-[[:xdigit:]]{4}-[[:xdigit:]]{12}$")
  (and (string? x) (regexp-match? uuid-rx x)))

(struct pg-custom-type (typeid typename basetype recv-convert send-convert))

   is_cidr is ignored
 line = not yet implemented
#lang racket/base
(require racket/serialize
         racket/string
         db/private/generic/interfaces
         db/util/private/geometry)
(provide (all-defined-out))

  inet ,  = family : byte bits : byte is_cidr : byte addrlen : byte addr : be - integer

  box = x1 y1 x2 y2 ( all  )
  circle = x y rad ( all  )
  lseg = x1 y1 x2 y2 ( all  )
  path = closed?:byte # points : int4 ( x y :  ) *
  point = x y ( all  )
  polygon = # points : int4 ( x y :  ) *

(serializable-struct pg-box (ne sw)
  #:transparent
  #:guard (lambda (ne sw _n)
            (let ([x1 (point-x ne)]
                  [x2 (point-x sw)]
                  [y1 (point-y ne)]
                  [y2 (point-y sw)])
              (values (point (max x1 x2) (max y1 y2))
                      (point (min x1 x2) (min y1 y2))))))

(serializable-struct pg-circle (center radius)
  #:transparent
  #:guard (lambda (center radius _n)
            (values center (exact->inexact radius))))

(serializable-struct pg-path (closed? points)
  #:transparent
  #:guard (lambda (closed? points _n)
            (values (and closed? #t)
                    points)))

(serializable-struct pg-array (dimensions dimension-lengths dimension-lower-bounds contents)
  #:transparent
  #:guard (lambda (ndim counts lbounds vals _n)
            (unless (= (length counts) ndim)
              (error* 'pg-array "list for dimension lengths has wrong length"
                      "expected length" ndim
                      '("got" value) counts))
            (unless (= (length lbounds) ndim)
              (error* 'pg-array "list for dimension lower bounds has wrong length"
                      "expected length" ndim
                      '("got" value) lbounds))
            (when (zero? ndim)
              (unless (equal? vals '#())
                (error* 'pg-array
                        "bad array contents for zero-dimensional array"
                        '("contents" value) vals)))
            (let loop ([counts* counts] [vals* vals])
              (when (pair? counts*)
                (unless (and (vector? vals*)
                             (= (vector-length vals*) (car counts*)))
                  (error 'pg-array "bad array contents: ~e" vals))
                (for ([sub (in-vector vals*)])
                  (loop (cdr counts*) sub))))
            (values ndim counts lbounds vals)))

(define (pg-array-ref arr . indexes)
  (unless (= (pg-array-dimensions arr) (length indexes))
    (error* 'pg-array-ref "wrong number of indexes"
            "expected number" (pg-array-dimensions arr)
            '("got" value) indexes))
  (let* ([counts (pg-array-dimension-lengths arr)]
         [lbounds (pg-array-dimension-lower-bounds arr)]
         [ubounds (map (lambda (c lb) (+ c lb -1)) counts lbounds)])
    (unless (for/and ([index indexes] [lbound lbounds] [ubound ubounds])
              (<= lbound index ubound))
      (error* 'pg-array-ref "index out of range"
              '("index" value) indexes
              "valid range" (string-join (for/list ([lbound lbounds] [ubound ubounds])
                                           (format "[~a,~a]" lbound ubound))
                                         ", ")))
    (let loop ([indexes (map - indexes lbounds)]
               [vals (pg-array-contents arr)])
      (cond [(pair? indexes)
             (let ([index (car indexes)])
               (loop (cdr indexes)
                     (vector-ref vals index)))]
            [else vals]))))

(define (pg-array->list arr)
  (unless (member (pg-array-dimensions arr) '(0 1))
    (raise-type-error 'pg-array->list "pg-array of dimension 0 or 1" arr))
  (vector->list (pg-array-contents arr)))

(define (list->pg-array lst)
  (cond [(zero? (length lst))
         (pg-array 0 '() '() '#())]
        [else (pg-array 1 (list (length lst)) '(1) (list->vector lst))]))

(serializable-struct pg-empty-range () #:transparent)
(serializable-struct pg-range (lb includes-lb? ub includes-ub?) #:transparent)

(define (pg-range-or-empty? v)
  (or (pg-empty-range? v) (pg-range? v)))

(define (uuid? x)
  (define uuid-rx
    #px"^[[:xdigit:]]{8}-[[:xdigit:]]{4}-[[:xdigit:]]{4}-[[:xdigit:]]{4}-[[:xdigit:]]{12}$")
  (and (string? x) (regexp-match? uuid-rx x)))

(struct pg-custom-type (typeid typename basetype recv-convert send-convert))
