#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)

;; 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

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.



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.

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))

(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))
           (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"))
    (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))
           (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))))
           (helper (cdr rest) (cons (car rest) acc) loader))))
  (helper attrs '() '()))

 (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))