diff options
Diffstat (limited to 'scripts/generate-test-data.scm')
-rwxr-xr-x | scripts/generate-test-data.scm | 119 |
1 files changed, 119 insertions, 0 deletions
diff --git a/scripts/generate-test-data.scm b/scripts/generate-test-data.scm new file mode 100755 index 00000000..076558e4 --- /dev/null +++ b/scripts/generate-test-data.scm @@ -0,0 +1,119 @@ +#!/usr/bin/guile \ +-e main -s +!# +(add-to-load-path (string-append (dirname (dirname (current-filename))) "/module")) + +(use-modules (vcomponent) + ((vcomponent recurrence parse) :select (parse-recurrence-rule)) + ((vcomponent formats xcal output) :select (vcomponent->sxcal ns-wrap)) + ((vcomponent formats ical output) :select (component->ical-string)) + (vcomponent datetime) + (datetime) + ((datetime instance) :select (zoneinfo)) + (hnh util) + (hnh util uuid) + (ice-9 format) + (ice-9 popen) + (ice-9 threads) + ((srfi srfi-88) :select (keyword->string)) + (sxml simple) + ) + +(define (vevent . rest) + (define v (make-vcomponent 'VEVENT)) + + (let loop ((rem rest)) + (unless (null? rem) + (let ((symb (-> (car rem) + keyword->string + string-upcase + string->symbol))) + (set! (prop v symb) + (case symb + ;; [(DTSTART EXDATE) (parse-ics-datetime (cadr rem))] + [(RRULE) (parse-recurrence-rule (cadr rem))] + [else (cadr rem)])) + ;; hack for multi valued fields + (when (eq? symb 'EXDATE) + (set! (prop* v symb) = list))) + (loop (cddr rem)))) + + v) + +(define ev + (vevent + summary: "Test Event #1" + uid: (uuid) + dtstart: #2021-12-21T10:30:00 + dtend: #2021-12-21T11:45:00 + dtstamp: (current-datetime) + )) + +(set! + (param (prop* ev 'DTSTART) 'TZID) "Europe/Stockholm" + (param (prop* ev 'DTEND) 'TZID) "Europe/Stockholm") + +(define zoneinfo + (zoneinfo->vtimezone (zoneinfo '("tzdata/europe")) + "Europe/Stockholm" ev)) + +(define cal (make-vcomponent 'VCALENDAR)) + +(set! + (prop cal 'PRODID) "-//hugo//calp TEST//EN" + (prop cal 'VERSION) "2.0") + +(add-child! cal zoneinfo) +(add-child! cal ev) + +(define sxcal + `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"UTF-8\"") + ,(ns-wrap (vcomponent->sxcal cal)))) + +(define (main args) + (for-each (lambda (fmt) + (define parts (map string->symbol (string-split fmt #\:))) + (case (car parts) + ((sxcal) + (if (memv 'pretty (cdr parts)) + (format #t "~y" sxcal) + (begin (write sxcal) (newline)))) + ((ical) (component->ical-string cal)) + ((xml) + (let ((pipe (open-output-pipe + (string-join + (append '("cat") + (if (memv 'pretty (cdr parts)) '("xmllint --format -") '()) + (if (memv 'color (cdr parts)) '("highlight -Oansi --syntax=xml") '())) + "|")))) + (sxml->xml sxcal pipe) + (close-pipe pipe) + (newline))) + ((newline) (newline)) + (else (format #t "Unknown mode [~a]~%" (car parts))))) + (cdr args))) + +;; (write sxcal) +;; +;; (newline) +;; (newline) +;; +;; (format #t "~y" sxcal) +;; +;; (newline) +;; +;; (let ((pipe (open-pipe* OPEN_WRITE "highlight" "-Oansi" "--syntax=xml"))) +;; ((@ (sxml simple) sxml->xml) sxcal pipe) +;; (close-pipe pipe)) +;; (newline) +;; +;; (let ((pipe (open-pipe "xmllint --format - | highlight -Oansi --syntax=xml" +;; OPEN_WRITE +;; ))) +;; (sxml->xml sxcal pipe) +;; (close-pipe pipe)) +;; (newline) +;; +;; +;; (newline) +;; (component->ical-string cal) |