diff options
| -rwxr-xr-x | generate-ttl-files.scm | 138 |
1 files changed, 112 insertions, 26 deletions
diff --git a/generate-ttl-files.scm b/generate-ttl-files.scm index 2f14b25..ded6423 100755 --- a/generate-ttl-files.scm +++ b/generate-ttl-files.scm @@ -3,12 +3,98 @@ (use-modules (ice-9 format) (ice-9 getopt-long) - (guix build utils) + (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))) + (define (call-with-temporary-directory proc) (let ((tmp-dir (mkdtemp "/tmp/generate-ttl-files.XXXXXX"))) (dynamic-wind @@ -16,52 +102,52 @@ (cut proc tmp-dir) (cut delete-file-recursively tmp-dir)))) + (let* ((option-spec '((settings (single-char #\s) (value #t)) (documentation (single-char #\d) (value #t)) (output (single-char #\o) (value #t)))) (options (getopt-long (command-line) option-spec)) - (settings (canonicalize-path (option-ref options 'settings #f))) - (output (canonicalize-path (option-ref options 'output #f))) - (documentation (canonicalize-path (option-ref options 'documentation #f))) + (settings (option-ref options 'settings #f)) + (output (option-ref options 'output #f)) + (documentation (option-ref options 'documentation #f)) (%source-dir (dirname (current-filename)))) (call-with-temporary-directory (lambda (tmpdir) (let* ((gn-docs-dir (string-append tmpdir "/gn-docs")) (rdf-documentation (string-append gn-docs-dir "/rdf-documentation"))) (unless (file-exists? output) - (mkdir-p output)) - - (invoke "git" "clone" "--depth" "1" - documentation gn-docs-dir) + (mkdir output)) + (system* "git" "clone" "--depth" "1" + documentation gn-docs-dir) ;; Delete all the files in the gn-docs/rdf-documentation - (delete-file-recursively rdf-documentation) - (mkdir-p rdf-documentation) + (for-each (lambda (file) + (delete-file file)) + (find-files rdf-documentation ".md")) ;; Transform data to RDF (for-each (lambda (file) (let* ((base-file-name (basename file ".scm")) - (pre-inst-env (canonicalize-path "./pre-inst-env")) - (ttl-file (string-append (canonicalize-path output) - "/" base-file-name ".ttl")) + (ttl-file (string-append output "/" base-file-name ".ttl")) (md-file (format #f "~a/~a.md" rdf-documentation base-file-name))) ;; Ignore dataset-metadata-git.scm because TODO (unless (string=? base-file-name "dataset-metadata-git") - (invoke "./pre-inst-env" file "--settings" settings - "--output" ttl-file - "--documentation" md-file)))) + (system* "./pre-inst-env" file "--settings" settings + "--output" ttl-file + "--documentation" md-file)))) (find-files "./examples" ".scm")) - (copy-recursively "./schema" output) + (for-each (lambda (file) + (copy-file + file (format #f "/~a/~a.ttl" output (basename file)))) + (find-files "./schema" ".ttl")) ;; Validate transformed turtle files (for-each (lambda (file) - (invoke "rapper" "--input" "turtle" "--count" file)) + (system* "rapper" "--input" "turtle" "--count" file)) (append (find-files output ".ttl") (find-files "./schema" ".ttl"))) ;; Push changes to git when data is correctly valldated - (guard (c ((invoke-error? c) - (invoke "git" "-C" gn-docs-dir "add" rdf-documentation) - (invoke "git" "-C" gn-docs-dir "commit" "--no-gpg-sign" "-m" - "Update RDF documentation.\n\n* Commit made via the generate-ttl-files.scm script\"") - (invoke "git" "-C" gn-docs-dir "push" "origin" "master"))) - (invoke "git" "-C" gn-docs-dir "diff" "--exit-code")))))) - - + (unless (zero? (status:exit-val + (system* "git" "-C" gn-docs-dir "diff" "--exit-code"))) + (system* "git" "-C" gn-docs-dir "add" rdf-documentation) + (system* "git" "-C" gn-docs-dir "commit" "--no-gpg-sign" "-m" + "Update RDF documentation.\n\n* Commit made via the generate-ttl-files.scm script\"") + (system* "git" "-C" gn-docs-dir "push" "origin" "master")))))) |