diff options
Diffstat (limited to 'generate-ttl-files.scm')
| -rwxr-xr-x | generate-ttl-files.scm | 169 |
1 files changed, 118 insertions, 51 deletions
diff --git a/generate-ttl-files.scm b/generate-ttl-files.scm index 65db03f..28be496 100755 --- a/generate-ttl-files.scm +++ b/generate-ttl-files.scm @@ -1,60 +1,127 @@ -#! ./pre-inst-env +#! /usr/bin/env guile !# + (use-modules (ice-9 format) - (ice-9 futures) (ice-9 getopt-long) - (ice-9 ftw)) + (ice-9 ftw) + (ice-9 regex) + (srfi srfi-26) + (srfi srfi-34) + (srfi srfi-35)) + + +;; Copied over from GNU/Guix source tree. +(define (file-name-predicate regexp) + "Return a predicate that returns true when passed a file name whose base +name matches REGEXP." + (let ((file-rx (if (regexp? regexp) + regexp + (make-regexp regexp)))) + (lambda (file stat) + (regexp-exec file-rx (basename file))))) + +(define* (find-files dir #:optional (pred (const #t)) + #:key (stat lstat) + directories? + fail-on-error?) + "Return the lexicographically sorted list of files under DIR for which PRED +returns true. PRED is passed two arguments: the absolute file name, and its +stat buffer; the default predicate always returns true. PRED can also be a +regular expression, in which case it is equivalent to (file-name-predicate +PRED). STAT is used to obtain file information; using 'lstat' means that +symlinks are not followed. If DIRECTORIES? is true, then directories will +also be included. If FAIL-ON-ERROR? is true, raise an exception upon error." + (let ((pred (if (procedure? pred) + pred + (file-name-predicate pred)))) + ;; Sort the result to get deterministic results. + (sort (file-system-fold (const #t) + (lambda (file stat result) ; leaf + (if (pred file stat) + (cons file result) + result)) + (lambda (dir stat result) ; down + (if (and directories? + (pred dir stat)) + (cons dir result) + result)) + (lambda (dir stat result) ; up + result) + (lambda (file stat result) ; skip + result) + (lambda (file stat errno result) + (format (current-error-port) "find-files: ~a: ~a~%" + file (strerror errno)) + (when fail-on-error? + (error "find-files failed")) + result) + '() + dir + stat) + string<?))) + +(define-syntax-rule (warn-on-error expr file) + (catch 'system-error + (lambda () + expr) + (lambda args + (format (current-error-port) + "warning: failed to delete ~a: ~a~%" + file (strerror + (system-error-errno args)))))) + +(define* (delete-file-recursively dir + #:key follow-mounts?) + "Delete DIR recursively, like `rm -rf', without following symlinks. Don't +follow mount points either, unless FOLLOW-MOUNTS? is true. Report but ignore +errors." + (let ((dev (stat:dev (lstat dir)))) + (file-system-fold (lambda (dir stat result) ; enter? + (or follow-mounts? + (= dev (stat:dev stat)))) + (lambda (file stat result) ; leaf + (warn-on-error (delete-file file) file)) + (const #t) ; down + (lambda (dir stat result) ; up + (warn-on-error (rmdir dir) dir)) + (const #t) ; skip + (lambda (file stat errno result) + (format (current-error-port) + "warning: failed to delete ~a: ~a~%" + file (strerror errno))) + #t + dir + + ;; Don't follow symlinks. + lstat))) (let* ((option-spec '((settings (single-char #\s) (value #t)) - (output (single-char #\o) (value #t)) - (documentation (single-char #\d) (value #t)))) + (documentation (single-char #\d) (value #t)) + (output (single-char #\o) (value #t)))) (options (getopt-long (command-line) option-spec)) (settings (option-ref options 'settings #f)) (output (option-ref options 'output #f)) - (documentation (option-ref options 'documentation #f))) - (define (enter? name stat result) - stat result ;ignore - ;; Skip version control directories if any. - (not (member (basename name) '(".git" ".svn" "CVS")))) - - (define (leaf name stat result) - stat result ;ignore - (when (string-suffix? ".scm" name) - (let* ((base-file-name (basename name ".scm")) - (cmd (format #f " ~a --settings ~a --output ~a --documentation ~a" - name - settings - (string-append output "/" base-file-name ".ttl") - (string-append documentation "/" base-file-name ".md")))) - (touch - (future - (begin - (display (format #f "Running ~a" cmd)) - (display "\n") - (system cmd))))))) - - (define (down name stat result) - name stat ;ignore - result) - - (define (up name stat result) - name stat ;ignore - result) - - (define (skip name stat result) - name stat ;ignore - result) - - ;; Ignore unreadable files/directories but warn the user. - (define (error name stat errno result) - stat ;ignore - (format (current-error-port) "warning: ~a: ~a~%" - name (strerror errno)) - result) - - (file-system-fold enter? leaf down up skip error - 0 ;initial counter is zero bytes - "./examples")) - - + (documentation (option-ref options 'documentation #f)) + (%source-dir (dirname (current-filename)))) + (unless (file-exists? output) + (mkdir output)) + ;; Transform data to RDF + (for-each (lambda (file) + (let* ((base-file-name (basename file ".scm")) + (ttl-file (string-append output "/" base-file-name ".ttl"))) + ;; Ignore dataset-metadata-git.scm because TODO + (unless (string=? base-file-name "dataset-metadata-git") + (system* "guile" "-L" (dirname (current-filename)) file + "--settings" settings "--output" ttl-file)))) + (find-files "./examples" ".scm")) + ;; Copy hand-woven ttl files. + (for-each (lambda (file) + (copy-file + file (format #f "~a/~a" output (basename file)))) + (find-files "./schema" ".ttl")) + ;; Validate transformed turtle files + (for-each (lambda (file) + (system* "rapper" "--input" "turtle" "--count" file)) + (append (find-files output ".ttl") + (find-files "./schema" ".ttl")))) |