first commit

AndroidManifest.xml

+<?xml version="1.0" encoding="utf-8"?>
+<manifest xmlns:android="http://schemas.android.com/apk/res/android"
+      package="foam.opensauces"
+      android:versionCode="2"
+      android:versionName="1.0">
+    <application android:label="@string/app_name"
+                 android:icon="@drawable/logo"
+                 android:hardwareAccelerated="true"
+                 >
+
+        <activity android:name="foam.starwisp.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>
+
+    </application>
+
+    <uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE" />
+    <uses-permission android:name="android.permission.CHANGE_WIFI_STATE" />
+    <uses-permission android:name="android.permission.ACCESS_WIFI_STATE" />
+    <uses-permission android:name="android.permission.INTERNET"/>
+    <uses-permission android:name="android.permission.VIBRATE"/>
+    <uses-permission android:name="android.permission.ACCESS_FINE_LOCATION" />
+    <uses-permission android:name="android.permission.ACCESS_COURSE_LOCATION" />
+    <uses-sdk android:minSdkVersion="8" />
+
+    <supports-screens
+        android:smallScreens="true"
+        android:normalScreens="true"
+        android:largeScreens="true"
+        android:xlargeScreens="true"
+        android:anyDensity="true" />
+
+</manifest>

README.md

+Open Sauces Notebook
+====================
+
+A structured notebook for recipes

ant.properties

+#
+# 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

assets/eavdb.scm

+;; MongooseWeb Copyright (C) 2013 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/>.
+
+;; android/racket stuff
+(define db-select db-exec)
+
+;; racket
+;(define db-exec exec/ignore)
+;(define db-select select)
+;(define db-insert insert)
+;(define (db-status) "")
+;(define (time) (list 0 0))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; entity-attribut-value system for sqlite
+;;
+
+
+;; 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)"))
+  (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)"))
+  (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)")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; basic key/type/value structure
+(define (ktv key type value) (list key type value))
+(define ktv-key car)
+(define ktv-type cadr)
+(define ktv-value caddr)
+
+;; stringify based on type (for url)
+(define (stringify-value ktv)
+  (cond
+   ((null? (ktv-value ktv)) "NULL")
+   ((equal? (ktv-type ktv) "varchar") (string-append "'" (ktv-value ktv) "'"))
+   (else
+    (if (not (string? (ktv-value ktv)))
+        (number->string (ktv-value ktv))
+        (ktv-value ktv)))))
+
+;; stringify based on type (for url)
+(define (stringify-value-url ktv)
+  (cond
+   ((null? (ktv-value ktv)) "NULL")
+   ((equal? (ktv-type ktv) "varchar") (ktv-value ktv))
+   (else
+    (if (not (string? (ktv-value ktv)))
+        (number->string (ktv-value ktv))
+        (ktv-value ktv)))))
+
+
+;; helper to return first instance from a select
+(define (select-first db str . args)
+  (let ((s (apply db-select (append (list db str) args))))
+    (if (or (null? s) (eq? s #t))
+        '()
+        (vector-ref (cadr s) 0))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; putting data in
+
+;; get the type from the attribute table with an entity/key
+(define (get-attribute-type db table entity-type key)
+  (let ((sql (string-append
+              "select attribute_type from " table
+              "_attribute where entity_type = ? and attribute_id = ?")))
+    (select-first db sql entity-type key)))
+
+;; search for a type and add it if it doesn't exist
+(define (find/add-attribute-type db table entity-type key type)
+  (let ((t (get-attribute-type db table entity-type key)))
+    ;; add and return passed in type if not exist
+    (cond
+      ((null? t)
+       (msg "adding new attribute for" entity-type " called " key " of type " type)
+       (db-insert
+        db (string-append "insert into " table "_attribute values (null, ?, ?, ?)")
+        key entity-type type)
+       type)
+      (else
+       (cond
+         ((equal? type t) t)
+         (else
+          (msg "type has changed for" entity-type key "from" t "to" type "???")
+          ;; wont work
+          ;; what do we do?
+          ;; some kind of coercion for existing data???
+          type))))))
+
+;; low level insert of a ktv
+(define (insert-value db table entity-id ktv)
+  ;; use type to dispatch insert to correct value table
+  (db-insert db (string-append "insert into " table "_value_" (ktv-type ktv)
+                               " values (null, ?, ?, ?, 0)")
+             entity-id (ktv-key ktv) (ktv-value ktv)))
+
+(define (get-unique user)
+  (let ((t (time)))
+    (string-append
+     user "-" (number->string (car t)) ":" (number->string (cadr t)))))
+
+;; insert an entire entity
+(define (insert-entity db table entity-type user ktvlist)
+  (insert-entity-wholesale db table entity-type (get-unique user) 1 0 ktvlist))
+
+;; insert an entire entity
+(define (insert-entity/get-unique db table entity-type user ktvlist)
+  (let ((uid (get-unique user)))
+    (insert-entity-wholesale db table entity-type uid 1 0 ktvlist)
+    uid))
+
+;; all the parameters - for syncing purposes
+(define (insert-entity-wholesale db table entity-type unique-id dirty version ktvlist)
+  (let ((id (db-insert
+             db (string-append
+                 "insert into " table "_entity values (null, ?, ?, ?, ?)")
+             entity-type unique-id dirty version)))
+    ;; create the attributes if they are new, and validate them if they exist
+    (for-each
+     (lambda (ktv)
+       (find/add-attribute-type db table entity-type (ktv-key ktv) (ktv-type ktv)))
+     ktvlist)
+    ;; add all the keys
+    (for-each
+     (lambda (ktv)
+       (insert-value db table id ktv))
+     ktvlist)
+    id))
+
+
+;; 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
+(define (update-value db table entity-id ktv)
+  (if (null? (select-first
+              db (string-append
+                  "select * from " table "_value_" (ktv-type ktv) " where entity_id = ? and attribute_id = ?")
+              entity-id (ktv-key ktv)))
+      (insert-value db table entity-id ktv)
+      (db-exec
+       db (string-append "update " table "_value_" (ktv-type ktv)
+                         " set value=?  where entity_id = ? and attribute_id = ?")
+       (ktv-value ktv) entity-id (ktv-key ktv))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; getting data out
+
+(define (entity-exists? db table unique-id)
+  (not (null? (select-first
+               db (string-append
+                   "select * from " table "_entity where unique_id = ?")
+               unique-id))))
+
+(define (get-entity-type db table entity-id)
+  (select-first
+   db (string-append
+       "select entity_type from " table "_entity where entity_id = ?")
+       entity-id))
+
+(define (get-all-entity-types db table)
+  (cdr (db-select db (string-append "select distinct entity_type from " table "_entity;"))))
+
+;; get all the (current) attributes for an entity type
+(define (get-attribute-ids/types db table entity-type)
+  (let ((s (db-select
+            db (string-append
+                "select * from " table "_attribute where entity_type = ?")
+                entity-type)))
+    (if (null? s) '()
+        (map
+         (lambda (row)
+           (list (vector-ref row 1)    ;; id
+                 (vector-ref row 3)))  ;; type
+         (cdr s)))))
+
+;; get the value given an entity type, a attribute type and it's key (= attriute_id)
+(define (get-value db table entity-id kt)
+  (select-first
+   db (string-append "select value from " table "_value_" (ktv-type kt)
+                     " where entity_id = ? and attribute_id = ?")
+   entity-id (ktv-key kt)))
+
+;; get an entire entity, as a list of key/value pairs
+(define (get-entity-plain db table entity-id)
+  (let* ((entity-type (get-entity-type db table entity-id)))
+    (cond
+      ((null? entity-type) (msg "entity" entity-id "not found!") '())
+      (else
+       (map
+        (lambda (kt)
+          (list (ktv-key kt) (ktv-type kt) (get-value db table entity-id kt)))
+        (get-attribute-ids/types db table entity-type))))))
+
+;; get an entire entity, as a list of key/value pairs (includes entity id)
+(define (get-entity db table entity-id)
+  (let ((unique-id (get-unique-id db table entity-id)))
+    (cons
+     (list "unique_id" "varchar" unique-id)
+     (get-entity-plain db table entity-id))))
+
+(define (all-entities db table type)
+  (let ((s (db-select
+            db (string-append "select e.entity_id from " table "_entity as e "
+                              "join " table "_value_varchar "
+                              " as n on n.entity_id = e.entity_id "
+                              "where entity_type = ? and n.attribute_id = ? order by n.value")
+            type "name")))
+    (msg (db-status db))
+    (if (null? s)
+        '()
+        (map
+         (lambda (i)
+           (vector-ref i 0))
+         (cdr s)))))
+
+(define (all-entities-where db table type ktv)
+  (let ((s (db-select
+            db (string-append
+                "select e.entity_id from " table "_entity as e "
+                "join " table "_value_" (ktv-type ktv)
+                " as a on a.entity_id = e.entity_id "
+                "join " table "_value_varchar "
+                " as n on n.entity_id = e.entity_id "
+                "where e.entity_type = ? and a.attribute_id = ? "
+                "and a.value = ? and n.attribute_id = ? order by n.value")
+            type (ktv-key ktv) (ktv-value ktv) "name")))
+    (msg (db-status db))
+    (if (null? s)
+        '()
+        (map
+         (lambda (i)
+           (vector-ref i 0))
+         (cdr s)))))
+
+(define (all-entities-where2 db table type ktv ktv2)
+  (let ((s (db-select
+            db (string-append
+                "select e.entity_id from " table "_entity as e "
+                "join " table "_value_" (ktv-type ktv)
+                " as a on a.entity_id = e.entity_id "
+                "join " table "_value_" (ktv-type ktv2)
+                " as b on b.entity_id = e.entity_id "
+                "where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and b.value = ? ")
+            type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2))))
+    (msg (db-status db))
+    (if (null? s)
+        '()
+        (map
+         (lambda (i)
+           (vector-ref i 0))
+         (cdr s)))))
+
+(define (all-entities-where2or db table type ktv ktv2 or-value)
+  (let ((s (db-select
+            db (string-append
+                "select e.entity_id from " table "_entity as e "
+                "join " table "_value_" (ktv-type ktv)
+                " as a on a.entity_id = e.entity_id "
+                "join " table "_value_" (ktv-type ktv2)
+                " as b on b.entity_id = e.entity_id "
+                "where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and (b.value = ? or b.value = ?) ")
+            type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2) or-value)))
+    (msg (db-status db))
+    (if (null? s)
+        '()
+        (map
+         (lambda (i)
+           (vector-ref i 0))
+         (cdr s)))))
+
+(define (all-entities-where-newer db table type ktv ktv2)
+  (let ((s (db-select
+            db (string-append
+                "select e.entity_id from " table "_entity as e "
+                "join " table "_value_" (ktv-type ktv)
+                " as a on a.entity_id = e.entity_id "
+                "join " table "_value_" (ktv-type ktv2)
+                " as b on b.entity_id = e.entity_id "
+                "where e.entity_type = ? "
+                "and a.attribute_id = ? and a.value = ? "
+                "and b.attribute_id = ? and (b.value > DateTime(?) and b.value != ?)"
+                )
+            type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2) "Unknown")))
+    (msg "date select" (db-status db))
+    (if (null? s)
+        '()
+        (map
+         (lambda (i)
+           (vector-ref i 0))
+         (cdr s)))))
+
+(define (all-entities-where-older db table type ktv ktv2)
+  (let ((s (db-select
+            db (string-append
+                "select e.entity_id from " table "_entity as e "
+                "join " table "_value_" (ktv-type ktv)
+                " as a on a.entity_id = e.entity_id "
+                "join " table "_value_" (ktv-type ktv2)
+                " as b on b.entity_id = e.entity_id "
+                "where e.entity_type = ? "
+                "and a.attribute_id = ? and a.value = ? "
+                "and b.attribute_id = ? and (b.value < DateTime(?) or b.value = ?)"
+                )
+            type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2) "Unknown")))
+    (msg "date select" (db-status db))
+    (if (null? s)
+        '()
+        (map
+         (lambda (i)
+           (vector-ref i 0))
+         (cdr s)))))
+
+(define (update-entities-where2 db table type ktv ktv2)
+  (let ((s (db-select
+            db (string-append
+                "select e.entity_id from " table "_entity as e "
+                "join " table "_value_" (ktv-type ktv)
+                " as a on a.entity_id = e.entity_id "
+                "join " table "_value_" (ktv-type ktv2)
+                " as b on b.entity_id = e.entity_id "
+                "where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and b.value = ? ")
+            type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2))))
+    (msg (db-status db))
+    (if (null? s)
+        '()
+        (map
+         (lambda (i)
+           (vector-ref i 0))
+         (cdr s)))))
+
+(define (validate db)
+  ;; check attribute for duplicate entity-id/attribute-ids
+  0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; helpers
+
+(define (ktv-get ktv-list key)
+  (cond
+   ((null? ktv-list) #f)
+   ((equal? (ktv-key (car ktv-list)) key)
+    (ktv-value (car ktv-list)))
+   (else (ktv-get (cdr ktv-list) key))))
+
+(define (ktv-set ktv-list ktv)
+  (cond
+   ((null? ktv-list) (list ktv))
+   ((equal? (ktv-key (car ktv-list)) (ktv-key ktv))
+    (cons ktv (cdr ktv-list)))
+   (else (cons (car ktv-list) (ktv-set (cdr ktv-list) ktv)))))
+
+
+(define (db-all db table type)
+  (prof-start "db-all")
+  (let ((r (map
+   (lambda (i)
+     (get-entity db table i))
+   (all-entities db table type))))
+    (prof-end "db-all")
+    r))
+
+;(define (db-all-where db table type clause)
+;  (prof-start "db-all-where")
+;  (let ((r (foldl
+;            (lambda (i r)
+;              (let ((e (get-entity db table i)))
+;                (if (equal? (ktv-get e (car clause)) (cadr clause))
+;                    (cons e r) r)))
+;            '()
+;            (all-entities db table type))))
+;    (prof-end "db-all-where")
+;    r))
+
+(define (db-all-where db table type ktv)
+  (prof-start "db-all-where")
+  (let ((r (map
+            (lambda (i)
+              (get-entity db table i))
+            (all-entities-where db table type ktv))))
+    (prof-end "db-all-where")
+    r))
+
+(define (db-all-where2 db table type ktv ktv2)
+  (prof-start "db-all-where2")
+  (let ((r (map
+            (lambda (i)
+              (get-entity db table i))
+            (all-entities-where2 db table type ktv ktv2))))
+    (prof-end "db-all-where2")
+    r))
+
+(define (db-all-where2or db table type ktv ktv2 or-value)
+  (prof-start "db-all-where2or")
+  (let ((r (map
+            (lambda (i)
+              (get-entity db table i))
+            (all-entities-where2or db table type ktv ktv2 or-value))))
+    (prof-end "db-all-where2or")
+    r))
+
+(define (db-all-newer db table type ktv ktv2)
+  (prof-start "db-all-where newer")
+  (let ((r (map
+            (lambda (i)
+              (get-entity db table i))
+            (all-entities-where-newer db table type ktv ktv2))))
+    (prof-end "db-all-where newer")
+    r))
+
+(define (db-all-older db table type ktv ktv2)
+  (prof-start "db-all-where older")
+  (let ((r (map
+            (lambda (i)
+              (get-entity db table i))
+            (all-entities-where-older db table type ktv ktv2))))
+    (prof-end "db-all-where older")
+    r))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; updating data
+
+;; update an entire entity (version incl), via a (possibly partial) list of key/value pairs
+(define (update-to-version db table entity-id version ktvlist)
+  (update-entity-values db table entity-id ktvlist)
+  (update-entity-version db table entity-id version))
+
+;; auto update version
+(define (update-entity db table entity-id ktvlist)
+  (update-entity-changed db table entity-id)
+  (update-entity-values db table entity-id ktvlist))
+
+;; update an entity, via a (possibly partial) list of key/value pairs
+(define (update-entity-values db table entity-id ktvlist)
+  (let* ((entity-type (get-entity-type db table entity-id)))
+    (cond
+     ((null? entity-type) (msg "entity" entity-id "not found!") '())
+     (else
+      ;; update main entity type
+      (for-each
+       (lambda (ktv)
+         (when (not (equal? (ktv-key ktv) "unique_id"))
+               (find/add-attribute-type db table entity-type (ktv-key ktv) (ktv-type ktv))))
+       ktvlist)
+      (for-each
+       (lambda (ktv)
+         (update-value db table entity-id ktv))
+       ktvlist)))))
+
+;; update or create an entire entity if it doesn't exist
+;; will return the new entity id if it's created
+(define (update/insert-entity db table entity-type user entity-id ktvlist)
+  (let* ((entity-type (get-entity-type db table entity-id)))
+    (cond
+     ((null? entity-type)
+      (insert-entity db table entity-type user ktvlist))
+     (else
+      (update-entity db table entity-id ktvlist)
+      #f))))
+
+(define (insert-entity-if-not-exists db table entity-type user entity-id ktvlist)
+  (let ((found (get-entity-type db table entity-id)))
+    (if (null? found)
+        (insert-entity db table entity-type user ktvlist)
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; versioning
+
+(define (get-entity-version db table entity-id)
+  (select-first
+   db (string-append "select version from " table "_entity where entity_id = ?")
+   entity-id))
+
+(define (get-entity-dirty db table entity-id)
+  (select-first
+   db (string-append "select dirty from " table "_entity where entity_id = ?")
+   entity-id))
+
+(define (update-entity-changed db table entity-id)
+  (db-exec
+   db (string-append
+       "update " table "_entity set dirty=?, version=? where entity_id = ?")
+   1 (+ 1 (get-entity-version db table entity-id)) entity-id))
+
+(define (update-entity-version db table entity-id version)
+  (db-exec
+   db (string-append
+       "update " table "_entity set dirty=?, version=? where entity_id = ?")
+   1 version entity-id))
+
+(define (update-entity-clean db table unique-id)
+  (db-exec
+   db (string-append "update " table "_entity set dirty=? where unique_id = ?")
+   0 unique-id))
+
+(define (get-dirty-stats db table)
+  (list
+   (select-first
+    db (string-append "select count(entity_id) from " table "_entity where dirty=1"))
+   (select-first
+    db (string-append "select count(entity_id) from " table "_entity;"))))
+
+(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;"))))
+    (if (null? de)
+        '()
+        (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 (vector-ref i 0))))
+         (cdr de)))))
+
+(define (dirty-and-all-entities db table)
+  (let ((de (db-select
+             db (string-append
+                 "select entity_id, entity_type, unique_id, dirty, version from " table "_entity"))))
+    (if (null? de)
+        '()
+        (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 (vector-ref i 0))))
+         (cdr de)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; syncing
+
+(define (stringify-list l)
+  (foldl
+   (lambda (i r)