Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
nebogeo
symbai
Commits
ad856dbd
Commit
ad856dbd
authored
Apr 03, 2014
by
Dave Griffiths
Browse files
added custom programmatic filtering ORM hack
parent
a01cb026
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
150 additions
and
81 deletions
+150
-81
android/assets/dbsync.scm
android/assets/dbsync.scm
+64
-0
android/assets/eavdb.scm
android/assets/eavdb.scm
+61
-0
android/assets/starwisp.scm
android/assets/starwisp.scm
+25
-81
No files found.
android/assets/dbsync.scm
View file @
ad856dbd
...
...
@@ -604,3 +604,67 @@
'text-view
(
get-id
(
string-append
(
symbol->string
display-id
)
"-lon"
))
'text
(
number->string
(
entity-get-value
(
string-append
key-prepend
"-lon"
))
"real"
0
))))
;; 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
)
(
vert-colour
colour-two
(
horiz
(
mtitle-scale
title
)
(
button
(
make-id
(
string-append
(
symbol->string
title
)
"-add"
))
(
mtext-lookup
'add-item-to-list
)
40
(
layout
100
'wrap-content
1
'centre
5
)
(
lambda
()
(
entity-init!
db
table
entity-type
ktv-default
)
(
entity-add-value!
"parent"
"varchar"
(
parent-fn
))
(
entity-record-values!
)
(
list
(
update-list-widget
db
table
entity-type
edit-activity
(
parent-fn
))))))
(
linear-layout
(
make-id
(
string-append
entity-type
"-list"
))
'vertical
(
layout
'fill-parent
'wrap-content
1
'centre
20
)
(
list
0
0
0
0
)
(
list
))))
;; pull db data into list of button widgets
(
define
(
update-list-widget
db
table
entity-type
edit-activity
parent
)
(
let
((
search-results
(
if
parent
(
db-with-parent
db
table
entity-type
parent
)
(
db-all
db
table
entity-type
))))
(
update-widget
'linear-layout
(
get-id
(
string-append
entity-type
"-list"
))
'contents
(
if
(
null?
search-results
)
(
list
(
mtext
'list-empty
))
(
map
(
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
)
(
lambda
()
(
msg
"sending start act"
(
ktv-get
e
"unique_id"
))
(
list
(
start-activity
edit-activity
0
(
ktv-get
e
"unique_id"
))))))
search-results
)))))
(
define
(
delete-button
)
(
mbutton
'delete
(
lambda
()
(
list
(
alert-dialog
"delete-check"
(
mtext-lookup
'delete-are-you-sure
)
(
lambda
(
v
)
(
cond
((
eqv?
v
1
)
(
entity-add-value!
"deleted"
"int"
1
)
(
entity-update-values!
)
(
list
(
finish-activity
1
)))
(
else
(
list
)))))))))
android/assets/eavdb.scm
View file @
ad856dbd
...
...
@@ -256,6 +256,62 @@
(
cdr
s
)))))
;; 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
(
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
"join "
table
"_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' and "
"d.value = 0 "
)
filter
)
"order by n.value"
))
(
define
(
build-args
filter
)
(
map
(
lambda
(
i
)
(
filter-arg
i
))
filter
))
(
define
(
filter-entities
db
table
type
filter
)
(
let
((
s
(
apply
db-select
(
dbg
(
append
(
list
db
(
build-query
table
filter
))
(
build-args
filter
))))))
(
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
...
...
@@ -297,6 +353,11 @@
(
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
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data
...
...
android/assets/starwisp.scm
View file @
ad856dbd
...
...
@@ -401,70 +401,6 @@
(
spacer
5
)
(
build-fragment
"bottom"
(
make-id
"bottom"
)
fillwrap
)))))
;; 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
)
(
vert-colour
colour-two
(
horiz
(
mtitle-scale
title
)
(
button
(
make-id
(
string-append
(
symbol->string
title
)
"-add"
))
(
mtext-lookup
'add-item-to-list
)
40
(
layout
100
'wrap-content
1
'centre
5
)
(
lambda
()
(
entity-init!
db
table
entity-type
ktv-default
)
(
entity-add-value!
"parent"
"varchar"
(
parent-fn
))
(
entity-record-values!
)
(
list
(
update-list-widget
db
table
entity-type
edit-activity
(
parent-fn
))))))
(
linear-layout
(
make-id
(
string-append
entity-type
"-list"
))
'vertical
(
layout
'fill-parent
'wrap-content
1
'centre
20
)
(
list
0
0
0
0
)
(
list
))))
;; pull db data into list of button widgets
(
define
(
update-list-widget
db
table
entity-type
edit-activity
parent
)
(
let
((
search-results
(
if
parent
(
db-with-parent
db
table
entity-type
parent
)
(
db-all
db
table
entity-type
))))
(
update-widget
'linear-layout
(
get-id
(
string-append
entity-type
"-list"
))
'contents
(
if
(
null?
search-results
)
(
list
(
mtext
'list-empty
))
(
map
(
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
)
(
lambda
()
(
msg
"sending start act"
(
ktv-get
e
"unique_id"
))
(
list
(
start-activity
edit-activity
0
(
ktv-get
e
"unique_id"
))))))
search-results
)))))
(
define
(
delete-button
)
(
mbutton
'delete
(
lambda
()
(
list
(
alert-dialog
"delete-check"
(
mtext-lookup
'delete-are-you-sure
)
(
lambda
(
v
)
(
cond
((
eqv?
v
1
)
(
entity-add-value!
"deleted"
"int"
1
)
(
entity-update-values!
)
(
list
(
finish-activity
1
)))
(
else
(
list
)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; activities
...
...
@@ -481,21 +417,7 @@
(
mbutton-scale
'sync
(
lambda
()
(
list
(
start-activity
"sync"
0
""
)))))
(
mspinner
'languages
(
list
'english
'khasi
'hindi
)
(
lambda
(
c
)
(
list
)))
(
mbutton
'test-upload
(
lambda
()
(
list
(
network-connect
"network"
"mongoose-web"
(
lambda
(
state
)
(
msg
state
)
(
if
(
equal?
state
"Connected"
)
(
list
(
http-upload
"test-upload"
"http://192.168.2.1:8889/symbai?fn=upload"
"/sdcard/symbai/photo.jpg"
))
'
()))
))))
(
mbutton
'find-individual
(
lambda
()
(
list
(
start-activity
"individual-chooser"
0
""
))))
(
build-list-widget
db
"sync"
'villages
"village"
"village"
(
lambda
()
#f
)
(
list
...
...
@@ -639,7 +561,7 @@
(
ktv
"tribe"
"varchar"
"none"
)
(
ktv
"subtribe"
"varchar"
"none"
)
(
ktv
"age"
"int"
0
)
(
ktv
"gender"
"varchar"
"
f
emale"
)
(
ktv
"gender"
"varchar"
"
F
emale"
)
(
ktv
"education"
"varchar"
"none"
)
(
ktv
"head-of-house"
"varchar"
"none"
)
(
ktv
"marital-status"
"varchar"
"none"
)
...
...
@@ -700,7 +622,9 @@
(
image-view
(
make-id
"photo"
)
"face"
(
layout
240
320
-1
'centre
10
))
(
vert
(
mtext
'name-display
)
(
spacer
20
)
(
mtext
'family-display
)
(
spacer
20
)
(
mtext
'photo-id-display
)))
(
mbutton
'agreement-button
(
lambda
()
(
list
(
start-activity
"agreement"
0
""
))))
(
horiz
...
...
@@ -977,11 +901,31 @@
(
activity
"individual-chooser"
(
build-activity
(
vert
(
linear-layout
(
make-id
"choose-pics"
)
'vertical
(
layout
'fill-parent
'wrap-content
0.75
'centre
0
)
(
list
0
0
0
0
)
(
list
))
(
mtext
'filter-stuff
))
)
(
lambda
(
activity
arg
)
(
set-current!
'activity-title
"Individual chooser"
)
(
activity-layout
activity
))
(
lambda
(
activity
arg
)
'
())
(
lambda
(
activity
arg
)
(
list
(
update-widget
'linear-layout
(
get-id
"choose-pics"
)
'contents
(
map
(
lambda
(
e
)
(
msg
(
ktv-get
e
"gender"
))
(
let
((
gender
(
ktv-get
e
"gender"
)))
(
text-view
(
make-id
(
string-append
"chooser-"
(
ktv-get
e
"unique_id"
)))
(
string-append
(
ktv-get
e
"unique_id"
)
": "
(
if
(
null?
gender
)
"not set"
gender
))
30
(
layout
'wrap-content
'wrap-content
1
'centre
5
))))
(
db-filter
db
"sync"
"individual"
(
list
(
make-filter
"gender"
"varchar"
"="
"female"
)))))))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment