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

sync fixed for new adhoc values, added child

parent 13ae1675
......@@ -68,24 +68,21 @@
;; store a ktv, replaces existing with same key
(define (entity-add-value! key type value)
(set-current!
'entity-values
(ktv-set
(get-current 'entity-values '())
(ktv key type value))))
;;(define (entity-add-value! key type value)
;; (set-current!
;; 'entity-values
;; (ktv-set
;; (get-current 'entity-values '())
;; (ktv key type value))))
;; internal version for checking version numbers are propagating properly
;; this is for automatically added ktv data (and adds 0 version)
;; rather than from the ui (which adds -999 by default)
(define (entity-add-value-create! key type value)
(msg "entity-add-value-create!" key type value)
(set-current!
'entity-values
(ktv-set
(get-current 'entity-values '())
(ktv-create key type value))))
(define (entity-set! ktv-list)
(set-current! 'entity-values ktv-list))
......@@ -102,7 +99,10 @@
(ktv-set
(get-current 'entity-values '())
(ktv key type value)))
(msg "entity-set-value -" key "of type" type "doesn't exist on this entity"))
;;
(begin
(msg "entity-set-value! - adding new " key "of type" type "to entity")
(entity-add-value-create! key type value)))
(msg "done entity-set-value!")))
(define (date-time->string dt)
......
......@@ -131,7 +131,7 @@
;; use type to dispatch insert to correct value table
(db-insert db (string-append "insert into " table "_value_" (ktv-type ktv)
" values (null, ?, ?, ?, ?, ?)")
entity-id (ktv-key ktv) (ktv-value ktv) dirty (ktv-version ktv)))
entity-id (ktv-key ktv) (ktv-value ktv) (if dirty 1 0) (ktv-version ktv)))
(define (get-unique user)
(let ((t (time-of-day)))
......@@ -262,13 +262,16 @@
;; get an entire entity, as a list of key/value pairs, only dirty values
(define (get-entity-plain-for-sync db table entity-id)
(msg "gepfs")
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
((null? entity-type) (msg "entity" entity-id "not found!") '())
(else
(foldl
(lambda (kt r)
(msg kt)
(let ((vdv (get-value db table entity-id kt)))
(msg vdv)
(cond
((null? vdv)
(msg "ERROR: get-entity-plain-for-sync: no value found for " entity-id " " (ktv-key kt))
......
......@@ -151,6 +151,7 @@
(list 'geneaology-button (list "Geneaology"))
(list 'social-button (list "Social"))
(list 'agreement-button (list "Agreement"))
(list 'is-a-child (list "Child"))
;; details
(list 'change-photo (list "Change photo"))
......@@ -490,7 +491,7 @@
;; todo determine *which* selector this came from...
(define (person-selector-return request-code key choose-code)
(when (eqv? request-code choose-code)
(entity-add-value! key "varchar" (get-current 'choose-result "not set"))))
(entity-set-value! key "varchar" (get-current 'choose-result "not set"))))
;; need to load from across entities, so need db, table
(define (update-person-selector db table id key)
......@@ -576,11 +577,11 @@
(mtext-small 'test-num))))))
(build-activity
(horiz
(medit-text 'village-name "normal" (lambda (v) (entity-add-value! "name" "varchar" v) '()))
(medit-text 'block "normal" (lambda (v) (entity-add-value! "block" "varchar" v) '())))
(medit-text 'village-name "normal" (lambda (v) (entity-set-value! "name" "varchar" v) '()))
(medit-text 'block "normal" (lambda (v) (entity-set-value! "block" "varchar" v) '())))
(horiz
(medit-text 'district "normal" (lambda (v) (entity-add-value! "district" "varchar" v) '()))
(mtoggle-button-scale 'car (lambda (v) (entity-add-value! "car" "int" v) '())))
(medit-text 'district "normal" (lambda (v) (entity-set-value! "district" "varchar" v) '()))
(mtoggle-button-scale 'car (lambda (v) (entity-set-value! "car" "int" v) '())))
(mbutton 'household-list
(lambda ()
......@@ -645,8 +646,8 @@
"household"
(build-activity
(horiz
(medit-text 'household-name "normal" (lambda (v) (entity-add-value! "name" "varchar" v) '()))
(medit-text 'num-pots "numeric" (lambda (v) (entity-add-value! "num-pots" "int" v) '())))
(medit-text 'household-name "normal" (lambda (v) (entity-set-value! "name" "varchar" v) '()))
(medit-text 'num-pots "numeric" (lambda (v) (entity-set-value! "num-pots" "int" v) '())))
(horiz
(vert
(mtext 'location)
......@@ -670,6 +671,7 @@
(ktv-create "photo" "file" "none")
(ktv-create "tribe" "varchar" "none")
(ktv-create "subtribe" "varchar" "none")
(ktv-create "child" "int" 0)
(ktv-create "age" "int" 0)
(ktv-create "gender" "varchar" "Female")
(ktv-create "education" "varchar" "none")
......@@ -735,7 +737,10 @@
(spacer 20)
(mtext 'family-display)
(spacer 20)
(mtext 'photo-id-display)))
(mtext 'photo-id-display)
(spacer 20)
(mtoggle-button-scale 'is-a-child (lambda (v) (entity-set-value! "child" "int" v) '()))
))
(mbutton 'agreement-button (lambda () (list (start-activity "agreement" 0 ""))))
(horiz
(mbutton-scale 'details-button (lambda () (list (start-activity "details" 0 ""))))
......@@ -759,7 +764,8 @@
(mupdate 'text-view 'name-display "name")
(mupdate 'text-view 'family-display "family")
(mupdate 'text-view 'photo-id-display "photo-id")
(mupdate 'image-view 'photo "photo")))
(mupdate 'image-view 'photo "photo")
(mupdate 'toggle-button 'is-a-child "child")))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
......@@ -783,15 +789,15 @@
)))
(vert
(medit-text 'details-name "normal" (lambda (v) (entity-add-value! "name" "varchar" v) '()))
(medit-text 'details-family "normal" (lambda (v) (entity-add-value! "family" "varchar" v) '()))
(medit-text 'details-photo-id "normal" (lambda (v) (entity-add-value! "photo-id" "varchar" v) '()))))
(mspinner-other 'tribe tribes-list (lambda (v) (msg "tribe now:" v) (entity-add-value! "tribe" "varchar" v) '()))
(mspinner-other 'sub-tribe subtribe-list (lambda (v) (entity-add-value! "subtribe" "varchar" v) '()))
(medit-text 'details-name "normal" (lambda (v) (entity-set-value! "name" "varchar" v) '()))
(medit-text 'details-family "normal" (lambda (v) (entity-set-value! "family" "varchar" v) '()))
(medit-text 'details-photo-id "normal" (lambda (v) (entity-set-value! "photo-id" "varchar" v) '()))))
(mspinner-other 'tribe tribes-list (lambda (v) (msg "tribe now:" v) (entity-set-value! "tribe" "varchar" v) '()))
(mspinner-other 'sub-tribe subtribe-list (lambda (v) (entity-set-value! "subtribe" "varchar" v) '()))
(horiz
(medit-text 'age "numeric" (lambda (v) (entity-add-value! "age" "int" v) '()))
(mspinner 'gender '(male female) (lambda (v) (entity-add-value! "gender" "varchar" v) '()))
(mspinner 'education education-list (lambda (v) (entity-add-value! "education" "varchar" v) '())))
(medit-text 'age "numeric" (lambda (v) (entity-set-value! "age" "int" v) '()))
(mspinner 'gender '(male female) (lambda (v) (entity-set-value! "gender" "varchar" v) '()))
(mspinner 'education education-list (lambda (v) (entity-set-value! "education" "varchar" v) '())))
)
(lambda (activity arg)
(set-current! 'activity-title "Individual details")
......@@ -820,7 +826,7 @@
;; need to do this before init is called again in on-start,
;; which happens next
(let ((unique-id (entity-get-value "unique_id")))
(entity-add-value! "photo" "file" (get-current 'photo-name "error no photo name!!"))
(entity-set-value! "photo" "file" (get-current 'photo-name "error no photo name!!"))
(entity-update-values!)
;; need to reset the individual from the db now (as update reset it)
(entity-init! db "sync" "individual" (get-entity-by-unique db "sync" unique-id)))
......@@ -834,23 +840,23 @@
(build-activity
(horiz
(vert
(mspinner 'head-of-house '(male female) (lambda (v) (entity-add-value! "head-of-house" "varchar" v) '()))
(mspinner 'marital-status married-list (lambda (v) (entity-add-value! "marital-status" "varchar" v) '()))
(medit-text 'times-married "numeric" (lambda (v) (entity-add-value! "times-married" "int" v) '())))
(mspinner 'head-of-house '(male female) (lambda (v) (entity-set-value! "head-of-house" "varchar" v) '()))
(mspinner 'marital-status married-list (lambda (v) (entity-set-value! "marital-status" "varchar" v) '()))
(medit-text 'times-married "numeric" (lambda (v) (entity-set-value! "times-married" "int" v) '())))
(build-person-selector 'spouse "id-spouse" (list) spouse-request-code)
)
(mtitle 'children)
(horiz
(medit-text 'children-living "numeric" (lambda (v) (entity-add-value! "children-living" "int" v) '()))
(medit-text 'children-dead "numeric" (lambda (v) (entity-add-value! "children-dead" "int" v) '())))
(medit-text 'children-living "numeric" (lambda (v) (entity-set-value! "children-living" "int" v) '()))
(medit-text 'children-dead "numeric" (lambda (v) (entity-set-value! "children-dead" "int" v) '())))
(horiz
(medit-text 'children-together "numeric" (lambda (v) (entity-add-value! "children-together" "int" v) '()))
(medit-text 'children-apart "numeric" (lambda (v) (entity-add-value! "children-apart" "int" v) '())))
(medit-text 'children-together "numeric" (lambda (v) (entity-set-value! "children-together" "int" v) '()))
(medit-text 'children-apart "numeric" (lambda (v) (entity-set-value! "children-apart" "int" v) '())))
(mspinner-other 'residence-after-marriage '(birthplace spouse-village) (lambda (v) '()))
(medit-text 'num-siblings "numeric" (lambda (v) (entity-add-value! "num-siblings" "int" v) '()))
(medit-text 'birth-order "numeric" (lambda (v) (entity-add-value! "birth-order" "int" v) '())))
(medit-text 'num-siblings "numeric" (lambda (v) (entity-set-value! "num-siblings" "int" v) '()))
(medit-text 'birth-order "numeric" (lambda (v) (entity-set-value! "birth-order" "int" v) '())))
(lambda (activity arg)
(set-current! 'activity-title "Individual family")
(activity-layout activity))
......@@ -895,11 +901,11 @@
(activity
"migration"
(build-activity
(medit-text 'length-time "numeric" (lambda (v) (entity-add-value! "length-time" "int" v) '()))
(medit-text 'place-of-birth "normal" (lambda (v) (entity-add-value! "place-of-birth" "varchar" v) '()))
(medit-text 'num-residence-changes "numeric" (lambda (v) (entity-add-value! "num-residence-changes" "int" v) '()))
(medit-text 'village-visits-month "numeric" (lambda (v) (entity-add-value! "village-visits-month" "int" v) '()))
(medit-text 'village-visits-year "numeric" (lambda (v) (entity-add-value! "village-visits-year" "int" v) '()))
(medit-text 'length-time "numeric" (lambda (v) (entity-set-value! "length-time" "int" v) '()))
(medit-text 'place-of-birth "normal" (lambda (v) (entity-set-value! "place-of-birth" "varchar" v) '()))
(medit-text 'num-residence-changes "numeric" (lambda (v) (entity-set-value! "num-residence-changes" "int" v) '()))
(medit-text 'village-visits-month "numeric" (lambda (v) (entity-set-value! "village-visits-month" "int" v) '()))
(medit-text 'village-visits-year "numeric" (lambda (v) (entity-set-value! "village-visits-year" "int" v) '()))
)
(lambda (activity arg)
(set-current! 'activity-title "Individual migration")
......@@ -921,13 +927,13 @@
"income"
(build-activity
(mspinner 'occupation '(agriculture gathering labour cows fishing other)
(lambda (v) (entity-add-value! "occupation" "varchar" v) '()))
(lambda (v) (entity-set-value! "occupation" "varchar" v) '()))
(horiz
(mtoggle-button-scale 'contribute (lambda (v) (entity-add-value! "contribute" "int" v) '()))
(mtoggle-button-scale 'own-land (lambda (v) (entity-add-value! "own-land" "int" v) '())))
(mtoggle-button-scale 'contribute (lambda (v) (entity-set-value! "contribute" "int" v) '()))
(mtoggle-button-scale 'own-land (lambda (v) (entity-set-value! "own-land" "int" v) '())))
(horiz
(mtoggle-button-scale 'rent-land (lambda (v) (entity-add-value! "rent-land" "int" v) '()))
(mtoggle-button-scale 'hire-land (lambda (v) (entity-add-value! "hire-land" "int" v) '())))
(mtoggle-button-scale 'rent-land (lambda (v) (entity-set-value! "rent-land" "int" v) '()))
(mtoggle-button-scale 'hire-land (lambda (v) (entity-set-value! "hire-land" "int" v) '())))
(mtitle 'crops)
;; todo ->
;; (horiz
......@@ -935,16 +941,16 @@
;; (mtext-scale 'used-or-eaten) (mtext-scale 'sold) (mtext-scale 'seed))
(mspinner-other 'house-type '(concrete tin thatched) (lambda (v) '()))
(horiz
(medit-text 'loan "numeric" (lambda (v) (entity-add-value! "loan" "int" v) '()))
(medit-text 'earning "numeric" (lambda (v) (entity-add-value! "earning" "int" v) '())))
(medit-text 'loan "numeric" (lambda (v) (entity-set-value! "loan" "int" v) '()))
(medit-text 'earning "numeric" (lambda (v) (entity-set-value! "earning" "int" v) '())))
(mtext 'in-the-home)
(horiz
(mtoggle-button-scale 'radio (lambda (v) (entity-add-value! "radio" "int" v) '()))
(mtoggle-button-scale 'tv (lambda (v) (entity-add-value! "tv" "int" v) '()))
(mtoggle-button-scale 'mobile (lambda (v) (entity-add-value! "mobile" "int" v) '())))
(mtoggle-button-scale 'radio (lambda (v) (entity-set-value! "radio" "int" v) '()))
(mtoggle-button-scale 'tv (lambda (v) (entity-set-value! "tv" "int" v) '()))
(mtoggle-button-scale 'mobile (lambda (v) (entity-set-value! "mobile" "int" v) '())))
(horiz
(medit-text 'visit-market "numeric" (lambda (v) (entity-add-value! "visit-market" "int" v) '()))
(medit-text 'town-sell "numeric" (lambda (v) (entity-add-value! "town-sell" "int" v) '())))
(medit-text 'visit-market "numeric" (lambda (v) (entity-set-value! "visit-market" "int" v) '()))
(medit-text 'town-sell "numeric" (lambda (v) (entity-set-value! "town-sell" "int" v) '())))
)
(lambda (activity arg)
(set-current! 'activity-title "Individual income")
......
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