diff options
Diffstat (limited to 'src/scm')
-rw-r--r-- | src/scm/webid-oidc/client/application.scm | 93 |
1 files changed, 93 insertions, 0 deletions
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)) |