client: define initializers for the different types of pages

3 files changed, 162 insertions, 42 deletions

diff --git a/po/disfluid.pot b/po/disfluid.pot
index df0e8cb..ce6ac9a 100644
--- a/po/disfluid.pot
+++ b/po/disfluid.pot
@@ -8,7 +8,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: disfluid SNAPSHOT\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-10-12 22:25+0200\n"
+"POT-Creation-Date: 2021-10-12 22:35+0200\n"
 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
 "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
 "Language-Team: LANGUAGE <LL@li.org>\n"
@@ -631,17 +631,41 @@ msgstr ""
 msgid "You already have an account for ~a issued by ~a."
 msgstr ""
 
-#: src/scm/webid-oidc/client/application.scm:493
+#: src/scm/webid-oidc/client/application.scm:393
+msgid "the page URI (#:uri) should be a string encoding an URI or an URI"
+msgstr ""
+
+#: src/scm/webid-oidc/client/application.scm:420
+msgid ""
+"the error code (#:code) should be an integer and the reason phrase (#:reason-"
+"phrase) should be a string"
+msgstr ""
+
+#: src/scm/webid-oidc/client/application.scm:466
+msgid ""
+"the etag (#:etag) should be a string, the links (#:links) should be a list "
+"of links, the content-type (#:content-type) should be a symbol, and the "
+"content (#:content) should be a string or a bytevector"
+msgstr ""
+
+#: src/scm/webid-oidc/client/application.scm:502
+msgid ""
+"the desired links (#:desired-links) should be an alist from URI to alists, "
+"the desired content-type (#:desired-content-type) should be a symbol, and "
+"the desired content (#:desired-content) should be a string or a bytevector"
+msgstr ""
+
+#: src/scm/webid-oidc/client/application.scm:586
 #, scheme-format
 msgid "Loading ~a..."
 msgstr ""
 
-#: src/scm/webid-oidc/client/application.scm:572
+#: src/scm/webid-oidc/client/application.scm:665
 #, scheme-format
 msgid "Updating ~a (expected ETag ~a)"
 msgstr ""
 
-#: src/scm/webid-oidc/client/application.scm:619
+#: src/scm/webid-oidc/client/application.scm:712
 #, scheme-format
 msgid "Deleting ~a (expected ETag ~a)"
 msgstr ""
diff --git a/po/fr.po b/po/fr.po
index 6ae4ccf..ee02a43 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -2,8 +2,8 @@ msgid ""
 msgstr ""
 "Project-Id-Version: webid-oidc 0.0.0\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-10-12 22:25+0200\n"
-"PO-Revision-Date: 2021-10-12 22:26+0200\n"
+"POT-Creation-Date: 2021-10-12 22:35+0200\n"
+"PO-Revision-Date: 2021-10-12 22:34+0200\n"
 "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n"
 "Language-Team: French <vivien@planete-kraus.eu>\n"
 "Language: fr\n"
@@ -682,17 +682,53 @@ msgstr ""
 msgid "You already have an account for ~a issued by ~a."
 msgstr "Vous avez déjà un compte pour ~a émis par ~a."
 
-#: src/scm/webid-oidc/client/application.scm:493
+#: src/scm/webid-oidc/client/application.scm:393
+msgid "the page URI (#:uri) should be a string encoding an URI or an URI"
+msgstr ""
+"l’URI de la page doit être une chaîne de caractères encodant une URI ou une "
+"URI"
+
+#: src/scm/webid-oidc/client/application.scm:420
+msgid ""
+"the error code (#:code) should be an integer and the reason phrase (#:reason-"
+"phrase) should be a string"
+msgstr ""
+"le code d’erreur (#:code) doit être un entier et l’explication (#:reason-"
+"phrase) doit être une chaîne de caractères"
+
+#: src/scm/webid-oidc/client/application.scm:466
+msgid ""
+"the etag (#:etag) should be a string, the links (#:links) should be a list "
+"of links, the content-type (#:content-type) should be a symbol, and the "
+"content (#:content) should be a string or a bytevector"
+msgstr ""
+"l’etag (#:etag) doit être une chaîne de caractères, les liens (#:links) "
+"doivent être une liste de liens, le type de contenu (#:content-type) doit "
+"être un symbole, et le contenu (#:content) doit être une chaîne de "
+"caractères ou un vecteur d’octets"
+
+#: src/scm/webid-oidc/client/application.scm:502
+msgid ""
+"the desired links (#:desired-links) should be an alist from URI to alists, "
+"the desired content-type (#:desired-content-type) should be a symbol, and "
+"the desired content (#:desired-content) should be a string or a bytevector"
+msgstr ""
+"les liens désirés (#:desired-links) doivent être une aliste d’URIs vers des "
+"alistes, le type de contenu désiré (#:desired-content-type) doit être un "
+"symbole, et le ccontenu désiré (#:desired-content-type) doit être unne "
+"chaîne de caractères ou un vecteur d’octets"
+
+#: src/scm/webid-oidc/client/application.scm:586
 #, scheme-format
 msgid "Loading ~a..."
 msgstr "Chargement de ~a…"
 
-#: src/scm/webid-oidc/client/application.scm:572
+#: src/scm/webid-oidc/client/application.scm:665
 #, scheme-format
 msgid "Updating ~a (expected ETag ~a)"
 msgstr "Mise à jour de ~a (ETag attendu ~a)"
 
-#: src/scm/webid-oidc/client/application.scm:619
+#: src/scm/webid-oidc/client/application.scm:712
 #, scheme-format
 msgid "Deleting ~a (expected ETag ~a)"
 msgstr "Suppression de ~a (ETag attendu ~a)"
@@ -2818,39 +2854,6 @@ msgstr "Contenu :"
 msgid "Discard edits"
 msgstr "Rejeter les modifications"
 
-#~ msgid "the page URI (#:uri) should be a string encoding an URI or an URI"
-#~ msgstr ""
-#~ "l’URI de la page doit être une chaîne de caractères encodant une URI ou "
-#~ "une URI"
-
-#~ msgid ""
-#~ "the error code (#:code) should be an integer and the reason phrase (#:"
-#~ "reason-phrase) should be a string"
-#~ msgstr ""
-#~ "le code d’erreur (#:code) doit être un entier et l’explication (#:reason-"
-#~ "phrase) doit être une chaîne de caractères"
-
-#~ msgid ""
-#~ "the etag (#:etag) should be a string, the links (#:links) should be a "
-#~ "list of links, the content-type (#:content-type) should be a symbol, and "
-#~ "the content (#:content) should be a string or a bytevector"
-#~ msgstr ""
-#~ "l’etag (#:etag) doit être une chaîne de caractères, les liens (#:links) "
-#~ "doivent être une liste de liens, le type de contenu (#:content-type) doit "
-#~ "être un symbole, et le contenu (#:content) doit être une chaîne de "
-#~ "caractères ou un vecteur d’octets"
-
-#~ msgid ""
-#~ "the desired links (#:desired-links) should be an alist from URI to "
-#~ "alists, the desired content-type (#:desired-content-type) should be a "
-#~ "symbol, and the desired content (#:desired-content) should be a string or "
-#~ "a bytevector"
-#~ msgstr ""
-#~ "les liens désirés (#:desired-links) doivent être une aliste d’URIs vers "
-#~ "des alistes, le type de contenu désiré (#:desired-content-type) doit être "
-#~ "un symbole, et le ccontenu désiré (#:desired-content-type) doit être unne "
-#~ "chaîne de caractères ou un vecteur d’octets"
-
 #~ msgid "Disfluid"
 #~ msgstr "Disfluid"
 
diff --git a/src/scm/webid-oidc/client/application.scm b/src/scm/webid-oidc/client/application.scm
index bbc39fb..dc0f3c4 100644
--- a/src/scm/webid-oidc/client/application.scm
+++ b/src/scm/webid-oidc/client/application.scm
@@ -378,6 +378,22 @@
 (define-class <page-with-uri> (<page>)
   (uri #:init-keyword #:uri #:getter uri))
 
+(define-method (initialize (page <page-with-uri>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((uri #f))
+   (let do-initialize ((uri uri))
+     (match uri
+       ((or (? string? (= string->uri (? uri? uri)))
+            (? uri? uri))
+        (slot-set! page 'uri uri))
+       (else
+        (scm-error 'wrong-type-arg "make <page-with-uri>"
+                   (G_ "the page URI (#:uri) should be a string encoding an URI or an URI")
+                   '()
+                   (list uri)))))))
+
 (define-method (equal? (x <page-with-uri>) (y <page-with-uri>))
   (and (equal? (uri x) (uri y))))
 
@@ -387,6 +403,24 @@
   (code #:init-keyword #:code #:getter code)
   (reason-phrase #:init-keyword #:reason-phrase #:getter reason-phrase))
 
+(define-method (initialize (page <error-page>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((code #f)
+    (reason-phrase #f))
+   (let do-initialize ((code code)
+                       (reason-phrase reason-phrase))
+     (match `(,code ,reason-phrase)
+       (((? integer? code) (? string? reason-phrase))
+        (slot-set! page 'code code)
+        (slot-set! page 'reason-phrase reason-phrase))
+       (else
+        (scm-error 'wrong-type-arg "make <error-page>"
+                   (G_ "the error code (#:code) should be an integer and the reason phrase (#:reason-phrase) should be a string")
+                   '()
+                   (list code reason-phrase)))))))
+
 (define-method (equal? (x <error-page>) (y <error-page>))
   (and (equal? (uri x) (uri y))
        (equal? (code x) (code y))
@@ -398,6 +432,41 @@
   (content-type #:init-keyword #:content-type #:getter content-type)
   (content #:init-keyword #:content #:getter content))
 
+(define (all-links? elements)
+  (match elements
+    (() #t)
+    (((? (cute is-a? <> <link>)) elements ...)
+     (all-links? elements))
+    (else #f)))
+
+(define-method (initialize (page <loaded-page>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((etag #f)
+    (links #f)
+    (content-type #f)
+    (content #f))
+   (let do-initialize ((etag etag)
+                       (links links)
+                       (content-type content-type)
+                       (content content))
+     (match `(,etag ,links ,content-type ,content)
+       (((? string? etag)
+         (? all-links? links)
+         (? symbol? content-type)
+         (or (? string? content)
+             (? bytevector? content)))
+        (slot-set! page 'etag etag)
+        (slot-set! page 'links links)
+        (slot-set! page 'content-type content-type)
+        (slot-set! page 'content content))
+       (else
+        (scm-error 'wrong-type-arg "make <error-page>"
+                   (G_ "the etag (#:etag) should be a string, the links (#:links) should be a list of links, the content-type (#:content-type) should be a symbol, and the content (#:content) should be a string or a bytevector")
+                   '()
+                   (list etag links content-type content)))))))
+
 (define-method (equal? (x <loaded-page>) (y <loaded-page>))
   (and (equal? (uri x) (uri y))
        (equal? (etag x) (etag y))
@@ -410,6 +479,30 @@
   (desired-content-type #:init-keyword #:desired-content-type #:getter desired-content-type)
   (desired-content #:init-keyword #:desired-content #:getter desired-content))
 
+(define-method (initialize (page <updated-page>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((desired-links #f)
+    (desired-content-type #f)
+    (desired-content #f))
+   (let do-initialize ((desired-links desired-links)
+                       (desired-content-type desired-content-type)
+                       (desired-content desired-content))
+     (match `(,desired-links ,desired-content-type ,desired-content)
+       (((? list? desired-links)
+         (? symbol? desired-content-type)
+         (or (? string? desired-content)
+             (? bytevector? desired-content)))
+        (slot-set! page 'desired-links desired-links)
+        (slot-set! page 'desired-content-type desired-content-type)
+        (slot-set! page 'desired-content desired-content))
+       (else
+        (scm-error 'wrong-type-arg "make <updated-page>"
+                   (G_ "the desired links (#:desired-links) should be an alist from URI to alists, the desired content-type (#:desired-content-type) should be a symbol, and the desired content (#:desired-content) should be a string or a bytevector")
+                   '()
+                   (list desired-links desired-content-type desired-content)))))))
+
 (define-method (equal? (x <updated-page>) (y <updated-page>))
   (and (equal? (uri x) (uri y))
        (equal? (etag x) (etag y))