* [potluck dish] an hyper-graphdb known as culture
@ 2016-02-16 19:27 Amirouche Boubekki
0 siblings, 0 replies; only message in thread
From: Amirouche Boubekki @ 2016-02-16 19:27 UTC (permalink / raw
To: Guile User
[-- Attachment #1: Type: text/plain, Size: 1237 bytes --]
Héllo!!
# Introduction
For the potluck I prepared a release of a database I've been working
on as part of an AI project that try to implement opencog.org [1] in
pure scheme (or mostly pure scheme).
This dish contains the database part called AtomSpace in OpenCog which
is an hypergraph database. The summarize what is an hyper graph
database.
The following summarize the what is an hypergraph database then, I
conclude with the other features:
# hyper graph API
## `(create-atom #:optional (assoc '()))`
Create an `<atom>` with `ASSOC`.
## `(atom-link! atom other context)`
Create a direct link between `ATOM` and `OTHER` inside the database
referenced by `CONTEXT`
# culture database
Culture has as extra features an: exact an index and a fuzzy index. A
spatial index [2] was also started but I did not have time to complete
it.
The database is implemented on top of wiredtiger [3].
Right now it's hosted at github [4] but you can find all the pieces as
attachment.
HTH and happy hacking!
[1] OpenCog is an Artificial General Intelligence framework.
[2] See znumber.scm
[3] https://git.framasoft.org/a-guile-mind/guile-wiredtiger
[4] https://github.com/amirouche/culturia
--
Amirouche ~ amz3 ~ http://www.hyperdev.fr
[-- Attachment #2: culture.md --]
[-- Type: text/plain, Size: 2419 bytes --]
# culturedb
## Kesako culturedb?
`culturedb` is hypergraph database ie. a graph database with single
kind of entity the `<atom>` which is linked to other `<atom>`. It's
similar to a graph database, but the datamodel simpler *ahem* more
generic.
It also comes with two kind of indices: exact and fuzzy.
## Reference API
Procedures with a exclamation mark suffix `!` mutate the database.
Throught this documentation `CONTEXT` is a wiredtiger**z** database
context created with `context-open`.
### `<atom>` API
#### `(atom-uid atom)
Return the unique identifier of `ATOM`.
#### `(atom-assoc atom)`
Return the assoc of `ATOM`.
#### `(create-atom #:optional (assoc '()))`
Create an `<atom>` with `ASSOC`.
#### `(atom-set atom key value)`
Shortcut to set `ATOM`'s assoc this returns a new `<atom>` record.
#### `(atom-ref atom key)`
Shortcut to reference `ATOM` assoc.
#### `(atom-insert! atom context)`
Insert as new atom `ATOM` in the wiredtiger database referenced by `CONTEXT`.
#### `(atom-update! atom context)`
Update `ATOM` inside the database reference by `CONTEXT`.
#### `(atom-ref* uid context)`
Reference `<atom>` with `UID` as unique identifier inside the database
referenced by `CONTEXT`.
#### `(atom-link! atom other context)`
Create a directed link between `ATOM` and `OTHER` inside the database
referenced by `CONTEXT`
#### `(atom-incomings atom context)`
Retrieve every **incomings** links of `ATOM` found inside the database
referenced by `CONTEXT`.
#### `(atom-outgoings atom context)`
Retrieve every **outgoings** links of `ATOM` found inside the database
referenced by `CONTEXT`.
#### `(atom-unlink! atom other context)`
Remove the directed link between `ATOM` and `OTHER` inside the database
referenced by `CONTEXT`.
#### `(atom-remove! atom context)`
Remove `ATOM` from the database referenced by `CONTEXT`.
### index API
#### `(index-set! key value context)`
Create an exact index as `KEY` on any scheme `VALUE` in database
referenced by `CONTEXT`.
#### `(index-ref key context)`
Reference scheme value indexed at `KEY` in the database referenced by
`CONTEXT`
### fuzzy index
#### `(fuzzy-index! word value context)`
Fuzzy index scheme `VALUE` as `WORD` inside the database referenced by
`CONTEXT`.
#### `(fuzzy-search word context)`
Fuzzy search `WORD` inside the database referenced by `CONTEXT`.
Returns top 10 results according to levenstein distance.
[-- Attachment #3: culture.scm --]
[-- Type: text/plain, Size: 14181 bytes --]
(define-module (culture))
(use-modules (rnrs hashtables))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-26))
(use-modules (ice-9 optargs))
(use-modules (plain))
(use-modules (wiredtiger))
(use-modules (wiredtigerz))
;;; database table definition
(define *atoms* '(atoms ((uid . record))
((assoc . string))
()))
(define *links* '(links ((start . unsigned-integer)
(end . unsigned-integer))
((value . string))
((outgoings (start) (end))
(incomings (end) (start)))))
(define *index* '(index ((key . string))
((value . string))
()))
(define *trigrams* '(trigrams ((key . record))
((word . string)
(trigram . string)
(value . string))
((index (trigram) (word value))
(value (value) (key)))))
(define-public *culture* (list *atoms* *links* *index* *trigrams*))
;;;
;;; <atom> procedures
;;;
(define-record-type* <atom> uid assoc)
(export atom-uid atom-assoc)
(define*-public (create-atom #:optional (assoc '()))
(make-atom #nil assoc))
(define-public (atom-set atom key value)
(let* ((assoc (atom-assoc atom))
(assoc (alist-delete key assoc))
(assoc (acons key value assoc)))
(make-atom (atom-uid atom) assoc)))
(define-public (atom-ref atom key)
(assoc-ref (atom-assoc atom) key))
(define-public (atom-insert! atom context)
(let ((cursor (context-ref context 'atoms-append)))
(cursor-insert* cursor
#nil
(list (scm->string (atom-assoc atom))))
(set-field atom (atom-uid) (car (cursor-key-ref cursor)))))
(define-public (atom-update! atom context)
(let ((cursor (context-ref context 'atoms)))
(cursor-update* cursor
(list (atom-uid atom))
(list (scm->string (atom-assoc atom))))))
(define-public (atom-ref* uid context)
(let ((cursor (context-ref context 'atoms)))
(make-atom uid (string->scm (car (cursor-value-ref* cursor uid))))))
(define-public (atom-link! atom other context)
(let ((cursor (context-ref context 'links)))
(cursor-insert* cursor
(list (atom-uid atom) (atom-uid other))
(list ""))))
(define-public (atom-incomings atom context)
(let ((cursor (context-ref context 'links-incomings)))
(map cadr (cursor-range cursor (atom-uid atom)))))
(define-public (atom-outgoings atom context)
(let ((cursor (context-ref context 'links-outgoings)))
(map cadr (cursor-range cursor (atom-uid atom)))))
(define-public (atom-unlink! atom other context)
(let ((cursor (context-ref context 'links)))
(cursor-remove* cursor (atom-uid atom) (atom-uid other))))
(define-public (atom-remove! atom context)
(let ((cursor (context-ref context 'atoms-append)))
;; remove assoc
(cursor-remove* cursor (atom-uid atom))
;; remove links
(for-each (lambda (uid) (atom-unlink! atom (make-atom uid #nil) context))
(atom-outgoings atom context))
(for-each (lambda (uid) (atom-unlink! (make-atom uid #nil) atom context))
(atom-incomings atom context))))
;;;
;;; *index*
;;;
(define-public (index-set! key value context)
(let ((cursor (context-ref context 'index)))
(cursor-insert* cursor (list key) (list (scm->string value)))))
(define-public (index-ref key context)
(let ((cursor (context-ref context 'index)))
(if (cursor-search* cursor key)
(string->scm (car (cursor-value-ref cursor)))
#nil)))
;;
;; XXX: it's possible to have multiple row with the same value so this
;; procedure is not enough to remove a value from the index
;;
;; (define-public (index-remove! value context)
;; (let ((cursor (context-ref context 'index-value))
;; (key (car (cursor-search* cursor (scm->string value)))))
;; (let ((cursor (contex-ref context 'index)))
;; (cursor-remove* cursor key))))
;;
;;; fuzzy index
(define (word->trigrams word)
(define (word->grams word)
(let loop ((word word)
(grams '()))
(if (>= (string-length word) 3)
(loop (string-drop word 1) (cons (string-take word 3) grams))
;; do not index grams < 3
(reverse grams))))
(append-map word->grams (list word (string-take word 1) (string-take word 2))))
(define (levenshtein s t)
(define (%levenshtein s sl t tl)
(cond ((zero? sl) tl)
((zero? tl) sl)
(else
(min (+ (%levenshtein (cdr s) (- sl 1) t tl) 1)
(+ (%levenshtein s sl (cdr t) (- tl 1)) 1)
(+ (%levenshtein (cdr s) (- sl 1) (cdr t) (- tl 1))
(if (char=? (car s) (car t)) 0 1))))))
(%levenshtein (string->list s)
(string-length s)
(string->list t)
(string-length t)))
(define-public (fuzzy-index! word value context)
(define (index! word value cursor)
(let ((value (scm->string value)))
(lambda (trigram)
(cursor-insert* cursor #nil (list word trigram value)))))
(let ((cursor (context-ref context 'trigrams-append)))
(for-each (index! word value cursor) (word->trigrams word))))
(define-public (fuzzy-search word context)
(define (lookup cursor)
(lambda (trigram)
( map cdr (cursor-range cursor trigram))))
(define (count counter)
(lambda (tuple)
(hashtable-set! counter tuple (+ 1 (hashtable-ref counter tuple 0)))))
(define (search word)
(let* ((cursor (context-ref context 'trigrams-index))
(counter (make-hashtable (cut hash <> 1024) equal?))
(results (append-map (lookup cursor) (word->trigrams word))))
(for-each (count counter) results)
counter))
(define (counter->ordered-list counter)
(define (less a b)
(> (hashtable-ref counter a 0) (hashtable-ref counter b 0)))
(let ((words (hashtable-keys counter)))
(sort words less)))
(define search* (compose vector->list counter->ordered-list search))
(define (list-head* lst size)
(if (< (length lst) size)
lst
(list-head lst size)))
;; (search* word))
(define (less a b)
(< (levenshtein (car a) word)
(levenshtein (car b) word)))
(let ((top (list-head* (search* word) 10)))
(map (compose string->scm cadr) (sort top less))))
;;;
;;; tests
;;;
(use-modules (tools)) ;; test-check
(use-modules (path)) ;; with-directory
(when (or (getenv "CHECK") (getenv "CHECK_CULTURE"))
;;; atoms
(test-check "atom set"
(atom-ref (atom-set (create-atom '((a . b))) 'a 'c) 'a)
'c)
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "open database"
(and #true)
#true)
(connection-close connection)))
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "create and retrieve"
(atom-uid (atom-insert! (create-atom) context))
1)
(connection-close connection)))
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "create, update and retrieve"
(let* ((atom (atom-insert! (create-atom) context))
(_ (atom-update! (atom-set atom 'a 'b) context)))
(atom-ref (atom-ref* (atom-uid atom) context) 'a))
'b)
(connection-close connection)))
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "link outgoings atom"
(let* ((atom (atom-insert! (create-atom) context))
(other (atom-insert! (create-atom) context)))
(atom-link! atom other context)
(atom-outgoings atom context))
(list 2))
(connection-close connection)))
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "link outgoings other"
(let* ((atom (atom-insert! (create-atom) context))
(other (atom-insert! (create-atom) context)))
(atom-link! atom other context)
(atom-outgoings other context))
(list))
(connection-close connection)))
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "link incomings other"
(let* ((atom (atom-insert! (create-atom) context))
(other (atom-insert! (create-atom) context)))
(atom-link! atom other context)
(atom-incomings other context))
(list 1))
(connection-close connection)))
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "link incomings atom"
(let* ((atom (atom-insert! (create-atom) context))
(other (atom-insert! (create-atom) context)))
(atom-link! atom other context)
(atom-incomings atom context))
(list))
(connection-close connection)))
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "other atom delete"
(let* ((atom (atom-insert! (create-atom) context))
(other (atom-insert! (create-atom) context)))
(atom-link! atom other context)
(atom-remove! other context)
(atom-outgoings atom context))
(list))
(connection-close connection)))
;;; index
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "index-set! and index-ref"
(begin (index-set! "key" "value" context)
(index-ref "key" context))
"value")
(connection-close connection)))
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "index-ref finds nothing"
(index-ref "key" context)
#nil)
(connection-close connection)))
;;; trigrams
(test-check "word->trigrams"
(word->trigrams "abcdef")
'("abc" "bcd" "cde" "def"))
(with-directory
"/tmp/culturia" (let* ((connection (connection-open "/tmp/culturia" "create"))
(_ (apply session-create* (cons (session-open connection) *culture*)))
(context (apply context-open (cons connection *culture*))))
(test-check "fuzzy index"
(begin (fuzzy-index! "fuzzyng" "second" context)
(fuzzy-index! "fuzzing" "last" context)
(fuzzy-index! "fuzzy" "first" context)
(fuzzy-search "fuzzy" context))
'("first" "second" "last"))
(connection-close connection)))
)
[-- Attachment #4: tools.scm --]
[-- Type: text/plain, Size: 1709 bytes --]
(define-module (tools))
;;;
;;; print
;;;
;;
;; nicer format
;;
;; (print "Héllo World, " ~s (list "you-name-it"))
;;
(define-public (print . rest)
(let ((template (reverse (cdr (reverse rest))))
(parameters (car (reverse rest))))
(let loop ((template template)
(parameters parameters))
(if (null? template)
(newline)
(if (procedure? (car template))
(begin ((car template) (car parameters))
(loop (cdr template) (cdr parameters)))
(begin (display (car template))
(loop (cdr template) parameters)))))))
(define-public (~s s) (format #true "~s" s))
(define-public (~a s) (format #true "~s" s))
;;;
;;; test-check
;;;
(define-syntax test-check
(syntax-rules ()
((_ title tested-expression expected-result)
(begin
(print "* Checking " ~s (list title))
(let* ((expected expected-result)
(produced tested-expression))
(if (not (equal? expected produced))
(begin (print "Expected: " ~s (list expected))
(print "Computed: " ~s (list produced)))))))))
(export test-check)
;;;
;;; exceptions
;;;
;;
;; helper for managing exceptions
(define-public (make-exception name)
"Generate a unique symbol prefixed with NAME"
(gensym (string-append "culturia-" name "-")))
(define-public *exception* (make-exception "exception"))
(define-public (raise message . rest)
"shorthand to throw EXCEPTION with MESSAGE formated with REST"
(throw *exception* (apply format (append (list #false message) rest))))
;; well, i'm too lazy to create other exception messages
(define-public (Oops!)
(raise "Oops!"))
[-- Attachment #5: wiredtigerz.md --]
[-- Type: text/plain, Size: 4416 bytes --]
title: Reference API: Guile Wiredtigerz
data: 2015-10-22 23:59
## wiredtigerz
`wiredtigerz` gather extra procedures to work with `guile wiredtiger` which aims
at making the main workflow more obvious.
It implements a declarative API to create tables with their indices and open
cursor on them. It provides a few helpers for common patterns.
`wiredtigerz` module can be found in [culturia repository](https://github.com/amirouche/Culturia/blob/master/culturia/wiredtigerz.scm).
## Reference API
### (session-create* session . configs)
`session-create*` will create the tables and indices defined declarativly in
`configs`. a `config` must looks like the following:
``` ascii
(table-name
(key assoc as (column-name . column-type))
(value assoc as (column-name . column-type))
((list indices as (indexed-ame (indexed keys) (projections column names)))))
```
`column-type` are verbose names for column types:
- `record`
- `string`
- `unsigned-integer`
- `integer`
- `raw`
An example of a configuration that defines an `posts` table with `uid`, `title`,
`body`, `published-at` fields and one index one `published-at` with a project
on `uid` column:
```scheme
(define posts '(posts
((uid . raw))
((title . string) (body . string) (published-at . raw))
((published-at (published-at) (uid)))))
```
You can create the table and indices in one call using the following code:
```scheme
(define connection (connection-open "/tmp/wiredtigerz" "create"))
(define session (session-open connection))
(session-create* session posts)
(session-close session)
```
### (cursor-open* session . configs)
`(cursor-open* session config)` will open all the cursors related to a given
`config` as an assoc.
You can open cursors over the table and indices you created using
`session-open*`. It use the same syntax and the same table declaration.
```scheme
(define connection (connection-open "/tmp/wiredtigerz" "create"))
(define session (session-open connection))
(define cursors (cursor-open* session posts))
```
`cursors` is an assoc that maps table name as symbol to its cursor and indices
to their cursor. An extra *append* cursor will be created if the table has a
single raw column. Index and append cursors are prefixed by the table name.
Which means that the above `cursors` should contain the following keys:
```scheme
(list 'posts 'posts-append 'posts-published)
```
Mind the fact that keys are symbols. Also `posts-published` cursor has `uid` as
cursor's value since a projection was done. Leave the field empty for the
default behavior. If there is no indices, leave the indices list empty.
### Simple database
#### (wiredtiger-open path . configs)
Open database at `path`, create tables using `configs` if necessary and return
a pair `(connection . session)` and a `cursors` assoc as returned
by `cursor-open*`.
This procedure is useful in a context where you don't plan to use threads.
#### (wiredtiger-close database)
Shortcut procedure to close a database where `database` is a pair of connection
and session.
### Context
Context is made of `<session>` and `cursors` assoc. This is useful in multithread
settings if you don't need to open multiple cursors for the same table.
### (context-open connection . configs)
`cursor-open*` sister procedure that will open a session and `cursors` assoc
and return a context.
### (context-session context)
Return the session associated with `context`
### (context-ref context name)
Return the cursor `name` from `context`.
### transactions
Use `(context-begin context)`, `(context-commit context)` and
`(context-rollback context)` to work with transactions.
There is macro helper `(with-transaction context e ...)` that begin and
commit a transaction at end.
### Cursor navigation
#### (cursor-value-ref* cursor . key)
Retreive the value associated with key in cursor.
#### (cursor-insert* cursor key value)
Insert `value` at `key` using cursor. If `key` is `#nil`, insert the `value`
directly.
#### (cursor-update* cursor key value)
Update `key` with `value` using `cursor`.
#### (cursor-remove* cursor . key)
Remove `key` using `cursor`.
#### (cursor-search* cursor . key)
Search `key` using `cursor`.
#### (cursor-search-near* cursor . key-prefix)
Prepare `cursor` for forward search using `key-prefix`.
#### (cursor-range cursor . key-prefix)
Return the list of key/value pairs that match `key-prefix` using `cursor`.
[-- Attachment #6: wiredtiger.md --]
[-- Type: text/plain, Size: 11386 bytes --]
title: Reference API: Guile Wiredtiger
data: 2015-10-22 23:59
## wiredtiger
Wiredtiger is a ordered key/value store written in C licensed gplv2 or gplv3.
It's some what the successor of Oracle Berkeley Database (bsddb). It's similar
in principles to leveldb but faster. It allows to build your own database
easily.
It's a ACID, NoSQL, networkless, with automatic indices, multithread support.
I created bindings for Guile using ffi that can be
[found in culturia repository](https://github.com/amirouche/Culturia/blob/master/culturia/wiredtiger.scm).
Here follow the documentation of that module which follows closely wiredtiger
API. It's highly recommended to get started to have a look at
[wiredtiger's schema](http://source.wiredtiger.com/2.6.1/schema.html)
documentation.
## Reference API
A lot of the API is available, what remains can be the subject of patches :)
The following documentation doesn't cover all of wiredtiger, it is best to have
a look at [wiredtiger manual](http://source.wiredtiger.com/2.6.1/index.html)
too.
They are three objects in guile-wiredtiger:
- `<connection>` a repsent a particular connection to the wiredtiger engine.
ACID is not supported across several instance of `<connection>`.
- `<session>` has a `<connection>` as parent. It's not threadsafe.
- `<cursor>` has a `<session>` as parent.
### <connection>
#### (connection-open home config) -> connection
Open a connection to a database. Most applications will open a single connection
to a database. A connection can be shared among several threads. There is no
support ACID transactions between several connections.
Example:
```scheme
(connection-open "./databases/magic-numbers" "create,cache_size=500M")
```
`home` the path to the database home directory. The path must exists.
#### (connection-close connection [config]) -> boolean
Close connection. Any open sessions will be closed. config optional argument,
that can be `leak_memory` to not free memory during close.
### <session>
#### (session-open connection [config]) -> <session>
Open a session.
Example:
```scheme
(session-open connection "isolation=snapshot")
```
`config` configures isolation level:
- `read-uncommited` transactions can see changes made by other transactions
before those transactions are committed. Dirty reads, non-repeatable reads
and phantoms are possible.
- `read-commited` transactions cannot see changes made by other transactions
before those transactions are committed. Dirty reads are not possible;
non-repeatable reads and phantoms are possible. Committed changes from
concurrent transactions become visible when no cursor is positioned in the
read-committed transaction.
- `snapshot` transactions read the versions of records committed before the
transaction started. Dirty reads and non-repeatable reads are not possible;
phantoms are possible.
If you don't know what you are doing, use `snapshot`.
#### (session-close session)
Close the session handle. This will release the resources associated with the
session handle, including rolling back any active transactions and closing any
cursors that remain open in the session.
All data operations are performed in the context of a session. This encapsulates
the thread and transactional context of the operation.
Thread safety: A session is not usually shared between threads, see
Multithreading for more information.
#### (session-create session name config)
Create a table, column group, index or file.
Example:
```scheme
(session-create session "table:magic-numbers" "key_format=i,value_format=S")
```
`name` the URI of the object to create, such as `"table:stock"`. For a
description of URI formats see **Data Sources**.
`config` configures the object.
In guile-wiredtiger, `key_format` and `key_value` only support integral types
`bBhHiIlLqQr` and variable length strings `S`. See format types for more
information.
#### (session-transaction-begin session [config])
Start a transaction.
#### (session-transaction-commit session [config])
Commit the current transaction. A transaction must be in progress when this
method is called. If sesssion-commit-transaction returns #f, the transaction
was rolled back, not committed.
#### (session-transaction-rollback session [config])
Roll back the current transaction. A transaction must be in progress when this
method is called. All cursors are reset.
### <cursor>
#### (cursor-open session uri config) -> <cursor>
Open a new cursor on a data source or duplicate an existing cursor.
An existing cursor can be duplicated by passing it as the `to_dup` parameter
and setting the uri parameter to `#nil`. Cursors being duplicated must have a
key set, and successfully duplicated cursors are positioned at the same place
in the data source as the original.
To reconfigure a cursor, duplicate it with a new configuration value
Cursor handles should be discarded by calling `cursor-close`.
Cursors capable of supporting transactional operations operate in the context
of the current transaction, if any.
`session-transaction-rollback` implicitly resets all cursors.
Cursors are relatively light-weight objects but may hold references to
heavier-weight objects; applications should re-use cursors when possible,
but instantiating new cursors is not so expensive that applications need
to cache cursors at all cost.
`uri` is the data source on which the cursor operates; cursors are usually
opened on tables, however, cursors can be opened on any data source,
regardless of whether it is ultimately stored in a table. Some cursor
types may have limited functionality (for example, they may be read-only
or not support transactional updates). See **Data Sources** for more
information.
#### (cursor-key-set cursor . key)
Set the key for the next operation. If an error occurs during this operation,
a flag will be set in the cursor, and the next operation to access the value
will fail. This simplifies error handling in applications.
`key` must consistent with the format of the current object key.
#### (cursor-value-set cursor key)
Set the key for the next operation. If an error occurs during this operation,
a flag will be set in the cursor, and the next operation to access the key will
fail. This simplifies error handling in applications.
`key` must consistent with the format of the current object value.
#### (cursor-key-ref cursor) -> list
Get the key for the current record. The returned value is a bytevector that can
be unpacked using the correct key format string of the associated object.
#### (cursor-value-ref cursor) -> list
Get the value for the current record. The returned value is a bytevector that
can be unpacked using the correct key format string of the associated object.
#### (cursor-next cursor) -> boolean
Move the cursor to the next record. Returns #f if there is no more records.
#### (cursor-previous cursor) -> boolean
Move the cursor to the previous record. Returns #f if there is no more records.
#### (cursor-reset cursor) -> boolean
Reset the position of the cursor. Any resources held by the cursor are released,
and the cursor's key and position are no longer valid. A subsequent iteration
with `cursor-next` will move to the first record, or with `cursor-prev` will
move to the last record.
#### (cursor-search cursor) -> boolean
On sucess move the cursor to the record matching the key. The key must first
be set.
To minimize cursor resources, the `cursor-reset` method should be called as soon
as the record has been retrieved and the cursor no longer needs that position.
#### (cursor-search-near cursor) -> -1, 0, 1 or #f
Return the record matching the key if it exists, or an adjacent record.
An adjacent record is either the smallest record larger than the key or the
largest record smaller than the key (in other words, a logically adjacent key).
The key must first be set.
On success, the cursor ends positioned at the returned record; to minimize
cursor resources, the cursor-reset method should be called as soon as the record
has been retrieved and the cursor no longer needs that position.
#### (cursor-insert cursor) -> boolean
Insert a record and optionally update an existing record.
If the cursor was configured with overwrite=true (the default), both the key
and value must be set; if the record already exists, the key's value will be
updated, otherwise, the record will be inserted.
If the cursor was configured with overwrite=false, both the key and value must
be set and the record must not already exist; the record will be inserted.
If a cursor with record number keys was configured with append=true (not the
default), the value must be set; a new record will be appended and the record
number set as the cursor key value.
The cursor ends with no position, and a subsequent call to the cursor-next
`cursor-prev` method will iterate from the beginning (end) of the table.
Inserting a new record after the current maximum record in a fixed-length bit
field column-store (that is, a store with an r type key and t type value) may
implicitly create the missing records as records with a value of 0.
When loading a large amount of data into a new object, using a cursor with the
bulk configuration string enabled and loading the data in sorted order will be
much faster than doing out-of-order inserts. See Bulk-load for more information.
The maximum length of a single column stored in a table is not fixed (as it
partially depends on the underlying file configuration), but is always a small
number of bytes less than 4GB.
#### (cursor-update cursor) -> boolean
Update a record and optionally insert an existing record.
If the cursor was configured with overwrite=true (the default), both the key and
value must be set; if the record already exists, the key's value will be
updated, otherwise, the record will be inserted.
If the cursor was configured with overwrite=false, both the key and value must
be set and the record must already existe; the record will be updated.
On success, the cursor ends positioned at the modified record; to minimize
cursor resources, the cursor-reset method should be called as soon as the
cursor no longer needs that position.
The maximum length of a single column stored in a table is not fixed (as it
partially depends on the underlying file configuration), but is always a small
number of bytes less than 4GB.
#### (cursor-remove cursor) -> boolean
Remove a record. The key must be set.
If the cursor was configured with overwrite=true (the default), the key must be
set; the key's record will be removed if it exists, no error will be returned if
the record does not exist.
If the cursor was configured with overwrite=false, the key must be set and the
key's record must exist; the record will be removed.
Removing a record in a fixed-length bit field column-store (that is, a store
with an `r` type key and t type value) is identical to setting the record's
value to 0.
On success, the cursor ends positioned at the removed record; to minimize cursor
resources, the cursor-reset method should be called as soon as the cursor no
longer needs that position.
#### (cursor-close cursor) -> boolean
Close the cursor. This releases the resources associated with the cursor handle.
Cursors are closed implicitly by ending the enclosing connection or closing the
session in which they were opened.
[-- Attachment #7: wiredtigerz.scm --]
[-- Type: text/plain, Size: 23779 bytes --]
;; guile-wiredtiger - 0.2 - 2015/10/22
;; Copyright © 2014-2015 Amirouche BOUBEKKI <amirouche@hypermove.net>
;; guile-wiredtiger is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 2 of the License, or
;; (at your option) or version 3.
;; guile-wiredtiger is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with guile-wiredtiger. If not, see <http://www.gnu.org/licenses/>
;;; Comment:
;;
;; Tested with wiredtiger-2.6.1
;;
(define-module (wiredtigerz))
(use-modules (ice-9 match))
(use-modules (ice-9 receive))
(use-modules (srfi srfi-1)) ;; append-map
(use-modules (srfi srfi-9)) ;; records
(use-modules (srfi srfi-9 gnu)) ;; set-record-type-printer!
(use-modules (srfi srfi-26)) ;; cut
(use-modules (wiredtiger))
;;;
;;; plain records
;;;
;;
;; macro to quickly define immutable records
;;
;;
;; Usage:
;;
;; (define-record-type <car> seats wheels)
;; (define smart (make-abc 2 4))
;; (car-seats smart) ;; => 2
;;
;; Mutation is not done in place, via set-field or set-fields eg.:
;;
;; (define smart-for-4 (set-field smart (seats) 4))
;;
(define-syntax define-record-type*
(lambda (x)
(define (%id-name name) (string->symbol (string-drop (string-drop-right (symbol->string name) 1) 1)))
(define (id-name ctx name)
(datum->syntax ctx (%id-name (syntax->datum name))))
(define (id-append ctx . syms)
(datum->syntax ctx (apply symbol-append (map syntax->datum syms))))
(syntax-case x ()
((_ rname field ...)
(and (identifier? #'rname) (and-map identifier? #'(field ...)))
(with-syntax ((cons (id-append #'rname #'make- (id-name #'rname #'rname)))
(pred (id-append #'rname (id-name #'rname #'rname) #'?))
((getter ...) (map (lambda (f)
(id-append f (id-name #'rname #'rname) #'- f))
#'(field ...))))
#'(define-record-type rname
(cons field ...)
pred
(field getter)
...))))))
;;; helpers
(define-public (scm->string scm)
(call-with-output-string
(lambda (port)
(write scm port))))
(define-public (string->scm string)
(call-with-input-string string
(lambda (port)
(read port))))
;;;
;;; wiredtigerz try to explicit main wiredtiger workflow
;;;
;;
;; This modules defines a star procedure version of wiredtiger procedure
;; to help jump into wiredtiger making the main workflow more explicit.
;;
;; The main workflow is the following:
;;
;; 1. define a some table and indices
;; 2. open session per thread
;; 3. open a single cursor per table and indices
;; 4. forward cursor navigation
;;
;; In theory you might open multiple cursors for the same table/index but this
;; leads to extra bookeeping for which I have no good reason to apply.
;;
;; The API defined as star procedure try to remains thin on top of wiredtiger
;; so that you can drop to raw wiredtiger when required, like open multiple cursors.
;;
;; This introduce a declarative API (described below) that both defines the tables
;; and the cursor in single block of code which must be used with `session-create*`
;; and `cursor-open*` which do the job described in 1. and 2.
;;
;; Also wiredtiger mainly rely on statefull API where the cursor is first configured with
;; cursor-key-set and then an operation is executed on it like cursor-search or
;; cursor-remove. This leaves the door open for many workflows while keeping each
;; procedure signature simple.
;;
;; The purpose of the proposed (star) procedures is to simplify user code by covering
;; the main workflow (I've encountered) while leaving aside some performance concerns.
;;
;;;
;;; Declarative api
;;;
;;
;; Declare the layout of the database and its cursors using list and symbols
;; Here is two example configurations:
;;
;; (define atoms '(atoms
;; ((uid . record))
;; ((assoc . raw))
;; ()))
;;
;; (define arrows '(arrows
;; ((key . record))
;; ((start . unsigned-integer)
;; (end . unsigned-integer))
;; ;; index
;; '((outgoings (start) (uid end))
;; (incomings (end) (uid start)))))
;;
;; The format can be described as follow:
;;
;; (table-name
;; (key assoc as (column-name . column-type))
;; (value assoc as (column-name . column-type))
;; (indices as (indexed name (indexed keys) (projection as column names))))
;;
;;
;; If there is no indices, the field MUST NOT be omited but replaced with an empty list
;;
;; The configuration can be used in (session-create* session . configs) to create
;; the tables and indices.
;;
;; And then in (cursor-open* session . configs) to all the table and indices cursors.
;;
;; A <context> record exists which should be associated with a thread. It encapsulates
;; a <session> and cursors.
;; A <context> can be created with (context-open connection . config).
;; Shortcuts exists to execute transaction against a context directly.
;;
;; utils for declarative configuration
(define-record-type* <config> name key value indices)
(define-record-type* <index> name keys values)
;; FIXME: some types are missing
(define (symbol->config symbol)
(assoc-ref '((record . "r")
(string . "S")
(unsigned-integer . "Q")
(integer . "q")
(raw . "u"))
symbol))
;;; define session-create*
(define-public (session-create* session . configs)
;; XXX: here instead of using `session-create` downstream
;; we wait for `session-create` arguments instead.
;; This makes the code easier to test...
(define (create args)
(apply session-create (cons session args)))
;; prepare arguments for every config and apply them
(for-each create (append-map config-prepare-create configs)))
(define-public (config-prepare-create config)
;; a config generate one table and maybe several indices
(cons (config-prepare-create-table config)
(config-prepare-create-indices config)))
(define (config-prepare-create-table config)
;; transform declarative api into a session-create arguments
(define (symbols->config symbols)
(string-concatenate (map (cut symbol->config <>) symbols)))
(define (symbols->columns symbols)
(string-join (map (cut symbol->string <>) symbols) ","))
(let* ((config (apply make-config config))
(name (string-append "table:" (symbol->string (config-name config))))
(key (symbols->config (map cdr (config-key config))))
(value (symbols->config (map cdr (config-value config))))
(columns (append (config-key config) (config-value config)))
(columns (symbols->columns (map car columns)))
(config (format #false
"key_format=~a,value_format=~a,columns=(~a)"
key value columns)))
(list name config)))
(define (config-prepare-create-indices config)
;; one config may have multiple indices
(let ((config (apply make-config config)))
(map (config-prepare-create-index (config-name config)) (config-indices config))))
(define (config-prepare-create-index name)
;; convert declarative configuration to session-create arguments
(define (symbols->columns symbols)
(string-join (map (cut symbol->string <>) symbols) ","))
(lambda (index)
(let* ((index (apply make-index index))
(name (string-append "index:" (symbol->string name) ":" (symbol->string (index-name index))))
(columns (format #false "columns=(~a)" (symbols->columns (index-keys index)))))
(list name columns))))
;;;
;;; define cursor-open*
;;;
;;
;; open cursor for every table and indices in an assoc where the key is
;; the table name for main cursor, '-append prefixed with the name of table
;; for the append cursor when applicable and the name index prefixed with
;; the name of the table.
;; cursor-open* will automatically create a 'append' cursor for tables
;; that have single record column.
;;
(define-public (cursor-open* session . configs)
;; XXX: just like session-open* we expect cursor-open arguments
;; but this time we return an assoc made of ('cursor-name . cursor)
(define (open name+args)
(cons (car name+args) (apply cursor-open (cons session (cadr name+args)))))
;; prepare arguments for every config and apply them
(map open (append-map config-prepare-open configs)))
(define (config-prepare-open config)
(append (config-prepare-cursor-open config)
(config-prepare-cursor-append-open config)
(config-prepare-cursor-indices-open config)))
(define (config-prepare-cursor-open config)
(let* ((config (apply make-config config))
(name (config-name config)))
;; XXX: config-prepare-open expect a list of cursor-open arguments
(list (list name (list (format #false "table:~a" name))))))
(define (config-prepare-cursor-append-open config)
(define (key-is-record? key)
(and (eq? (length key) 1) (eq? (cdar key) 'record)))
(let* ((config (apply make-config config))
(name (config-name config))
(cursor-name (symbol-append name '-append)))
(if (key-is-record? (config-key config))
;; add a append cursor over the table
;; XXX: config-prepare-open expect a list of cursor-open arguments
(list (list cursor-name (list (format #false "table:~a" name) "append")))
;; no cursor is required
(list))))
(define (config-prepare-cursor-indices-open config)
(let ((config (apply make-config config)))
(map (config-prepare-cursor-index-open (config-name config)) (config-indices config))))
(define (config-prepare-cursor-index-open name)
(define (symbols->columns symbols)
(string-join (map (cut symbol->string <>) symbols) ","))
(lambda (index)
(let* ((index (apply make-index index))
(columns (symbols->columns (index-values index)))
(cursor-name (symbol-append name '- (index-name index))))
(if (equal? columns "")
(list cursor-name
(list (format #false "index:~a:~a" name (index-name index))))
(list cursor-name
(list (format #false "index:~a:~a(~a)" name (index-name index) columns)))))))
;;;
;;; wiredtiger-create
;;;
;;
;; Create database and return a connection with its cursors
;;
(define-public (wiredtiger-open path . configs)
(let* ((connection (connection-open path "create"))
(session (session-open connection)))
(apply session-create* (append (list session) configs))
(values (cons connection session) (apply cursor-open* (append (list session) configs)))))
(define-public (wiredtiger-close database)
(connection-close (car database)))
;;;
;;; <context>
;;;
;;
;; A session and cursors assoc
;;
(define-record-type* <context> session cursors)
(export context-session)
(define-public (context-open connection . configs)
(let* ((session (session-open connection))
(cursors (apply cursor-open* (cons session configs))))
(make-context session cursors)))
(define-public (context-ref context name)
(assoc-ref (context-cursors context) name))
(define-public (context-begin context)
(session-transaction-begin (context-session context)))
(define-public (context-commit context)
(session-transaction-commit (context-session context)))
(define-public (context-rollback context)
(session-transaction-rollback (context-session context)))
(define-syntax-rule (with-transaction context e ...)
(begin
(context-begin context)
(let ((out (begin e ...)))
(context-commit context)
out)))
(export with-transaction)
;;;
;;; Cursor navigation
;;;
;;
;; Quickly operate on cursors
;;
;; helper for reseting cursors after doing some operations
;; @@@: emacs: (put 'with-cursor 'scheme-indent-function 1)
(define-syntax-rule (with-cursor cursor e ...)
(let ((out (begin e ...)))
(cursor-reset cursor)
out))
(export with-cursor)
(define-public (cursor-value-ref* cursor . key)
(with-cursor cursor
(apply cursor-key-set (cons cursor key))
(if (cursor-search cursor)
(cursor-value-ref cursor)
(list))))
(define-public (cursor-insert* cursor key value)
(when (not (null? key))
(apply cursor-key-set (cons cursor key)))
(apply cursor-value-set (cons cursor value))
(cursor-insert cursor))
(define-public (cursor-update* cursor key value)
(apply cursor-key-set (cons cursor key))
(apply cursor-value-set (cons cursor value))
(cursor-update cursor))
(define-public (cursor-remove* cursor . key)
(apply cursor-key-set (cons cursor key))
(cursor-remove cursor))
(define-public (cursor-search* cursor . key)
(apply cursor-key-set (cons cursor key))
(cursor-search cursor))
(define-public (cursor-search-near* cursor . key-prefix)
"Search near KEY on CURSOR and prepare a forward range"
(apply cursor-key-set (cons cursor key-prefix))
(let ((code (cursor-search-near cursor)))
(cond
((or (eq? code -1) (eq? code 4294967295)) (if (cursor-next cursor) #true #false))
;; not found
((eq? code #false) #false)
;; 0 the correct position or 1 which means above and should be filtered
;; if above the key-prefix range
(else #true))))
(define-public (prefix? prefix other)
"Return #true if OTHER has KEY as prefix"
;; filter "empty" values from the key
(define (empty? x) (or (eq? x 0) (equal? x "") (eq? x #vu8())))
(define (predicate? a b) (not (or (empty? a) (equal? a b))))
(not (any predicate? prefix other)))
(define-public (cursor-range cursor . key-prefix)
"Return CURSOR range association where keys match PREFIX"
(define (next?)
(if (cursor-next cursor)
(prefix? key-prefix (cursor-key-ref cursor))
#false))
(with-cursor cursor
(if (apply cursor-search-near* (cons cursor key-prefix))
(let loop ((out (list))
(next (prefix? key-prefix (cursor-key-ref cursor))))
(if next
(loop (acons (cursor-key-ref cursor) (cursor-value-ref cursor) out)
(next?))
out))
(list))))
;;;
;;; generate-uid
;;;
(define-public (generate-uid exists?)
"Generate a random string made up alphanumeric ascii chars that doesn't exists
according to `exists?`"
(define (random-id)
(define CHARS "0123456789AZERTYUIOPQSDFGHJKLMWXCVBN")
;; append 8 alphanumeric chars from `CHARS`
(let loop ((count 8)
(id ""))
(if (eq? count 0)
id
(loop (1- count) (format #f "~a~a" id (string-ref CHARS (random 36)))))))
(let loop ()
;; generate a random uid until it find an id that doesn't already exists?
(let ((id (random-id)))
(if (exists? id) (loop) id))))
;;;
;;; tests
;;;
(use-modules (ice-9 receive))
(define-public (path-join . rest)
"Return the absolute path made of REST. If the first item
of REST is not absolute the current working directory
will be prepend"
(let ((path (string-join rest "/")))
(if (string-prefix? "/" path)
path
(string-append (getcwd) "/" path))))
(define-public (path-dfs-walk dirpath proc)
(define dir (opendir dirpath))
(let loop ()
(let ((entry (readdir dir)))
(cond
((eof-object? entry))
((or (equal? entry ".") (equal? entry "..")) (loop))
(else (let ((path (path-join dirpath entry)))
(if (equal? (stat:type (stat path)) 'directory)
(begin (path-dfs-walk path proc)
(proc path))
(begin (proc path) (loop))))))))
(closedir dir)
(proc (path-join dirpath)))
(define-public (rmtree path)
(path-dfs-walk path (lambda (path)
(if (equal? (stat:type (stat path)) 'directory)
(rmdir path)
(delete-file path)))))
(define-syntax-rule (with-directory path e ...)
(begin
(when (access? path F_OK)
(rmtree path))
(mkdir path)
e ...
(rmtree path)))
;;;
;;; print
;;;
;;
;; nicer format
;;
;; (print "Héllo World, " ~s (list "you-name-it"))
;;
(define-public (print . rest)
(let ((template (reverse (cdr (reverse rest))))
(parameters (car (reverse rest))))
(let loop ((template template)
(parameters parameters))
(if (null? template)
(newline)
(if (procedure? (car template))
(begin ((car template) (car parameters))
(loop (cdr template) (cdr parameters)))
(begin (display (car template))
(loop (cdr template) parameters)))))))
(define-public (~s s) (format #true "~s" s))
(define-public (~a s) (format #true "~a" s))
;;;
;;; test-check
;;;
(define-syntax test-check
(syntax-rules ()
((_ title tested-expression expected-result)
(begin
(print "* Checking " ~s (list title))
(let* ((expected expected-result)
(produced tested-expression))
(if (not (equal? expected produced))
(begin (print "Expected: " ~a (list expected))
(print "Computed: " ~a (list produced)))))))))
(when (or (getenv "CHECK") (getenv "CHECK_WIREDTIGERZ"))
;;; test declarative API
(test-check "create table config without index"
(config-prepare-create '(atoms
((uid . record))
((assoc . raw))
()))
(list (list "table:atoms" "key_format=r,value_format=u,columns=(uid,assoc)")))
(test-check "create table config with index and projections"
(config-prepare-create '(arrows
((key . record))
((start . unsigned-integer)
(end . unsigned-integer))
;; index
((outgoings (uid,start) (uid end))
(incomings (end) ()))))
(list (list "table:arrows" "key_format=r,value_format=QQ,columns=(key,start,end)")
(list "index:arrows:outgoings" "columns=(uid,start)")
(list "index:arrows:incomings" "columns=(end)")))
(test-check "create cursor config without index"
(config-prepare-open '(atoms
((uid . record))
((assoc . raw))
()))
(list (list 'atoms (list "table:atoms"))
(list 'atoms-append (list "table:atoms" "append"))))
(test-check "create cursor config with index with and without projection"
(config-prepare-open '(atoms
((uid . record))
((assoc . raw))
((reversex (assoc) (uid))
(reverse (assoc) ()))))
(list (list 'atoms (list "table:atoms"))
(list 'atoms-append (list "table:atoms" "append"))
(list 'atoms-reversex (list "index:atoms:reversex(uid)"))
(list 'atoms-reverse (list "index:atoms:reverse"))))
(with-directory
"/tmp/culturia" (receive (db cursors)
(wiredtiger-open "/tmp/culturia"
'(table ((key . record)) ((value . integer)) ()))
(test-check "wiredtiger-open"
db
db)
(wiredtiger-close db)))
(with-directory
"/tmp/culturia" (receive (db cursors)
(wiredtiger-open "/tmp/culturia"
'(table ((key . record)) ((value . integer)) ()))
(test-check "cursor-insert* and cursor-search*"
(let ((cursor (assoc-ref cursors 'table))
(append (assoc-ref cursors 'table-append)))
(cursor-insert* append #nil (list 42))
(cursor-insert* append #nil (list 1337))
(cursor-insert* append #nil (list 1985))
(cursor-search* cursor 1)
(cursor-value-ref cursor))
(list 42))
(wiredtiger-close db)))
(with-directory
"/tmp/culturia" (receive (db cursors)
(wiredtiger-open "/tmp/culturia"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(test-check "cursor-range"
(let ((cursor (assoc-ref cursors 'table)))
(cursor-insert* cursor (list 0 0) (list 0))
(cursor-insert* cursor (list 1 1) (list 1))
(cursor-insert* cursor (list 1 2) (list 1))
(cursor-insert* cursor (list 2 0) (list 2))
(cursor-range cursor 1 0))
'(((1 2) 1)
((1 1) 1)))
(wiredtiger-close db)))
(with-directory
"/tmp/culturia" (receive (db cursors)
(wiredtiger-open "/tmp/culturia"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(test-check "cursor-range 2"
(let ((cursor (assoc-ref cursors 'table)))
(cursor-insert* cursor (list 1 1) (list 1))
(cursor-insert* cursor (list 1 2) (list 1))
(cursor-insert* cursor (list 2 0) (list 2))
(cursor-range cursor 1 0))
'(((1 2) 1)
((1 1) 1)))
(wiredtiger-close db)))
(with-directory
"/tmp/culturia" (receive (db cursors)
(wiredtiger-open "/tmp/culturia"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(test-check "cursor-range 3"
(let ((cursor (assoc-ref cursors 'table)))
(cursor-insert* cursor (list 2 0) (list 2))
(cursor-range cursor 1 0))
'())
(wiredtiger-close db)))
(with-directory
"/tmp/culturia" (receive (db cursors)
(wiredtiger-open "/tmp/culturia"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(test-check "cursor-range 3"
(let ((cursor (assoc-ref cursors 'table)))
(cursor-insert* cursor (list 0 0) (list 0))
(cursor-range cursor 1 0))
'())
(wiredtiger-close db)))
)
[-- Attachment #8: wiredtiger.scm --]
[-- Type: text/plain, Size: 22114 bytes --]
;; guile-wiredtiger - 0.2 - 2015/10/22
;; Copyright © 2014-2015 Amirouche BOUBEKKI <amirouche@hypermove.net>
;; guile-wiredtiger is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 2 of the License, or
;; (at your option) or version 3.
;; guile-wiredtiger is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with guile-wiredtiger. If not, see <http://www.gnu.org/licenses/>
;;; Comment:
;;
;; Tested with wiredtiger-2.6.1
;;
(define-module (wiredtiger))
(use-modules (srfi srfi-9)) ;; records
(use-modules (srfi srfi-9 gnu)) ;; set-record-type-printer!
(use-modules (srfi srfi-26)) ;; cut
(use-modules (rnrs bytevectors))
(use-modules (ice-9 iconv)) ;; string->bytevector
(use-modules (ice-9 match))
(use-modules (ice-9 format))
(use-modules (ice-9 optargs)) ;; lambda*
(use-modules (ice-9 receive))
(use-modules (system foreign)) ;; ffi
;;;
;;; srfi-99
;;;
;;
;; macro to quickly define immutable records
;;
;;
;; Usage:
;;
;; (define-record-type <abc> field-one field-two)
;; (define zzz (make-abc 1 2))
;; (abc-field-one zzz) ;; => 1
;;
(define-syntax define-record-type*
(lambda (x)
(define (%id-name name) (string->symbol (string-drop (string-drop-right (symbol->string name) 1) 1)))
(define (id-name ctx name)
(datum->syntax ctx (%id-name (syntax->datum name))))
(define (id-append ctx . syms)
(datum->syntax ctx (apply symbol-append (map syntax->datum syms))))
(syntax-case x ()
((_ rname field ...)
(and (identifier? #'rname) (and-map identifier? #'(field ...)))
(with-syntax ((cons (id-append #'rname #'make- (id-name #'rname #'rname)))
(pred (id-append #'rname (id-name #'rname #'rname) #'?))
((getter ...) (map (lambda (f)
(id-append f (id-name #'rname #'rname) #'- f))
#'(field ...))))
#'(define-record-type rname
(cons field ...)
pred
(field getter)
...))))))
;;; ffi helpers
(define *NULL* %null-pointer)
(define *pointer* '*)
;; This is small syntax change
(define* ((dynamic-link* shared-object) func-name)
(dynamic-func func-name shared-object))
;;; foreign macro
(define-syntax-rule (foreign
;; function pointer and signature
(ret function-pointer args ...)
;; foreign-function lambda wrapper
wrapper)
(let ((foreign-function (pointer->procedure ret
function-pointer
(list args ...))))
(lambda rest
(apply wrapper (append (list foreign-function) rest)))))
;;: utils
(define (make constructor constructor-structure pointer size)
"Convert a POINTER to a structure of SIZE and into a record
using CONSTRUCTOR and where the structure is wrapped using
CONSTRUCTOR-STRUCTURE"
(let* ((pointer (make-pointer (array-ref pointer 0)))
(array (pointer->bytevector pointer size 0 'u64))
(structure (apply constructor-structure (map make-pointer (array->list array)))))
(constructor pointer structure)))
;;;
;;; wiredtiger bindings
;;;
(define wiredtiger (dynamic-link "libwiredtiger.so"))
(define wiredtiger* (dynamic-link* wiredtiger))
(define-public WT_NOTFOUND -31803)
;;
;; (wiredtiger-error-string code)
;;
(define* (%wiredtiger-string-error call)
(foreign
(*pointer* (wiredtiger* "wiredtiger_strerror") int)
(lambda (foreign-function code)
(let ((message (pointer->string (foreign-function code))))
(format #t "wiredtiger error while calling ~a: ~a" call message))
;; here we use (exit) instead of (error) which outputs a not very useful traceback
(exit -1))))
(define (wiredtiger-string-error call message)
((%wiredtiger-string-error call) message))
;;;
;;; Connection
;;;
(define-record-type* <connection> handle structure)
(set-record-type-printer! <connection>
(lambda (record port)
(format port
"<connection 0x~x>"
(pointer-address (connection-handle record)))))
;; record holding structure pointers
(define-record-type* <connection-structure>
async-flush
async-new-op
close
reconfigure
get-home
configure-method
is-new
open-session
load-extension
add-data-source
add-collator
add-compressor
add-encryptor
add-extractor
get-extension-api)
(define-public connection-open
(foreign
(int (wiredtiger* "wiredtiger_open") *pointer* *pointer* *pointer* *pointer*)
(lambda (foreign-function home config)
(let* (;; init a double pointer
(pointer (u64vector 0))
(double-pointer (bytevector->pointer pointer))
;; convert arguments to c types
(%home (string->pointer home))
(%config (string->pointer config))
;; call the foreign function
;; FIXME: add support for error_handler
(code (foreign-function %home *NULL* %config double-pointer)))
(if (eq? code 0)
(make make-connection make-connection-structure pointer 15)
(let ((message (format #false "(wiredtiger-open ~s ~s)" home config)))
(wiredtiger-string-error message code)))))))
(define (%connection-close connection)
(foreign
(int (connection-structure-close (connection-structure connection)) *pointer* *pointer*)
(lambda (foreign-function config)
(let* (;; init a double pointer
(pointer (u64vector 0))
(double-pointer (bytevector->pointer pointer))
;; convert arguments to c types
(%config (string->pointer config))
;; call the foreign function
;; FIXME: add support for error_handler
(code (foreign-function (connection-handle connection) %config)))
(if (eq? code 0)
#true
(let ((message (format #false "(connection-close ~s ~s)" connection config)))
(wiredtiger-string-error message code)))))))
(define*-public (connection-close connection #:optional (config ""))
((%connection-close connection) config))
;;;
;;; Session
;;;
(define-record-type* <session> handle structure)
(set-record-type-printer! <session>
(lambda (record port)
(format port
"<session 0x~x>"
(pointer-address (session-handle record)))))
;; record holding structure pointers
(define-record-type* <session-structure>
connection
%app-private%
close
reconfigure
string-error
cursor-open
create
compact
drop
log-printf
rename
salvage
truncate
upgrade
verify
transaction-begin
transaction-commit
transaction-rollback
checkpoint
snapshot
transaction-pinned-range
transaction-sync)
(define (%session-string-error session)
(foreign
(int (session-structure-string-error (session-structure session)) *pointer* int)
(lambda (foreign-function code)
(format #true
"wiredtiger session error: ~a"
(pointer->string (make-pointer (foreign-function (session-handle session) code))))
(exit -1))))
(define-public (session-string-error session code)
((%session-string-error session) code))
(define (%session-open connection)
(foreign
(int (connection-structure-open-session (connection-structure connection)) *pointer* *pointer* *pointer* *pointer*)
(lambda (foreign-function config)
(let* (;; init a double pointer
(pointer (u64vector 0))
(double-pointer (bytevector->pointer pointer))
;; convert arguments to c types
(%config (string->pointer config))
;; call the foreign function
;; FIXME: add support for error_handler
(code (foreign-function (connection-handle connection) *NULL* %config double-pointer)))
(if (eq? code 0)
(make make-session make-session-structure pointer 22)
(let ((message (format #false "(session-open ~s ~s)" connection config)))
(wiredtiger-string-error message code)))))))
(define*-public (session-open connection #:optional (config ""))
((%session-open connection) config))
(define (%session-create session)
(foreign
(int (session-structure-create (session-structure session)) *pointer* *pointer* *pointer*)
(lambda (foreign-function name config)
(let* (;; convert arguments to c types
(%name (string->pointer name))
(%config (string->pointer config))
;; call the foreign function
(code (foreign-function (session-handle session) %name %config)))
(if (not (eq? code 0))
(let ((message (format #false "(session-create ~s ~s)" name config)))
(wiredtiger-string-error message code)))))))
(define-public (session-create session name config)
((%session-create session) name config))
(define (%session-close session)
(foreign
(int (session-structure-close (session-structure session)) *pointer*)
(lambda (foreign-function)
(let* (;; call the foreign function
(code (foreign-function (session-handle session))))
(if (not (eq? code 0))
(let ((message (format #false "(session-close ~s)" session)))
(wiredtiger-string-error message code)))))))
(define-public (session-close session)
((%session-close session)))
(define (%session-transaction-begin session)
(foreign
(int (session-structure-transaction-begin (session-structure session)) *pointer* *pointer*)
(lambda (foreign-function config)
(let* ((%config (string->pointer config))
;; call the foreign function
(code (foreign-function (session-handle session) %config)))
(if (eq? code 0)
#true
(let ((message (format #false "(session-transaction-begin ~s ~s)" session config)))
(wiredtiger-string-error message code)))))))
(define*-public (session-transaction-begin session #:optional (config ""))
((%session-transaction-begin session) config))
(define (%session-transaction-commit session)
(foreign
(int (session-structure-transaction-commit (session-structure session)) *pointer* *pointer*)
(lambda (foreign-function config)
(let* ((%config (string->pointer config))
;; call the foreign function
(code (foreign-function (session-handle session) %config)))
(if (eq? code 0)
#true
(let ((message (format #false "(session-transaction-commit ~s ~s)" session config)))
(wiredtiger-string-error message code)))))))
(define*-public (session-transaction-commit session #:optional (config ""))
((%session-transaction-commit session) config))
(define (%session-transaction-rollback session)
(foreign
(int (session-structure-transaction-rollback (session-structure session)) *pointer* *pointer*)
(lambda (foreign-function name config)
(let* ((%config (string->pointer config))
;; call the foreign function
(code (foreign-function (session-handle session) %config)))
(if (eq? code 0)
#true
(let ((message (format #false "(session-transaction-rollback ~s ~s)" session config)))
(wiredtiger-string-error message code)))))))
(define*-public (session-transaction-rollback session #:optional (config ""))
((%session-transaction-rollback session) config))
;;;
;;; Cursor
;;;
(define-record-type* <cursor> handle structure)
(set-record-type-printer! <cursor>
(lambda (record port)
(format port
"<cursor 0x~x>"
(pointer-address (cursor-handle record)))))
;; record holding structure pointers
(define-record-type* <cursor-structure>
session
uri
key-format
value-format
key-ref
value-ref
key-set
value-set
compare
equals
next
previous
reset
search
search-near
insert
update
remove
close
reconfigure
;; XXX: other fields are defined in the header
;; those are only useful to implement a new cursor type
;; and as such are not part the record
)
(define (cursor-key-format cursor)
(pointer->string (cursor-structure-key-format (cursor-structure cursor))))
(define (cursor-value-format cursor)
(pointer->string (cursor-structure-value-format (cursor-structure cursor))))
(define (%cursor-open session)
(foreign
(int (session-structure-cursor-open (session-structure session)) *pointer* *pointer* *pointer* *pointer* *pointer*)
(lambda (foreign-function uri config)
(let* (;; init a double pointer
(pointer (u64vector 0))
(double-pointer (bytevector->pointer pointer))
;; convert arguments to c types
(%uri (string->pointer uri))
(%config (string->pointer config))
;; call the foreign function
(code (foreign-function (session-handle session) %uri *NULL* %config double-pointer)))
(if (eq? code 0)
(make make-cursor make-cursor-structure pointer 20)
(let ((message (format #false "(cursor-open ~a ~s ~s)" session uri config)))
(wiredtiger-string-error message code)))))))
(define*-public (cursor-open session uri #:optional (config ""))
((%cursor-open session) uri config))
;;; key/value set/ref
(define (item->string bv)
(pointer->string (make-pointer (array-ref bv 0))))
(define (item->integer bv)
(array-ref bv 0))
(define *item->value* `((#\S . ,item->string)
(#\Q . ,item->integer)
(#\q . ,item->integer)
(#\r . ,item->integer)))
(define (pointers->scm formats pointers)
(let loop ((formats (string->list formats))
(pointers pointers)
(out '()))
(cond
((and (null? formats) (null? pointers)) out)
((or (null? formats) (null? pointers))
(throw 'wiredtiger "failed to ref cursor value due to format error"))
(else (loop (cdr formats)
(cdr pointers)
(append out (list ((assoc-ref *item->value* (car formats)) (car pointers)))))))))
(define-public (cursor-key-ref cursor)
(let* ((args (map (lambda (_) (u64vector 0)) (string->list (cursor-key-format cursor))))
(args* (append (list (cursor-handle cursor)) (map bytevector->pointer args)))
(signature (map (lambda (_) *pointer*) args*))
(proc (pointer->procedure int
(cursor-structure-key-ref (cursor-structure cursor))
signature)))
(apply proc args*)
(pointers->scm (cursor-key-format cursor) args)))
(define-public (cursor-value-ref cursor)
(let* ((args (map (lambda ignore (u64vector 0))
(string->list (cursor-value-format cursor))))
(args* (append (list (cursor-handle cursor))
(map bytevector->pointer args)))
(signature (map (lambda (_) *pointer*) args*))
(proc (pointer->procedure int
(cursor-structure-value-ref (cursor-structure cursor))
signature)))
(apply proc args*)
(pointers->scm (cursor-value-format cursor) args)))
;;; set procedures
(define make-string-pointer
(compose bytevector->pointer
(cut string->bytevector <> "utf-8")
(cut string-append <> "\0")))
(define *format->pointer* `((#\S . ,make-string-pointer)
(#\Q . ,make-pointer)
(#\q . ,make-pointer)
(#\r . ,make-pointer)))
(define (formats->items formats values)
(let loop ((formats (string->list formats))
(values values)
(out '()))
(cond
((and (null? formats) (null? values)) out)
((or (null? formats) (null? values))
(throw 'wiredtiger "failed to set cursor due to format error"))
(else (loop (cdr formats)
(cdr values)
(append out (list ((assoc-ref *format->pointer* (car formats)) (car values)))))))))
(define-public (cursor-key-set cursor . key)
(let* ((args (append (list (cursor-handle cursor)) (formats->items (cursor-key-format cursor) key)))
(signature (map (lambda (_) *pointer*) args))
(proc (pointer->procedure int
(cursor-structure-key-set (cursor-structure cursor))
signature)))
(apply proc args)))
(define-public (cursor-value-set cursor . value)
(let* ((args (append (list (cursor-handle cursor)) (formats->items (cursor-value-format cursor) value)))
(signature (map (lambda (_) *pointer*) args))
(proc (pointer->procedure int
(cursor-structure-value-set (cursor-structure cursor))
signature)))
(apply proc args)))
(define (%cursor-reset cursor)
(foreign
(int (cursor-structure-reset (cursor-structure cursor)) *pointer*)
(lambda (foreign-function)
(let* (;; call the foreign function
(code (foreign-function (cursor-handle cursor))))
(if (eq? code 0)
#true
(let ((message (format #false "(cursor-reset ~a)" cursor)))
(wiredtiger-string-error message code)))))))
(define-public (cursor-reset cursor)
((%cursor-reset cursor)))
(define (%cursor-next cursor)
(foreign
(int (cursor-structure-next (cursor-structure cursor)) *pointer*)
(lambda (foreign-function)
(let* (;; call the foreign function
(code (foreign-function (cursor-handle cursor))))
(if (eq? code 0)
#true
(if (eq? code WT_NOTFOUND)
#false
(let ((message (format #false "(cursor-next ~a)" cursor)))
(wiredtiger-string-error message code))))))))
(define-public (cursor-next cursor)
((%cursor-next cursor)))
(define (%cursor-previous cursor)
(foreign
(int (cursor-structure-previous (cursor-structure cursor)) *pointer*)
(lambda (foreign-function)
(let* (;; call the foreign function
(code (foreign-function (cursor-handle cursor))))
(if (eq? code 0)
#true
(let ((message (format #false "(cursor-previous ~a)" cursor)))
(wiredtiger-string-error message code)))))))
(define-public (cursor-previous cursor)
((%cursor-previous cursor)))
(define (%cursor-search cursor)
(foreign
(int (cursor-structure-search (cursor-structure cursor)) *pointer*)
(lambda (foreign-function)
(let* (;; call the foreign function
(code (foreign-function (cursor-handle cursor))))
(if (eq? code 0)
#true
#false)))))
(define-public (cursor-search cursor)
((%cursor-search cursor)))
(define (%cursor-search-near cursor)
(foreign
(int (cursor-structure-search-near (cursor-structure cursor)) *pointer* *pointer*)
(lambda (foreign-function)
(let* (;; init a integer pointer
(integer (u64vector 0))
(pointer (bytevector->pointer integer))
;; call the foreign function
(code (foreign-function (cursor-handle cursor) pointer)))
(if (eq? code 0)
(array-ref integer 0)
(if (eq? code WT_NOTFOUND)
#false
(let ((message (format #false "(cursor-search-near ~a)" cursor)))
(wiredtiger-string-error message code))))))))
(define-public (cursor-search-near cursor)
((%cursor-search-near cursor)))
(define (%cursor-insert cursor)
(foreign
(int (cursor-structure-insert (cursor-structure cursor)) *pointer*)
(lambda (foreign-function)
(let* (;; call the foreign function
(code (foreign-function (cursor-handle cursor))))
(if (eq? code 0)
#true
(let ((message (format #false "(cursor-insert ~a)" cursor)))
(wiredtiger-string-error message code)))))))
(define-public (cursor-insert cursor)
((%cursor-insert cursor)))
(define (%cursor-update cursor)
(foreign
(int (cursor-structure-update (cursor-structure cursor)) *pointer*)
(lambda (foreign-function)
(let* (;; call the foreign function
(code (foreign-function (cursor-handle cursor))))
(if (eq? code 0)
#true
(let ((message (format #false "(cursor-update ~a)" cursor)))
(wiredtiger-string-error message code)))))))
(define-public (cursor-update cursor)
((%cursor-update cursor)))
(define (%cursor-remove cursor)
(foreign
(int (cursor-structure-remove (cursor-structure cursor)) *pointer*)
(lambda (foreign-function)
(let* (;; call the foreign function
(code (foreign-function (cursor-handle cursor))))
(if (eq? code 0)
#true
(let ((message (format #false "(cursor-remove ~a)" cursor)))
(wiredtiger-string-error message code)))))))
(define-public (cursor-remove cursor)
((%cursor-remove cursor)))
(define (%cursor-close cursor)
(foreign
(int (cursor-structure-close (cursor-structure cursor)) *pointer*)
(lambda (foreign-function)
(let* (;; call the foreign function
(code (foreign-function (cursor-handle cursor))))
(if (eq? code 0)
#true
(let ((message (format #false "(cursor-close ~a)" cursor)))
(wiredtiger-string-error message code)))))))
(define-public (cursor-close cursor)
((%cursor-close cursor)))
[-- Attachment #9: path.scm --]
[-- Type: text/plain, Size: 2259 bytes --]
(define-module (path))
(use-modules (ice-9 optargs))
(define (path-exists? path)
"Return #true if path is a file or directory.
#false if it doesn't exists"
(access? path F_OK))
(define-public (path-join . rest)
"Return the absolute path made of REST. If the first item
of REST is not absolute the current working directory
will be prepended"
(let ((path (string-join rest "/")))
(if (string-prefix? "/" path)
path
(string-append (getcwd) "/" path))))
(define-public (path-split path)
(let ((parts (string-split path #\/)))
(if (equal? (car parts) "")
(cons (string-append "/" (cadr parts)) (cddr parts))
parts)))
(define*-public (path-mkdir dirpath #:optional (parents #false))
"Create DIRPATH directory and its parents if PARENTS is true"
(if parents
(let* ((parts (path-split dirpath))
(paths (let loop ((dirs (cdr parts))
(out (list (car parts))))
(if (null? dirs)
(reverse out)
(loop (cdr dirs) (cons (apply path-join (list (car out) (car dirs))) out))))))
(and (map (lambda (p) (if (not (path-exists? p)) (mkdir p))) paths) #true))
(if (not (path-exists? dirpath)) (and (mkdir dirpath) #true))))
(define-public (path-dfs-walk dirpath proc)
(define dir (opendir dirpath))
(let loop ()
(let ((entry (readdir dir)))
(cond
((eof-object? entry))
((or (equal? entry ".") (equal? entry "..")) (loop))
(else (let ((path (path-join dirpath entry)))
(if (equal? (stat:type (stat path)) 'directory)
(begin (path-dfs-walk path proc)
(proc path))
(begin (proc path) (loop))))))))
(closedir dir)
(proc (path-join dirpath)))
(define-public (rmtree path)
(path-dfs-walk path (lambda (path)
(if (equal? (stat:type (stat path)) 'directory)
(rmdir path)
(delete-file path)))))
(define-syntax-rule (with-directory path e ...)
(begin
(when (access? path F_OK)
(rmtree path))
(mkdir path)
e ...
(rmtree path)))
(export with-directory)
[-- Attachment #10: znumber.scm --]
[-- Type: text/plain, Size: 1444 bytes --]
(define-module (znumber))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-60))
;;; z order curve also known as morton code
;;
;; 64bit max positive integer packing and unpacking
;;
;; zpack
(define (->u64-list v)
(if (eq? (length v) 64)
v
(->u64-list (cons #false v))))
(define integer->list*
(compose ->u64-list integer->list))
(define (zbits vs)
(concatenate (apply zip (map integer->list* vs))))
(define (zbits->bv zbits)
(let loop ((zbits zbits)
(out (list)))
(if (null? zbits)
(list->u8vector out)
(loop (drop zbits 8)
(append out (list (list->integer (take zbits 8))))))))
(define-public (zpack vs)
(zbits->bv (zbits vs)))
(define-public (zpack* vs)
(zpack (map (lambda (v) (if (string? v) (string-hash v) v)) vs)))
;; zunpack
(define (->u8-list v)
(if (eq? (length v) 8)
v
(->u8-list (cons #false v))))
(define (bv->zbits bv)
(append-map integer->list bv))
(define (unzip* input count)
(let loop ((input input)
(out (map (lambda (x) (list)) (iota count))))
(if (null? input)
out
(loop (drop input count)
(map (lambda (x y) (append x (list y))) out (take input count))))))
(define-public (zunpack bv count)
(let* ((->bits (compose ->u8-list integer->list))
(zbits (append-map ->bits (u8vector->list bv))))
(map list->integer (unzip* zbits count))))
[-- Attachment #11: tests.scm --]
[-- Type: text/plain, Size: 3039 bytes --]
#!/usr/bin/env guile
!#
(use-modules (srfi srfi-64)) ;; unit test framework
(use-modules (srfi srfi-41)) ;; stream
(use-modules (culturia))
(test-begin "main")
;;; path utils
(define (path-join . rest)
"Return the absolute path made of REST. If the first item
of REST is not absolute the current working directory
will be prepend"
(let ((path (string-join rest "/")))
(if (string-prefix? "/" path)
path
(string-append (getcwd) "/" path))))
(define (path-dfs-walk dirpath proc)
(define dir (opendir dirpath))
(let loop ()
(let ((entry (readdir dir)))
(cond
((eof-object? entry))
((or (equal? entry ".") (equal? entry "..")) (loop))
(else (let ((path (path-join dirpath entry)))
(if (equal? (stat:type (stat path)) 'directory)
(begin (path-dfs-walk path proc)
(proc path))
(begin (proc path) (loop))))))))
(closedir dir)
(proc (path-join dirpath)))
(define (rmtree path)
(path-dfs-walk path (lambda (path)
(if (equal? (stat:type (stat path)) 'directory)
(rmdir path)
(delete-file path)))))
(define-syntax-rule (with-directory path e ...)
(begin
(when (access? path F_OK)
(rmtree path))
(mkdir path)
e ...
(rmtree path)))
(test-group "culturia"
(with-directory "/tmp/culturia"
(let* ((culturia (open-culturia "/tmp/culturia"))
(atom (create-atom culturia (list (cons "name" "Kely Vaue")))))
;; a few sanity tests
(test-equal "empty outgoings"
(stream->list (atom-outgoings atom))
(list))
(test-equal "empty incomings"
(stream->list (atom-incomings atom))
(list))
(test-equal "assoc" (atom-assoc atom) (list (cons "name" "Kely Vaue")))
(let ((idem (culturia-ref culturia (atom-uid atom))))
(test-equal "atom-assoc is equal" (atom-assoc atom) (atom-assoc idem)))
;;
(let ((atom! (atom-set atom "name" "Vaue Kely")))
(test-equal "atom-set" (atom-ref atom! "name") "Vaue Kely")
(let ((other (create-atom culturia (list (cons "name" "Oter Ahtom")))))
;; prepare
(atom-link atom other)
;; tests
(test-equal "not empty outgoings"
(stream->list (atom-outgoings atom)) (list other))
(test-equal "not empty incomings"
(stream->list (atom-incomings other)) (list atom!))))
(culturia-close culturia)
)
))
(test-end "main")
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2016-02-16 19:27 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-02-16 19:27 [potluck dish] an hyper-graphdb known as culture Amirouche Boubekki
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).