Commit bdbc3d86 authored by dave griffiths's avatar dave griffiths
Browse files

rpi changes

parent df7416c2
......@@ -116,7 +116,7 @@
;; exporting human editable reports
(define (deref-entity entity)
(define (deref-entity db entity)
(foldl
(lambda (ktv r)
(append
......@@ -163,34 +163,48 @@
(dbg (string-append r row-text "\n"))))
"" l))
;; meant to be general, but made for pup focal reports
(define (export-csv db table parent-entity entity-types)
(let* ((focal (get-entity db "sync" (get-entity-id db "sync" (ktv-get parent-entity "id-focal-subject"))))
(pack (get-entity db "sync" (get-entity-id db "sync" (ktv-get focal "pack-id")))))
(csvify
(cons
'("time" "user" "pack" "subject" "observation type" "key" "value" "key" "value")
(sort
(define (ktv-filter ktv-list key)
(filter
(lambda (ktv)
(not (equal? (ktv-key ktv) key)))
ktv-list))
(define (ktv-filter-many ktv-list key-list)
(foldl
(lambda (entity-type r)
(append
r (map
(lambda (entity)
(append
(list
(ktv-get entity "time")
(ktv-get entity "user")
(ktv-get pack "name")
(ktv-get focal "name")
entity-type)
(deref-entity
(ktv-filter-many
entity (list "user" "unique_id" "parent" "time")))))
(db-all-with-parent
db table entity-type
(ktv-get parent-entity "unique_id")))))
'()
entity-types)
(lambda (a b)
(string<? (car a) (car b))))))))
(lambda (key r)
(ktv-filter r key))
ktv-list
key-list))
;; meant to be general, but made for pup focal reports
;(define (export-csv db table parent-entity entity-types)
; (let* ((focal (get-entity db "sync" (get-entity-id db "sync" (ktv-get parent-entity "id-focal-subject"))))
; (pack (get-entity db "sync" (get-entity-id db "sync" (ktv-get focal "pack-id")))))
; (csvify
; (cons
; '("time" "user" "pack" "subject" "observation type" "key" "value" "key" "value")
; (sort
; (foldl
; (lambda (entity-type r)
; (append
; r (map
; (lambda (entity)
; (append
; (list
; (ktv-get entity "time")
; (ktv-get entity "user")
; (ktv-get pack "name")
; (ktv-get focal "name")
; entity-type)
; (deref-entity
; db (ktv-filter-many
; entity (list "user" "unique_id" "parent" "time")))))
; (db-all-with-parent
; db table entity-type
; (ktv-get parent-entity "unique_id")))))
; '()
; entity-types)
; (lambda (a b)
; (string<? (car a) (car b))))))))
......@@ -51,18 +51,20 @@
(define sema (make-semaphore 1))
(define (syncro-try fn)
(msg "s-start")
(if (semaphore-try-wait? sema)
(let ((r (fn)))
(msg "s-end")
(semaphore-post sema)
r)
(begin
(msg "couldn't get lock")
(pluto-response (scheme->txt '("fail"))))))
(define (syncro fn)
(fn))
; (msg "s-start")
; (if (semaphore-try-wait? sema)
; (let ((r (fn)))
; (msg "s-end")
; (semaphore-post sema)
; r)
; (begin
; (msg "couldn't get lock")
; (pluto-response (scheme->txt '("fail"))))))
(define (syncro-new fn)
(msg "s-start")
(semaphore-wait sema)
(let ((r (fn)))
......
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