imported symbai version of base stuff

eavdb/eavdb.ss

@@ -63,11 +63,10 @@
 ;; helpers
 
 (define (db-all db table type)
-  (msg "db-all")
   (map
    (lambda (i)
      (get-entity db table i))
-   (dbg (all-entities db table type))))
+   (all-entities db table type)))
 
 (define (db-with-parent db table type parent)
   (map
@@ -83,8 +82,14 @@
 
 ;; only return (eg. name and photo)
 (define (db-filter-only db table type filter kt-list)
-  (msg "db-filter-only")
   (map
    (lambda (i)
      (get-entity-only db table i kt-list))
-   (dbg (filter-entities db table type filter))))
+   (filter-entities db table type filter)))
+
+;; only return (eg. name and photo)
+(define (db-filter-only-inc-deleted db table type filter kt-list)
+  (map
+   (lambda (i)
+     (get-entity-only db table i kt-list))
+   (filter-entities-inc-deleted db table type filter)))

eavdb/entity-csv.ss

@@ -89,7 +89,6 @@
              "select entity_id, unique_id from "
              table "_entity where entity_type = ?") entity-type)))
     (msg "CSV ------------------------------>" entity-type)
-    (msg s)
     (if (null? s)
 	;; nothing here, just return titles
 	(csv-titles db table entity-type)
@@ -100,7 +99,6 @@
 	      r "\n"
 	      (foldl
 	       (lambda (ktv r)
-		 (msg ktv)
 		 (cond
 		  ((equal? (ktv-key ktv) "unique_id") r)
 		  ((null? (ktv-value ktv))
@@ -116,7 +114,7 @@
 
 ;; exporting human editable reports
 
-(define (deref-entity entity)
+(define (deref-entity db entity)
   (foldl
    (lambda (ktv r)
      (append
@@ -160,37 +158,51 @@
                      (string-append r ", " converted))))
              "" row)))
        (msg row-text)
-       (dbg (string-append r row-text "\n"))))
+       (string-append r row-text "\n")))
    "" l))
 
+
+(define (ktv-filter ktv-list key)
+  (filter
+   (lambda (ktv)
+     (not (equal? (ktv-key ktv) key)))
+   ktv-list))
+
+(define (ktv-filter-many ktv-list key-list)
+  (foldl
+   (lambda (key r)
+     (ktv-filter r key))
+   ktv-list
+   key-list))
+
 ;; meant to be general, but made for pup focal reports
-(define (export-csv db table parent-entity entity-types)
-  (let* ((focal (get-entity db "sync" (get-entity-id db "sync" (ktv-get parent-entity "id-focal-subject"))))
-         (pack (get-entity db "sync" (get-entity-id db "sync" (ktv-get focal "pack-id")))))
-    (csvify
-     (cons
-      '("time" "user" "pack" "subject" "observation type" "key" "value" "key" "value")
-      (sort
-       (foldl
-        (lambda (entity-type r)
-          (append
-           r (map
-              (lambda (entity)
-                (append
-                 (list
-                  (ktv-get entity "time")
-                  (ktv-get entity "user")
-                 (ktv-get pack "name")
-                 (ktv-get focal "name")
-                 entity-type)
-                 (deref-entity
-                  (ktv-filter-many
-                   entity (list "user" "unique_id" "parent" "time")))))
-              (db-all-with-parent
-               db table entity-type
-               (ktv-get parent-entity "unique_id")))))
-        '()
-        entity-types)
-      (lambda (a b)
-        (string<? (car a) (car b))))))))
+;(define (export-csv db table parent-entity entity-types)
+;  (let* ((focal (get-entity db "sync" (get-entity-id db "sync" (ktv-get parent-entity "id-focal-subject"))))
+;         (pack (get-entity db "sync" (get-entity-id db "sync" (ktv-get focal "pack-id")))))
+;    (csvify
+;     (cons
+;      '("time" "user" "pack" "subject" "observation type" "key" "value" "key" "value")
+;      (sort
+;       (foldl
+;        (lambda (entity-type r)
+;          (append
+;           r (map
+;              (lambda (entity)
+;                (append
+;                 (list
+;                  (ktv-get entity "time")
+;                  (ktv-get entity "user")
+;                 (ktv-get pack "name")
+;                 (ktv-get focal "name")
+;                 entity-type)
+;                 (deref-entity 
+;		  db (ktv-filter-many
+;		      entity (list "user" "unique_id" "parent" "time")))))
+;              (db-all-with-parent
+;               db table entity-type
+;               (ktv-get parent-entity "unique_id")))))
+;        '()
+;        entity-types)
+;      (lambda (a b)
+;        (string<? (car a) (car b))))))))
 

eavdb/entity-filter.ss

@@ -86,6 +86,28 @@
    (if typed "where e.entity_type = ? order by n.value"
        "order by n.value")))
 
+(define (build-query-inc-deleted table filter)
+  (string-append
+   (foldl
+    (lambda (i r)
+      (let ((var (string-append (filter-key i) "_var")))
+        ;; add a query chunk
+        (string-append
+         r "join " table "_value_" (filter-type i) " "
+         "as " var " on "
+         var ".entity_id = e.entity_id and " var ".attribute_id = '" (filter-key i) "' and "
+         var ".value " (filter-op i) " ? ")))
+
+    ;; boilerplate query start
+    (string-append
+     "select e.entity_id from " table "_entity as e "
+     ;; order by name
+     "join " table "_value_varchar "
+     "as n on n.entity_id = e.entity_id and n.attribute_id = 'name' ")
+    filter)
+   "where e.entity_type = ? order by n.value"))
+
+
 (define (build-args filter)
   (map
    (lambda (i)
@@ -93,6 +115,23 @@
    filter))
 
 (define (filter-entities db table type filter)
+  (let ((q (build-query table filter (not (equal? type "*")))))
+    (let ((s (apply
+	      db-select
+	      (append
+	       (list db q)
+	       (build-args filter)
+	       (list type)))))
+      (msg (db-status db))
+      (if (null? s)
+	  '()
+	  (map
+	   (lambda (i)
+	     (vector-ref i 0))
+	   (cdr s))))))
+
+(define (filter-entities-inc-deleted db table type filter)
+  (let ((q (build-query-inc-deleted table filter)))
   (let ((s (apply
             db-select
             (append
@@ -105,4 +144,4 @@
         (map
          (lambda (i)
            (vector-ref i 0))
-         (cdr s)))))
+         (cdr s))))))

eavdb/entity-insert.ss

@@ -65,8 +65,7 @@
     ;; add all the keys
     (for-each
      (lambda (ktv)
-       (msg "inserting" ktv)
-       (insert-value db table id ktv dirty))
+       (insert-value db table id ktv (not (zero? dirty))))
      ktvlist)
 
     (db-exec db "end transaction")

eavdb/entity-sync.ss

@@ -68,7 +68,8 @@
 (define (dirty-entities db table)
   (let ((de (db-select
              db (string-append
-                 "select entity_id, entity_type, unique_id, dirty, version from " table "_entity where dirty=1;"))))
+                 "select entity_id, entity_type, unique_id, dirty, version from "
+                 table "_entity where dirty=1 limit 5;"))))
     (if (null? de)
         '()
         (map

eavdb/entity-values.ss

@@ -88,7 +88,7 @@
     ;;(msg ktv)
     ;;(msg entity-id)
     (if (null? s)
-        (insert-value db table entity-id ktv #t)
+        (insert-value db table entity-id ktv #t) ;; <- don't make dirty!?
         (db-exec
          db (string-append "update " table "_value_" (ktv-type ktv)
                            " set value=?, dirty=0 where entity_id = ? and attribute_id = ?")
@@ -114,8 +114,8 @@
                               " where entity_id = ? and attribute_id = ?")
             entity-id (ktv-key kt))))
     (if (null? s) '()
-	(list (vector-ref (cadr s) 0)
-	      (vector-ref (cadr s) 1)))))
+        (list (vector-ref (cadr s) 0)
+              (vector-ref (cadr s) 1)))))
 
 (define (clean-value db table entity-id kt)
   (db-exec db (string-append "update " table "_value_" (ktv-type kt)

eavdb/ktv-list.ss

@@ -25,6 +25,13 @@
     (ktv-value (car ktv-list)))
    (else (ktv-get (cdr ktv-list) key))))
 
+(define (ktv-get-whole ktv-list key)
+  (cond
+   ((null? ktv-list) #f)
+   ((equal? (ktv-key (car ktv-list)) key)
+    (car ktv-list))
+   (else (ktv-get-whole (cdr ktv-list) key))))
+
 (define (ktv-get-type ktv-list key)
   (cond
    ((null? ktv-list) #f)