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

partial filtering fix

parent 2b2c447e
......@@ -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
......
......@@ -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) '())
......
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