Commit ad856dbd authored by Dave Griffiths's avatar Dave Griffiths
Browse files

added custom programmatic filtering ORM hack

parent a01cb026
...@@ -604,3 +604,67 @@ ...@@ -604,3 +604,67 @@
'text-view (get-id (string-append (symbol->string display-id) "-lon")) 'text-view (get-id (string-append (symbol->string display-id) "-lon"))
'text (number->string 'text (number->string
(entity-get-value (string-append key-prepend "-lon")) "real" 0)))) (entity-get-value (string-append key-prepend "-lon")) "real" 0))))
;; 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 parent-fn ktv-default)
(vert-colour
colour-two
(horiz
(mtitle-scale title)
(button
(make-id (string-append (symbol->string title) "-add"))
(mtext-lookup 'add-item-to-list)
40 (layout 100 'wrap-content 1 'centre 5)
(lambda ()
(entity-init! db table entity-type ktv-default)
(entity-add-value! "parent" "varchar" (parent-fn))
(entity-record-values!)
(list (update-list-widget db table entity-type edit-activity (parent-fn))))))
(linear-layout
(make-id (string-append entity-type "-list"))
'vertical
(layout 'fill-parent 'wrap-content 1 'centre 20)
(list 0 0 0 0)
(list))))
;; pull db data into list of button widgets
(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"))
'contents
(if (null? search-results)
(list (mtext 'list-empty))
(map
(lambda (e)
(button
(make-id (string-append "list-button-" (ktv-get e "unique_id")))
(or (ktv-get e "name") "Unamed item")
40 (layout 'fill-parent 'wrap-content 1 'centre 5)
(lambda ()
(msg "sending start act" (ktv-get e "unique_id"))
(list (start-activity edit-activity 0 (ktv-get e "unique_id"))))))
search-results)))))
(define (delete-button)
(mbutton
'delete
(lambda ()
(list
(alert-dialog
"delete-check"
(mtext-lookup 'delete-are-you-sure)
(lambda (v)
(cond
((eqv? v 1)
(entity-add-value! "deleted" "int" 1)
(entity-update-values!)
(list (finish-activity 1)))
(else
(list)))))))))
...@@ -256,6 +256,62 @@ ...@@ -256,6 +256,62 @@
(cdr s))))) (cdr s)))))
;; filter is list of (attribute-key type op arg) e.g. ("gender" "varchar" "=" "Female")
;; note: only one filter per key..
(define (make-filter k t o a) (list k t o a))
(define (filter-key f) (list-ref f 0))
(define (filter-type f) (list-ref f 1))
(define (filter-op f) (list-ref f 2))
(define (filter-arg f) (list-ref f 3))
(define (build-query 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' "
;; ignore deleted
"join " table "_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' and "
"d.value = 0 ")
filter)
"order by n.value"))
(define (build-args filter)
(map
(lambda (i)
(filter-arg i))
filter))
(define (filter-entities db table type filter)
(let ((s (apply
db-select
(dbg (append
(list db (build-query table filter))
(build-args filter))))))
(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
...@@ -297,6 +353,11 @@ ...@@ -297,6 +353,11 @@
(get-entity db table i)) (get-entity db table i))
(all-entities-with-parent db table type parent))) (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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data ;; updating data
......
...@@ -401,70 +401,6 @@ ...@@ -401,70 +401,6 @@
(spacer 5) (spacer 5)
(build-fragment "bottom" (make-id "bottom") fillwrap))))) (build-fragment "bottom" (make-id "bottom") fillwrap)))))
;; 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 parent-fn ktv-default)
(vert-colour
colour-two
(horiz
(mtitle-scale title)
(button
(make-id (string-append (symbol->string title) "-add"))
(mtext-lookup 'add-item-to-list)
40 (layout 100 'wrap-content 1 'centre 5)
(lambda ()
(entity-init! db table entity-type ktv-default)
(entity-add-value! "parent" "varchar" (parent-fn))
(entity-record-values!)
(list (update-list-widget db table entity-type edit-activity (parent-fn))))))
(linear-layout
(make-id (string-append entity-type "-list"))
'vertical
(layout 'fill-parent 'wrap-content 1 'centre 20)
(list 0 0 0 0)
(list))))
;; pull db data into list of button widgets
(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"))
'contents
(if (null? search-results)
(list (mtext 'list-empty))
(map
(lambda (e)
(button
(make-id (string-append "list-button-" (ktv-get e "unique_id")))
(or (ktv-get e "name") "Unamed item")
40 (layout 'fill-parent 'wrap-content 1 'centre 5)
(lambda ()
(msg "sending start act" (ktv-get e "unique_id"))
(list (start-activity edit-activity 0 (ktv-get e "unique_id"))))))
search-results)))))
(define (delete-button)
(mbutton
'delete
(lambda ()
(list
(alert-dialog
"delete-check"
(mtext-lookup 'delete-are-you-sure)
(lambda (v)
(cond
((eqv? v 1)
(entity-add-value! "deleted" "int" 1)
(entity-update-values!)
(list (finish-activity 1)))
(else
(list)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; activities ;; activities
...@@ -481,21 +417,7 @@ ...@@ -481,21 +417,7 @@
(mbutton-scale 'sync (lambda () (list (start-activity "sync" 0 ""))))) (mbutton-scale 'sync (lambda () (list (start-activity "sync" 0 "")))))
(mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list))) (mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list)))
(mbutton 'test-upload (lambda () (mbutton 'find-individual (lambda () (list (start-activity "individual-chooser" 0 ""))))
(list
(network-connect
"network"
"mongoose-web"
(lambda (state)
(msg state)
(if (equal? state "Connected")
(list
(http-upload
"test-upload"
"http://192.168.2.1:8889/symbai?fn=upload"
"/sdcard/symbai/photo.jpg"))
'()))
))))
(build-list-widget (build-list-widget
db "sync" 'villages "village" "village" (lambda () #f) db "sync" 'villages "village" "village" (lambda () #f)
(list (list
...@@ -639,7 +561,7 @@ ...@@ -639,7 +561,7 @@
(ktv "tribe" "varchar" "none") (ktv "tribe" "varchar" "none")
(ktv "subtribe" "varchar" "none") (ktv "subtribe" "varchar" "none")
(ktv "age" "int" 0) (ktv "age" "int" 0)
(ktv "gender" "varchar" "female") (ktv "gender" "varchar" "Female")
(ktv "education" "varchar" "none") (ktv "education" "varchar" "none")
(ktv "head-of-house" "varchar" "none") (ktv "head-of-house" "varchar" "none")
(ktv "marital-status" "varchar" "none") (ktv "marital-status" "varchar" "none")
...@@ -700,7 +622,9 @@ ...@@ -700,7 +622,9 @@
(image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10)) (image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10))
(vert (vert
(mtext 'name-display) (mtext 'name-display)
(spacer 20)
(mtext 'family-display) (mtext 'family-display)
(spacer 20)
(mtext 'photo-id-display))) (mtext 'photo-id-display)))
(mbutton 'agreement-button (lambda () (list (start-activity "agreement" 0 "")))) (mbutton 'agreement-button (lambda () (list (start-activity "agreement" 0 ""))))
(horiz (horiz
...@@ -977,11 +901,31 @@ ...@@ -977,11 +901,31 @@
(activity (activity
"individual-chooser" "individual-chooser"
(build-activity (build-activity
(vert
(linear-layout
(make-id "choose-pics") 'vertical
(layout 'fill-parent 'wrap-content 0.75 'centre 0)
(list 0 0 0 0)
(list))
(mtext 'filter-stuff))
) )
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Individual chooser") (set-current! 'activity-title "Individual chooser")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) '()) (lambda (activity arg)
(list
(update-widget
'linear-layout (get-id "choose-pics") 'contents
(map
(lambda (e)
(msg (ktv-get e "gender"))
(let ((gender (ktv-get e "gender")))
(text-view
(make-id (string-append "chooser-" (ktv-get e "unique_id")))
(string-append (ktv-get e "unique_id") ": " (if (null? gender) "not set" gender))
30 (layout 'wrap-content 'wrap-content 1 'centre 5))))
(db-filter db "sync" "individual"
(list (make-filter "gender" "varchar" "=" "female")))))))
(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