From 1deb7d533866f7b67e9df112e5ad89dd42ee70cd Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Thu, 23 Dec 2021 17:53:07 +0530
Subject: Dump metadata about the dump itself.

* dump.scm (remove-namespace, dump-id): New functions.
(define-dump): Dump metadata about the dump itself.
---
 dump.scm | 46 +++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 43 insertions(+), 3 deletions(-)

(limited to 'dump.scm')

diff --git a/dump.scm b/dump.scm
index 882438b..c92a0cd 100755
--- a/dump.scm
+++ b/dump.scm
@@ -197,6 +197,10 @@ ALIST field-name) forms."
                   key))))
         clauses))
 
+(define (remove-namespace str)
+  "Remove RDF namespace prefix from STR."
+  (substring str (1+ (string-index str #\:))))
+
 (define (column-id table-name column-name)
   (string->identifier
    "field" (string-append
@@ -206,6 +210,13 @@ ALIST field-name) forms."
                 "user2" table-name)
             "__" column-name)))
 
+(define (dump-id dump-table predicate)
+  (symbol->string
+   (string->identifier
+    "dump"
+    (string-append
+     dump-table "_" (remove-namespace (symbol->string predicate))))))
+
 (define-syntax define-dump
   (lambda (x)
     (syntax-case x (tables schema-triples triples)
@@ -215,8 +226,8 @@ ALIST field-name) forms."
                                         #'(schema-triples)))
              (triples-clause (find-clause #'(clauses ...) 'triples)))
          (syntax-case triples-clause (triples)
-           ((triples subject predicates ...)
-            (let ((fields (collect-fields #'(subject predicates ...))))
+           ((triples subject predicate-clauses ...)
+            (let ((fields (collect-fields #'(subject predicate-clauses ...))))
               #`(define (name db)
                   #,(syntax-case schema-triples-clause (schema-triples)
                       ((schema-triples (triple-subject triple-predicate triple-object) ...)
@@ -225,9 +236,38 @@ ALIST field-name) forms."
                                    (list 'triple-predicate ...)
                                    (list 'triple-object ...)))
                       (_ (error "Invalid schema triples clause:" schema-triples-clause)))
+                  #,@(let ((dump-table (syntax-case tables-clause (tables)
+                                         ((tables (primary-table _ ...) _ ...)
+                                          (symbol->string (syntax->datum #'primary-table)))
+                                         (_ (error "Invalid tables clause:" (syntax->datum tables-clause)))))
+                           (subject-type (any (lambda (predicate)
+                                                (syntax-case predicate (rdf:type)
+                                                  ((_ rdf:type type) #'type)
+                                                  (_ #f)))
+                                              #'(predicate-clauses ...))))
+                       (map (lambda (predicate-clause)
+                              (syntax-case predicate-clause ()
+                                ((_ predicate _)
+                                 ;; Dump metadata about the dump itself.
+                                 #`(scm->triples
+                                    (map-alist '()
+                                      (set rdf:type 'gn:dump)
+                                      (set gn:createsPredicate 'predicate)
+                                      (filter-set gn:forSubjectType #,subject-type)
+                                      (multiset gn:dependsOn
+                                                '#,(map (lambda (field)
+                                                          (match (syntax->datum field)
+                                                            ((table-name column-name _ ...)
+                                                             (datum->syntax
+                                                              x (column-id (symbol->string table-name)
+                                                                           (symbol->string column-name))))))
+                                                        (collect-fields predicate-clause))))
+                                    #,(dump-id dump-table (syntax->datum #'predicate))))
+                                (_ (error "Invalid predicate clause:" predicate-clause))))
+                            #'(predicate-clauses ...)))
                   (sql-for-each (lambda (row)
                                   (scm->triples
-                                   (map-alist row #,@(field->key #'(predicates ...)))
+                                   (map-alist row #,@(field->key #'(predicate-clauses ...)))
                                    #,(field->assoc-ref #'row #'subject)))
                                 db
                                 #,(syntax-case tables-clause (tables)
-- 
cgit v1.2.3