#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DBD-SPGSQL.plt
;;
;; DBI wrapper over schematics/spgsql.
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; released under LGPL.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; array.ss
;; this module parses & reads the array structure, found in
;; postgresql's array object.
;; yc 9/8/2009 - first version
(require parser-tools/lex
         (prefix-in : parser-tools/lex-sre)
         mzlib/string
         scheme/contract
         )

(define-lex-abbrevs
  (array-begin #\{)
  (array-end #\})
  (array-delim (:: (:* #\space) #\, (:* #\space)))
  (space #\space)
  ;; displayable characters???
  ;; a naked string would include all displayble
  ;; character, except #{ #\, and #\}
  (naked-char (:& (:~ #\{ #\} #\,) any-char))
  (naked-string (:* naked-char))
  ;; below are c-style quoted strings...
  (newline (:: #\\ #\n))
  (return (:: #\\ #\r))
  (formfeed (:: #\\ #\f))
  (alert (:: #\\ #\a))
  (tab (:: #\\ #\t))
  (backslash (:: #\\ #\\)) 
  (quoted-char (:or newline
                    return
                    formfeed
                    alert
                    tab
                    backslash
                    any-char))
  (quoted-string (:: #\" (:* quoted-char) #\")))

(define lex-array
  (lexer ((eof) 'eof)
         (array-begin 'begin)
         (array-end 'end)
         (array-delim 'delim)
         (quoted-string (read-from-string lexeme))
         (naked-string lexeme)
         (space 'space)))

(define (read-array in)
  (define (helper acc begin?)
    (let ((token (lex-array in)))
      (case token
        ((end eof) ;; we are done...
         (reverse acc))
        ((begin) ;; just starting to collect...
         ;; it's possible we are not yet
         (if begin? ;; then we need to nest...
             (helper (cons (read-array in) acc) begin?)
             (helper acc #t)))
        ((delim space) ;; skip
         (helper acc begin?))
        (else (helper (cons token acc) begin?)))))
  (helper '() #f))

(define (parse-array str)
  (cond ((string? str) (read-array (open-input-string str)))
        ((bytes? str) (read-array (open-input-bytes str)))
        ((null? str) str)))

(provide/contract (read-array (-> input-port? any)) ;; list?
                  (parse-array (-> (or/c string? bytes? null?) any)) ;; list?
                  )