Commit 0116bda6 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

partial filtering fix

parent 2b2c447e
...@@ -233,6 +233,30 @@ ...@@ -233,6 +233,30 @@
(vector-ref i 0)) (vector-ref i 0))
(cdr s))))) (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) (define (validate db)
;; check attribute for duplicate entity-id/attribute-ids ;; check attribute for duplicate entity-id/attribute-ids
0) 0)
...@@ -262,13 +286,17 @@ ...@@ -262,13 +286,17 @@
(else (cons (car ktv-list) (ktv-set (cdr ktv-list) ktv))))) (else (cons (car ktv-list) (ktv-set (cdr ktv-list) ktv)))))
(define (db-all db table type) (define (db-all db table type)
(prof-start "db-all") (map
(let ((r (map (lambda (i)
(get-entity db table i))
(all-entities db table type)))
(define (db-with-parent db table type parent)
(map
(lambda (i) (lambda (i)
(get-entity db table i)) (get-entity db table i))
(all-entities db table type)))) (all-entities-with-parent db table type parent)))
(prof-end "db-all")
r))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data ;; updating data
......
...@@ -114,6 +114,8 @@ ...@@ -114,6 +114,8 @@
(list 'market (list "Market")) (list 'market (list "Market"))
;; household ;; household
(list 'household-name (list "Household name"))
(list 'default-household-name (list "A household"))
(list 'location (list "House location")) (list 'location (list "House location"))
(list 'elevation (list "Elevation")) (list 'elevation (list "Elevation"))
(list 'toilet-location (list "Toilet location")) (list 'toilet-location (list "Toilet location"))
...@@ -125,6 +127,9 @@ ...@@ -125,6 +127,9 @@
(list 'add-individual (list "Add individual")) (list 'add-individual (list "Add individual"))
;; 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 'details (list "Details"))
(list 'family (list "Family")) (list 'family (list "Family"))
(list 'migration (list "Migration")) (list 'migration (list "Migration"))
...@@ -350,7 +355,7 @@ ...@@ -350,7 +355,7 @@
;; dispatches based on widget type ;; dispatches based on widget type
(define (mupdate widget-type id-symbol key) (define (mupdate widget-type id-symbol key)
(cond (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 (update-widget widget-type (get-symbol-id id-symbol) 'text
(entity-get-value key))) (entity-get-value key)))
((eq? widget-type 'toggle-button) ((eq? widget-type 'toggle-button)
...@@ -542,7 +547,7 @@ ...@@ -542,7 +547,7 @@
;; a standard builder for list widgets of entities and a ;; a standard builder for list widgets of entities and a
;; make new button, to add defaults to the list ;; 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 (vert-colour
colour-two colour-two
(horiz (horiz
...@@ -552,7 +557,7 @@ ...@@ -552,7 +557,7 @@
(lambda () (lambda ()
(entity-init! db table entity-type ktv-default) (entity-init! db table entity-type ktv-default)
(entity-record-values!) (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 (linear-layout
(make-id (string-append entity-type "-list")) (make-id (string-append entity-type "-list"))
'vertical 'vertical
...@@ -561,8 +566,11 @@ ...@@ -561,8 +566,11 @@
(list)))) (list))))
;; pull db data into list of button widgets ;; pull db data into list of button widgets
(define (update-list-widget db table entity-type edit-activity) (define (update-list-widget db table entity-type edit-activity parent)
(let ((search-results (db-all db table entity-type))) (let ((search-results
(if parent
(db-with-parent db table entity-type parent)
(db-all db table entity-type))))
(update-widget (update-widget
'linear-layout 'linear-layout
(get-id (string-append entity-type "-list")) (get-id (string-append entity-type "-list"))
...@@ -629,7 +637,7 @@ ...@@ -629,7 +637,7 @@
'())) '()))
)))) ))))
(build-list-widget (build-list-widget
db "sync" 'villages "village" "village" db "sync" 'villages "village" "village" #f
(list (list
(ktv "name" "varchar" (mtext-lookup 'default-village-name)) (ktv "name" "varchar" (mtext-lookup 'default-village-name))
(ktv "block" "varchar" "") (ktv "block" "varchar" "")
...@@ -641,7 +649,7 @@ ...@@ -641,7 +649,7 @@
(set-current! 'activity-title "Main screen") (set-current! 'activity-title "Main screen")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (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) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
...@@ -711,8 +719,7 @@ ...@@ -711,8 +719,7 @@
(mupdate 'edit-text 'block "block") (mupdate 'edit-text 'block "block")
(mupdate 'edit-text 'district "district") (mupdate 'edit-text 'district "district")
(mupdate 'toggle-button 'car "car") (mupdate 'toggle-button 'car "car")
(mupdate 'image-view 'photo "photo") (mupdate 'image-view 'photo "photo")))
(toast arg)))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
...@@ -736,7 +743,7 @@ ...@@ -736,7 +743,7 @@
"household-list" "household-list"
(build-activity (build-activity
(build-list-widget (build-list-widget
db "sync" 'households "household" "household" db "sync" 'households "household" "household" (get-current 'village #f)
(list (list
(ktv "name" "varchar" (mtext-lookup 'default-household-name)) (ktv "name" "varchar" (mtext-lookup 'default-household-name))
(ktv "num-pots" "int" 0) (ktv "num-pots" "int" 0)
...@@ -749,7 +756,8 @@ ...@@ -749,7 +756,8 @@
(set-current! 'activity-title "Household List") (set-current! 'activity-title "Household List")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (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) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
...@@ -778,9 +786,9 @@ ...@@ -778,9 +786,9 @@
(medit-text 'elevation "numeric" (lambda (v) '()))) (medit-text 'elevation "numeric" (lambda (v) '())))
(build-list-widget (build-list-widget
db "sync" 'individuals "individual" "individual" db "sync" 'individuals "individual" "individual" (get-current 'household #f)
(list (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 "family" "varchar" (mtext-lookup 'default-family-name))
(ktv "photo-id" "varchar" (mtext-lookup 'default-photo-id)) (ktv "photo-id" "varchar" (mtext-lookup 'default-photo-id))
(ktv "parent" "varchar" (get-current 'household "error no household set"))))) (ktv "parent" "varchar" (get-current 'household "error no household set")))))
...@@ -791,7 +799,7 @@ ...@@ -791,7 +799,7 @@
(entity-init! db "sync" "household" (get-entity-by-unique db "sync" arg)) (entity-init! db "sync" "household" (get-entity-by-unique db "sync" arg))
(set-current! 'household arg) (set-current! 'household arg)
(list (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 'household-name "name")
(mupdate 'edit-text 'num-pots "num-pots"))) (mupdate 'edit-text 'num-pots "num-pots")))
...@@ -810,6 +818,7 @@ ...@@ -810,6 +818,7 @@
(mtext 'name) (mtext 'name)
(mtext 'family) (mtext 'family)
(mtext 'photo-id))) (mtext 'photo-id)))
(mbutton 'agreement (lambda () (list (start-activity "agreement" 0 ""))))
(horiz (horiz
(mbutton-scale 'details (lambda () (list (start-activity "details" 0 "")))) (mbutton-scale 'details (lambda () (list (start-activity "details" 0 ""))))
(mbutton-scale 'family (lambda () (list (start-activity "family" 0 ""))))) (mbutton-scale 'family (lambda () (list (start-activity "family" 0 "")))))
...@@ -818,13 +827,18 @@ ...@@ -818,13 +827,18 @@
(mbutton-scale 'income (lambda () (list (start-activity "income" 0 ""))))) (mbutton-scale 'income (lambda () (list (start-activity "income" 0 "")))))
(horiz (horiz
(mbutton-scale 'geneaology (lambda () (list (start-activity "geneaology" 0 "")))) (mbutton-scale 'geneaology (lambda () (list (start-activity "geneaology" 0 ""))))
(mbutton-scale 'social (lambda () (list (start-activity "social" 0 ""))))) (mbutton-scale 'social (lambda () (list (start-activity "social" 0 ""))))))
(mbutton 'agreement (lambda () (list (start-activity "agreement" 0 "")))))
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Individual") (set-current! 'activity-title "Individual")
(activity-layout activity)) (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) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment