︙ | | | ︙ | |
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
;; (dartifact->alist
;; (car (get-dartifacts db #f 0 #f))
;; '((foods (fruit . f)
;; (meat . m)))))
;; => "beef"
;;
(module artifacts
(
;; cards, util and misc
;; sort-cards
;; calc-sha1
;;
;; low-level constructor procs, exposed only for development/testing, will be removed
|
>
>
|
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
;; (dartifact->alist
;; (car (get-dartifacts db #f 0 #f))
;; '((foods (fruit . f)
;; (meat . m)))))
;; => "beef"
;;
;; NOTE: We call artifacts "arfs"
(module artifacts
(
;; cards, util and misc
;; sort-cards
;; calc-sha1
;;
;; low-level constructor procs, exposed only for development/testing, will be removed
|
︙ | | | ︙ | |
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
dartifacts->alists ;; apply dartifact->alist to a list of alists using a artifact-spec
alist->artifact ;; returns two values uuid, artifact
get-value ;; looks up a value given a key in a dartifact
flatten-all ;; merge the list of values from a query which includes a artifact into a flat alist <== really useful!
check-artifact
;; artifact alists
write-alist->artifact
read-artifact->alist
;; archive database
;; archive-open-db
;; write-archive-artifacts
;; archive-artifacts
|
>
|
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
dartifacts->alists ;; apply dartifact->alist to a list of alists using a artifact-spec
alist->artifact ;; returns two values uuid, artifact
get-value ;; looks up a value given a key in a dartifact
flatten-all ;; merge the list of values from a query which includes a artifact into a flat alist <== really useful!
check-artifact
;; artifact alists
get-artifact-fname
write-alist->artifact
read-artifact->alist
;; archive database
;; archive-open-db
;; write-archive-artifacts
;; archive-artifacts
|
︙ | | | ︙ | |
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
write-bundle
read-bundle
;; new artifacts db
with-todays-adb
get-all-artifacts
refresh-artifacts-db
)
(import (chicken base) scheme (chicken process) (chicken time posix)
(chicken io) (chicken file) (chicken pathname)
chicken.process-context.posix (chicken string)
(chicken time) (chicken sort) (chicken file posix) (chicken condition) srfi-1
regex srfi-13 srfi-69 (chicken port) (chicken process-context)
crypt sha1 matchable message-digest sqlite3 typed-records
directory-utils
scsh-process)
;;======================================================================
;; DATA MANIPULATION UTILS
;;======================================================================
(define-inline (unescape-data data)
(string-translate* data '(("\\n" . "\n") ("\\\\" . "\\"))))
|
|
|
>
>
>
|
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
write-bundle
read-bundle
;; new artifacts db
with-todays-adb
get-all-artifacts
refresh-artifacts-db
)
(import scheme)
(cond-expand
(chicken-5
(import (chicken base)
(chicken process) (chicken time posix)
(chicken io) (chicken file) (chicken pathname)
chicken.process-context.posix (chicken string)
(chicken time) (chicken sort) (chicken file posix) (chicken condition)
(chicken port) (chicken process-context)
))
(chicken-4
(import chicken
posix
data-structures
extras
ports
files
setup-api
)
(define file-executable? file-execute-access?))
(else))
(import srfi-69 srfi-1
regex srfi-13 srfi-69
crypt sha1 matchable message-digest sqlite3 typed-records
directory-utils
scsh-process)
;;======================================================================
;; DATA MANIPULATION UTILS
;;======================================================================
(define-inline (unescape-data data)
(string-translate* data '(("\\n" . "\n") ("\\\\" . "\\"))))
|
︙ | | | ︙ | |
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
|
;;======================================================================
;; Read/write packets to files (convience functions)
;;======================================================================
;; write alist to a artifact file
;;
(define (write-alist->artifact targdir dat #!key (artifactspec '())(ptype #f))
(let-values (((uuid artifact)(alist->artifact dat artifactspec ptype: ptype)))
(with-output-to-file (conc targdir "/" uuid ".artifact")
(lambda ()
(print artifact)))
uuid)) ;; return the uuid
;; read artifact into alist
;;
(define (read-artifact->alist artifact-file #!key (artifactspec #f))
|
>
>
>
|
|
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
|
;;======================================================================
;; Read/write packets to files (convience functions)
;;======================================================================
(define (get-artifact-fname targdir uuid)
(conc targdir "/" uuid ".artifact"))
;; write alist to a artifact file
;;
(define (write-alist->artifact targdir dat #!key (artifactspec '())(ptype #f))
(let-values (((uuid artifact)(alist->artifact dat artifactspec ptype: ptype)))
(with-output-to-file (get-artifact-fname targdir uuid)
(lambda ()
(print artifact)))
uuid)) ;; return the uuid
;; read artifact into alist
;;
(define (read-artifact->alist artifact-file #!key (artifactspec #f))
|
︙ | | | ︙ | |