db.scm (1995B) [raw]
1 (import sqlite3 2 sql-null 3 (chicken condition) 4 (chicken string) 5 (chicken format)) 6 7 (define conn (open-database "rsvp.sqlite3")) 8 9 (define-record guest id name party-id going meal-choice) 10 (set-record-printer! guest 11 (lambda (x o) 12 (fprintf o "(guest id: ~A name: ~A going: ~A meal: ~A)" 13 (guest-id x) 14 (guest-name x) 15 (guest-going x) 16 (guest-meal-choice x)))) 17 18 (define-record party id notes guests) 19 (set-record-printer! party 20 (lambda (x o) 21 (fprintf o "(party id: ~A guests: ~A)" 22 (party-id x) 23 (map (lambda (x) (guest-name x)) (party-guests x))))) 24 25 (define (get-guest-by-name name) 26 (apply make-guest 27 (first-row conn 28 "SELECT 29 id, 30 name, 31 party_id, 32 going, 33 meal_choice 34 FROM guests WHERE name = $name" name))) 35 36 (define (get-guest-by-id id) 37 (apply make-guest 38 (first-row conn 39 "SELECT 40 id, 41 name, 42 party_id, 43 going, 44 meal_choice 45 FROM guests WHERE id = $name" id))) 46 47 (define (get-guests-in-party pid) 48 (map-row make-guest conn 49 "SELECT 50 id, 51 name, 52 party_id, 53 going, 54 meal_choice 55 FROM guests WHERE party_id = $pid" pid)) 56 57 (define (get-party-by-id pid) 58 (let ((res (first-row conn "SELECT id, notes FROM parties WHERE id = $pid" pid))) 59 (make-party (car res) (cadr res) '()))) 60 61 (define (get-party-by-name name) 62 ;; Throws <sqlite3 exn> if any queries return empty fails 63 (let* ((guest (get-guest-by-name name)) 64 (party-id (guest-party-id guest)) 65 (guests (get-guests-in-party party-id)) 66 (party (get-party-by-id party-id))) 67 (party-guests-set! party guests) 68 party)) 69 70 (define (update-guest g) 71 (update conn " 72 UPDATE guests SET 73 name = $1, 74 going = $2, 75 meal_choice = $3 76 WHERE id = $4" 77 (guest-name g) 78 (guest-going g) 79 (guest-meal-choice g) 80 (guest-id g))) 81 82 (define (update-party-notes pid notes) 83 (update conn "UPDATE parties SET notes = $1 WHERE id = $2" notes pid))