listit/servlets/model.scm
;;; model.scm

(module model mzscheme
  (provide (all-defined))
  
  (require 
   (planet "sqlite.ss" ("jaymccarthy" "sqlite.plt" 3 1))
   (planet "sqlite.ss" ("soegaard" "sqlite.plt" 1 2)))

  ;;; CONFIGURATION
  
  (define PAGE-LIMIT        (make-parameter 50))   ; number of entries on each page
  (define DATABASE-PATH     (string->path "listit.db"))

  ; initialization of the db happens at the first run, see bottom of this file
  (define current-database  (make-parameter #f))
    
  ;;; CONVENIENCE
  
  ; define db to be short for (current-database)
  (define-syntax db 
    (syntax-id-rules () [db (or (current-database)
                                (let ([d (open DATABASE-PATH)])
                                  (current-database d)
                                  d))]))
  
  ;;; DATABASE CREATION
  
  (define (create-table-entries)
    (exec/ignore 
     db 
     #<<SQL
   CREATE TABLE entries ( 
     entry_id  INTEGER PRIMARY KEY, 
     title     TEXT,
     url       TEXT,
     score     INTEGER )
SQL
     ))
  
  (define (drop-table-entries)
    (exec/ignore db "DROP TABLE entries"))
  

  ;; DATABASE INSERTION AND UPDATES
  
  (define (insert-entry title url score)
    (insert db (sql (INSERT INTO entries (title url score)
                            VALUES (,title ,url ,score)))))
  
  (define (increase-score entry-id)
    (update db (sql (UPDATE entries
                            SET (score = (+ score 1))
                            WHERE (= entry_id ,entry-id)))))
  
  (define (decrease-score entry-id)
    (update db (sql (UPDATE entries
                            SET (score = (- score 1)) 
                            WHERE (= entry_id ,entry-id)))))
  
  
  ;;; DATABASE RETRIEVAL
  
  (define (top n)
    (select db (sql (SELECT (entry_id title url score)
                            FROM entries 
                            ORDER-BY (score DESC)
                            LIMIT ,n))))
  
  (define (page n)
    (select db (sql (SELECT (entry_id title url score)
                            FROM entries
                            ORDER-BY (score DESC)
                            LIMIT ,(PAGE-LIMIT) OFFSET ,(* (PAGE-LIMIT) n)))))
  
  (define (entries-with-url url-str)
    (select db (sql (SELECT (entry_id title url score)
                            FROM entries
                            WHERE ,(format "url='~a'" url-str)))))
  
  (define (url-in-db? url-str)
    (let ([result (entries-with-url db url-str)])
      (if (null? (entries-with-url db url-str))
          #f
          result)))
  

  ;;; INITIALIZATION

  ; on first run, create tables
  (unless (and (file-exists? DATABASE-PATH)
               (table-exists? db "'entries'"))
    (create-table-entries)
    (current-database (make-parameter (open DATABASE-PATH)))))


;;; Example of using prepare to avoid SQL injections.
; Note: This exposes a bug in sql-generate-value, where
;       the symbol ? generates a "?" instead of simply ?.


;> (define s (prepare db (sql (SELECT (entry_id title url score)
;                                  FROM entries
;                                  ORDER-BY (score DESC)
;                                  LIMIT ,"?"))))
;> (load-params s 5)
;> (step* s)
;(#4(6 "A TITLE" "AN URL" 0)
; #4(1 "Everything Scheme" "http://www.scheme.dk/blog/" 42)
; #4(3 "PLT Scheme" "http://www.plt-scheme.org" 9)
; #4(2 "Reddit" "http://www.reddit.com" 7)
; #4(4 "PLT Scheme" "http://www.plt-scheme.org" 5))
;> (reset s)
;> (load-params s 10)
;> (step* s)
;(#4(6 "A TITLE" "AN URL" 0)
; #4(1 "Everything Scheme" "http://www.scheme.dk/blog/" 42)
; #4(3 "PLT Scheme" "http://www.plt-scheme.org" 9)
; #4(2 "Reddit" "http://www.reddit.com" 7)
; #4(4 "PLT Scheme" "http://www.plt-scheme.org" 5)
; #4(5 "PLT' Scheme" "http://www.plt-scheme.org" 5))
;> (reset s)
;> (load-params s 2)
;> (step* s)
;(#4(6 "A TITLE" "AN URL" 0) #4(1 "Everything Scheme" "http://www.scheme.dk/blog/" 42))
;> (sql (INSERT INTO entries (title url score)
;               VALUES (,"?" ,"?" ,"?")))
;"INSERT INTO entries (title, url, score) VALUES ('?', '?', '?')"