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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
;;; Harmonic Flow web site
(define-module (apps base utils)
#:use-module (apps aux lists)
#:use-module (apps aux system)
#:use-module (apps base types)
#:use-module (apps i18n)
#:use-module (haunt artifact)
#:use-module (ice-9 i18n)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (gnu-url
hfweb-url
locale-display-name
manual-url
manual-devel-url
manual-url-with-language
number*
paginate
packages-url))
;;;
;;; Harmonic Flow variables.
;;;
(define* (gnu-url #:optional (path ""))
"Append PATH to GNU.org URL.
PATH (string)
An optional relative URL path to a resource. For example:
'software/guile/'.
RETURN VALUE (string)
A URL. For example: https://gnu.org/software/guile/."
(string-append "https://gnu.org/" path))
(define hfweb-root-url-path
;; Path to hfge site:
(let ((path (match (getenv "HFGE_WEB_SITE_LOCAL")
;; If we are trying out the website locally, use "/" as the root.
("yes" "/")
(else (or (getenv "HFGE_WEB_SITE_ROOT_PATH") "/")))))
(make-parameter
path
;; When setting hfweb-root-url-path, make it end in a slash.
(lambda (path)
(if (string-suffix? "/" path)
path
(string-append path "/"))))))
(define (locale-display-name)
"Return the display name of the current locale."
;; TRANSLATORS: The locale’s display name; please include a country
;; code like in English (US) *only* if there are multiple
;; translations for the same language.
(let ((str '(G_ "English")))
;;; XXX: If we ever add a separate English (UK) translation, then
;;; change the display name to English (US), but maybe do not
;;; change str, because it would break translated PO files.
(gettext (cadr str))))
;;;
;;; URL linking.
;;;
(define* (hfweb-url #:optional (subpath "") #:key (localize #t))
"Append SUBPATH to Harmonic Flow root URL path (see hfweb-root-url-path).
SUBPATH (string)
An optional relative URL path to a resource in the Harmonic Flwo path.
For example: 'indeed/something-XYZ/'.
LOCALIZE (boolean)
Whether to prepend the result of 'localized-root-path' to the URL path.
RETURN VALUE (string)
A URL path. For example: /indeed/something/-XYZ/."
(string-append (hfweb-root-url-path)
(if localize (localized-root-path subpath) "")
subpath))
(define* (manual-url #:optional (subpath "")
#:key (language "en"))
"Append SUBPATH to the Harmonic Flow manual URL path.
SUBPATH (string)
An optional relative URL path to a section of the manual.
For example: 'SomeFile.html'.
RETURN VALUE (string)
A URL path. For example:
/indeed/SomeFile.html."
(string-append
(hfweb-url (string-append (string-append "manual/" language
"/html_node/")
subpath) #:localize #f)))
(define* (manual-devel-url #:optional (subpath "")
#:key (language "en"))
"Similar to 'manual-url', but link to the development manual."
(string-append
(hfweb-url (string-append (string-append "manual/devel/" language
"/html_node/")
subpath) #:localize #f)))
(define* (manual-url-with-language _ language #:optional (subpath ""))
"Shorthand for manual-url without keywords for prettier output
PO files when marked for translation. It can be marked for translation
as:
(G_ (manual-url-with-language (G_ \"en\") (G_ \"Some-section.html\")))
LANGUAGE (string)
Normalized language for the Guix manual as produced by
'doc/build.scm' in the Guix source tree, i.e. \"en\" for the English
manual.
SUBPATH (string)
Like manual-url.
RETURN VALUE (string)
A URL path. For example:
/software/guix/manual/en/html_node/System-installation.html."
;; The _ argument is a placeholder for an arg added by G_, cf. i18n-howto.txt.
(manual-url subpath #:language language))
;;;
;;; Helper procedures.
;;;
(define (number* number)
"Return NUMBER correctly formatting according to English conventions."
(number->locale-string number 0
(or (false-if-exception
(make-locale LC_ALL "en_US.utf8"))
(make-locale LC_ALL "en_US.UTF-8"))))
(define* (paginate #:key dataset (limit 30) base-path template (context '()) writer)
"Distribute the objects of the DATASET in pages.
DATASET (list)
A list with any kind of object.
LIMIT (integer)
The maximum number of objects that should appear in a page.
The limit is optional. If not provided, it defaults to 30.
BASE-PATH (string)
A system path relative to the website directory where all the
pages will be written to. For example: 'blog' or 'blog/tags'.
In the latter example, pages would be written to files in a path
like 'blog/tags/page/PAGE_NUMBER/index.html'.
TEMPLATE (procedure)
A procedure that accepts a context and returns an SXML tree.
CONTEXT (context)
A context object as defined in (apps base types). The context
holds additional data to insert into the TEMPLATE.
The context is optional, and will always be extended to include
the following data that can be used in the TEMPLATE:
items (list)
The list of items to insert into the page.
total-pages (integer)
The number of pages generated to distribute all items.
page-number (integer)
The number of the page.
WRITER
A procedure that writes the page into a given format. See Haunt's
'sxml->html' writer in the (haunt html) module, for example.
RETURN VALUE (list)
A list of <page> objects as defined in (haunt page) module."
(let* ((grouped-data (list-group dataset limit))
(total-pages (cons "total-pages" (length grouped-data))))
;; Read the following like (cons Page ListOfPages):
(cons
;; Page
;; This is the cover of the pages. For example, the resource
;; located in a path such as /blog/, which is identical to the
;; resource available in /blog/page/1/.
(let* ((page-number (cons "page-number" 1))
(path (path-join base-path "index.html"))
(items
(match grouped-data
(()
(cons "items" '()))
((head _ ...)
(cons "items" head))))
(new-context
(append context
(list items page-number total-pages))))
(serialized-artifact path (template new-context) writer))
;; ListOfPages
;; This is a list of pages that are the actual ordered pages
;; located in paths such as /blog/page/NUMBER/.
(map
(lambda (index)
(let* ((page-number (cons "page-number" (+ index 1)))
(path (path-join base-path
"page"
(number->string (+ index 1))
"index.html"))
(items (cons "items" (list-ref grouped-data index)))
(new-context
(append context (list items page-number total-pages))))
(serialized-artifact path (template new-context) writer)))
(iota (length grouped-data))))))
|
