Commit f2e7fb9e authored by dave griffiths's avatar dave griffiths

merged

parents 651e57f3 90a6d104
<?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.symbai"
android:versionCode="8"
android:versionCode="10"
android:versionName="1.0">
<application android:label="@string/app_name"
android:icon="@drawable/logo"
......@@ -26,7 +26,7 @@
<activity android:name="foam.symbai.FamilyActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.MigrationActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.IncomeActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.GeneaologyActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.GenealogyActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.SocialActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.FriendshipActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.AgreementActivity" android:configChanges="orientation"></activity>
......
Open Sauces Notebook
====================
A structured notebook for recipes
Symbai android app
==================
......@@ -17,6 +17,8 @@
(msg "dbsync.scm")
(define unset-int 2147483647)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stuff in memory
......@@ -88,22 +90,51 @@
(define (entity-get-value 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
(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)))
(if (equal? existing-type type)
(set-current!
'entity-values
(ktv-set
(get-current 'entity-values '())
(ktv key type value)))
;;
(begin
(msg "entity-set-value! - adding new " key "of type" type "to entity")
(entity-add-value-create! key type value)))
;; save straight to local db every time
(entity-update-single-value! (list key type value))
))
(cond
((equal? existing-type type)
;; save straight to local db every time (checks for modification)
(entity-update-single-value! (list key type value))
;; then save to memory
(set-current!
'entity-values
(ktv-set
(get-current 'entity-values '())
(ktv key type value))))
;;
(else
(msg "entity-set-value! - adding new " key "of type" type "to entity")
(entity-add-value-create! key type value))
)))
;; version to check the entity has the key
(define (entity-set-value-mem! key type value)
(when (not (check-type type value))
(msg "INCORRECT TYPE FOR" key ":" type ":" value))
;; then save to memory
(set-current!
'entity-values
(ktv-set
(get-current 'entity-values '())
(ktv key type value))))
(define (date-time->string dt)
......@@ -163,6 +194,8 @@
(table (get-current 'table #f))
(unique-id (ktv-get (get-current 'entity-values '()) "unique_id")))
(cond
((ktv-eq? (ktv-get-whole (get-current 'entity-values '()) (ktv-key ktv)) ktv)
(msg "eusv: no change for" (ktv-key ktv)))
(unique-id
(update-entity db table (entity-id-from-unique db table unique-id) (list ktv)))
(else
......@@ -455,7 +488,7 @@
(list
(network-connect
"network"
"mongoose-web"
"symbai-web"
(lambda (state)
(debug! (string-append "Raspberry Pi connection state now: " state))
(append
......@@ -575,11 +608,25 @@
(layout 'fill-parent 'wrap-content 1 'centre 0)
fn))))
(define (medit-text-large id type fn)
(linear-layout
(make-id (string-append (symbol->string id) "-container"))
'vertical
(layout 'fill-parent 'wrap-content 1 'centre 20)
(list 0 0 0 0)
(list
(text-view 0 (mtext-lookup id)
30 (layout 'wrap-content 'wrap-content -1 'centre 0))
(edit-text (symbol->id id) "" 30 type
(layout 'fill-parent 300 -1 'left 0)
fn))))
(define (mspinner id types fn)
(vert
(text-view (symbol->id id)
(mtext-lookup id)
30 (layout 'wrap-content 'wrap-content 1 'centre 10))
30 (layout 'wrap-content 'wrap-content 1 'centre 0))
(spinner (make-id (string-append (symbol->string id) "-spinner"))
(map mtext-lookup types)
(layout 'wrap-content 'wrap-content 1 'centre 0)
......@@ -650,15 +697,19 @@
(define (image-invalid? image-name)
(or (null? image-name)
(not image-name)
(equal? image-name "none")))
(equal? image-name "none")
(equal? image-name "")))
;; fill out the widget from the current entity in the memory store
;; dispatches based on widget type
(define (mupdate widget-type id-symbol key)
(cond
((or (eq? widget-type 'edit-text) (eq? widget-type 'text-view))
(update-widget widget-type (get-symbol-id id-symbol) 'text
(entity-get-value key)))
(let ((v (entity-get-value key)))
(update-widget widget-type (get-symbol-id id-symbol) 'text
;; hide -1 as it represents unset
(if (and (number? v) (eqv? v -1))
"" v))))
((eq? widget-type 'toggle-button)
(update-widget widget-type (get-symbol-id id-symbol) 'checked
(entity-get-value key)))
......@@ -779,7 +830,7 @@
;; a standard builder for list widgets of entities and a
;; make new button, to add defaults to the list
(define (build-list-widget db table title entity-type edit-activity parent-fn ktv-default-fn)
(define (build-list-widget db table title title-ids entity-type edit-activity parent-fn ktv-default-fn)
(vert-colour
colour-two
(horiz
......@@ -794,7 +845,7 @@
(ktvlist-merge
(ktv-default-fn)
(list (ktv "parent" "varchar" (parent-fn)))))
(list (update-list-widget db table entity-type edit-activity (parent-fn))))))
(list (update-list-widget db table title-ids entity-type edit-activity (parent-fn))))))
(linear-layout
(make-id (string-append entity-type "-list"))
'vertical
......@@ -802,13 +853,28 @@
(list 0 0 0 0)
(list))))
(define (make-list-widget-title e title-ids)
(if (eqv? (length title-ids) 1)
(ktv-get e (car title-ids))
(string-append
(ktv-get e (car title-ids)) "\n"
(foldl
(lambda (id r)
(if (equal? r "")
(ktv-get e id)
(string-append r " " (ktv-get e id))))
"" (cdr title-ids)))))
;; 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 title-ids entity-type edit-activity parent)
(let ((search-results
(if parent
(db-filter-only db table entity-type
(list (list "parent" "varchar" "=" parent))
(list (list "name" "varchar")))
(map
(lambda (id)
(list id "varchar"))
title-ids))
(db-all db table entity-type))))
(update-widget
'linear-layout
......@@ -820,8 +886,8 @@
(lambda (e)
(button
(make-id (string-append "list-button-" (ktv-get e "unique_id")))
(or (ktv-get e "name") "Unamed item")
40 (layout 'fill-parent 'wrap-content 1 'centre 5)
(make-list-widget-title e title-ids)
30 (layout 'fill-parent 'wrap-content 1 'centre 5)
(lambda ()
(list (start-activity edit-activity 0 (ktv-get e "unique_id"))))))
search-results)))))
......@@ -1029,13 +1095,13 @@
(msg "making village" i)
(let ((village (simpsons-village db table village-ktvlist)))
(looper!
3
15
(lambda (i)
(alog "household")
(msg "making household" i)
(let ((household (simpsons-household db table village household-ktvlist)))
(looper!
(random 10)
(+ 2 (random 5))
(lambda (i)
(msg "making individual" i)
(simpsons-individual db table household individual-ktvlist))))))))))
......
......@@ -706,7 +706,7 @@
(define (relative rules colour . l)
(relative-layout
0 (rlayout 'fill-parent 'wrap-content 20 rules)
0 (rlayout 'fill-parent 'wrap-content (list 20 20 20 20) rules)
colour
l))
......@@ -795,7 +795,8 @@
((null? w) #f)
;; drill deeper
((eq? (update-widget-token w) 'contents)
(msg "updateing contents from callback")
(update-callbacks! (update-widget-value w)))
((eq? (update-widget-token w) 'contents-add)
(update-callbacks! (update-widget-value w)))
((eq? (update-widget-token w) 'grid-buttons)
(add-callback! (callback (update-widget-id w)
......@@ -862,6 +863,7 @@
(begin (display "no dialog called ")(display name)(newline))
(let ((events (apply (dialog-fn dialog) args)))
(update-dialogs! events)
(update-callbacks-from-update! events)
(send (scheme->json events))))))
;; called by java
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -71,7 +71,7 @@ public class starwisp extends StarwispActivity
ActivityManager.RegisterActivity("family",FamilyActivity.class);
ActivityManager.RegisterActivity("migration",MigrationActivity.class);
ActivityManager.RegisterActivity("income",IncomeActivity.class);
ActivityManager.RegisterActivity("geneaology",GeneaologyActivity.class);
ActivityManager.RegisterActivity("genealogy",GenealogyActivity.class);
ActivityManager.RegisterActivity("social",SocialActivity.class);
ActivityManager.RegisterActivity("friendship",FriendshipActivity.class);
ActivityManager.RegisterActivity("individual-chooser",IndividualChooserActivity.class);
......@@ -96,6 +96,8 @@ public class starwisp extends StarwispActivity
File filesdir = new File(m_AppDir+"/files/");
filesdir.mkdirs();
File backupdir = new File(m_AppDir+"/backup/");
backupdir.mkdirs();
// build static things
m_Scheme = new Scheme(this);
......
......@@ -86,3 +86,10 @@
(lambda (i)
(get-entity-only db table i kt-list))
(filter-entities db table type filter)))
;; only return (eg. name and photo)
(define (db-filter-only-inc-deleted db table type filter kt-list)
(map
(lambda (i)
(get-entity-only db table i kt-list))
(filter-entities-inc-deleted db table type filter)))
......@@ -86,6 +86,28 @@
(if typed "where e.entity_type = ? order by n.value"
"order by n.value")))
(define (build-query-inc-deleted table filter)
(string-append
(foldl
(lambda (i r)
(let ((var (string-append (filter-key i) "_var")))
;; add a query chunk
(string-append
r "join " table "_value_" (filter-type i) " "
"as " var " on "
var ".entity_id = e.entity_id and " var ".attribute_id = '" (filter-key i) "' and "
var ".value " (filter-op i) " ? ")))
;; boilerplate query start
(string-append
"select e.entity_id from " table "_entity as e "
;; order by name
"join " table "_value_varchar "
"as n on n.entity_id = e.entity_id and n.attribute_id = 'name' ")
filter)
"where e.entity_type = ? order by n.value"))
(define (build-args filter)
(map
(lambda (i)
......@@ -93,6 +115,23 @@
filter))
(define (filter-entities db table type filter)
(let ((q (build-query table filter)))
(let ((s (apply
db-select
(append
(list db q)
(build-args filter)
(list type)))))
(msg (db-status db))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s))))))
(define (filter-entities-inc-deleted db table type filter)
(let ((q (build-query-inc-deleted table filter)))
(let ((s (apply
db-select
(append
......@@ -105,4 +144,4 @@
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
(cdr s))))))
......@@ -65,7 +65,7 @@
;; add all the keys
(for-each
(lambda (ktv)
(insert-value db table id ktv dirty))
(insert-value db table id ktv (not (zero? dirty))))
ktvlist)
(db-exec db "end transaction")
......
......@@ -68,7 +68,8 @@
(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;"))))
(if (null? de)
'()
(map
......
......@@ -88,7 +88,7 @@
;;(msg ktv)
;;(msg entity-id)
(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 (string-append "update " table "_value_" (ktv-type ktv)
" set value=?, dirty=0 where entity_id = ? and attribute_id = ?")
......@@ -114,8 +114,8 @@
" where entity_id = ? and attribute_id = ?")
entity-id (ktv-key kt))))
(if (null? s) '()
(list (vector-ref (cadr s) 0)
(vector-ref (cadr s) 1)))))
(list (vector-ref (cadr s) 0)
(vector-ref (cadr s) 1)))))
(define (clean-value db table entity-id kt)
(db-exec db (string-append "update " table "_value_" (ktv-type kt)
......
......@@ -25,6 +25,13 @@
(ktv-value (car ktv-list)))
(else (ktv-get (cdr ktv-list) key))))
(define (ktv-get-whole ktv-list key)
(cond
((null? ktv-list) #f)
((equal? (ktv-key (car ktv-list)) key)
(car ktv-list))
(else (ktv-get-whole (cdr ktv-list) key))))
(define (ktv-get-type ktv-list key)
(cond
((null? ktv-list) #f)
......
<?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.symbaidb"
android:versionCode="1"
android:versionName="1.0">
<application android:label="@string/app_name"
android:icon="@drawable/logo"
android:theme="@style/StarwispTheme"
android:hardwareAccelerated="true"
>
<activity android:name="foam.symbaidb.starwisp"
android:configChanges="orientation"
android:label="@string/app_name">
<intent-filter>
<action android:name="android.intent.action.MAIN" />
<category android:name="android.intent.category.LAUNCHER" />
</intent-filter>
</activity>
<activity android:name="MainActivity" android:configChanges="orientation"></activity>
<activity android:name="ReviewItemActivity" android:configChanges="orientation"></activity>
</application>
<uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE" />
<uses-sdk android:minSdkVersion="8" />
<uses-feature android:name="android.hardware.camera" android:required="true" />
<supports-screens
android:smallScreens="true"
android:normalScreens="true"
android:largeScreens="true"
android:xlargeScreens="true"
android:anyDensity="true" />
</manifest>
Admin SQLite eavdb editor
=========================
#
# Set the keystore properties for signing the application.
#
#key.store=ushahidi-key.keystore
#key.alias=ushahidi-android
key.store=/home/dave/.keystore
key.alias=release_key
dave@fulmar.4670:1404729118
\ No newline at end of file
This diff is collapsed.
../../eavdb/
\ No newline at end of file
This diff is collapsed.
#lang racket
;; Starwisp Copyright (C) 2014 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; 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/>.
;; common code - require and provide ignored on tinyscheme
(require (planet jaymccarthy/sqlite:5:1/sqlite))
(require
"../web/scripts/utils.ss"
"../web/scripts/sql.ss"
"ktv.ss"
"ktv-list.ss"
"entity-values.ss"
"entity-insert.ss"
"entity-get.ss"
"entity-update.ss"
"entity-sync.ss"
"entity-filter.ss")
(provide (all-defined-out))
;; create eav tables (add types as required)
(define (setup db table)
(db-exec db (string-append "create table " table "_entity ( entity_id integer primary key autoincrement, entity_type varchar(256), unique_id varchar(256), dirty integer, version integer)"))
(db-exec db (string-append "create table " table "_attribute ( id integer primary key autoincrement, attribute_id varchar(256), entity_type varchar(256), attribute_type varchar(256))"))
(db-exec db (string-append "create table " table "_value_varchar ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer, version integer)"))
(db-exec db (string-append "create table " table "_value_int ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value integer, dirty integer, version integer)"))
(db-exec db (string-append "create table " table "_value_real ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value real, dirty integer, version integer)"))
(db-exec db (string-append "create table " table "_value_file ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer, version integer)")))
(define (db-open db-name)
(cond
((file-exists? (string->path db-name))
(display "open existing db")(newline)
(open (string->path db-name)))
(else
(display "making new db")(newline)
(let ((db (open (string->path db-name))))
;; todo, dynamically create these tables
(setup db "sync")
(setup db "stream")
db))))
(define (validate db)
;; check attribute for duplicate entity-id/attribute-ids
0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helpers
(define (db-all db table type)
(map
(lambda (i)
(get-entity db table i))
(all-entities db table type)))
(define (db-with-parent db table type parent)
(map
(lambda (i)
(get-entity db table i))
(all-entities-with-parent db table type parent)))
(define (db-filter db table type filter)
(map
(lambda (i)
(get-entity db table i))
(filter-entities db table type filter)))
;; Naked on Pluto Copyright (C) 2010 Aymeric Mansoux, Marloes de Valk, Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; 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/>.
#lang scheme
(require
"../web/scripts/utils.ss"
"../web/scripts/sql.ss"
"ktv.ss"
"ktv-list.ss"
"entity-values.ss"
"entity-get.ss")
(provide (all-defined-out))
(define (csv-titles db table entity-type)
(foldl
(lambda (kt r)
(if (equal? r "") (string-append "\"" (ktv-key kt) "\"")
(string-append r ", \"" (ktv-key kt) "\"")))
"id "
(get-attribute-ids/types db table entity-type)))
(define (csv db table entity-type)
(foldl
(lambda (res r)
(let ((entity (get-entity-for-csv db table (vector-ref res 0))))
(string-append
r "\n"
(foldl
(lambda (ktv r)
(cond
((equal? (ktv-key ktv) "unique_id") r)
((null? (ktv-value ktv))
(msg "value not found in csv for " (ktv-key ktv))
(string-append r ", NULL"))
;; dereferences lists of ids
((and
(> (string-length (ktv-key ktv)) 8)
(equal? (substring (ktv-key ktv) 0 8) "id-list-"))
(string-append r ", \"" (get-entity-names db "sync" (string-split (ktv-value ktv) '(#\,))) "\""))
;; look for unique ids and dereference them
((and
(> (string-length (ktv-key ktv)) 3)
(equal? (substring (ktv-key ktv) 0 3) "id-")
(not (equal? (ktv-value ktv) "none")))
(let ((name (get-entity-name db "sync" (ktv-value ktv))))
(if (null? name)
"\"nobody\""
(string-append r ", \"" name "\""))))
(else
(string-append r ", \"" (stringify-value-url ktv) "\""))))
(vector-ref res 1) ;; unique_id
entity))))
(csv-titles db table entity-type)
(cdr (db-select
db (string-append
"select entity_id, unique_id from "
table "_entity where entity_type = ?") entity-type))))
#lang racket
;; Starwisp Copyright (C) 2014 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; 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/>.
(require
"../web/scripts/utils.ss"
"../web/scripts/sql.ss"
"ktv.ss"
"ktv-list.ss"
"entity-values.ss"
"entity-insert.ss"
"entity-get.ss"
"entity-update.ss")
(provide (all-defined-out))
;; filter is list of (attribute-key type op arg) e.g. ("gender" "varchar" "=" "Female")
;; note: only one filter per key..
(define (make-filter k t o a) (list k t o a))
(define (filter-key f) (list-ref f 0))
(define (filter-type f) (list-ref f 1))
(define (filter-op f) (list-ref f 2))
(define (filter-arg f) (list-ref f 3))
(define (merge-filter f fl)
(cond
((null? fl) (list f))
((equal? (filter-key (car fl)) (filter-key f))
(cons f (cdr fl)))
(else (cons (car fl) (merge-filter f (cdr fl))))))
(define (delete-filter key fl)
(cond
((null? fl) '())
((equal? (filter-key (car fl)) key)
(cdr fl))
(else (cons (car fl) (delete-filter key (cdr fl))))))
(define (build-query table filter)
(string-append
(foldl
(lambda (i r)
(let ((var (string-append (filter-key i) "_var")))
;; add a query chunk
(string-append
r "join " table "_value_" (filter-type i) " "
"as " var " on "
var ".entity_id = e.entity_id and " var ".attribute_id = '" (filter-key i) "' and "
var ".value " (filter-op i) " ? ")))
;; boilerplate query start
(string-append
"select e.entity_id from " table "_entity as e "
;; order by name
"join " table "_value_varchar "
"as n on n.entity_id = e.entity_id and n.attribute_id = 'name' "
;; ignore deleted