diff options
53 files changed, 518 insertions, 248 deletions
@@ -1,5 +1,5 @@ .PHONY: all clean test \ - static + static coverage GUILE_SITE_DIR=$(shell guile -c "(display (%site-dir))") GUILE_CCACHE_DIR=$(shell guile -c "(display (%site-ccache-dir))") @@ -42,5 +42,12 @@ README: README.in test: tests/run-tests.scm - genhtml -o coverage lcov.info - + $(MAKE) coverage + +coverage: + genhtml \ + --show-details \ + --output-directory coverage \ + --prefix $(shell pwd) \ + --no-function-coverage \ + lcov.info diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index b21850bd..f7373767 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -2,6 +2,109 @@ @chapter Guile @include guile/util.texi +@include guile/vcomponent.texi + + +@node Other +@section Other + +@defun get-parser type +@example +get-parser ∷ type-name → hash-table x string → any +type = 'BINARY | 'BOOLEAN | 'CAL-ADDRES | 'DATE | 'DATE-TIME + | 'DURATION | 'FLOAT | 'INTEGER | 'PERIOD | 'RECUR + | 'TEXT | 'TIME | 'URI | 'UTC-OFFSET +@end example + +@ref{ical-get-writer} +@end defun + +@subsection formats ical +@subsubsection output + +@defun component->ical-string component +@end defun + +@defun print-components-with-fake-parent events +@end defun + +@defun print-all-events +@end defun + +@defun print-events-in-interval start end +@end defun + +@subsubsection parse + +@defun parse-calendar port +@end defun + +@subsubsection types + +@defun escape-chars str +Escape ``@verb{|,|}'', ``@verb{|;|}'' and ``@verb{|\|}'' with a +backslash, and encode newlines as ``@verb{|\n|}''. +@end defun + +@defun get-writer type +@anchor{ical-get-writer} +@example +get-writer ∷ type-name → hash-table x value → string +type = 'BINARY | 'BOOLEAN | 'CAL-ADDRES | 'DATE | 'DATE-TIME + | 'DURATION | 'FLOAT | 'INTEGER | 'PERIOD | 'RECUR + | 'TEXT | 'TIME | 'URI | 'UTC-OFFSET +@end example +@end defun + +@subsection formats vdir +@subsubsection parse + +@defun parse-vdir path +@end defun + +@subsubsection save-delete + +@defun save-event event +@end defun + +@defun remove-event event +@end defun + +@subsection formats xcal +@subsubsection output + +@defun vcomponent->sxcal component +@end defun + +@defun ns-wrap +@lisp +(define (ns-wrap sxml) + `(icalendar (@ (xmlns "urn:ietf:params:xml:ns:icalendar-2.0")) + ,sxml)) +@end lisp +Where @var{sxml} is expected to be the output of @var{vcomponent->sxcal}. +@end defun + +@subsubsection parse +@defun sxcal->vcomponent sxcal +Parses a vcomponent in sxcal format. Requires that the vcomponent is +the root of the document (fragment), so wrapping icalendar-tags or +similar @emph{must} be removed. + +@example +(vcalendar + (properties ...) + (components ...)) +@end example +@end defun + +@subsubsection types +@defun get-writer type +@ref{ical-get-writer} +@end defun + + +@c -------------------------------------------------- @c TODO This chapter will probably in the future be replaced by a proper diff --git a/doc/ref/guile/vcomponent.texi b/doc/ref/guile/vcomponent.texi new file mode 100644 index 00000000..299ae1da --- /dev/null +++ b/doc/ref/guile/vcomponent.texi @@ -0,0 +1,117 @@ +@node VComponent +@section (vcomponent) + +@defvr {Configuration Variable} calendar-files +List of filepaths +@end defvr + +@defvr {Configuration Variable} default-calendar +@end defvr + +@c ===== Concepts ===== + +@c - internal fields +@c DATA layout +@c how does multiple value work? + +@c ===== BASE ===== + +@deftp {Record Type} <vline> + +@c - key +@c - value +@c - parameters +@c - source + +@defun make-vline key value [ht=(make-hash-table)] +@var{ht} is the hash table storing the parameters, can be explicitly +given if need for optimizations arrises. +@end defun + +@defun vline? x +@end defun + +@defun vline-key vline +@end defun + +@deffn {Slot} vline-source vline +@end deffn + +@deffn {Slot} value vline +@end deffn + +@deffn {Slot} param vline key +@end deffn + +@defun delete-parameter! vline key +@end defun + +@defun parameters vline +Key a list of all parameters +@example +((key value) ...) +@end example +@end defun + +@end deftp + + +@deftp {Record Type} <vcomponent> + +@defun vcomponent? x +@end defun + +@defun make-vcomponent [type='VIRTUAL] +@end defun + +@defun children vcomponent +Returns all direct children of vcomponent, as a list of vcomponents. +@end defun + +@deffn {Slot} parent vcomonent +@end deffn + +@defun type vcomponent +Returns the type of this vcomponent, as a symbol. Probably one of +@code{VCALENDAR}, @code{VEVENT}, ... +@end defun + +@defun add-child! parent child +Adds child to the parents child list, but also updates the child to +have parent in its parent slot +@end defun + +@deffn {Prop} prop* vcomponent key +@deffnx {Prop} prop vcomponent key +@var{prop*} return the vline object, while @var{prop} is equivalent to +@lisp +(value (prop* vcomponent key)) +@end lisp +@end deffn + +@deffn (extract field) vcomponent +@deffnx (extract* field) vcomponent +Curried version of @var{prop}. +@end deffn + +@defun delete-property! component key +@end defun + +@defun properties comopnent +@example +((key . value) ...) +@end example +@end defun + +@end deftp + +@defun copy-vcomponent vcomponent +@end defun + + +@defun x-property? symb +Does symbol start with ``X-''? +@end defun + +@defun internal-field? symb [prefix="-"] +@end defun diff --git a/module/calp/benchmark/parse.scm b/module/calp/benchmark/parse.scm index f1be66f5..2d7c7b18 100644 --- a/module/calp/benchmark/parse.scm +++ b/module/calp/benchmark/parse.scm @@ -27,7 +27,7 @@ (display "All read\n") (map (lambda ( fullname) (let ((cal (call-with-input-file fullname - (@@ (vcomponent ical parse) read-file)))) + (@@ (vcomponent formats ical parse) read-file)))) cal)) all-calendar-files)))) @@ -36,7 +36,7 @@ (lambda () (display "Tokenized\n") (map (lambda (one-read) - (map (@@ (vcomponent ical parse) tokenize) + (map (@@ (vcomponent formats ical parse) tokenize) one-read)) all-read)))) @@ -44,7 +44,7 @@ (statprof (lambda () (display "Parsed\n") - (map (@@ (vcomponent ical parse) parse) tokenized)))) + (map (@@ (vcomponent formats ical parse) parse) tokenized)))) (format #t "~a files processed~%" (length parsed)) diff --git a/module/calp/entry-points/benchmark.scm b/module/calp/entry-points/benchmark.scm index 851edc59..152a398c 100644 --- a/module/calp/entry-points/benchmark.scm +++ b/module/calp/entry-points/benchmark.scm @@ -5,8 +5,8 @@ :use-module (calp util options) :use-module ((srfi srfi-41) :select (stream->list)) - :use-module ((vcomponent instance methods) :select (get-event-set)) - :autoload (vcomponent instance) (global-event-object) + :use-module ((vcomponent util instance methods) :select (get-event-set)) + :autoload (vcomponent util instance) (global-event-object) :export (main) ) diff --git a/module/calp/entry-points/convert.scm b/module/calp/entry-points/convert.scm index 52ee6b2d..f05b1e7b 100644 --- a/module/calp/entry-points/convert.scm +++ b/module/calp/entry-points/convert.scm @@ -61,11 +61,11 @@ (case (string->symbol from) [(ical) ;; read ical - (@ (vcomponent ical parse) parse-calendar)] + (@ (vcomponent formats ical parse) parse-calendar)] [(xcal) ;; read xcal (compose - (@ (vcomponent xcal parse) sxcal->vcomponent) + (@ (vcomponent formats xcal parse) sxcal->vcomponent) ;; TODO strip *TOP* xml->sxml)] [else (error "")] @@ -76,13 +76,13 @@ [(ical) ;; write ical (lambda (component port) - (display ((@ (vcomponent ical output) component->ical-string) + (display ((@ (vcomponent formats ical output) component->ical-string) component) port))] [(xcal) ;; write xcal (lambda (component port) - (sxml->xml ((@ (vcomponent xcal output) vcomponent->sxcal) + (sxml->xml ((@ (vcomponent formats xcal output) vcomponent->sxcal) component) port))] [else (error "")])) diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm index 39f00979..45e71947 100644 --- a/module/calp/entry-points/html.scm +++ b/module/calp/entry-points/html.scm @@ -14,14 +14,14 @@ :renamer (lambda _ 'render-calendar-wide)) :use-module ((calp html view calendar month) :select (render-calendar-table)) - :use-module ((vcomponent instance methods) + :use-module ((vcomponent util instance methods) :select (get-calendars get-event-set)) :use-module ((sxml simple) :select (sxml->xml)) :use-module ((sxml transformations) :select (href-transformer)) :use-module ((xdg basedir) :prefix xdg-) - :autoload (vcomponent instance) (global-event-object) + :autoload (vcomponent util instance) (global-event-object) ) diff --git a/module/calp/entry-points/ical.scm b/module/calp/entry-points/ical.scm index 15e677b5..0ac01b17 100644 --- a/module/calp/entry-points/ical.scm +++ b/module/calp/entry-points/ical.scm @@ -2,7 +2,7 @@ :export (main) :use-module (calp util) :use-module (calp util options) - :use-module (vcomponent ical output) + :use-module (vcomponent formats ical output) :use-module (ice-9 getopt-long) :use-module (datetime) ) diff --git a/module/calp/entry-points/import.scm b/module/calp/entry-points/import.scm index f25e642f..69c5b687 100644 --- a/module/calp/entry-points/import.scm +++ b/module/calp/entry-points/import.scm @@ -7,9 +7,11 @@ :use-module (srfi srfi-1) ;; TODO FIX ;; :use-module (output vdir) - :use-module ((vcomponent vdir save-delete) :select (save-event)) + :use-module ((vcomponent formats vdir save-delete) :select (save-event)) :use-module (vcomponent) - :autoload (vcomponent instance) (global-event-object) + ;; :use-module ((vcomponent formats ical parse) :select (parse-cal-path)) + :use-module ((vcomponent util parse-cal-path) :select (parse-cal-path)) + :autoload (vcomponent util instance) (global-event-object) ) (define options diff --git a/module/calp/entry-points/server.scm b/module/calp/entry-points/server.scm index a456c292..a7be4afd 100644 --- a/module/calp/entry-points/server.scm +++ b/module/calp/entry-points/server.scm @@ -1,7 +1,6 @@ (define-module (calp entry-points server) :use-module (calp util) :use-module (calp util options) - :use-module (calp util exceptions) :use-module (calp util config) :use-module (srfi srfi-1) @@ -68,7 +67,7 @@ (lambda _ (display "Received SIGUSR1, reloading calendars\n" (current-error-port)) - ((@ (vcomponent instance) reload))))) + ((@ (vcomponent util instance) reload))))) diff --git a/module/calp/entry-points/tidsrapport.scm b/module/calp/entry-points/tidsrapport.scm index 4716ceeb..abdd7aa2 100644 --- a/module/calp/entry-points/tidsrapport.scm +++ b/module/calp/entry-points/tidsrapport.scm @@ -50,8 +50,8 @@ (srfi srfi-1) (vcomponent) (datetime) - (vcomponent instance) - (vcomponent instance methods) + (vcomponent util instance) + (vcomponent util instance methods) (calp util) (ice-9 regex) (ice-9 popen) @@ -66,7 +66,7 @@ (define instances (group-by (compose day as-date (extract 'DTSTART)) (stream->list - ((@ (vcomponent search) execute-query) + ((@ (vcomponent util search) execute-query) (lambda (e) (define d (as-datetime (prop e 'DTSTART))) (define s (date year: year month: month day: 1)) diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm index 1d677c0d..36ec5166 100644 --- a/module/calp/html/components.scm +++ b/module/calp/html/components.scm @@ -1,6 +1,5 @@ (define-module (calp html components) :use-module (calp util) - :use-module (calp util exceptions) :use-module (ice-9 curried-definitions) :use-module (ice-9 match) :export (xhtml-doc) diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 3e7cc4dc..2abf370d 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -1,11 +1,9 @@ (define-module (calp html vcomponent) :use-module (calp util) - :use-module ((calp util exceptions) :select (warning)) - :use-module (vcomponent) :use-module (srfi srfi-1) - :use-module (srfi srfi-26) :use-module (srfi srfi-41) :use-module ((rnrs io ports) :select (put-bytevector)) + :use-module (vcomponent) :use-module (datetime) :use-module ((text util) :select (add-enumeration-punctuation)) :use-module ((web uri-query) :select (encode-query-parameters)) @@ -16,7 +14,6 @@ :use-module ((crypto) :select (sha256 checksum->string)) :use-module ((xdg basedir) :prefix xdg-) :use-module ((vcomponent recurrence) :select (repeating?)) - :use-module ((vcomponent recurrence internal) :prefix #{rrule:}#) :use-module ((vcomponent datetime output) :select (fmt-time-span format-description @@ -169,7 +166,7 @@ (src ,link)))))))) ;; URI (cond ((and=> (param attach 'FMTTYPE) - (compose (cut string= <> "image" 0 5) car)) + (lambda (p) (string=? (car p) "image" 0 5))) `(img (@ (class "attach") (src ,(value attach))))) (else `(a (@ (class "attach") @@ -289,6 +286,7 @@ "🗎"))))))) +;; TODO possibly unused? (define (repeat-info event) `(div (@ (class "eventtext")) (h2 "Upprepningar") diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index aa311fcb..64fafb3d 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -3,8 +3,6 @@ :use-module (vcomponent) :use-module ((vcomponent datetime) :select (events-between)) - :use-module ((vcomponent build) - :select (vcalendar vevent)) :use-module (datetime) :use-module (calp html components) :use-module ((calp html vcomponent) @@ -26,7 +24,7 @@ :use-module (srfi srfi-41 util) :use-module ((vcomponent recurrence) :select (repeating? generate-recurrence-set)) - :use-module ((vcomponent group) + :use-module ((vcomponent util group) :select (group-stream get-groups-between)) :use-module ((base64) :select (base64encode)) ) @@ -406,6 +404,6 @@ window.default_calendar='~a';" ;; rendered as xcal. (div (@ (style "display:none !important;") (id "xcal-data")) - ,((@ (vcomponent xcal output) ns-wrap) - (map (@ (vcomponent xcal output) vcomponent->sxcal) + ,((@ (vcomponent formats xcal output) ns-wrap) + (map (@ (vcomponent formats xcal output) vcomponent->sxcal) (append regular repeating))))))))) diff --git a/module/calp/html/view/calendar/month.scm b/module/calp/html/view/calendar/month.scm index 02689fd5..6506b0ea 100644 --- a/module/calp/html/view/calendar/month.scm +++ b/module/calp/html/view/calendar/month.scm @@ -12,7 +12,7 @@ events-between)) :use-module ((calp html vcomponent) :select (make-block output-uid)) - :use-module ((vcomponent group) + :use-module ((vcomponent util group) :select (group-stream get-groups-between)) ) diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm index 499de1d6..1714c6c4 100644 --- a/module/calp/html/view/calendar/week.scm +++ b/module/calp/html/view/calendar/week.scm @@ -17,7 +17,7 @@ :select (make-block output-uid) ) ;; :use-module ((calp html components) ;; :select ()) - :use-module ((vcomponent group) + :use-module ((vcomponent util group) :select (group-stream get-groups-between)) ) diff --git a/module/calp/html/view/search.scm b/module/calp/html/view/search.scm index c356baec..b939e7a2 100644 --- a/module/calp/html/view/search.scm +++ b/module/calp/html/view/search.scm @@ -1,7 +1,7 @@ (define-module (calp html view search) :use-module (calp util) :use-module (vcomponent) - :use-module (vcomponent search) + :use-module (vcomponent util search) :use-module ((ice-9 pretty-print) :select (pretty-print)) :use-module ((web uri-query) :select (encode-query-parameters)) :use-module ((calp html components) diff --git a/module/calp/main.scm b/module/calp/main.scm index 1af2861a..a27e4c38 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -35,7 +35,7 @@ (description "Start a Guile repl which can be connected to, defaults to the unix socket " (i "/run/user/${UID}/calp-${PID}") ", but it can be bound to any unix or " - "TCP socket. ((@ (vcomponent instance) global-event-object)) " + "TCP socket. ((@ (vcomponent util instance) global-event-object)) " "should contain all events." (br) (b "Should NOT be used in production."))) @@ -260,5 +260,5 @@ ;; and prints them. (map (lambda (it) (with-output-to-port (current-error-port) - (lambda () ((@ (vcomponent describe) describe) it)))) + (lambda () ((@ (vcomponent util describe) describe) it)))) (filter-stack (@ (vcomponent) vcomponent?) (make-stack #t)))))) diff --git a/module/calp/repl.scm b/module/calp/repl.scm index e6fbfe3d..0765b65c 100644 --- a/module/calp/repl.scm +++ b/module/calp/repl.scm @@ -6,7 +6,7 @@ :use-module (system repl server) :use-module (ice-9 regex) :use-module ((calp util hooks) :select (shutdown-hook)) - :use-module (calp util exceptions) + :use-module ((calp util exceptions) :select (warning)) ) (define-public (repl-start address) diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm index 08e48714..a435bbc0 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -25,11 +25,11 @@ :use-module (web http make-routes) :use-module (vcomponent) - :use-module (vcomponent search) + :use-module (vcomponent util search) :use-module (datetime) - :use-module (vcomponent ical output) + :use-module (vcomponent formats ical output) - :autoload (vcomponent instance) (global-event-object) + :autoload (vcomponent util instance) (global-event-object) :use-module (calp html view calendar) :use-module ((calp html view search) :select (search-result-page)) @@ -159,7 +159,7 @@ (remove-event global-event-object it) (set! (prop it 'X-HNH-REMOVED) #t) (set! (param (prop* it 'X-HNH-REMOVED) 'VALUE) "BOOLEAN") - (unless ((@ (vcomponent vdir save-delete) save-event) it) + (unless ((@ (vcomponent formats vdir save-delete) save-event) it) (return (build-response code: 500) "Saving event to disk failed.")) (return (build-response code: 204))) @@ -203,7 +203,7 @@ ;; *TOP* node is a required part of the sxml. (let ((event - ((@ (vcomponent xcal parse) sxcal->vcomponent) + ((@ (vcomponent formats xcal parse) sxcal->vcomponent) (catch 'parser-error (lambda () (move-to-namespace @@ -232,7 +232,7 @@ => (lambda (old-event) ;; remove old instance of event from runtime - ((@ (vcomponent instance methods) remove-event) + ((@ (vcomponent util instance methods) remove-event) global-event-object old-event) ;; Add new event to runtime, @@ -252,7 +252,7 @@ ;; save-event sets -X-HNH-FILENAME from the UID. This is fine ;; since the two events are guaranteed to have the same UID. - (unless ((@ (vcomponent vdir save-delete) save-event) event) + (unless ((@ (vcomponent formats vdir save-delete) save-event) event) (return (build-response code: 500) "Saving event to disk failed.")) @@ -266,7 +266,7 @@ ;; created (since we save beforehand). This is just a minor problem ;; which either a better atomic model, or a propper error ;; recovery log would solve. - ((@ (vcomponent vdir save-delete) remove-event) old-event)) + ((@ (vcomponent formats vdir save-delete) remove-event) old-event)) (format (current-error-port) @@ -284,7 +284,7 @@ ;; NOTE Posibly defer save to a later point. ;; That would allow better asyncronous preformance. - (unless ((@ (vcomponent vdir save-delete) save-event) event) + (unless ((@ (vcomponent formats vdir save-delete) save-event) event) (return (build-response code: 500) "Saving event to disk failed.")) @@ -339,7 +339,7 @@ ;; Look into changing how events carry around their ;; parent information, possibly splitting "source parent" ;; and "program parent" into different fields. - (lambda () (sxml->xml ((@ (vcomponent xcal output) vcomponent->sxcal) it))))) + (lambda () (sxml->xml ((@ (vcomponent formats xcal output) vcomponent->sxcal) it))))) (return (build-response code: 404) (format #f "No component with UID=~a found." uid)))) diff --git a/module/calp/terminal.scm b/module/calp/terminal.scm index 4b62895d..1014b94c 100644 --- a/module/calp/terminal.scm +++ b/module/calp/terminal.scm @@ -3,18 +3,17 @@ #:use-module (datetime) #:use-module (srfi srfi-17) #:use-module (srfi srfi-26) - #:use-module (srfi srfi-41) - #:use-module (srfi srfi-41 util) + #:use-module ((srfi srfi-41) :select (stream-car)) #:use-module (calp util) #:use-module (vulgar) #:use-module (vulgar info) #:use-module (vulgar color) #:use-module (vulgar components) - #:use-module (vcomponent group) #:use-module (vcomponent) #:use-module (vcomponent datetime) - #:use-module (vcomponent search) + #:use-module (vcomponent util search) + #:use-module (vcomponent util group) #:use-module (text util) #:use-module (text flow) @@ -28,7 +27,7 @@ #:use-module (oop goops) #:use-module (oop goops describe) - #:autoload (vcomponent instance) (global-event-object) + #:autoload (vcomponent util instance) (global-event-object) #:export (main-loop)) diff --git a/module/calp/util.scm b/module/calp/util.scm index 70091b2e..93e9fd0c 100644 --- a/module/calp/util.scm +++ b/module/calp/util.scm @@ -14,6 +14,7 @@ case* define-many and=>> label print-and-return + begin1 ) #:replace (let* set! define-syntax when unless)) @@ -136,6 +137,14 @@ (let* ((head tail (split-at lst len))) (append head (list tail)))) + +(define-syntax-rule (begin1 first rest ...) + (let ((return first)) + rest ... + return)) + + + (define-macro (print-and-return expr) diff --git a/module/calp/util/exceptions.scm b/module/calp/util/exceptions.scm index 04fc7a67..d9df30ed 100644 --- a/module/calp/util/exceptions.scm +++ b/module/calp/util/exceptions.scm @@ -7,44 +7,7 @@ #:use-module ((system vm frame) :select (frame-bindings binding-ref)) - #:export (throw-returnable - catch-multiple - assert)) - -(define-syntax-rule (throw-returnable symb args ...) - (call/cc (lambda (cont) (throw symb cont args ...)))) - -;; Takes a (non nested) list, and replaces all single underscore -;; symbols with a generated symbol. For macro usage. -(define (multiple-ignore lst) - (map/dotted (lambda (symb) (if (eq? symb '_) (gensym "ignored_") symb)) - lst)) - -;; Like @var{catch}, but multiple handlers can be specified. -;; Each handler is on the form -;; @example -;; [err-symb (args ...) body ...] -;; @end example -;; -;; Only errors with a handler are caught. Error can *not* be given as -;; an early argument. -(define-macro (catch-multiple thunk . cases) - (let catch-recur% ((errs (map car cases)) (cases cases)) - (let* ((v (car errs)) - (case other (partition (lambda (case) (eq? v (car case))) cases)) - (g!rest (gensym "rest"))) - `(catch (quote ,v) - ,(if (null? (cdr errs)) - thunk - `(lambda () ,(catch-recur% (cdr errs) other))) - (lambda (err . ,g!rest) - (apply (lambda ,(let ((param-list (second (car case)))) - (if (not (pair? param-list)) - param-list - (multiple-ignore param-list))) - ,@(cddr (car case))) - ,g!rest)))))) - + #:export (assert)) (define-public warning-handler @@ -81,7 +44,6 @@ [else tree])) - (define-macro (assert form) `(unless ,form (throw 'assertion-error "Assertion failed. ~a expected, ~a got" @@ -89,16 +51,6 @@ ((@@ (calp util exceptions) prettify-tree) (list ,form))))) -(define-syntax catch-warnings - (syntax-rules () - ((_ default body ...) - (parametrize ((warnings-are-errors #t)) - (catch 'warning - (lambda () - body ...) - (lambda _ default)))))) - - (define-public (filter-stack pred? stk) (concatenate (for i in (iota (stack-length stk)) diff --git a/module/datetime/instance.scm b/module/datetime/instance.scm index 6cce17f4..a03916d9 100644 --- a/module/datetime/instance.scm +++ b/module/datetime/instance.scm @@ -9,7 +9,13 @@ (define-config tz-list '() description: "List of default zoneinfo files to be parsed") -;; TODO see (vcomponent instance), this has a similar problem with early load +;; TODO see (vcomponent uil instance), this has a similar problem with early load +;; Takes a list of zoneinfo files relative +;; $XDG-DATA-HOME/calp/zoneinfo, which will probably be +;; '("tzdata/europe" "tzdata/afrifa" ...) +;; and builds all these into one giant zoneinfo database object +;; Note that scripts/tzget should be run beforehand, to download the +;; data (define-once zoneinfo (let ((cache (make-hash-table))) (label self diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 226b740f..c1983977 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -2,14 +2,15 @@ :use-module (calp util) :use-module (calp util config) :use-module (vcomponent base) - :use-module (vcomponent parse) - :use-module (vcomponent instance methods) - :re-export (make-vcomponent - parse-cal-path parse-calendar)) + ;; :use-module ((vcomponent util instance methods) + ;; :select (make-vcomponent)) + :use-module ((vcomponent util parse-cal-path) + :select (parse-cal-path)) + :re-export (make-vcomponent parse-cal-path)) (define cm (module-public-interface (current-module))) (module-use! cm (resolve-interface '(vcomponent base))) -(module-use! cm (resolve-interface '(vcomponent instance methods))) +(module-use! cm (resolve-interface '(vcomponent util instance methods))) (define-config calendar-files '() diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index ab2121a2..66e6534f 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -85,9 +85,6 @@ => (lambda (vline) (set-vline-value! vline value))] [else (hashq-set! ht key (make-vline key value))]))) -(define-public (set-vline! component key vline) - (hashq-set! (get-component-properties component) - key vline)) @@ -158,9 +155,6 @@ (define-public (properties component) (hash-map->list cons (get-component-properties component))) -(define-public (property-keys component) - (hash-map->list (lambda (a _) a) (get-component-properties component))) - (define (copy-vline vline) (make-vline (vline-key vline) (get-vline-value vline) @@ -186,10 +180,6 @@ (define-public (extract* field) (lambda (e) (prop* e field))) -(define-public (key=? k1 k2) - (eq? (as-symb k1) - (as-symb k2))) - (define-public (x-property? symb) (string=? "X-" (string-take (symbol->string symb) 2))) diff --git a/module/vcomponent/build.scm b/module/vcomponent/build.scm deleted file mode 100644 index d49844cc..00000000 --- a/module/vcomponent/build.scm +++ /dev/null @@ -1,38 +0,0 @@ -;;; Commentary: -;; Module for quickly building new vcomponents from code. -;; @example -;; (vevent -;; summary: "This is a test event" -;; dtstart: #2020-01-01T13:37:00 -;; children: (list -;; (valarm ...))) -;;; Code: - -(define-module (vcomponent build) - :use-module (calp util) - :use-module (vcomponent base) - :use-module (srfi srfi-26) - :use-module ((srfi srfi-88) :select (keyword->string))) - -(define-public (vevent . body) (apply vcomponent 'VEVENT body)) -(define-public (vcalendar . body) (apply vcomponent 'VCALENDAR body)) -(define-public (valarm . body) (apply vcomponent 'VALARM body)) - -(define-public (vcomponent tag . rest) - (define v (make-vcomponent tag)) - - (let loop ((rem rest)) - (unless (null? rem) - (if (eq? children: (car rem)) - (for-each (cut add-child! v <>) (cadr rem)) - (let ((symb (-> (car rem) - keyword->string - string-upcase - string->symbol))) - (set! (prop v symb) (cadr rem)))) - (loop (cddr rem)))) - - ;; Return - v) - - diff --git a/module/vcomponent/control.scm b/module/vcomponent/control.scm index 5fe5b8b0..4cb6c708 100644 --- a/module/vcomponent/control.scm +++ b/module/vcomponent/control.scm @@ -1,4 +1,4 @@ -(define-module (vcomponent control) +(define-module (vcomponent util control) #:use-module (calp util) #:use-module (vcomponent) #:export (with-replaced-properties)) diff --git a/module/vcomponent/parse/types.scm b/module/vcomponent/formats/common/types.scm index ba4b2b47..87425c01 100644 --- a/module/vcomponent/parse/types.scm +++ b/module/vcomponent/formats/common/types.scm @@ -1,9 +1,10 @@ -(define-module (vcomponent parse types) +(define-module (vcomponent formats common types) :use-module (calp util) :use-module (calp util exceptions) :use-module (base64) :use-module (datetime) :use-module (srfi srfi-9 gnu) + :use-module (datetime timespec) ) ;; BINARY @@ -103,8 +104,6 @@ (define (parse-uri props value) value) -(use-modules (datetime timespec)) - ;; UTC-OFFSET (define (parse-utc-offset props value) (make-timespec diff --git a/module/vcomponent/ical/output.scm b/module/vcomponent/formats/ical/output.scm index bcc6bb1d..9efac3c4 100644 --- a/module/vcomponent/ical/output.scm +++ b/module/vcomponent/formats/ical/output.scm @@ -1,21 +1,21 @@ -(define-module (vcomponent ical output) +(define-module (vcomponent formats ical output) + :use-module (calp util exceptions) + :use-module (calp util) + :use-module (datetime) + :use-module (datetime zic) + :use-module ((datetime instance) :select (zoneinfo)) + :use-module (glob) :use-module (ice-9 format) :use-module (ice-9 match) - :use-module (calp util) - :use-module (calp util exceptions) - :use-module (vcomponent) - :use-module (vcomponent datetime) :use-module (srfi srfi-1) - :use-module (datetime) :use-module (srfi srfi-41) :use-module (srfi srfi-41 util) - :use-module (datetime zic) - :use-module (glob) - :use-module (vcomponent recurrence) + :use-module (vcomponent) + :use-module (vcomponent datetime) :use-module (vcomponent geo) - :use-module (vcomponent ical types) - :autoload (vcomponent instance) (global-event-object) - :use-module ((datetime instance) :select (zoneinfo)) + :use-module (vcomponent formats ical types) + :use-module (vcomponent recurrence) + :autoload (vcomponent util instance) (global-event-object) ) (define (prodid) @@ -165,32 +165,6 @@ => (lambda (alts) (hash-map->list (lambda (_ comp) (component->ical-string comp)) alts))])) -;; TODO tzid param on dtstart vs tz field in datetime object -;; TODO remove this, replace with methods from (output vdir) -;; how do we keep these two in sync? -(define (write-event-to-file event calendar-path) - (define cal (make-vcomponent 'VCALENDAR)) - - (set! (prop cal 'PRODID) (prodid) - (prop cal 'VERSION) "2.0" - (prop cal 'CALSCALE) "GREGORIAN") - - (add-child! cal event) - - (awhen (and (provided? 'zoneinfo) - (param (prop* event 'DTSTART) 'TZID)) - ;; TODO this is broken - (add-child! cal (zoneinfo->vtimezone (zoneinfo) it))) - - (unless (prop event 'UID) - (set! (prop event 'UID) - (uuidgen))) - - (with-output-to-file (glob (format #f "~a/~a.ics" - calendar-path - (prop event 'UID))) - (lambda () (component->ical-string cal)))) - (define (print-header) diff --git a/module/vcomponent/ical/parse.scm b/module/vcomponent/formats/ical/parse.scm index b67ae593..d76044a3 100644 --- a/module/vcomponent/ical/parse.scm +++ b/module/vcomponent/formats/ical/parse.scm @@ -1,14 +1,14 @@ -(define-module (vcomponent ical parse) - :use-module (calp util) - :use-module (calp util exceptions) +(define-module (vcomponent formats ical parse) :use-module ((ice-9 rdelim) :select (read-line)) - :use-module (vcomponent base) + :use-module (calp util exceptions) + :use-module (calp util) :use-module (datetime) :use-module (srfi srfi-1) - :use-module (srfi srfi-9 gnu) :use-module (srfi srfi-26) - :use-module (vcomponent parse types) + :use-module (srfi srfi-9 gnu) + :use-module (vcomponent base) :use-module (vcomponent geo) + :use-module (vcomponent formats common types) ) (define string->symbol diff --git a/module/vcomponent/ical/types.scm b/module/vcomponent/formats/ical/types.scm index 1ec9d0bd..d063ca8f 100644 --- a/module/vcomponent/ical/types.scm +++ b/module/vcomponent/formats/ical/types.scm @@ -1,10 +1,12 @@ ;; see (vcomponent parse types) -(define-module (vcomponent ical types) +(define-module (vcomponent formats ical types) :use-module (calp util) :use-module (calp util exceptions) :use-module (base64) - :use-module (datetime)) + :use-module (datetime) + :use-module (datetime timespec)) +;; TODO shouldn't these really take vline:s? (define (write-binary _ value) (bytevector->base64-string value)) @@ -62,8 +64,6 @@ value) -(use-modules (datetime timespec)) - (define (write-utc-offset _ value) (with-output-to-string (lambda () diff --git a/module/vcomponent/vdir/parse.scm b/module/vcomponent/formats/vdir/parse.scm index 6bbd1329..f3810887 100644 --- a/module/vcomponent/vdir/parse.scm +++ b/module/vcomponent/formats/vdir/parse.scm @@ -1,10 +1,10 @@ ;;; Commentary: ;; Code for parsing vdir's and icalendar files. ;; This module handles the finding of files, while -;; (vcomponent parse ical) handles reading data from icalendar files. +;; (vcomponent formats parse ical) handles reading data from icalendar files. ;;; Code: -(define-module (vcomponent vdir parse) +(define-module (vcomponent formats vdir parse) :use-module (srfi srfi-1) :use-module ((ice-9 hash-table) :select (alist->hash-table)) @@ -15,7 +15,7 @@ :use-module (calp util exceptions) :use-module (vcomponent base) - :use-module (vcomponent ical parse) + :use-module (vcomponent formats ical parse) ) diff --git a/module/vcomponent/vdir/save-delete.scm b/module/vcomponent/formats/vdir/save-delete.scm index b3c7f9c5..1c70dabf 100644 --- a/module/vcomponent/vdir/save-delete.scm +++ b/module/vcomponent/formats/vdir/save-delete.scm @@ -9,10 +9,10 @@ ;;; Code: -(define-module (vcomponent vdir save-delete) +(define-module (vcomponent formats vdir save-delete) :use-module (calp util) :use-module ((calp util exceptions) :select (assert)) - :use-module (vcomponent ical output) + :use-module (vcomponent formats ical output) :use-module (vcomponent) :use-module ((calp util io) :select (with-atomic-output-to-file)) ) diff --git a/module/vcomponent/xcal/output.scm b/module/vcomponent/formats/xcal/output.scm index 70288cba..e2cada83 100644 --- a/module/vcomponent/xcal/output.scm +++ b/module/vcomponent/formats/xcal/output.scm @@ -1,9 +1,9 @@ -(define-module (vcomponent xcal output) +(define-module (vcomponent formats xcal output) :use-module (calp util) :use-module (calp util exceptions) :use-module (vcomponent) :use-module (vcomponent geo) - :use-module (vcomponent xcal types) + :use-module (vcomponent formats xcal types) :use-module (ice-9 match) :use-module (datetime) :use-module (srfi srfi-1) diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/formats/xcal/parse.scm index c6a2122f..e84f380e 100644 --- a/module/vcomponent/xcal/parse.scm +++ b/module/vcomponent/formats/xcal/parse.scm @@ -1,4 +1,4 @@ -(define-module (vcomponent xcal parse) +(define-module (vcomponent formats xcal parse) :use-module (calp util) :use-module (calp util exceptions) :use-module (base64) @@ -6,7 +6,7 @@ :use-module (sxml match) :use-module (vcomponent) :use-module (vcomponent geo) - :use-module (vcomponent parse types) + :use-module (vcomponent formats common types) :use-module (datetime) :use-module (srfi srfi-1) ) diff --git a/module/vcomponent/xcal/types.scm b/module/vcomponent/formats/xcal/types.scm index 468400f4..34c7c40d 100644 --- a/module/vcomponent/xcal/types.scm +++ b/module/vcomponent/formats/xcal/types.scm @@ -1,6 +1,6 @@ -(define-module (vcomponent xcal types) +(define-module (vcomponent formats xcal types) :use-module (calp util) - :use-module (vcomponent ical types) + :use-module (vcomponent formats ical types) :use-module (datetime) ) @@ -40,7 +40,7 @@ (hashq-set! sxml-writers simple-type (lambda (p v) `(,(downcase-symbol simple-type) - ,(((@ (vcomponent ical types) get-writer) simple-type) p v))))) + ,(((@ (vcomponent formats ical types) get-writer) simple-type) p v))))) (hashq-set! sxml-writers 'BOOLEAN write-boolean) (hashq-set! sxml-writers 'DATE write-date) diff --git a/module/vcomponent/util/control.scm b/module/vcomponent/util/control.scm new file mode 100644 index 00000000..4cb6c708 --- /dev/null +++ b/module/vcomponent/util/control.scm @@ -0,0 +1,36 @@ +(define-module (vcomponent util control) + #:use-module (calp util) + #:use-module (vcomponent) + #:export (with-replaced-properties)) + + +(eval-when (expand load) ; No idea why I must have load here. + (define href (make-procedure-with-setter hash-ref hash-set!)) + + (define (set-temp-values! table component kvs) + (for-each (lambda (kv) + (let* (((key val) kv)) + (when (prop component key) + (set! (href table key) (prop component key)) + (set! (prop component key) val)))) + kvs)) + + (define (restore-values! table component keys) + (for-each (lambda (key) + (and=> (href table key) + (lambda (val) + (set! (prop component key) val)))) + keys))) + +;; TODO what is this even used for? +(define-syntax with-replaced-properties + (syntax-rules () + [(_ (component (key val) ...) + body ...) + + (let ((htable (make-hash-table 10))) + (dynamic-wind + (lambda () (set-temp-values! htable component (quote ((key val) ...)))) ; In guard + (lambda () body ...) + (lambda () (restore-values! htable component (quote (key ...))))))])) ; Out guard + diff --git a/module/vcomponent/describe.scm b/module/vcomponent/util/describe.scm index af0f9433..5c3afd30 100644 --- a/module/vcomponent/describe.scm +++ b/module/vcomponent/util/describe.scm @@ -1,4 +1,4 @@ -(define-module (vcomponent describe) +(define-module (vcomponent util describe) :use-module (calp util) :use-module (vcomponent base) :use-module (text util)) @@ -23,7 +23,7 @@ (format #f "~a" (value vline)) (- 80 indent maxlen))) (awhen (vline-source vline) - (display ((@@ (vcomponent ical parse) get-line) it))) + (display ((@@ (vcomponent formats ical parse) get-line) it))) (unless (null? (parameters vline)) (display " ;") (for (key value) in (parameters vline) diff --git a/module/vcomponent/group.scm b/module/vcomponent/util/group.scm index d23787ef..f328cd18 100644 --- a/module/vcomponent/group.scm +++ b/module/vcomponent/util/group.scm @@ -1,4 +1,4 @@ -(define-module (vcomponent group) +(define-module (vcomponent util group) #:use-module (vcomponent) #:use-module (vcomponent datetime) #:use-module (datetime) diff --git a/module/vcomponent/instance.scm b/module/vcomponent/util/instance.scm index 206d7f19..15c020b1 100644 --- a/module/vcomponent/instance.scm +++ b/module/vcomponent/util/instance.scm @@ -1,4 +1,4 @@ -(define-module (vcomponent instance) +(define-module (vcomponent util instance) :use-module (calp util) :use-module ((calp util config) :select (get-config)) :use-module ((oop goops) :select (make)) @@ -12,11 +12,11 @@ ;; TODO this is loaded on compile, meaning that Guile's auto-compiler may ;; evaluate this to early. (define-once global-event-object - (make (@@ (vcomponent instance methods) <events>) + (make (@@ (vcomponent util instance methods) <events>) calendar-files: (get-config 'calendar-files))) (define-public (reload) - (let ((new-value (make (@@ (vcomponent instance methods) <events>) + (let ((new-value (make (@@ (vcomponent util instance methods) <events>) calendar-files: (get-config 'calendar-files)))) (display "Reload done\n" (current-error-port)) (set! global-event-object new-value))) diff --git a/module/vcomponent/instance/methods.scm b/module/vcomponent/util/instance/methods.scm index 414587a9..37aef3bc 100644 --- a/module/vcomponent/instance/methods.scm +++ b/module/vcomponent/util/instance/methods.scm @@ -1,11 +1,12 @@ -(define-module (vcomponent instance methods) +(define-module (vcomponent util instance methods) :use-module (calp util) :use-module (srfi srfi-1) :use-module (srfi srfi-41) :use-module (srfi srfi-41 util) :use-module (datetime) :use-module (vcomponent base) - :use-module (vcomponent parse) + ;; :use-module (vcomponent parse) + :use-module ((vcomponent util parse-cal-path) :select (parse-cal-path)) :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?)) :use-module ((vcomponent datetime) :select (ev-time<?)) :use-module (oop goops) diff --git a/module/vcomponent/parse.scm b/module/vcomponent/util/parse-cal-path.scm index 9790d1eb..94c0c6ed 100644 --- a/module/vcomponent/parse.scm +++ b/module/vcomponent/util/parse-cal-path.scm @@ -1,12 +1,12 @@ -(define-module (vcomponent parse) +(define-module (vcomponent util parse-cal-path) :use-module (calp util) - :use-module (vcomponent base) - :use-module ((vcomponent vdir parse) :select (parse-vdir)) :use-module ((calp util time) :select (report-time!)) + :use-module (vcomponent base) + :use-module ((vcomponent formats ical parse) + :select (parse-calendar)) + :use-module ((vcomponent formats vdir parse) + :select (parse-vdir))) - :use-module (vcomponent ical parse) - :re-export (parse-calendar) - ) ;; Parse a vdir or ics file at the given path. (define-public (parse-cal-path path) diff --git a/module/vcomponent/search.scm b/module/vcomponent/util/search.scm index a850fb40..fb395022 100644 --- a/module/vcomponent/search.scm +++ b/module/vcomponent/util/search.scm @@ -24,7 +24,7 @@ ;;; Code: -(define-module (vcomponent search) +(define-module (vcomponent util search) :use-module (calp util) :use-module (srfi srfi-1) :use-module (srfi srfi-9) diff --git a/tests/datetime.scm b/tests/datetime.scm index 5bf2df6d..1eb3fb3b 100644 --- a/tests/datetime.scm +++ b/tests/datetime.scm @@ -149,3 +149,5 @@ #2020-02-29 (date+ #2020-02-28 (date day: 1))) + +;; TODO string->date family diff --git a/tests/param.scm b/tests/param.scm index a60e8d47..c5a23cbe 100644 --- a/tests/param.scm +++ b/tests/param.scm @@ -4,7 +4,7 @@ ;;; Code: (((vcomponent base) param prop* parameters prop) - ((vcomponent parse) parse-calendar) + ((vcomponent formats ical parse) parse-calendar) ((vcomponent) make-vcomponent) ((calp util) sort* set!)) diff --git a/tests/recurrence-simple.scm b/tests/recurrence-simple.scm index bbe6dd9d..cd170976 100644 --- a/tests/recurrence-simple.scm +++ b/tests/recurrence-simple.scm @@ -11,8 +11,8 @@ ((calp util exceptions) warnings-are-errors warning-handler) ((guile) format @@) - ((vcomponent) parse-calendar) - ((vcomponent xcal parse) sxcal->vcomponent) + ((vcomponent formats ical parse) parse-calendar) + ((vcomponent formats xcal parse) sxcal->vcomponent) ((vcomponent recurrence) parse-recurrence-rule make-recur-rule @@ -243,7 +243,7 @@ END:VCALENDAR" ;;; Earlier I failed to actually parse the recurrence parts, in short, 1 ≠ "1". (test-assert "Test that xcal recur rules are parseable" - ((@@ (vcomponent xcal parse) handle-value) + ((@@ (vcomponent formats xcal parse) handle-value) 'recur 'props-are-unused-for-recur '((freq "WEEKLY") (interval "1") diff --git a/tests/run-tests.scm b/tests/run-tests.scm index 4f871299..6ec8dea7 100755 --- a/tests/run-tests.scm +++ b/tests/run-tests.scm @@ -115,7 +115,8 @@ (append modules '(((srfi srfi-64) test-assert test-equal test-error - test-eqv) + test-eqv test-eq + test-approximate) ((ice-9 ports) call-with-input-string) ((guile) make-struct/no-tail) ) diff --git a/tests/vcomponent-control.scm b/tests/vcomponent-control.scm index a1300a8c..1f4d6801 100644 --- a/tests/vcomponent-control.scm +++ b/tests/vcomponent-control.scm @@ -2,8 +2,8 @@ ;; Tests that with-replaced-properties work. ;;; Code: -(((vcomponent control) with-replaced-properties) - ((vcomponent) parse-calendar) +(((vcomponent util control) with-replaced-properties) + ((vcomponent formats ical parse) parse-calendar) ((vcomponent base) prop)) diff --git a/tests/vcomponent-datetime.scm b/tests/vcomponent-datetime.scm index 0bc584f6..0f410979 100644 --- a/tests/vcomponent-datetime.scm +++ b/tests/vcomponent-datetime.scm @@ -8,7 +8,7 @@ datetime) ((vcomponent datetime) event-length/clamped) - ((vcomponent) parse-calendar) + ((vcomponent formats ical parse) parse-calendar) ) (define ev (call-with-input-string diff --git a/tests/vcomponent-formats-common-types.scm b/tests/vcomponent-formats-common-types.scm new file mode 100644 index 00000000..d9c80ff9 --- /dev/null +++ b/tests/vcomponent-formats-common-types.scm @@ -0,0 +1,115 @@ +(((vcomponent formats common types) + get-parser) + ((datetime) date time datetime)) + + + +(define parse-binary (get-parser 'BINARY)) +;; TODO + + + +(define parse-boolean (get-parser 'BOOLEAN)) + +(test-equal #t (parse-boolean #f "TRUE")) +(test-equal #f (parse-boolean #f "FALSE")) + +(test-error 'warning (parse-boolean #f "ANYTHING ELSE")) + + + +(define parse-cal-address (get-parser 'CAL-ADDRESS)) + +(test-equal "Test uri is passthrough" 74 (parse-cal-address #f 74)) + + + +(define parse-date (get-parser 'DATE)) + +(test-equal #2021-12-02 (parse-date #f "20211202")) +;; TODO negative test here + + + +(define parse-datetime (get-parser 'DATE-TIME)) + +(test-equal #2021-12-02T10:20:30 + (parse-datetime (make-hash-table) "20211202T102030")) + +;; TODO tests with timezones here +;; TODO test -X-HNH-ORIGINAL here + +;; TODO negative test here + + + +(define parse-duration (get-parser 'DURATION)) + +;; assume someone else tests this one +;; (test-eq (@ (vcomponent duration) parse-duration) +;; parse-duration) + + + +(define parse-float (get-parser 'FLOAT)) + +(test-equal 1.0 (parse-float #f "1.0")) +(test-equal 1 (parse-float #f "1")) +(test-equal 1/2 (parse-float #f "1/2")) + +;; TODO negative test here? + + + +(define parse-integer (get-parser 'INTEGER)) + +(test-equal "parse integer" 123456 (parse-integer #f "123456")) +(test-equal "parse bigint" 123451234512345123456666123456 + (parse-integer #f "123451234512345123456666123456")) + +;; TODO is this expected behaivour? +(test-error 'warning (parse-integer #f "failure")) + +(test-error + "Non-integers aren't integers" + 'warning (parse-integer #f "1.1")) + +(test-equal "But exact floats are" + 1.0 (parse-integer #f "1.0")) + + + +(define parse-period (get-parser 'PERIOD)) + +;; TODO + + + +(define parse-recur (get-parser 'RECUR)) + +;; (test-eq (@ (vcomponent recurrence parse) parse-recurrence-rule)) + + + +(define parse-text (get-parser 'TEXT)) + +;; TODO + + + +(define parse-time (get-parser 'TIME)) + +(test-equal #10:20:30 (parse-time #f "102030")) +;; TODO negative test here + + + +(define parse-uri (get-parser 'URI)) + +(test-equal "Test uri is passthrough" 74 (parse-uri #f 74)) + + + +(define parse-utc-offset (get-parser 'UTC-OFFSET)) + +;; TODO diff --git a/tests/vcomponent.scm b/tests/vcomponent.scm index 28f1cf91..acdb970b 100644 --- a/tests/vcomponent.scm +++ b/tests/vcomponent.scm @@ -3,7 +3,7 @@ ;;; Code: (((vcomponent base) prop) - ((vcomponent) parse-calendar)) + ((vcomponent formats ical parse) parse-calendar)) (define ev (call-with-input-string "BEGIN:DUMMY diff --git a/tests/xcal.scm b/tests/xcal.scm index babb2218..df8a5135 100644 --- a/tests/xcal.scm +++ b/tests/xcal.scm @@ -3,9 +3,9 @@ ;; Currently only checks that events survive a round trip. ;;; Code: -(((vcomponent xcal parse) sxcal->vcomponent) - ((vcomponent xcal output) vcomponent->sxcal) - ((vcomponent ical parse) parse-calendar) +(((vcomponent formats xcal parse) sxcal->vcomponent) + ((vcomponent formats xcal output) vcomponent->sxcal) + ((vcomponent formats ical parse) parse-calendar) ((calp util) ->) ((vcomponent base) parameters prop* children) |