blob: ded64238b375454350376790198659afd1f593cd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
#! /usr/bin/env guile
!#
(use-modules (ice-9 format)
(ice-9 getopt-long)
(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
(const #t)
(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 (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 output))
(system* "git" "clone" "--depth" "1"
documentation gn-docs-dir)
;; Delete all the files in the gn-docs/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"))
(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")
(system* "./pre-inst-env" file "--settings" settings
"--output" ttl-file
"--documentation" md-file))))
(find-files "./examples" ".scm"))
(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)
(system* "rapper" "--input" "turtle" "--count" file))
(append (find-files output ".ttl")
(find-files "./schema" ".ttl")))
;; Push changes to git when data is correctly valldated
(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"))))))
|
