diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-05-27 20:33:47 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-06-05 16:59:44 +0200 |
commit | 3b46a347ec00a926c8b9a923ed1ddc4563e7da42 (patch) | |
tree | 1e2a333aec89ba30b6d3a1fab6303d7e598393d2 /src | |
parent | 16a0cc211e7de59002399cd15a2b99bb6fdb941d (diff) |
Easier interface to query an RDF dataset
Diffstat (limited to 'src')
-rw-r--r-- | src/scm/webid-oidc/Makefile.am | 6 | ||||
-rw-r--r-- | src/scm/webid-oidc/rdf-index.scm | 76 |
2 files changed, 80 insertions, 2 deletions
diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am index 6aeadfc..af8746f 100644 --- a/src/scm/webid-oidc/Makefile.am +++ b/src/scm/webid-oidc/Makefile.am @@ -24,7 +24,8 @@ dist_webidoidcmod_DATA += \ %reldir%/hello-world.scm \ %reldir%/reverse-proxy.scm \ %reldir%/client.scm \ - %reldir%/example-app.scm + %reldir%/example-app.scm \ + %reldir%/rdf-index.scm webidoidcgo_DATA += \ %reldir%/errors.go \ @@ -52,6 +53,7 @@ webidoidcgo_DATA += \ %reldir%/hello-world.go \ %reldir%/reverse-proxy.go \ %reldir%/client.go \ - %reldir%/example-app.go + %reldir%/example-app.go \ + %reldir%/rdf-index.go EXTRA_DIST += %reldir%/ChangeLog diff --git a/src/scm/webid-oidc/rdf-index.scm b/src/scm/webid-oidc/rdf-index.scm new file mode 100644 index 0000000..3875f91 --- /dev/null +++ b/src/scm/webid-oidc/rdf-index.scm @@ -0,0 +1,76 @@ +(define-module (webid-oidc rdf-index) + #:use-module (oop goops) + #:use-module (rdf rdf) + #:export + ( + with-index + )) + +(define-class <rdf-index> () + (triples #:init-keyword #:triples #:getter triples) + (subject-index #:init-thunk (lambda () (make-hash-table)) + #:getter subject-index) + (predicate-index #:init-thunk (lambda () (make-hash-table)) + #:getter predicate-index) + (object-index #:init-thunk (lambda () (make-hash-table)) + #:getter object-index)) + +(define (build-index triples) + (let ((ret (make <rdf-index> #:triples (list->vector triples)))) + (define (do-index n triples) + (unless (null? triples) + (let ((first (car triples)) + (rest (cdr triples))) + (let ((s (rdf-triple-subject first)) + (p (rdf-triple-predicate first)) + (o (rdf-triple-object first))) + (let ((other-s (hash-ref (subject-index ret) s '())) + (other-p (hash-ref (predicate-index ret) p '())) + (other-o (hash-ref (object-index ret) o '())) + (i (- n 1))) + (hash-set! (subject-index ret) s (cons i other-s)) + (hash-set! (predicate-index ret) p (cons i other-p)) + (hash-set! (object-index ret) o (cons i other-o)))) + (do-index (- n 1) rest)))) + (do-index (length triples) (reverse triples)) + ret)) + +(define (intersection-2 a b) + (cond + ((not a) b) + ((not b) a) + ((or (null? a) (null? b)) + '()) + ((< (car a) (car b)) + (intersection-2 (cdr a) b)) + ((> (car a) (car b)) + (intersection-2 a (cdr b))) + (else + (cons (car a) (intersection-2 (cdr a) (cdr b)))))) + +(define (intersection a . rest) + (if (null? rest) + a + (let ((b (car rest)) + (true-rest (cdr rest))) + (apply intersection (intersection-2 a b) true-rest)))) + +(define (rdf-match index subject predicate object) + (let ((by-subject (and subject (hash-ref (subject-index index) subject '()))) + (by-predicate (and predicate (hash-ref (predicate-index index) predicate '()))) + (by-object (and object (hash-ref (object-index index) object '())))) + (let ((indices (intersection by-subject by-predicate by-object))) + (define (accumulate-triples acc i) + (if (null? i) + (reverse acc) + (let ((t (vector-ref (triples index) (car i)))) + (accumulate-triples (cons t acc) (cdr i))))) + (if indices + (accumulate-triples '() indices) + (vector->list (triples index)))))) + + +(define (with-index graph f) + (let ((index (build-index graph))) + (f (lambda (s p o) + (rdf-match index s p o))))) |