Commit 43a6057f authored by Dave Griffiths's avatar Dave Griffiths
Browse files

typing and dirty flag fix

parent 4f49a811
<?xml version="1.0" encoding="utf-8"?> <?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android" <manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.symbai" package="foam.symbai"
android:versionCode="8" android:versionCode="9"
android:versionName="1.0"> android:versionName="1.0">
<application android:label="@string/app_name" <application android:label="@string/app_name"
android:icon="@drawable/logo" android:icon="@drawable/logo"
......
...@@ -90,8 +90,22 @@ ...@@ -90,8 +90,22 @@
(define (entity-get-value key) (define (entity-get-value key)
(ktv-get (get-current 'entity-values '()) key)) (ktv-get (get-current 'entity-values '()) key))
(define (check-type type value)
(cond
((equal? type "varchar")
(string? value))
((equal? type "file")
(string? value))
((equal? type "int")
(number? value))
((equal? type "real")
(number? value))))
;; version to check the entity has the key ;; version to check the entity has the key
(define (entity-set-value! key type value) (define (entity-set-value! key type value)
(when (not (check-type type value))
(msg "INCORRECT TYPE FOR" key ":" type ":" value))
(let ((existing-type (ktv-get-type (get-current 'entity-values '()) key))) (let ((existing-type (ktv-get-type (get-current 'entity-values '()) key)))
(if (equal? existing-type type) (if (equal? existing-type type)
(set-current! (set-current!
...@@ -664,8 +678,7 @@ ...@@ -664,8 +678,7 @@
(update-widget widget-type (get-symbol-id id-symbol) 'text (update-widget widget-type (get-symbol-id id-symbol) 'text
;; hide -1 as it represents unset ;; hide -1 as it represents unset
(if (and (number? v) (eqv? v -1)) (if (and (number? v) (eqv? v -1))
"" "" v))))
(entity-get-value key)))))
((eq? widget-type 'toggle-button) ((eq? widget-type 'toggle-button)
(update-widget widget-type (get-symbol-id id-symbol) 'checked (update-widget widget-type (get-symbol-id id-symbol) 'checked
(entity-get-value key))) (entity-get-value key)))
......
...@@ -570,7 +570,8 @@ ...@@ -570,7 +570,8 @@
;; from activity on result with request id: choose-code ;; from activity on result with request id: choose-code
;; todo determine *which* selector this came from... ;; todo determine *which* selector this came from...
(define (person-selector-return request-code key choose-code) (define (person-selector-return request-code key choose-code)
(when (eqv? request-code choose-code) (when (and (eqv? request-code choose-code)
(get-current 'choose-result #f))
(entity-set-value! key "varchar" (get-current 'choose-result "not set")) (entity-set-value! key "varchar" (get-current 'choose-result "not set"))
(entity-update-values!))) (entity-update-values!)))
...@@ -969,8 +970,8 @@ ...@@ -969,8 +970,8 @@
"household" "household"
(build-activity (build-activity
(horiz (horiz
(medit-text 'num-pots "numeric" (lambda (v) (entity-set-value! "num-pots" "int" v) '())) (medit-text 'num-pots "numeric" (lambda (v) (entity-set-value! "num-pots" "int" (string->number v)) '()))
(medit-text 'num-children "numeric" (lambda (v) (entity-set-value! "num-children" "int" v) '()))) (medit-text 'num-children "numeric" (lambda (v) (entity-set-value! "num-children" "int" (string->number v)) '())))
(horiz (horiz
(vert (vert
(mtext 'location) (mtext 'location)
...@@ -1102,11 +1103,14 @@ ...@@ -1102,11 +1103,14 @@
(mspinner-other 'tribe tribes-list (lambda (v) (entity-set-value! "tribe" "varchar" (spinner-choice tribes-list v)) '())) (mspinner-other 'tribe tribes-list (lambda (v) (entity-set-value! "tribe" "varchar" (spinner-choice tribes-list v)) '()))
(mspinner-other 'sub-tribe subtribe-list (lambda (v) (entity-set-value! "subtribe" "varchar" (spinner-choice subtribe-list v)) '())) (mspinner-other 'sub-tribe subtribe-list (lambda (v) (entity-set-value! "subtribe" "varchar" (spinner-choice subtribe-list v)) '()))
(horiz (horiz
(medit-text 'age "numeric" (lambda (v) (entity-set-value! "age" "int" v) '())) (medit-text 'age "numeric" (lambda (v) (entity-set-value! "age" "int" (string->number v)) '()))
(mspinner 'gender gender-list (lambda (v) (entity-set-value! "gender" "varchar" (spinner-choice gender-list v)) '()))) (mspinner 'gender gender-list (lambda (v) (entity-set-value! "gender" "varchar" (spinner-choice gender-list v)) '())))
(horiz (horiz
(mtoggle-button-scale 'literate (lambda (v) (entity-set-value! "literate" "int" v) '())) (mtoggle-button-scale 'literate (lambda (v) (entity-set-value! "literate" "int" v) '()))
(mspinner 'education education-list (lambda (v) (entity-set-value! "education" "varchar" v) '()))) (mspinner 'education education-list
(lambda (v)
(entity-set-value! "education" "varchar"
(spinner-choice education-list v)) '())))
(mbutton 'details-next (lambda () (list (start-activity "family" 0 "")))) (mbutton 'details-next (lambda () (list (start-activity "family" 0 ""))))
(spacer 20) (spacer 20)
...@@ -1158,7 +1162,7 @@ ...@@ -1158,7 +1162,7 @@
(mspinner 'marital-status married-list (lambda (v) (entity-set-value! "marital-status" "varchar" (spinner-choice married-list v)) '())) (mspinner 'marital-status married-list (lambda (v) (entity-set-value! "marital-status" "varchar" (spinner-choice married-list v)) '()))
(medit-text 'times-married "numeric" (medit-text 'times-married "numeric"
(lambda (v) (lambda (v)
(entity-set-value! "times-married" "int" v) (entity-set-value! "times-married" "int" (string->number v))
(list (list
(update-widget 'linear-layout (get-id "residence-after-marriage-container") (update-widget 'linear-layout (get-id "residence-after-marriage-container")
(if (equal? v "0") 'hide 'show) 0))))) (if (equal? v "0") 'hide 'show) 0)))))
...@@ -1177,8 +1181,8 @@ ...@@ -1177,8 +1181,8 @@
(mspinner-other 'residence-after-marriage residence-list (lambda (v) (entity-set-value! (mspinner-other 'residence-after-marriage residence-list (lambda (v) (entity-set-value!
"residence-after-marriage" "varchar" "residence-after-marriage" "varchar"
(spinner-choice residence-list v)) '())) (spinner-choice residence-list v)) '()))
(medit-text 'num-siblings "numeric" (lambda (v) (entity-set-value! "num-siblings" "int" v) '())) (medit-text 'num-siblings "numeric" (lambda (v) (entity-set-value! "num-siblings" "int" (string->number v)) '()))
(medit-text 'birth-order "numeric" (lambda (v) (entity-set-value! "birth-order" "int" v) '())) (medit-text 'birth-order "numeric" (lambda (v) (entity-set-value! "birth-order" "int" (string->number v)) '()))
(mbutton 'family-next (lambda () (list (start-activity "migration" 0 "")))) (mbutton 'family-next (lambda () (list (start-activity "migration" 0 ""))))
(spacer 20) (spacer 20)
) )
...@@ -1253,11 +1257,11 @@ ...@@ -1253,11 +1257,11 @@
(activity (activity
"migration" "migration"
(build-activity (build-activity
(medit-text 'length-time "numeric" (lambda (v) (entity-set-value! "length-time" "int" v) '())) (medit-text 'length-time "numeric" (lambda (v) (entity-set-value! "length-time" "int" (string->number v)) '()))
(medit-text 'place-of-birth "normal" (lambda (v) (entity-set-value! "place-of-birth" "varchar" 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 'num-residence-changes "numeric" (lambda (v) (entity-set-value! "num-residence-changes" "int" (string->number v)) '()))
(medit-text 'village-visits-month "numeric" (lambda (v) (entity-set-value! "village-visits-month" "int" v) '())) (medit-text 'village-visits-month "numeric" (lambda (v) (entity-set-value! "village-visits-month" "int" (string->number v)) '()))
(medit-text 'village-visits-year "numeric" (lambda (v) (entity-set-value! "village-visits-year" "int" v) '())) (medit-text 'village-visits-year "numeric" (lambda (v) (entity-set-value! "village-visits-year" "int" (string->number v)) '()))
(mbutton 'migration-next (lambda () (list (start-activity "income" 0 "")))) (mbutton 'migration-next (lambda () (list (start-activity "income" 0 ""))))
(spacer 20) (spacer 20)
) )
...@@ -1306,16 +1310,16 @@ ...@@ -1306,16 +1310,16 @@
(mspinner-other 'house-type house-type-list (lambda (v) (entity-set-value! "house-type" "varchar" (mspinner-other 'house-type house-type-list (lambda (v) (entity-set-value! "house-type" "varchar"
(spinner-choice house-type-list v)) '())) (spinner-choice house-type-list v)) '()))
(horiz (horiz
(medit-text 'loan "numeric" (lambda (v) (entity-set-value! "loan" "int" v) '())) (medit-text 'loan "numeric" (lambda (v) (entity-set-value! "loan" "int" (string->number v)) '()))
(medit-text 'earning "numeric" (lambda (v) (entity-set-value! "earning" "int" v) '()))) (medit-text 'earning "numeric" (lambda (v) (entity-set-value! "earning" "int" (string->number v)) '())))
(mtext 'in-the-home) (mtext 'in-the-home)
(horiz (horiz
(mtoggle-button-scale 'radio (lambda (v) (entity-set-value! "radio" "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 'tv (lambda (v) (entity-set-value! "tv" "int" v) '()))
(mtoggle-button-scale 'mobile (lambda (v) (entity-set-value! "mobile" "int" v) '()))) (mtoggle-button-scale 'mobile (lambda (v) (entity-set-value! "mobile" "int" v) '())))
(horiz (horiz
(medit-text 'visit-market "numeric" (lambda (v) (entity-set-value! "visit-market" "int" v) '())) (medit-text 'visit-market "numeric" (lambda (v) (entity-set-value! "visit-market" "int" (string->number v)) '()))
(medit-text 'town-sell "numeric" (lambda (v) (entity-set-value! "town-sell" "int" v) '()))) (medit-text 'town-sell "numeric" (lambda (v) (entity-set-value! "town-sell" "int" (string->number v)) '())))
(mbutton 'income-next (lambda () (list (start-activity "genealogy" 0 "")))) (mbutton 'income-next (lambda () (list (start-activity "genealogy" 0 ""))))
(spacer 20) (spacer 20)
) )
......
...@@ -65,7 +65,7 @@ ...@@ -65,7 +65,7 @@
;; add all the keys ;; add all the keys
(for-each (for-each
(lambda (ktv) (lambda (ktv)
(insert-value db table id ktv dirty)) (insert-value db table id ktv (not (zero? dirty))))
ktvlist) ktvlist)
(db-exec db "end transaction") (db-exec db "end transaction")
......
...@@ -88,7 +88,7 @@ ...@@ -88,7 +88,7 @@
;;(msg ktv) ;;(msg ktv)
;;(msg entity-id) ;;(msg entity-id)
(if (null? s) (if (null? s)
(insert-value db table entity-id ktv #t) (insert-value db table entity-id ktv #t) ;; <- don't make dirty!?
(db-exec (db-exec
db (string-append "update " table "_value_" (ktv-type ktv) db (string-append "update " table "_value_" (ktv-type ktv)
" set value=?, dirty=0 where entity_id = ? and attribute_id = ?") " set value=?, dirty=0 where entity_id = ? and attribute_id = ?")
......
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