eavdb.ss 3.42 KB
Newer Older
Dave Griffiths's avatar
Dave Griffiths committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
#lang racket

;; Starwisp Copyright (C) 2014 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;; common code - require and provide ignored on tinyscheme

(require (planet jaymccarthy/sqlite:5:1/sqlite))

(require
 "../web/scripts/utils.ss"
 "../web/scripts/sql.ss"
 "ktv.ss"
 "ktv-list.ss"
 "entity-values.ss"
 "entity-insert.ss"
 "entity-get.ss"
 "entity-update.ss"
 "entity-sync.ss"
 "entity-filter.ss")

(provide (all-defined-out))

(msg "hello from eavdb.ss")

dave griffiths's avatar
dave griffiths committed
38 39 40 41 42

(define (upgrade-table db name)
  (db-exec db (string-append "alter table " name " add version integer")))


Dave Griffiths's avatar
Dave Griffiths committed
43 44
;; create eav tables (add types as required)
(define (setup db table)
dave griffiths's avatar
dave griffiths committed
45
  (msg "db setup")
Dave Griffiths's avatar
Dave Griffiths committed
46 47 48
  (db-exec db (string-append "create table " table "_entity ( entity_id integer primary key autoincrement, entity_type varchar(256), unique_id varchar(256), dirty integer, version integer)"))
  (db-exec db (string-append "create table " table "_attribute ( id integer primary key autoincrement, attribute_id varchar(256), entity_type varchar(256), attribute_type varchar(256))"))
  (db-exec db (string-append "create table " table "_value_varchar ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer, version integer)"))
dave griffiths's avatar
dave griffiths committed
49
  (upgrade-table db (string-append table "_value_varchar"))
Dave Griffiths's avatar
Dave Griffiths committed
50
  (db-exec db (string-append "create table " table "_value_int ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value integer, dirty integer, version integer)"))
dave griffiths's avatar
dave griffiths committed
51
  (upgrade-table db (string-append table "_value_int"))
Dave Griffiths's avatar
Dave Griffiths committed
52
  (db-exec db (string-append "create table " table "_value_real ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value real, dirty integer, version integer)"))
dave griffiths's avatar
dave griffiths committed
53 54 55
  (upgrade-table db (string-append table "_value_real"))
  (db-exec db (string-append "create table " table "_value_file ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer, version integer)"))
  (upgrade-table db (string-append table "_value_file")))
Dave Griffiths's avatar
Dave Griffiths committed
56

Dave Griffiths's avatar
Dave Griffiths committed
57

Dave Griffiths's avatar
Dave Griffiths committed
58 59 60 61 62 63 64 65 66 67 68
(define (validate db)
  ;; check attribute for duplicate entity-id/attribute-ids
  0)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helpers

(define (db-all db table type)
  (map
   (lambda (i)
     (get-entity db table i))
dave griffiths's avatar
dave griffiths committed
69
   (all-entities db table type)))
Dave Griffiths's avatar
Dave Griffiths committed
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87

(define (db-with-parent db table type parent)
  (map
   (lambda (i)
     (get-entity db table i))
   (all-entities-with-parent db table type parent)))

(define (db-filter db table type filter)
  (map
   (lambda (i)
     (get-entity db table i))
   (filter-entities db table type filter)))

;; only return (eg. name and photo)
(define (db-filter-only db table type filter kt-list)
  (map
   (lambda (i)
     (get-entity-only db table i kt-list))
dave griffiths's avatar
dave griffiths committed
88
   (filter-entities db table type filter)))