;;; sql.scm  --  Jens Axel Søgaard

(module sql mzscheme
  (provide sql sql->sexp)
  
  (require-for-syntax "sql-generate.scm")
  (require (lib "42.ss" "srfi")
           (lib "match.ss"))
  
  (define-syntax (sql stx)
    (syntax-case stx ()
      ; debug only [(_ . more) #`(sql->sexp . more)]
      [(_ . more)
       #`(sql-sexp->string (sql->sexp . more))]))
  
  (define-syntax (sql->sexp stx)
    (syntax-case stx ()
      [(sql statement)
       (syntax-case #'statement (SELECT UPDATE INSERT REPLACE DELETE)
         [(SELECT . more)
          #``#,(generate-select stx #'statement)]
         [(UPDATE . more)
          #``#,(generate-update stx #'statement)]
         [(INSERT . more)
          #``#,(generate-insert stx #'statement)]
         [(REPLACE . more)
          #``#,(generate-insert stx (syntax/loc stx (INSERT OR REPLACE . more)))]
         [(DELETE . more)
          #``#,(generate-delete stx #'statement)]
         [else
          (raise-syntax-error #f "unknown SQL statement" stx #'statement)])]
      [(sql error)
       (raise-syntax-error #f "expected (sql <statement>)" stx #'error)]))
  
  (define (sql-sexp->string s)
    (define (->string x)
      (cond
        [(eq? x 'ORDER-BY)  "ORDER BY"]
        [(symbol? x)        (symbol->string x)]
        [(string? x)        x]
        [(number? x)        (number->string x)]
        [(pair? x)          (match x
                              [('COMMA-LIST element ...)
                               (list->comma-separated-string (map ->string (cdr x)))]
                              [('PAREN-COMMA-LIST element ...)
                               (string-append 
                                "(" (list->comma-separated-string (map ->string (cdr x))) ")")]
                              [('STRING element)
                               (string-append 
                                "'" (->string (cdr x)) "'")]
                              [('PAREN element ...)
                               (string-append 
                                "(" (list->space-separated-string (map ->string (cdr x))) ")")]
                              [(elements ...)
                               (list->space-separated-string (map ->string x))]
                              [_
                               (error x)])]
        [else                 (error x)]))
    (define (list->comma-separated-string xs)
      (if (null? xs) 
          ""
          (string-append (car xs)
                         (string-append-ec (: x (cdr xs))
                                           (string-append ", " x)))))
    (define (list->space-separated-string xs)
      (if (null? xs) 
          ""
          (string-append (car xs)
                         (string-append-ec (: x (cdr xs))
                                           (string-append " " x)))))
    ; (display s) (newline)
    (->string s))
    
  
  
  
  ;;; TEST
  
  #;
  (for-each (lambda (o) (display o) (newline)) 
    (list
     (sql (SELECT (name)))
     (sql (SELECT ALL (name)))
     (sql (SELECT DISTINCT (name)))
     (sql (SELECT DISTINCT (first-name last-name)))
     (sql (SELECT ALL (name) FROM personnel))
     (sql (SELECT ALL (name) FROM (personnel JOIN salaries ON name)))
     (sql (SELECT ALL (name) FROM (personnel JOIN salaries USING (bar))))
     (sql (SELECT ALL (name) FROM (personnel JOIN salaries ON name USING (bar))))
     (sql (SELECT ALL (name) FROM (personnel JOIN salaries ON name USING (bar foo))))
     (sql (SELECT ALL (name) WHERE (= x 1)))
     (sql (SELECT ALL (name) GROUP-BY (first last)))
     (sql (SELECT ALL (name) HAVING (= x 1)))
     (sql (SELECT ALL (name) UNION (SELECT (name) FROM fired)))
     (sql (SELECT ALL (name) UNION-ALL (SELECT (name) FROM fired)))
     (sql (SELECT ALL (name) INTERSECT (SELECT (name) FROM fired)))
     (sql (SELECT ALL (name) EXCEPT (SELECT (name) FROM fired)))
     (sql (SELECT ALL (name) ORDER-BY (name ASC)))
     (sql (SELECT ALL (name) ORDER-BY (name DESC)))
     (sql (SELECT ALL (name) ORDER-BY (name COLLATE a-collation-name)))
     (sql (SELECT ALL (name) LIMIT 10))
     (sql (SELECT ALL (name) LIMIT 10 20))
     (sql (SELECT ALL (name) LIMIT 10 OFFSET 5))
     "--"
     ;;;
     
     "SELECT entry_id, header, url, score FROM entries ORDER BY score DESC LIMIT ~a"
     (sql (SELECT (entry_id header url score)
                  FROM entries
                  ORDER-BY (score DESC)
                  LIMIT 50))
     "--"
     "SELECT entry_id, header, url, score FROM entries ORDER BY score DESC LIMIT ~a OFFSET ~a"
     (let ([an-offset 100])
       (sql (SELECT (entry_id header url score)
                    FROM entries
                    ORDER-BY (score DESC)
                    LIMIT 50 OFFSET ,an-offset)))
     "--"
     "SELECT entry_id, header, url, score FROM entries WHERE url='~a' "
  ; TODO: "unquote"-expressions
  #;  (let ([url "http://www.reddit.com"])
       (sql (SELECT (entry_id header url score)
                    FROM entries
                    WHERE ,(format "url='~a'" url))))
     "--"
     '(let ([x 'entry])
        (sql (SELECT (,x) FROM entries)))
  #;(let ([x 'entry]) 
       (sql (SELECT (,x) FROM entries)))
     "--"
     '(let ([x 'entries])
        (sql (SELECT (name) FROM ,x)))
     (let ([x 'entries])
       (sql (SELECT (name) FROM ,x)))
     '---------------------------------------
     "UPDATE entries SET score=score+1 WHERE entry_id=~a"
     (sql (UPDATE entries SET (score = (+ score 1)) WHERE (= entry_id 4)))
     (sql (UPDATE OR FAIL entries SET (score = (+ score 1)) WHERE (= entry_id 4)))
     (sql (UPDATE OR FAIL db.entries SET (score = (+ score 1)) (time = (+ time 1)) WHERE (= entry_id 4)))
     (sql (UPDATE entries SET (score = (+ score 1))))
     #;(sql (UPDATE entries SET ,(format "score=score+~a" 10)))
     
     
     '---------------------------------------
     "INSERT INTO entries (header, url, score) VALUES ('~a','~a','~a')"
     (sql (INSERT INTO entries (header url score) VALUES ("Reddit" "http://www.reddit.com" 42)))
     (sql (INSERT OR REPLACE INTO entries (header url score) VALUES ("Reddit" "http://www.reddit.com" 42)))
     (sql (INSERT OR REPLACE INTO entries (header url score) (SELECT (header))))
     (sql (REPLACE INTO entries (header url score) (SELECT (header))))
     
     '---------------------------------------
     (sql (DELETE FROM entries WHERE "score<-10"))
     (sql (DELETE FROM entries))
     
     )
    )
  
  )