#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DBI.plt
;;
;; database interface abstraction.  Inspired by Perl DBI.
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; released under LGPL.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; pool.ss 
;; prepared statements parsers & bulk loaders.
;; yc 9/8/2009 - first version
(require (planet bzlib/base)
         "base.ss"
         scheme/file
         scheme/path
         )

#|
;; usage 
;; (load-prepared-statements handle path ...)
;; format

the script can contain multiple prepared statements in the following manner

--;;-- <key_name>
<sql prepared statement goes here>
--;;-- <key_name>
<sql prepared statement goes here>
.... repeat ... 

Key declaration:

The key must be on its own line, preceded by "--;;--" (whitespace okay).  The first word
after the indicator will be used as the key (so everything after the first word is
discarded).

SQL Prepared Statement Body: 
The sql prepared statement MUST be preceded by a key declaration.  all lines will be discarded
prior to finding the first key declaration.

there will be little effort toward making the current parser robust.


;;|#

#|
design:

to handle the above parsing, line-based readers are fine.

to skip all lines up to the first key declaration - we can track it via
two separate branch of the code (until it hits the first block - skip it).

we can add "skip comments" reader if the line starts with '--' but not '--**--'

to read the key declaration - it can be as simple as using regexp I think.
^--;;--\s*(\w+)

to know it's a comment - just test it when the key declaration fails.
^--

the rest of the line will be kept and converted into the prepared statement.
;;|#

(define (key-declaration? line)
  (if-it (regexp-match #px"^--;;--\\s*([\\w\\:\\-\\?\\!\\/\\_]+)" line)
         (string->symbol (cadr it))
         #f))

(define (comment? line)
  (or (regexp-match #px"^\\s*$" line)
      (regexp-match #px"^\\s*--" line)))

;; to read - we'll simply load the whole file as a set of lines...
(define (parse-statements lines)
  (define (skip-until-key-then-parse rest)
    (cond ((null? rest) ;; we've skipped every thing.
           (error 'parse-statements "No key declaraction found - the whole file checked and skipped"))
          ((key-declaration? (car rest)) ;; great!!
           (parse-rest rest '()))
          (else (skip-until-key-then-parse (cdr rest)))))

  (define (parse-rest rest stmts)
    ;; key will have to be the first line...
    (cond ((null? rest) (reverse stmts))
          (else
           (let-values (((stmt rest)
                         (parse (key-declaration? (car rest)) (cdr rest) '())))
             (parse-rest rest (cons stmt stmts))))))
  (define (parse key rest acc)
    (define (return key acc rest)
      (values (cons key (string-join (reverse acc) "\n"))
              rest))
    (cond ((null? rest) ;; done the whole file.
           (if (null? acc) ;; empty statement.
               (error 'parse-statements "key ~a had no following statement" key)
               (return key acc rest)))
          ((key-declaration? (car rest)) ;; found the next key declaraction.
           (return key acc rest))
          ((comment? (car rest)) ;; skip comment.
           (parse key (cdr rest) acc))
          (else
           (parse key (cdr rest) (cons (car rest) acc)))))
  (skip-until-key-then-parse lines))

(define (file->statements path)
  (define (file->lines path)
    (call-with-input-file path
      (lambda (in)
        (let loop ((b (read-line in 'any))
                   (lines '()))
          (if (eof-object? b)
              (reverse lines)
              (loop (read-line in 'any) (cons b lines)))))))
  (parse-statements (file->lines path)))

(define (load-file! handle path)
  (for-each (lambda (stmt)
              (prepare handle (car stmt) (cdr stmt)))
            (file->statements path)))

(define (directory-list/regex path pat)
  (define (match? file)
    (regexp-match pat (path->string file)))
  (map (lambda (p)
         (normalize-path (build-path path p)))
       (filter match? (directory-list path))))

(define (load-files! handle paths)
  (define (helper path)
    (if (directory-exists? path)
        (for-each (lambda (path)
                    (load-file! handle path))
                  (directory-list/regex path #px"\\.sql$"))
        (load-file! handle path)))
  (for-each helper paths))

;; we'll handle a very specific attribute #:files
(define (filter-file-loader/attrs attrs)
  (define (helper rest acc loader)
    (cond ((null? rest) (values loader (reverse acc)))
          ((equal? (car rest) '#:load)
           (if (null? (cdr rest))
               (error 'connect "invalid attribute ~a - no values" (car rest))
               (helper (cddr rest) acc (cadr rest))))
          (else
           (helper (cdr rest) (cons (car rest) acc) loader))))
  (helper attrs '() '()))

(provide/contract
 (key-declaration? (-> string? (or/c false/c symbol?)))
 (load-file! (-> handle? path-string? any))
 (load-files! (-> handle? (listof path-string?) any))
 (filter-file-loader/attrs (-> (listof any/c) any))
 )