1 ! Copyright (C) 2014 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.data alien.strings arrays
4 byte-arrays classes.struct combinators constructors
5 continuations destructors forestdb.ffi forestdb.paths fry
6 generalizations io.encodings.string io.encodings.utf8
7 io.pathnames kernel libc math multiline namespaces sequences
14 ! Get byseq ignores seqnum and uses key instead if key is set
17 ERROR: fdb-error error ;
19 : fdb-check-error ( ret -- )
20 dup FDB_RESULT_SUCCESS = [ drop ] [ fdb-error ] if ;
23 TUPLE: fdb-kvs-handle < disposable handle ;
24 : <fdb-kvs-handle> ( handle -- obj )
25 fdb-kvs-handle new-disposable
26 swap >>handle ; inline
28 M: fdb-kvs-handle dispose*
29 handle>> fdb_kvs_close fdb-check-error ;
32 TUPLE: fdb-file-handle < disposable handle ;
33 : <fdb-file-handle> ( handle -- obj )
34 fdb-file-handle new-disposable
35 swap >>handle ; inline
37 M: fdb-file-handle dispose*
38 handle>> fdb_close fdb-check-error ;
41 SYMBOL: current-fdb-file-handle
42 SYMBOL: current-fdb-kvs-handle
44 : get-file-handle ( -- handle )
45 current-fdb-file-handle get handle>> ;
47 : get-kvs-handle ( -- handle )
48 current-fdb-kvs-handle get handle>> ;
50 GENERIC: encode-kv ( object -- bytes )
52 M: string encode-kv utf8 encode ;
53 M: byte-array encode-kv ;
55 : fdb-set-kv ( key value -- )
56 [ get-kvs-handle ] 2dip
57 [ encode-kv dup length ] bi@ fdb_set_kv fdb-check-error ;
59 : <key-doc> ( key -- doc )
61 swap [ utf8 malloc-string >>key ] [ length >>keylen ] bi ;
63 : <seqnum-doc> ( seqnum -- doc )
67 ! Fill in document by exemplar
68 : fdb-get ( doc -- doc )
69 [ get-kvs-handle ] dip [ fdb_get fdb-check-error ] keep ;
71 : fdb-get-metaonly ( doc -- doc )
72 [ get-kvs-handle ] dip [ fdb_get_metaonly fdb-check-error ] keep ;
74 : fdb-get-byseq ( doc -- doc )
75 [ get-kvs-handle ] dip [ fdb_get_byseq fdb-check-error ] keep ;
77 : fdb-get-metaonly-byseq ( doc -- doc )
78 [ get-kvs-handle ] dip [ fdb_get_metaonly_byseq fdb-check-error ] keep ;
80 : fdb-get-byoffset ( doc -- doc )
81 [ get-kvs-handle ] dip [ fdb_get_byoffset fdb-check-error ] keep ;
84 ! Set/delete documents
86 [ get-kvs-handle ] dip fdb_set fdb-check-error ;
89 [ get-kvs-handle ] dip fdb_del fdb-check-error ;
91 : ret>string ( void** len -- string )
92 [ void* deref ] [ size_t deref ] bi*
93 memory>byte-array utf8 decode ;
95 : fdb-get-kv ( key -- value/f )
96 [ get-kvs-handle ] dip
97 utf8 encode dup length f void* <ref> 0 size_t <ref>
100 { FDB_RESULT_SUCCESS [ ret>string ] }
101 { FDB_RESULT_KEY_NOT_FOUND [ 2drop f ] }
105 : fdb-del-kv ( key -- )
106 [ get-kvs-handle ] dip
107 utf8 encode dup length fdb_del_kv fdb-check-error ;
109 : fdb-doc-create ( key meta body -- doc )
110 [ f void* <ref> ] 3dip
111 [ utf8 encode dup length ] tri@
112 [ fdb_doc_create fdb-check-error ] 7 nkeep 6 ndrop
113 void* deref fdb_doc memory>struct ;
115 : fdb-doc-update ( doc meta body -- )
117 [ utf8 encode dup length ] bi@
118 fdb_doc_update fdb-check-error ;
120 : fdb-doc-free ( doc -- )
121 fdb_doc_free fdb-check-error ;
123 : clear-doc-key ( doc -- doc )
124 [ dup [ (free) f ] when ] change-key
127 : with-doc ( doc quot: ( doc -- ) -- )
128 over '[ _ _ [ _ fdb-doc-free rethrow ] recover ] call ; inline
130 : with-create-doc ( key meta body quot: ( doc -- ) -- )
131 [ fdb-doc-create ] dip with-doc ; inline
133 : fdb-get-info ( -- fdb_file_info )
135 fdb_file_info <struct> [ fdb_get_file_info fdb-check-error ] keep ;
137 : fdb-get-kvs-info ( -- fdb_kvs_info )
139 fdb_kvs_info <struct> [ fdb_get_kvs_info fdb-check-error ] keep ;
141 : fdb-commit ( fdb_commit_opt_t -- )
142 [ get-file-handle ] dip fdb_commit fdb-check-error ;
144 : fdb-maybe-commit ( fdb_commit_opt_t/f -- )
145 [ fdb-commit ] when* ;
147 : fdb-commit-normal ( -- ) FDB_COMMIT_NORMAL fdb-commit ;
149 : fdb-commit-wal-flush ( -- ) FDB_COMMIT_MANUAL_WAL_FLUSH fdb-commit ;
151 : fdb-compact-to-path ( new-path -- )
152 [ get-file-handle ] dip absolute-path
153 fdb_compact fdb-check-error ;
156 get-file-handle f fdb_compact fdb-check-error ;
158 : fdb-compact-commit-to-path ( path -- )
159 fdb-compact-to-path fdb-commit-wal-flush ;
161 : fdb-compact-commit ( -- )
162 fdb-compact fdb-commit-wal-flush ;
165 ! Call from within with-foresdb
166 : fdb-open-snapshot ( seqnum -- handle )
171 fdb_snapshot_open fdb-check-error
172 ] 2keep drop void* deref <fdb-kvs-handle> ;
174 ! fdb_rollback returns a new handle, so we
175 ! have to replace our current handle with that one
176 ! XXX: can't call dispose on old handle, library handles that
177 : fdb-rollback ( seqnum -- )
178 [ get-kvs-handle void* <ref> ] dip
179 [ fdb_rollback fdb-check-error ] 2keep drop
180 void* deref <fdb-kvs-handle> current-fdb-kvs-handle set ;
183 TUPLE: fdb-iterator < disposable handle ;
185 : <fdb-iterator> ( handle -- obj )
186 fdb-iterator new-disposable
187 swap >>handle ; inline
189 M: fdb-iterator dispose*
190 handle>> fdb_iterator_close fdb-check-error ;
192 : fdb-iterator-init ( start-key end-key fdb_iterator_opt_t -- iterator )
193 [ get-kvs-handle f void* <ref> ] 3dip
194 [ [ utf8 encode dup length ] bi@ ] dip
195 [ fdb_iterator_init fdb-check-error ] 7 nkeep 5 ndrop nip
196 void* deref <fdb-iterator> ;
198 : fdb-iterator-byseq-init ( start-seq end-seq fdb_iterator_opt_t -- iterator )
199 [ get-kvs-handle f void* <ref> ] 3dip
200 [ fdb_iterator_sequence_init fdb-check-error ] 5 nkeep 3 ndrop nip
201 void* deref <fdb-iterator> ;
203 : fdb-iterator-init-none ( start-key end-key -- iterator )
204 FDB_ITR_NONE fdb-iterator-init ;
206 : fdb-iterator-no-deletes ( start-key end-key -- iterator )
207 FDB_ITR_NO_DELETES fdb-iterator-init ;
209 : check-iterate-result ( fdb_status -- ? )
211 { FDB_RESULT_SUCCESS [ t ] }
212 { FDB_RESULT_ITERATOR_FAIL [ f ] }
216 ! fdb_doc key, meta, body only valid inside with-forestdb
217 ! so make a helper word to preserve them outside
218 TUPLE: fdb-doc seqnum keylen key metalen meta bodylen body deleted? offset size-ondisk ;
220 CONSTRUCTOR: <fdb-doc> fdb-doc ( seqnum keylen key metalen meta bodylen body deleted? offset size-ondisk -- obj ) ;
222 TUPLE: fdb-info filename new-filename doc-count space-used file-size ;
223 CONSTRUCTOR: <info> fdb-info ( filename new-filename doc-count space-used file-size -- obj ) ;
226 ! Example fdb_doc and converted doc
228 { keylen 4 } { metalen 0 } { bodylen 4 } { size_ondisk 0 }
229 { key ALIEN: 1002f2f10 } { seqnum 5 } { offset 4256 }
230 { meta ALIEN: 1002dc790 } { body f } { deleted f }
234 { keylen 4 } { key "key5" }
235 { metalen 0 } { bodylen 4 }
236 { offset 4256 } { size-ondisk 0 }
240 : alien/length>string ( alien n -- string/f )
243 memory>byte-array utf8 decode
249 : fdb_doc>doc ( fdb_doc -- doc )
253 [ [ key>> ] [ keylen>> ] bi alien/length>string ]
255 [ [ meta>> ] [ metalen>> ] bi alien/length>string ]
257 [ [ body>> ] [ bodylen>> ] bi alien/length>string ]
258 [ deleted>> >boolean ]
263 : fdb_file_info>info ( fdb_doc -- doc )
265 [ filename>> alien>native-string ]
266 [ new_filename>> alien>native-string ]
272 : fdb-iterator-get ( iterator -- doc/f )
274 [ fdb_iterator_get check-iterate-result ] keep swap
275 [ void* deref fdb_doc memory>struct ]
278 : fdb-iterator-seek ( iterator key seek-opt -- )
279 [ dup length ] dip fdb_iterator_seek fdb-check-error ;
281 : fdb-iterator-seek-lower ( iterator key -- )
282 FDB_ITR_SEEK_LOWER fdb-iterator-seek ;
284 : fdb-iterator-seek-higher ( iterator key -- )
285 FDB_ITR_SEEK_HIGHER fdb-iterator-seek ;
287 : with-fdb-iterator ( start-key end-key fdb_iterator_opt_t iterator-init iterator-advance quot: ( obj -- ) -- )
291 _ &dispose handle>> [
292 [ fdb-iterator-get ] keep swap
293 [ _ with-doc _ execute check-iterate-result ]
296 ] with-destructors ; inline
300 : collector-when-as ( quot exemplar -- quot' vec )
301 [ length ] keep new-resizable [ [ over [ push ] [ 2drop ] if ] curry compose ] keep ; inline
303 : collector-when ( quot -- quot' vec )
304 V{ } collector-when-as ; inline
308 : get-kvs-default-config ( -- kvs-config )
309 fdb_get_default_kvs_config ;
311 : fdb-open ( path config -- file-handle )
312 [ f void* <ref> ] 2dip
313 [ absolute-path ensure-fdb-filename-directory ] dip
314 [ fdb_open fdb-check-error ] 3keep
315 2drop void* deref <fdb-file-handle> ;
317 : fdb-config-normal-commit ( -- config )
318 fdb_get_default_config
319 FDB_SEQTREE_USE >>seqtree_opt ;
321 : fdb-config-auto-commit ( -- config )
322 fdb-config-normal-commit
323 FDB_COMPACTION_AUTO >>compaction_mode
324 1 >>compactor_sleep_duration
327 ! Make SEQTREES by default
328 : fdb-open-auto-commit ( path -- file-handle )
329 fdb-config-auto-commit fdb-open ;
331 : fdb-open-normal-commit ( path -- file-handle )
332 fdb-config-normal-commit fdb-open ;
334 : fdb-kvs-open-config ( name config -- kvs-handle )
336 current-fdb-file-handle get handle>>
339 [ fdb_kvs_open fdb-check-error ] 3keep 2drop
340 void* deref <fdb-kvs-handle> ;
342 : fdb-kvs-open-default-config ( name -- kvs-handle )
343 get-kvs-default-config fdb-kvs-open-config ;
345 : with-fdb-map ( start-key end-key fdb_iterator_opt_t iterator-init iterator-next quot: ( obj -- ) -- )
349 _ &dispose handle>> [
350 [ fdb-iterator-get ] keep swap
351 [ _ with-doc swap _ execute check-iterate-result ]
352 [ drop f f ] if* swap
353 ] curry collector-when [ loop ] dip
354 ] with-destructors ; inline
356 : with-fdb-normal-iterator ( start-key end-key quot -- )
357 [ FDB_ITR_NONE \ fdb-iterator-init \ fdb_iterator_next ] dip
358 with-fdb-iterator ; inline
360 : with-fdb-byseq-each ( start-seq end-seq quot -- )
361 [ FDB_ITR_NONE \ fdb-iterator-byseq-init \ fdb_iterator_next ] dip
362 with-fdb-iterator ; inline
364 : with-fdb-byseq-map ( start-seq end-seq quot -- )
365 [ FDB_ITR_NONE \ fdb-iterator-byseq-init \ fdb_iterator_next ] dip
366 with-fdb-map ; inline
368 ! : changes-cb ( handle doc ctx -- changes_decision )
371 ! : fdb-changes-since ( seqnum iterator_opt cb ctx -- seq )
372 ! f 101 FDB_ITR_NONE fdb_changes_since ;
375 : with-kvs-name-config ( name config quot -- )
377 _ _ fdb-kvs-open-config &dispose current-fdb-kvs-handle _ with-variable
378 ] with-destructors ; inline
380 : with-kvs-name ( name quot -- )
381 [ fdb_get_default_kvs_config ] dip with-kvs-name-config ; inline
384 : with-forestdb-file-handle ( path config quot -- )
386 _ _ fdb-open &dispose current-fdb-file-handle _ with-variable
387 ] with-destructors ; inline
389 : with-forestdb-path-config-kvs-name-config ( path config kvs-name kvs-config quot -- )
391 _ _ with-kvs-name-config
392 ] with-forestdb-file-handle ; inline
394 : with-forestdb-path-config-kvs-name ( path config kvs-name quot -- )
397 ] with-forestdb-file-handle ; inline
400 ! Do not try to commit here, as it will fail with FDB_RESULT_RONLY_VIOLATION
401 ! fdb-current is weird, it gets replaced if you call fdb-rollback
402 ! Therefore, only clean up fdb-current once, and clean it up at the end
403 : with-forestdb-handles ( file-handle handle quot fdb_commit_opt_t/f -- )
405 _ current-fdb-file-handle [
406 _ current-fdb-kvs-handle [
410 current-fdb-file-handle get &dispose drop
411 current-fdb-kvs-handle get &dispose drop
414 current-fdb-file-handle get &dispose drop
415 current-fdb-kvs-handle get &dispose drop
421 ] with-destructors ; inline
423 ! XXX: When you don't commit-wal at the end of with-forestdb, it won't
424 ! persist to disk for next time you open the db.
425 : with-forestdb-handles-commit-normal ( file-handle handle quot commit -- )
426 FDB_COMMIT_NORMAL with-forestdb-handles ; inline
428 : with-forestdb-handles-commit-wal ( file-handle handle quot commit -- )
429 FDB_COMMIT_MANUAL_WAL_FLUSH with-forestdb-handles ; inline
431 : with-forestdb-snapshot ( n quot -- )
432 [ fdb-open-snapshot ] dip '[
433 _ current-fdb-kvs-handle [
436 current-fdb-kvs-handle get &dispose drop
438 current-fdb-kvs-handle get [ &dispose drop ] when*
442 ] with-destructors ; inline
444 : with-forestdb-path ( path quot -- )
445 [ absolute-path fdb-open-default-config ] dip with-forestdb-handles-commit-wal ; inline
446 ! [ absolute-path fdb-open-default-config ] dip with-forestdb-handle-commit-normal ; inline