Replace (guix build utils) functions with guile in-built ones.

Signed-off-by: Munyoki Kilyungi <me@bonfacemunyoki.com>

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"))))))