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 classes.struct combinators constructors continuations
5 destructors forestdb.ffi forestdb.paths fry generalizations
6 io.encodings.string io.encodings.utf8 io.pathnames kernel libc
7 math multiline namespaces sequences ;
13 ! Get byseq ignores seqnum and uses key instead if key is set
16 ERROR: fdb-error error ;
18 : fdb-check-error ( ret -- )
19 dup FDB_RESULT_SUCCESS = [ drop ] [ fdb-error ] if ;
22 TUPLE: fdb-kvs-handle < disposable handle ;
23 : <fdb-kvs-handle> ( handle -- obj )
24 fdb-kvs-handle new-disposable
25 swap >>handle ; inline
27 M: fdb-kvs-handle dispose*
28 handle>> fdb_kvs_close fdb-check-error ;
31 TUPLE: fdb-file-handle < disposable handle ;
32 : <fdb-file-handle> ( handle -- obj )
33 fdb-file-handle new-disposable
34 swap >>handle ; inline
36 M: fdb-file-handle dispose*
37 handle>> fdb_close fdb-check-error ;
40 SYMBOL: current-fdb-file-handle
41 SYMBOL: current-fdb-kvs-handle
43 : get-file-handle ( -- handle )
44 current-fdb-file-handle get handle>> ;
46 : get-kvs-handle ( -- handle )
47 current-fdb-kvs-handle get handle>> ;
49 : fdb-set-kv ( key value -- )
50 [ get-kvs-handle ] 2dip
51 [ utf8 encode dup length ] bi@ fdb_set_kv fdb-check-error ;
53 : <key-doc> ( key -- doc )
55 swap [ utf8 malloc-string >>key ] [ length >>keylen ] bi ;
57 : <seqnum-doc> ( seqnum -- doc )
61 ! Fill in document by exemplar
62 : fdb-get ( doc -- doc )
63 [ get-kvs-handle ] dip [ fdb_get fdb-check-error ] keep ;
65 : fdb-get-metaonly ( doc -- doc )
66 [ get-kvs-handle ] dip [ fdb_get_metaonly fdb-check-error ] keep ;
68 : fdb-get-byseq ( doc -- doc )
69 [ get-kvs-handle ] dip [ fdb_get_byseq fdb-check-error ] keep ;
71 : fdb-get-metaonly-byseq ( doc -- doc )
72 [ get-kvs-handle ] dip [ fdb_get_metaonly_byseq fdb-check-error ] keep ;
74 : fdb-get-byoffset ( doc -- doc )
75 [ get-kvs-handle ] dip [ fdb_get_byoffset fdb-check-error ] keep ;
78 ! Set/delete documents
80 [ get-kvs-handle ] dip fdb_set fdb-check-error ;
83 [ get-kvs-handle ] dip fdb_del fdb-check-error ;
85 : ret>string ( void** len -- string )
86 [ void* deref ] [ size_t deref ] bi*
87 memory>byte-array utf8 decode ;
89 : fdb-get-kv ( key -- value/f )
90 [ get-kvs-handle ] dip
91 utf8 encode dup length f void* <ref> 0 size_t <ref>
94 { FDB_RESULT_SUCCESS [ ret>string ] }
95 { FDB_RESULT_KEY_NOT_FOUND [ 2drop f ] }
99 : fdb-del-kv ( key -- )
100 [ get-kvs-handle ] dip
101 utf8 encode dup length fdb_del_kv fdb-check-error ;
103 : fdb-doc-create ( key meta body -- doc )
104 [ f void* <ref> ] 3dip
105 [ utf8 encode dup length ] tri@
106 [ fdb_doc_create fdb-check-error ] 7 nkeep 6 ndrop
107 void* deref fdb_doc memory>struct ;
109 : fdb-doc-update ( doc meta body -- )
111 [ utf8 encode dup length ] bi@
112 fdb_doc_update fdb-check-error ;
114 : fdb-doc-free ( doc -- )
115 fdb_doc_free fdb-check-error ;
117 : clear-doc-key ( doc -- doc )
118 [ dup [ (free) f ] when ] change-key
121 : with-doc ( doc quot: ( doc -- ) -- )
122 over '[ _ _ [ _ fdb-doc-free rethrow ] recover ] call ; inline
124 : with-create-doc ( key meta body quot: ( doc -- ) -- )
125 [ fdb-doc-create ] dip with-doc ; inline
127 : fdb-get-info ( -- fdb_file_info )
129 fdb_file_info <struct> [ fdb_get_file_info fdb-check-error ] keep ;
131 : fdb-get-kvs-info ( -- fdb_kvs_info )
133 fdb_kvs_info <struct> [ fdb_get_kvs_info fdb-check-error ] keep ;
135 : fdb-commit ( fdb_commit_opt_t -- )
136 [ get-file-handle ] dip fdb_commit fdb-check-error ;
138 : fdb-maybe-commit ( fdb_commit_opt_t/f -- )
139 [ fdb-commit ] when* ;
141 : fdb-commit-normal ( -- ) FDB_COMMIT_NORMAL fdb-commit ;
143 : fdb-commit-wal-flush ( -- ) FDB_COMMIT_MANUAL_WAL_FLUSH fdb-commit ;
145 : fdb-compact ( new-path -- )
146 [ get-file-handle ] dip absolute-path
147 fdb_compact fdb-check-error ;
149 : fdb-compact-commit ( new-path -- )
150 fdb-compact fdb-commit-wal-flush ;
153 ! Call from within with-foresdb
154 : fdb-open-snapshot ( seqnum -- handle )
159 fdb_snapshot_open fdb-check-error
160 ] 2keep drop void* deref <fdb-kvs-handle> ;
162 ! fdb_rollback returns a new handle, so we
163 ! have to replace our current handle with that one
164 ! XXX: can't call dispose on old handle, library handles that
165 : fdb-rollback ( seqnum -- )
166 [ get-kvs-handle void* <ref> ] dip
167 [ fdb_rollback fdb-check-error ] 2keep drop
168 void* deref <fdb-kvs-handle> current-fdb-kvs-handle set ;
171 TUPLE: fdb-iterator < disposable handle ;
173 : <fdb-iterator> ( handle -- obj )
174 fdb-iterator new-disposable
175 swap >>handle ; inline
177 M: fdb-iterator dispose*
178 handle>> fdb_iterator_close fdb-check-error ;
180 : fdb-iterator-init ( start-key end-key fdb_iterator_opt_t -- iterator )
181 [ get-kvs-handle f void* <ref> ] 3dip
182 [ [ utf8 encode dup length ] bi@ ] dip
183 [ fdb_iterator_init fdb-check-error ] 7 nkeep 5 ndrop nip
184 void* deref <fdb-iterator> ;
186 : fdb-iterator-byseq-init ( start-seq end-seq fdb_iterator_opt_t -- iterator )
187 [ get-kvs-handle f void* <ref> ] 3dip
188 [ fdb_iterator_sequence_init fdb-check-error ] 5 nkeep 3 ndrop nip
189 void* deref <fdb-iterator> ;
191 : fdb-iterator-init-none ( start-key end-key -- iterator )
192 FDB_ITR_NONE fdb-iterator-init ;
194 : fdb-iterator-no-deletes ( start-key end-key -- iterator )
195 FDB_ITR_NO_DELETES fdb-iterator-init ;
197 : check-iterate-result ( fdb_status -- ? )
199 { FDB_RESULT_SUCCESS [ t ] }
200 { FDB_RESULT_ITERATOR_FAIL [ f ] }
204 ! fdb_doc key, meta, body only valid inside with-forestdb
205 ! so make a helper word to preserve them outside
206 TUPLE: fdb-doc seqnum keylen key metalen meta bodylen body deleted? offset size-ondisk ;
208 CONSTRUCTOR: <fdb-doc> fdb-doc ( seqnum keylen key metalen meta bodylen body deleted? offset size-ondisk -- obj ) ;
210 TUPLE: fdb-info filename new-filename doc-count space-used file-size ;
211 CONSTRUCTOR: <info> fdb-info ( filename new-filename doc-count space-used file-size -- obj ) ;
214 ! Example fdb_doc and converted doc
216 { keylen 4 } { metalen 0 } { bodylen 4 } { size_ondisk 0 }
217 { key ALIEN: 1002f2f10 } { seqnum 5 } { offset 4256 }
218 { meta ALIEN: 1002dc790 } { body f } { deleted f }
222 { keylen 4 } { key "key5" }
223 { metalen 0 } { bodylen 4 }
224 { offset 4256 } { size-ondisk 0 }
228 : alien/length>string ( alien n -- string/f )
231 memory>byte-array utf8 decode
237 : fdb_doc>doc ( fdb_doc -- doc )
241 [ [ key>> ] [ keylen>> ] bi alien/length>string ]
243 [ [ meta>> ] [ metalen>> ] bi alien/length>string ]
245 [ [ body>> ] [ bodylen>> ] bi alien/length>string ]
246 [ deleted>> >boolean ]
251 : fdb_file_info>info ( fdb_doc -- doc )
253 [ filename>> alien>native-string ]
254 [ new_filename>> alien>native-string ]
260 : fdb-iterator-get ( iterator -- doc/f )
262 [ fdb_iterator_get check-iterate-result ] keep swap
263 [ void* deref fdb_doc memory>struct ]
266 : fdb-iterator-seek ( iterator key seek-opt -- )
267 [ dup length ] dip fdb_iterator_seek fdb-check-error ;
269 : fdb-iterator-seek-lower ( iterator key -- )
270 FDB_ITR_SEEK_LOWER fdb-iterator-seek ;
272 : fdb-iterator-seek-higher ( iterator key -- )
273 FDB_ITR_SEEK_HIGHER fdb-iterator-seek ;
275 : with-fdb-iterator ( start-key end-key fdb_iterator_opt_t iterator-init iterator-advance quot: ( obj -- ) -- )
279 _ &dispose handle>> [
280 [ fdb-iterator-get ] keep swap
281 [ _ with-doc _ execute check-iterate-result ]
284 ] with-destructors ; inline
288 : collector-for-when ( quot exemplar -- quot' vec )
289 [ length ] keep new-resizable [ [ over [ push ] [ 2drop ] if ] curry compose ] keep ; inline
291 : collector-when ( quot -- quot' vec )
292 V{ } collector-for-when ; inline
297 : get-kvs-default-config ( -- kvs-config )
299 { create_if_missing t }
303 : fdb-open ( path config -- file-handle )
304 [ f void* <ref> ] 2dip
305 [ absolute-path ensure-fdb-filename-directory ] dip
306 [ fdb_open fdb-check-error ] 3keep
307 2drop void* deref <fdb-file-handle> ;
309 : fdb-open-default-config ( path -- file-handle )
310 fdb_get_default_config fdb-open ;
312 : fdb-kvs-open-config ( name config -- kvs-handle )
314 current-fdb-file-handle get handle>>
317 [ fdb_kvs_open fdb-check-error ] 3keep 2drop
318 void* deref <fdb-kvs-handle> ;
320 : fdb-kvs-open ( name -- kvs-handle )
321 get-kvs-default-config fdb-kvs-open-config ;
323 : with-fdb-map ( start-key end-key fdb_iterator_opt_t iterator-init iterator-next quot: ( obj -- ) -- )
327 _ &dispose handle>> [
328 [ fdb-iterator-get ] keep swap
329 [ _ with-doc swap _ execute check-iterate-result ]
331 ] curry collector-when [ loop ] dip
332 ] with-destructors ; inline
334 : with-fdb-normal-iterator ( start-key end-key quot -- )
335 [ FDB_ITR_NONE \ fdb-iterator-init \ fdb_iterator_next ] dip
336 with-fdb-iterator ; inline
338 : with-fdb-byseq-each ( start-seq end-seq quot -- )
339 [ FDB_ITR_NONE \ fdb-iterator-byseq-init \ fdb_iterator_next ] dip
340 with-fdb-iterator ; inline
342 : with-fdb-byseq-map ( start-seq end-seq quot -- )
343 [ FDB_ITR_NONE \ fdb-iterator-byseq-init \ fdb_iterator_next ] dip
344 with-fdb-map ; inline
347 : with-kvs ( name quot -- )
349 [ fdb-kvs-open &dispose current-fdb-kvs-handle ] dip with-variable
350 ] with-destructors ; inline
353 : with-default-kvs ( quot -- )
354 [ "default" ] dip with-kvs ; inline
356 : with-forestdb ( path quot -- )
358 [ fdb-open-default-config &dispose current-fdb-file-handle ] dip with-variable
359 ] with-destructors ; inline
361 : with-forestdb-kvs ( path name quot -- )
364 ] with-forestdb ; inline
367 ! Do not try to commit here, as it will fail with FDB_RESULT_RONLY_VIOLATION
368 ! fdb-current is weird, it gets replaced if you call fdb-rollback
369 ! Therefore, only clean up fdb-current once, and clean it up at the end
370 : with-forestdb-handles ( file-handle handle quot fdb_commit_opt_t/f -- )
372 _ current-fdb-file-handle [
373 _ current-fdb-kvs-handle [
377 current-fdb-file-handle get &dispose drop
378 current-fdb-kvs-handle get &dispose drop
381 current-fdb-file-handle get &dispose drop
382 current-fdb-kvs-handle get &dispose drop
388 ] with-destructors ; inline
390 ! XXX: When you don't commit-wal at the end of with-forestdb, it won't
391 ! persist to disk for next time you open the db.
392 : with-forestdb-handles-commit-normal ( file-handle handle quot commit -- )
393 FDB_COMMIT_NORMAL with-forestdb-handles ; inline
395 : with-forestdb-handles-commit-wal ( file-handle handle quot commit -- )
396 FDB_COMMIT_MANUAL_WAL_FLUSH with-forestdb-handles ; inline
398 : with-forestdb-snapshot ( n quot -- )
399 [ fdb-open-snapshot ] dip '[
400 _ current-fdb-kvs-handle [
403 current-fdb-kvs-handle get &dispose drop
405 current-fdb-kvs-handle get [ &dispose drop ] when*
409 ] with-destructors ; inline
411 : with-forestdb-path ( path quot -- )
412 [ absolute-path fdb-open-default-config ] dip with-forestdb-handles-commit-wal ; inline
413 ! [ absolute-path fdb-open-default-config ] dip with-forestdb-handle-commit-normal ; inline