Commit 526b6b82 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

big sync fixed

parent 9cbd5a22
......@@ -334,7 +334,9 @@
(get-entity-id db table unique-id))))
;; if we don't have this entity or the version on the server is newer
(if (or (not exists) old)
(if (and (or (not exists) old)
;; limit this to 5 a time
(< (length r) 5))
(cons (suck-entity-from-server db table unique-id) r)
r)))
'()
......@@ -723,3 +725,197 @@
(list (finish-activity 1)))
(else
(list)))))))))
(define vowel (map symbol->string (list 'a 'e 'i 'o 'u)))
(define consonant (map symbol->string (list 'b 'c 'd 'f 'g 'h 'j 'k 'l 'm 'n 'p 'q 'r 's 't 'v 'w 'x 'y 'z)))
(define (word-gen)
(define (_ s vowel-prob)
(cond
((zero? s) '())
((< (random) vowel-prob)
(cons (choose vowel) (_ (- s 1) (/ vowel-prob 2))))
(else
(cons (choose consonant) (_ (- s 1) (* vowel-prob 2))))))
(apply string-append (_ (+ 3 (random-int 8)) 0.5)))
(define (simpsons-village db table default-ktvlist)
(entity-create! db table "village"
(ktvlist-merge
default-ktvlist
(list
(ktv "name" "varchar" (word-gen))
(ktv "block" "varchar" (word-gen))
(ktv "district" "varchar" (word-gen))
(ktv "car" "int" (random-int 2))))))
(define (simpsons-household db table parent default-ktvlist)
(entity-create! db table "household"
(ktvlist-merge
default-ktvlist
(list
(ktv "name" "varchar" (word-gen))
(ktv "num-pots" "int" (random-int 10))
(ktv "parent" "varchar" parent)))))
(define (simpsons-individual db table parent default-ktvlist)
(let ((n (random-int 1000)))
(entity-create! db table "individual"
(ktvlist-merge
default-ktvlist
(append
(list (ktv "parent" "varchar" parent))
(choose
(list
(list
(ktv-create "name" "varchar"
(string-append "Abe-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "abe.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Akira-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "akira.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Apu-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "apu.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Barney-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "barney.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Bart-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "bartsimpson.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Billy-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "billy.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Carl-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "carl.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Cletus-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "cletus.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "ComicBookGuy-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "comicbookguy.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Homer-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "homersimpson.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Jasper-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "jasper.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Kent-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "kentbrockman.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Kodos-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "kodos.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Lenny-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "lenny.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Lisa-" (number->string n)))
(ktv-create "gender" "varchar" "Female")
(ktv-create "photo" "file" "lisasimpson.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Marge-" (number->string n)))
(ktv-create "gender" "varchar" "Female")
(ktv-create "photo" "file" "margesimpson.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Martin-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "martinprince.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Milhouse-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "milhouse.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "MrBurns-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "mrburns.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Ned-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "nedflanders.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Nelson-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "nelson.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Otto-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "otto.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Ralph-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "ralphwiggum.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "Santaslittlehelper-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "santaslittlehelper.jpg"))
(list
(ktv-create
"name" "varchar" (string-append "SideshowBob-" (number->string n)))
(ktv-create "gender" "varchar" "Male")
(ktv-create "photo" "file" "sideshowbob.jpg")))))))))
(define (looper! n fn)
(when (not (zero? n))
(fn n)
(looper! (- n 1) fn)))
(msg (random-int 100))
(define (build-test! db table village-ktvlist household-ktvlist individual-ktvlist)
(looper!
3
(lambda (i)
(msg "making village" i)
(let ((village (simpsons-village db table village-ktvlist)))
(looper!
8
(lambda (i)
(alog "household")
(msg "making household" i)
(let ((household (simpsons-household db table village household-ktvlist)))
(looper!
(random-int 30)
(lambda (i)
(msg "making individual" i)
(simpsons-individual db table household individual-ktvlist))))))))))
......@@ -185,7 +185,6 @@
;; update the value given an entity type, a attribute type and it's key (= attriute_id)
;; creates the value if it doesn't already exist, updates it otherwise if it's different
(define (update-value db table entity-id ktv)
(msg "update-value")
(let ((s (select-first
db (string-append
"select value from " table "_value_" (ktv-type ktv) " where entity_id = ? and attribute_id = ?")
......@@ -195,7 +194,6 @@
;; only update if they are different
(if (not (ktv-eq? ktv (list (ktv-key ktv) (ktv-type ktv) s)))
(begin
(msg "incrementing value version in update-value")
(db-exec
db (string-append "update " table "_value_" (ktv-type ktv)
" set value=?, dirty=1, version=version+1 where entity_id = ? and attribute_id = ?")
......@@ -211,7 +209,7 @@
(if (null? s)
(insert-value db table entity-id ktv #t)
(begin
(msg "actually updating (fs)" (ktv-key ktv) "to" (ktv-value ktv))
;;(msg "actually updating (fs)" (ktv-key ktv) "to" (ktv-value ktv))
(db-exec
db (string-append "update " table "_value_" (ktv-type ktv)
" set value=?, dirty=0, version=? where entity_id = ? and attribute_id = ?")
......@@ -270,7 +268,7 @@
(let ((vdv (get-value db table entity-id kt)))
(if (null? vdv)
(begin
(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
;;(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
r)
(cons (list (ktv-key kt) (ktv-type kt)
(list-ref vdv 0) (list-ref vdv 2)) r))))
......@@ -279,23 +277,19 @@
;; 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))
;;(msg "ERROR: get-entity-plain-for-sync: no value found for " entity-id " " (ktv-key kt))
r)
;; only return if dirty
((not (zero? (cadr vdv)))
(msg "value-dirty-version found" vdv)
(cons
(list (ktv-key kt) (ktv-type kt) (list-ref vdv 0) (list-ref vdv 2))
r))
......@@ -310,6 +304,24 @@
(list "unique_id" "varchar" unique-id)
(get-entity-plain db table entity-id))))
;; like get-entity-plain, but only look for specific key/types - for speed
(define (get-entity-only db table entity-id kt-list)
(let ((unique-id (get-unique-id db table entity-id)))
(cons
(list "unique_id" "varchar" unique-id)
(foldl
(lambda (kt r)
(let ((vdv (get-value db table entity-id kt)))
(if (null? vdv)
(begin
;;(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
r)
(cons (list (ktv-key kt) (ktv-type kt)
(list-ref vdv 0) (list-ref vdv 2)) r))))
'()
kt-list))))
(define (all-entities db table type)
(let ((s (db-select
db (string-append "select e.entity_id from " table "_entity as e "
......@@ -468,6 +480,13 @@
(get-entity db table i))
(filter-entities db table type filter)))
;; only return name and photo
(define (db-filter-only db table type filter kt-list)
(map
(lambda (i)
(get-entity-only db table i kt-list))
(filter-entities db table type filter)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data
......@@ -479,7 +498,6 @@
;; auto update version
(define (update-entity db table entity-id ktvlist)
(msg "update-entity")
;; dirty
(update-entity-changed db table entity-id)
(update-entity-values db table entity-id ktvlist #t))
......@@ -490,7 +508,6 @@
entity-id (ktv-key kt)))
(define (clean-entity-values db table entity-id)
(msg "clean-entity-values")
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
((null? entity-type)
......@@ -498,14 +515,13 @@
(else
(for-each
(lambda (kt)
(msg "cleaning" kt)
(clean-value db table entity-id (list (ktv-key kt) (ktv-type kt))))
(get-attribute-ids/types db table entity-type))))))
;; update an entity, via a (possibly partial) list of key/value pairs
;; if dirty is not true, this is coming from a sync
(define (update-entity-values db table entity-id ktvlist dirty)
(msg "update-entity-values")
;;(msg "update-entity-values")
(let* ((entity-type (get-entity-type db table entity-id)))
(cond
((null? entity-type) (msg "entity" entity-id "not found!") '())
......@@ -568,15 +584,21 @@
version entity-id))
(define (update-entity-clean db table unique-id)
(msg "cleaning")
;;(msg "cleaning")
;; clean entity table
(db-exec
db (string-append "update " table "_entity set dirty=? where unique_id = ?")
0 unique-id)
;; clean value tables for this entity
(msg "cleaning values")
;;(msg "cleaning values")
(clean-entity-values db table (entity-id-from-unique db table unique-id)) )
(define (have-dirty? db table)
(not (zero?
(select-first
db (string-append "select count(entity_id) from " table "_entity where dirty=1")))))
(define (get-dirty-stats db table)
(list
(select-first
......@@ -589,17 +611,18 @@
(define (dirty-entities db table)
(let ((de (db-select
db (string-append
"select entity_id, entity_type, unique_id, dirty, version from " table "_entity where dirty=1;"))))
"select entity_id, entity_type, unique_id, dirty, version from "
table "_entity where dirty=1 limit 5;"))))
(msg de)
(if (null? de)
'()
(map
(lambda (i)
(msg "dirty-entities")
(msg "dirty:" (vector-ref i 2))
(list
;; build according to url ([table] entity-type unique-id dirty version)
(cdr (vector->list i))
;; data entries (todo - only dirty values!)
(dbg (get-entity-plain-for-sync db table (vector-ref i 0)))))
(get-entity-plain-for-sync db table (vector-ref i 0))))
(cdr de)))))
;; todo: BROKEN...
......
......@@ -269,6 +269,9 @@
(define random
(random-maker 19781116)) ;; another arbitrarily chosen birthday
(define (random-int n)
(abs (random n)))
(define rndf random)
(define (rndvec) (vector (rndf) (rndf) (rndf)))
......
......@@ -303,9 +303,24 @@
(list 'weekly (list "Weekly"))
(list 'monthly (list "Monthly"))
(list 'less (list "Less"))
))
(define village-ktvlist
(list
(ktv-create "name" "varchar" (mtext-lookup 'default-village-name))
(ktv-create "block" "varchar" "")
(ktv-create "district" "varchar" "test")
(ktv-create "car" "int" 0)))
(define household-ktvlist
(list
(ktv-create "name" "varchar" (mtext-lookup 'default-household-name))
(ktv-create "num-pots" "int" 0)
(ktv-create "house-lat" "real" 0) ;; get from current location?
(ktv-create "house-lon" "real" 0)
(ktv-create "toilet-lat" "real" 0)
(ktv-create "toilet-lon" "real" 0)))
(define individual-ktvlist
(list
(ktv-create "name" "varchar" (mtext-lookup 'default-individual-name))
......@@ -371,10 +386,10 @@
(append
(list (toast "sync-cb"))
(upload-dirty db)
(suck-new db "sync")))))
(if (have-dirty? db "sync") '() (suck-new db "sync"))))))
(else '()))
(list
(delayed "debug-timer" (+ 10000 (random 5000)) debug-timer-cb)
(delayed "debug-timer" (+ 30000 (random 5000)) debug-timer-cb)
(update-debug))))
......@@ -544,40 +559,61 @@
(define (update-individual-filter)
(update-widget
'linear-layout (get-id "choose-pics") 'contents
(grid-ify
(map
(lambda (e)
(let* ((id (ktv-get e "unique_id"))
(image-name (ktv-get e "photo"))
(image (if (image-invalid? image-name)
"face" (string-append "/sdcard/symbai/files/" image-name))))
(if (equal? image "face")
(let ((search (db-filter-only db "sync" "individual" (filter-get)
(list
(list "photo" "file")
(list "name" "varchar")))))
(update-widget
'linear-layout (get-id "choose-pics") 'contents
(grid-ify
(map
(lambda (e)
(let* ((id (ktv-get e "unique_id"))
(image-name (ktv-get e "photo"))
(image (if (image-invalid? image-name)
"face" (string-append "/sdcard/symbai/files/" image-name))))
(cond
((> (length search) 50)
(button
(make-id (string-append "chooser-" id))
(ktv-get e "name") 30 (layout (car button-size) (cadr button-size) 1 'centre 5)
(ktv-get e "name") 30 (layout (car button-size) (/ (cadr button-size) 3) 1 'centre 5)
(lambda ()
(set-current! 'choose-result id)
(list (finish-activity 0))))
(image-button
(list (finish-activity 0)))))
((equal? image "face")
(button
(make-id (string-append "chooser-" id))
image (layout (car button-size) (cadr button-size) 1 'centre 5)
(ktv-get e "name") 30 (layout (car button-size) (cadr button-size) 1 'centre 5)
(lambda ()
(set-current! 'choose-result id)
(list (finish-activity 0)))))))
(db-filter db "sync" "individual" (filter-get)))
3)))
(list (finish-activity 0)))))
(define (image-from-unique-id db table unique-id)
(else
(vert
(image-button
(make-id (string-append "chooser-" id))
image (layout (car button-size) (cadr button-size) 1 'centre 5)
(lambda ()
(set-current! 'choose-result id)
(list (finish-activity 0))))
(text-view 0 (ktv-get e "name") 20 (layout 'wrap-content 'wrap-content -1 'centre 0)))
))))
search)
3))))
(define (image/name-from-unique-id db table unique-id)
(let ((e (get-entity-by-unique db table unique-id)))
(ktv-get e "photo")))
(list
(ktv-get e "name")
(ktv-get e "photo"))))
(define (build-person-selector id key filter request-code)
(vert
(mtitle id)
(image-view (make-id (string-append (symbol->string id) "-image"))
"face" (layout 240 320 -1 'centre 0))
(mtext-small (string->symbol (string-append (symbol->string id) "-text")))
(button
(make-id (string-append "change-" (symbol->string id)))
(mtext-lookup 'change-id)
......@@ -591,6 +627,7 @@
(mtitle id)
(image-view (make-id (string-append (symbol->string id) "-image"))
"face" (layout 120 160 -1 'centre 0))
(mtext-small (string->symbol (string-append (symbol->string id) "-text")))
(button
(make-id (string-append "change-" (symbol->string id)))
(mtext-lookup 'change-id)
......@@ -611,12 +648,18 @@
(msg "update-person-selector" key)
(let ((entity-id (entity-get-value key)))
(msg "entity-id is" entity-id)
(let ((image-name (image-from-unique-id db table entity-id))
(id (get-id (string-append (symbol->string id) "-image"))))
(msg "image-name is" image-name)
(if (image-invalid? image-name)
(update-widget 'image-view id 'image "face")
(update-widget 'image-view id 'external-image (string-append dirname "files/" image-name))))))
(let ((image-name (image/name-from-unique-id db table entity-id))
(id (get-id (string-append (symbol->string id) "-image")))
(text-id (get-id (string-append (symbol->string id) "-text"))))
(msg "image-name is" (cadr image-name) (image-invalid? (cadr image-name)))
(if (image-invalid? (cadr image-name))
(list
(update-widget 'image-view id 'image "face")
(update-widget 'text-view text-id 'text (car image-name)))
(list
(update-widget 'text-view text-id 'text (car image-name))
(update-widget 'image-view id 'external-image
(string-append dirname "files/" (cadr image-name))))))))
(define (build-social-connection id key type request-code)
(let ((id-text (string-append (symbol->string id))))
......@@ -650,20 +693,21 @@
(define (update-social-connection db table id key type request-code)
(let ((id-text (string-append (symbol->string id))))
(list
(append
(update-person-selector db table id key)
(mupdate-spinner-other
(string->symbol (string-append id-text "-relationship"))
(string-append key "-relationship")
social-relationship-list)
(mupdate-spinner-other
(string->symbol (string-append id-text "-residence"))
(string-append key "-residence")
social-residence-list)
(mupdate-spinner
(string->symbol (dbg (string-append id-text "-strength")))
(string-append key "-strength")
social-strength-list)
(list
(mupdate-spinner-other
(string->symbol (string-append id-text "-relationship"))
(string-append key "-relationship")
social-relationship-list)
(mupdate-spinner-other
(string->symbol (string-append id-text "-residence"))
(string-append key "-residence")
social-residence-list)
(mupdate-spinner
(string->symbol (dbg (string-append id-text "-strength")))
(string-append key "-strength")
social-strength-list))
)))
(define (build-amenity-widgets id shade)
......@@ -730,11 +774,7 @@
(mbutton-scale 'find-individual (lambda () (list (start-activity "individual-chooser" choose-code "")))))
(build-list-widget
db "sync" 'villages "village" "village" (lambda () #f)
(list
(ktv-create "name" "varchar" (mtext-lookup 'default-village-name))
(ktv-create "block" "varchar" "")
(ktv-create "district" "varchar" "test")
(ktv-create "car" "int" 0))))
village-ktvlist))
(lambda (activity arg)
(set-current! 'activity-title "Main screen")
......@@ -824,13 +864,7 @@
(build-activity
(build-list-widget
db "sync" 'households "household" "household" (lambda () (get-current 'village #f))
(list
(ktv-create "name" "varchar" (mtext-lookup 'default-household-name))
(ktv-create "num-pots" "int" 0)
(ktv-create "house-lat" "real" 0) ;; get from current location?
(ktv-create "house-lon" "real" 0)
(ktv-create "toilet-lat" "real" 0)
(ktv-create "toilet-lon" "real" 0))))
household-ktvlist))
(lambda (activity arg)
(set-current! 'activity-title "Household List")
(activity-layout activity))
......@@ -1023,19 +1057,20 @@
(set-current! 'activity-title "Individual family")
(activity-layout activity))
(lambda (activity arg)
(list
(append
(update-person-selector db "sync" 'spouse "id-spouse")