From ba392c218664937dbd07411a38cbbc4e6f0c69b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 16 Oct 2023 15:02:42 +0200 Subject: Add number of clearifying comments + minor cleanup. --- module/calp/server/webdav.scm | 38 ++++++++++++++++++++++++++++++++ module/calp/webdav/resource/virtual.scm | 3 ++- module/hnh/util/table.scm | 11 +++++++-- module/sxml/namespace.scm | 6 +++++ module/vcomponent/data-stores/common.scm | 2 ++ module/vcomponent/duration.scm | 4 ++++ 6 files changed, 61 insertions(+), 3 deletions(-) diff --git a/module/calp/server/webdav.scm b/module/calp/server/webdav.scm index 7cbdd32e..3413f254 100644 --- a/module/calp/server/webdav.scm +++ b/module/calp/server/webdav.scm @@ -131,6 +131,7 @@ +;;; Extract the root element from sxml tree (define (root-element sxml) (sxml-match sxml [(*TOP* (*PI* . ,args) ,root) root] @@ -471,15 +472,37 @@ +;;; Log tables are tables for easily adding key value data, +;;; and later formatting them. +;;; They in themself do not actually do any logging. + +;;; The "global" log table (define log-table (make-parameter #f)) + +;;; Initialize the global log table to an empty log table (define (init-log-table!) (log-table '())) + +;;; Takes a list of alternating symbols and values, +;;; Each such pair is added to the log global table (define (log-table-add! . args) (for (key value) in (group args 2) (log-table (acons key value (log-table))))) + +;;; Get the given key from the global key table +;;; or return dflt (default #f) if not found (define* (log-table-get key optional: dflt) (or (assoc-ref (log-table) key) dflt)) +;;; Write data from the global log table to current output port. +;;; Each argument should be one of the following types +;;; string? :: printed verbatim +;;; symbol? :: value looked up in the global log table, +;;; and value printed +;;; pair? :: The car is a symbol to look up per `symbol?' +;;; The cdr is a procedure for foramtting the given +;;; value for output +;;; All other types are ignored. (define (log-table-format . args) (for-each (lambda (arg) (cond ((string? arg) (display arg)) @@ -490,6 +513,21 @@ (else #f))) args)) +;;; Writes a log message to current error port. +;;; This reads values for the log table. +;;; +;;; The following table fields are used +;;; now :: current datetime, as a datetime? +;;; method :: Name of the source method +;;; uri :: URI accessed, an an uri? object +;;; request :: The source request +;;; If the request-method of the request is +;;; 'COPY or 'MOVE then `headers' is checked for a +;;; destination header. +;;; headers :: Request headers, see `request' +;;; response-code :: Response code to emit (e.x. 200) +;;; response-phrase :: Phrase belonging to that code (e.x. "OK") +;;; msg :: Optional freetext message (define (emit-log!) ;; (write (log-table) (current-error-port)) ;; (newline (current-error-port)) diff --git a/module/calp/webdav/resource/virtual.scm b/module/calp/webdav/resource/virtual.scm index 1d2d5d31..42ffc123 100644 --- a/module/calp/webdav/resource/virtual.scm +++ b/module/calp/webdav/resource/virtual.scm @@ -38,7 +38,8 @@ (define-method (live-properties (self )) (append (next-method) - (list (cons (xml-element-hash-key (xml virtual-ns 'isvirtual)) (make-live-property isvirtual set-isvirtual!))))) + (list (cons (xml-element-hash-key (xml virtual-ns 'isvirtual)) + (make-live-property isvirtual set-isvirtual!))))) (define-method (content (self )) (content* self)) diff --git a/module/hnh/util/table.scm b/module/hnh/util/table.scm index a57e6591..268f1081 100644 --- a/module/hnh/util/table.scm +++ b/module/hnh/util/table.scm @@ -1,8 +1,15 @@ +;;; Commentary: +;;; An immutable key-value table. +;;; +;;; Currently implemented as a simple binary search tree, +;;; this may however change at any time. +;;; Code: + (define-module (hnh util table) :use-module (srfi srfi-1) :use-module (srfi srfi-88) - :use-module (srfi srfi-9) - :use-module (srfi srfi-9 gnu) + ;; :use-module (srfi srfi-9) + ;; :use-module (srfi srfi-9 gnu) :use-module (hnh util lens) :use-module (hnh util object) :export ((make-tree . table) diff --git a/module/sxml/namespace.scm b/module/sxml/namespace.scm index 144d1905..b29de017 100644 --- a/module/sxml/namespace.scm +++ b/module/sxml/namespace.scm @@ -1,3 +1,9 @@ +;;; Commentary: +;;; Module for changing the namespace prefix in sxml symbols. +;;; TODO consider removing this module in favour of (sxml namespaced). +;;; This is a hack, that one works correctly +;;; Code: + (define-module (sxml namespace) :use-module (hnh util) :use-module (sxml transform) diff --git a/module/vcomponent/data-stores/common.scm b/module/vcomponent/data-stores/common.scm index 2fb4422a..f9dee506 100644 --- a/module/vcomponent/data-stores/common.scm +++ b/module/vcomponent/data-stores/common.scm @@ -6,6 +6,8 @@ get-all get-by-uid)) +;;; This should NOT inherit from WebDAV . +;;; Instead, CalDAV resources should hold a reference to a calendar data store. (define-class () ;; (path init-keyword: path: diff --git a/module/vcomponent/duration.scm b/module/vcomponent/duration.scm index 449645fc..83f3d6e7 100644 --- a/module/vcomponent/duration.scm +++ b/module/vcomponent/duration.scm @@ -11,6 +11,10 @@ format-duration )) +;;; TODO Write tests for this + +;;; TODO replace record type + (define-immutable-record-type (make-duration sign week day dur-time) duration? -- cgit v1.2.3