Commit 423b9918 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

docs

parent 0611b540
| ktv | ktv-list | sql
| | racket-fix
| entity-values | entity-insert | entity-get |
| entity-update |
| entity-sync | entity-filter |
| eavdb |
...@@ -13,7 +13,6 @@ ...@@ -13,7 +13,6 @@
;; You should have received a copy of the GNU Affero General Public License ;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; abstractions for synced databased ;; abstractions for synced databased
(msg "dbsync.scm") (msg "dbsync.scm")
...@@ -173,6 +172,9 @@ ...@@ -173,6 +172,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; syncing code ;; syncing code
;; todo - separate logic from gui and stick this in common code
;; then we can unit test this stuff...
(define url "http://192.168.2.1:8889/symbai?") (define url "http://192.168.2.1:8889/symbai?")
(define (build-url-from-ktv ktv) (define (build-url-from-ktv ktv)
...@@ -195,6 +197,7 @@ ...@@ -195,6 +197,7 @@
"&version=" (number->string (list-ref (car e) 3)) "&version=" (number->string (list-ref (car e) 3))
(build-url-from-ktvlist (cadr e)))) (build-url-from-ktvlist (cadr e))))
;; todo fix all hardcoded paths here ;; todo fix all hardcoded paths here
(define (send-files ktvlist) (define (send-files ktvlist)
(msg "send-files" ktvlist) (msg "send-files" ktvlist)
...@@ -270,7 +273,6 @@ ...@@ -270,7 +273,6 @@
(msg "suck ent") (msg "suck ent")
(define (suck-entity-from-server db table unique-id) (define (suck-entity-from-server db table unique-id)
;; ask for the current version ;; ask for the current version
(http-request (http-request
...@@ -301,6 +303,27 @@ ...@@ -301,6 +303,27 @@
(update-widget 'text-view (get-id "sync-dirty") 'text (build-dirty db)) (update-widget 'text-view (get-id "sync-dirty") 'text (build-dirty db))
(request-files ktvlist)))))) (request-files ktvlist))))))
(define (build-entity-requests db table version-data)
(foldl
(lambda (i r)
(let* ((unique-id (car i))
(version (cadr i))
(exists (entity-exists? db table unique-id))
(old
(if exists
(> version (get-entity-version
db table
(get-entity-id db table unique-id)))
#f)))
;; if we don't have this entity or the version on the server is newer
(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)))
'()
version-data))
;; repeatedly read version and request updates ;; repeatedly read version and request updates
(define (suck-new db table) (define (suck-new db table)
...@@ -312,42 +335,23 @@ ...@@ -312,42 +335,23 @@
(string-append url "fn=entity-versions&table=" table) (string-append url "fn=entity-versions&table=" table)
(lambda (data) (lambda (data)
(msg "entity-versions:" data) (msg "entity-versions:" data)
(let ((r (foldl (let ((new-entity-requests (build-entity-requests db table data)))
(lambda (i r)
(let* ((unique-id (car i))
(version (cadr i))
(exists (entity-exists? db table unique-id))
(old
(if exists
(> version (get-entity-version
db table
(get-entity-id db table unique-id)))
#f)))
;; if we don't have this entity or the version on the server is newer
(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)))
'()
data)))
(cond (cond
((null? r) ((null? new-entities)
(debug! "No new data to download") (debug! "No new data to download")
(set-current! 'download 1) (set-current! 'download 1)
(append (append
(if (eqv? (get-current 'upload 0) 1) (if (eqv? (get-current 'upload 0) 1)
(list (play-sound "ping")) '()) (list (play-sound "ping")) '())
(list (list
(toast "No new data to download")) r)) (toast "No new data to download"))))
(else (else
(debug! (string-append (debug! (string-append
"Requesting " "Requesting "
(number->string (length r)) " entities")) (number->string (length new-entities)) " entities"))
(cons (cons
(play-sound "active") (play-sound "active")
r)))))))) new-entities))))))))
(msg "build-dirty defined...") (msg "build-dirty defined...")
...@@ -392,8 +396,6 @@ ...@@ -392,8 +396,6 @@
)))))) ))))))
(define i18n-lang 0) (define i18n-lang 0)
(define i18n-text (define i18n-text
...@@ -702,14 +704,12 @@ ...@@ -702,14 +704,12 @@
;; pull db data into list of button widgets ;; pull db data into list of button widgets
(define (update-list-widget db table entity-type edit-activity parent) (define (update-list-widget db table entity-type edit-activity parent)
(msg "ulw")
(let ((search-results (let ((search-results
(if parent (if parent
(db-filter-only db table entity-type (db-filter-only db table entity-type
(list (list "parent" "varchar" "=" parent)) (list (list "parent" "varchar" "=" parent))
(list (list "name" "varchar"))) (list (list "name" "varchar")))
(db-all db table entity-type)))) (db-all db table entity-type))))
(msg "ulw search results " search-results)
(update-widget (update-widget
'linear-layout 'linear-layout
(get-id (string-append entity-type "-list")) (get-id (string-append entity-type "-list"))
......
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