partial filtering fix

android/assets/eavdb.scm

@@ -233,6 +233,30 @@
            (vector-ref i 0))
          (cdr s)))))
 
+(define (all-entities-with-parent db table type parent)
+  (let ((s (db-select
+            db (string-append "select e.entity_id from " table "_entity as e "
+                              "join " table "_value_varchar "
+                              " as n on n.entity_id = e.entity_id and n.attribute_id = ?"
+                              "join " table "_value_varchar "
+                              " as p on p.entity_id = e.entity_id and p.attribute_id = ?"
+                              "left join " table "_value_int "
+                              "as d on d.entity_id = e.entity_id and d.attribute_id = ? "
+                              "where e.entity_type = ? and "
+                              "p.value = ? and "
+                              "(d.value='NULL' or d.value is NULL or d.value = 0) "
+                              "order by n.value")
+            "name" "parent" "deleted" type parent)))
+    (msg (db-status db))
+    (if (null? s)
+        '()
+        (map
+         (lambda (i)
+           (vector-ref i 0))
+         (cdr s)))))
+
+
+
 (define (validate db)
   ;; check attribute for duplicate entity-id/attribute-ids
   0)
@@ -262,13 +286,17 @@
    (else (cons (car ktv-list) (ktv-set (cdr ktv-list) ktv)))))
 
 (define (db-all db table type)
-  (prof-start "db-all")
-  (let ((r (map
+  (map
+   (lambda (i)
+     (get-entity db table i))
+   (all-entities db table type)))
+
+(define (db-with-parent db table type parent)
+  (map
    (lambda (i)
      (get-entity db table i))
-   (all-entities db table type))))
-    (prof-end "db-all")
-    r))
+   (all-entities-with-parent db table type parent)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; updating data

android/assets/starwisp.scm

@@ -114,6 +114,8 @@
    (list 'market (list "Market"))
 
    ;; household
+   (list 'household-name (list "Household name"))
+   (list 'default-household-name (list "A household"))
    (list 'location (list "House location"))
    (list 'elevation (list "Elevation"))
    (list 'toilet-location (list "Toilet location"))
@@ -125,6 +127,9 @@
    (list 'add-individual (list "Add individual"))
 
    ;; individual
+   (list 'default-individual-name (list "A person"))
+   (list 'default-family-name (list "A family"))
+   (list 'default-photo-id (list "???"))
    (list 'details (list "Details"))
    (list 'family (list "Family"))
    (list 'migration (list "Migration"))
@@ -350,7 +355,7 @@
 ;; dispatches based on widget type
 (define (mupdate widget-type id-symbol key)
   (cond
-   ((eq? widget-type 'edit-text)
+   ((or (eq? widget-type 'edit-text) (eq? widget-type 'text-view))
     (update-widget widget-type (get-symbol-id id-symbol) 'text
                    (entity-get-value key)))
    ((eq? widget-type 'toggle-button)
@@ -542,7 +547,7 @@
 
 ;; a standard builder for list widgets of entities and a
 ;; make new button, to add defaults to the list
-(define (build-list-widget db table title entity-type edit-activity ktv-default)
+(define (build-list-widget db table title entity-type edit-activity parent ktv-default)
     (vert-colour
      colour-two
      (horiz
@@ -552,7 +557,7 @@
        (lambda ()
          (entity-init! db table entity-type ktv-default)
          (entity-record-values!)
-         (list (update-list-widget db table entity-type edit-activity)))))
+         (list (update-list-widget db table entity-type edit-activity parent)))))
      (linear-layout
       (make-id (string-append entity-type "-list"))
       'vertical
@@ -561,8 +566,11 @@
       (list))))
 
 ;; pull db data into list of button widgets
-(define (update-list-widget db table entity-type edit-activity)
-  (let ((search-results (db-all db table entity-type)))
+(define (update-list-widget db table entity-type edit-activity parent)
+  (let ((search-results
+         (if parent
+             (db-with-parent db table entity-type parent)
+             (db-all db table entity-type))))
     (update-widget
      'linear-layout
      (get-id (string-append entity-type "-list"))
@@ -629,7 +637,7 @@
                                     '()))
                               ))))
     (build-list-widget
-     db "sync" 'villages "village" "village"
+     db "sync" 'villages "village" "village" #f
      (list
       (ktv "name" "varchar" (mtext-lookup 'default-village-name))
       (ktv "block" "varchar" "")
@@ -641,7 +649,7 @@
      (set-current! 'activity-title "Main screen")
      (activity-layout activity))
    (lambda (activity arg)
-     (list (update-list-widget db "sync" "village" "village")))
+     (list (update-list-widget db "sync" "village" "village" #f)))
    (lambda (activity) '())
    (lambda (activity) '())
    (lambda (activity) '())
@@ -711,8 +719,7 @@
       (mupdate 'edit-text 'block "block")
       (mupdate 'edit-text 'district "district")
       (mupdate 'toggle-button 'car "car")
-      (mupdate 'image-view 'photo "photo")
-      (toast arg)))
+      (mupdate 'image-view 'photo "photo")))
    (lambda (activity) '())
    (lambda (activity) '())
    (lambda (activity) '())
@@ -736,7 +743,7 @@
    "household-list"
    (build-activity
     (build-list-widget
-     db "sync" 'households "household" "household"
+     db "sync" 'households "household" "household" (get-current 'village #f)
      (list
       (ktv "name" "varchar" (mtext-lookup 'default-household-name))
       (ktv "num-pots" "int" 0)
@@ -749,7 +756,8 @@
      (set-current! 'activity-title "Household List")
      (activity-layout activity))
    (lambda (activity arg)
-     (list (update-list-widget db "sync" "household" "household")))
+     (list (update-list-widget
+            db "sync" "household" "household" arg)))
    (lambda (activity) '())
    (lambda (activity) '())
    (lambda (activity) '())
@@ -778,9 +786,9 @@
      (medit-text 'elevation "numeric" (lambda (v) '())))
 
     (build-list-widget
-     db "sync" 'individuals "individual" "individual"
+     db "sync" 'individuals "individual" "individual" (get-current 'household #f)
      (list
-      (ktv "name" "varchar" (mtext-lookup 'default-household-name))
+      (ktv "name" "varchar" (mtext-lookup 'default-individual-name))
       (ktv "family" "varchar" (mtext-lookup 'default-family-name))
       (ktv "photo-id" "varchar" (mtext-lookup 'default-photo-id))
       (ktv "parent" "varchar" (get-current 'household "error no household set")))))
@@ -791,7 +799,7 @@
      (entity-init! db "sync" "household" (get-entity-by-unique db "sync" arg))
      (set-current! 'household arg)
      (list
-      (update-list-widget db "sync" "household" "household")
+      (update-list-widget db "sync" "individual" "individual" arg)
       (mupdate 'edit-text 'household-name "name")
       (mupdate 'edit-text 'num-pots "num-pots")))
 
@@ -810,6 +818,7 @@
       (mtext 'name)
       (mtext 'family)
       (mtext 'photo-id)))
+    (mbutton 'agreement (lambda () (list (start-activity "agreement" 0 ""))))
     (horiz
      (mbutton-scale 'details (lambda () (list (start-activity "details" 0 ""))))
      (mbutton-scale 'family (lambda () (list (start-activity "family" 0 "")))))
@@ -818,13 +827,18 @@
      (mbutton-scale 'income (lambda () (list (start-activity "income" 0 "")))))
     (horiz
      (mbutton-scale 'geneaology (lambda () (list (start-activity "geneaology" 0 ""))))
-     (mbutton-scale 'social (lambda () (list (start-activity "social" 0 "")))))
-    (mbutton 'agreement (lambda () (list (start-activity "agreement" 0 "")))))
+     (mbutton-scale 'social (lambda () (list (start-activity "social" 0 ""))))))
 
    (lambda (activity arg)
      (set-current! 'activity-title "Individual")
      (activity-layout activity))
-   (lambda (activity arg) '())
+   (lambda (activity arg)
+     (entity-init! db "sync" "individual" (get-entity-by-unique db "sync" arg))
+     (set-current! 'individual arg)
+     (list
+      (mupdate 'text-view 'name "name")
+      (mupdate 'text-view 'family "family")
+      (mupdate 'text-view 'photo-id "photo-id")))
    (lambda (activity) '())
    (lambda (activity) '())
    (lambda (activity) '())