Skip to content

GitLab

Commit 53837a3b authored by Dave Griffiths's avatar Dave Griffiths
Browse files

syncing works, and missing files

parent e265b1bf
Hide whitespace changes
Inline Side-by-side
Showing with 80 additions and 46 deletions
android/assets/eavdb.scm
View file @ 53837a3b
......@@ -220,12 +220,13 @@
;; get an entire entity, as a list of key/value pairs (includes entity id)
(define (get-entity db table entity-id)
(let* ((entity-type (get-entity-type db table entity-id)))
(let* ((entity-type (get-entity-type db table entity-id))
(unique-id (get-unique-id db table entity-id)))
(cond
((null? entity-type) (msg "entity" entity-id "not found!") '())
(else
(cons
(list "entity_id" "int" entity-id)
(list "unique_id" "varchar" unique-id)
(map
(lambda (kt)
(list (ktv-key kt) (ktv-type kt) (get-value db table entity-id kt)))
......@@ -370,3 +371,26 @@
(select-first
db (string-append "select version from " table "_entity where unique_id = '"
unique-id "'")))
(define (dirty-entities db table)
(map
(lambda (i)
(list
;; build according to url ([table] entity-type unique-id dirty version)
(cdr (vector->list i))
;; data entries (todo - only dirty values!)
(get-entity-plain db table (string->number (vector-ref i 0)))))
(cdr (db-select
db (string-append "select entity_id, entity_type, unique_id, dirty, version from " table "_entity where dirty=1;")))))
(define (get-unique-id db table entity-id)
(select-first db (string-append "select unique_id from " table "_entity where entity_id = '" (number->string entity-id) "';")))
(define (get-entity-id db table unique-id)
(select-first db (string-append "select entity_id from " table "_entity where unique_id = '" unique-id "';")))
(define (get-entity-version db table unique-id)
(select-first db (string-append "select version from " table "_entity where unique_id = '" unique-id "';")))
(define (entity-exists? db table unique-id)
(not (null? (select-first db (string-append "select * from " table "_entity where unique_id = '" unique-id "';")))))
android/assets/starwisp.scm
View file @ 53837a3b
......@@ -73,26 +73,6 @@
(define url "http://192.168.2.1:8888/mongoose?")
(define (dirty-entities db table)
(map
(lambda (i)
(list
;; build according to url ([table] entity-type unique-id dirty version)
(cdr (vector->list i))
;; data entries (todo - only dirty values!)
(get-entity-plain db table (string->number (vector-ref i 0)))))
(cdr (db-select
db (string-append "select entity_id, entity_type, unique_id, dirty, version from " table "_entity where dirty=1;")))))
(define (get-entity-id db table unique-id)
(select-first db (string-append "select entity_id from " table "_entity where unique_id = '" unique-id "';")))
(define (get-entity-version db table unique-id)
(select-first db (string-append "select version from " table "_entity where unique_id = '" unique-id "';")))
(define (entity-exists? db table unique-id)
(not (null? (select-first db (string-append "select * from " table "_entity where unique_id = '" unique-id "';")))))
(define (build-url-from-ktv ktv)
(string-append "&" (ktv-key ktv) ":" (ktv-type ktv) "=" (stringify-value-url ktv)))
......@@ -127,7 +107,7 @@
(display "somefink went wrong")(newline)))))
(dirty-entities db table)))
(define (suck-entity-from-server db table unique-id)
(define (suck-entity-from-server db table unique-id exists)
(msg "suck-entity-from-server" unique-id)
;; ask for the current version
(http-request
......@@ -136,17 +116,20 @@
(lambda (data)
(msg "data from server request" data)
;; check "sync-insert" in sync.ss raspberry pi-side for the contents of 'entity'
(let ((entity (list-ref data 1))
(ktvlist (list-ref data 2)))
(let ((entity (list-ref data 0))
(ktvlist (list-ref data 1)))
(msg "1111" exists)
(if (not exists)
(insert-entity-wholesale
db table
(list-ref entity 0) ;; entity-type
(list-ref entity 1) ;; unique-id
"0"
(list-ref entity 2) ;; version
ktvlist)
(begin
(msg entity)
(msg (string? (list-ref entity 2)))
(insert-entity-wholesale
db table
(list-ref entity 0) ;; entity-type
(list-ref entity 1) ;; unique-id
0 ;; dirty
(list-ref entity 2) ;; version
ktvlist))
(update-to-version
db table (get-entity-id db table unique-id)
(list-ref entity 4) ktvlist)))
......@@ -176,7 +159,7 @@
#f)))
;; if we don't have this entity or the version on the server is newer
(if (or (not exists) old)
(cons (suck-entity-from-server db table unique-id) r)
(cons (suck-entity-from-server db table unique-id exists) r)
r)))
'()
data))))))
......@@ -455,16 +438,21 @@
(let ((build-pack-buttons
(lambda ()
(map
(lambda (pack)
(foldl
(lambda (pack r)
(let ((name (ktv-get pack "name")))
(button (make-id (string-append "manage-packs-pack-" name))
name 20 fillwrap
(lambda ()
(msg "going to manage individuals")
(msg pack)
(set-current! 'pack pack)
(list (start-activity "manage-individual" 2 ""))))))
(msg name)
(if (not (null? name))
(cons (button (make-id (string-append "manage-packs-pack-" name))
name 20 fillwrap
(lambda ()
(msg "going to manage individuals")
(msg pack)
(set-current! 'pack pack)
(list (start-activity "manage-individual" 2 ""))))
r)
r)))
'()
(db-all db "sync" "pack")))))
(activity
"manage-packs"
......@@ -480,7 +468,7 @@
(lambda (activity arg)
(list
(update-widget 'linear-layout (get-id "manage-packs-pack-list") 'contents
(build-pack-buttons))
(dbg (build-pack-buttons)))
))
(lambda (activity) '())
(lambda (activity) '())
......@@ -528,7 +516,7 @@
(list (start-activity "manage-individual" 2 ""))))))
(db-all-where
db "sync" "mongoose"
(list "pack-id" (number->string (ktv-get (get-current 'pack) "entity_id"))))
(list "pack-id" (ktv-get (get-current 'pack) "unique_id")))
))))
(activity
"manage-individual"
......@@ -587,7 +575,7 @@
(ktv "gender" "varchar" (get-current 'individual-gender))
(ktv "litter-code" "varchar" (get-current 'individual-litter-code))
(ktv "chip-code" "varchar" (get-current 'individual-chip-code))
(ktv "pack-id" "int" (ktv-get (get-current 'pack) "entity_id"))
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack) "unique_id"))
))
(list (finish-activity 2)))))
)
......@@ -710,7 +698,8 @@
(lambda (activity arg)
(list
(update-widget 'text-view (get-id "sync-dirty") 'text (build-dirty))
(update-widget 'text-view (get-id "sync-console") 'text (build-sync-debug db "sync"))))
;;(update-widget 'text-view (get-id "sync-console") 'text (build-sync-debug db "sync"))
))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
......
android/assets/unit-tests.scm 0 → 100644
View file @ 53837a3b
(asserteq "filter" (filter (lambda (i) (odd? i)) (list 0 1 2 3)) (list 1 3))
(asserteq "sort" (sort (list 3 2 0 1) <) (list 0 1 2 3))
(asserteq "find" (find 3 (list '(3 30) '(2 20) '(0 100) '(1 10))) (list 3 30))
(asserteq "build-list" (build-list (lambda (i) (* i 2)) 5) (list 0 2 4 6 8))
(asserteq "foldl" (foldl (lambda (i r) (+ i r)) 0 (list 1 2 3 4)) 10)
(asserteq "insert-to" (insert-to 999 3 (list 0 1 2 3 4)) (list 0 1 2 999 3 4))
(asserteq "list-replace" (list-replace (list 1 2 3 4) 2 100) (list 1 2 100 4))
(asserteq "insert" (insert 4 < (list 2 5 100)) (list 2 4 5 100))
(assert "date<" (date< (list 20 12 2010) (list 25 12 2010)))
(asserteq "date->string" (date->string (list 20 12 2012)) "20/12/2012")
(asserteq "scheme->json" (scheme->json (list 10)) "[10]")
(asserteq "scheme->json2" (scheme->json (list 10 20)) "[10, 20]")
(asserteq "scheme->json3" (scheme->json (list (list "one" "two") 10))
"[[\"one\", \"two\"], 10]")
(asserteq "scheme->json4" (scheme->json (list)) "[]")
(asserteq "scheme->json5" (scheme->json 'sym) "\"sym\"")
(asserteq "scheme->json6" (scheme->json (list #t #f)) "[true, false]")
(asserteq "assoc->json" (assoc->json '((one . 1) (two . "three")))
"{\n\"one\": 1,\n\"two\": \"three\"\n}")
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