blob: 3f602b0732c6558f5277a999b43b11bf83f77414 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
(define-module (calp entry-points convert)
:export (main)
:use-module (hnh util)
:use-module (hnh util options)
:use-module (ice-9 getopt-long)
:use-module (sxml simple)
)
(define opt-spec
`((from (single-char #\f) (value (options "xcal" "ical"))
(description "Input format (infered from " (i "infile") ")"))
(to (single-char #\t) (value (options "xcal" "ical"))
(description "Output format (infered from " (i "outfile") ")"))
(infile (value #t) (single-char #\i) (description "Input file"))
(outfile (value #t) (single-char #\o) (description "Output file"))
(help (single-char #\h) (description "Print this help."))))
(define (filename-to-type filename)
(let ((extension (car (reverse (string-split filename #\.)))))
(cond [(string-ci=? "ics" extension)
"ical"]
[(or (string-ci=? "xcal" extension)
(string-ci=? "xml" extension))
"xcal"])))
(define (main args)
(define opts (getopt-long args (getopt-opt opt-spec)))
(define infile "/dev/stdin")
(define outfile "/dev/stdout")
(define from "ical")
(define to "xcal")
(when (option-ref opts 'help #f)
(print-arg-help opt-spec)
(throw 'return))
(awhen (option-ref opts 'infile #f)
(set! infile it
from (filename-to-type it)))
(awhen (option-ref opts 'outfile #f)
(set! outfile it
to (filename-to-type it)))
(awhen (option-ref opts 'from #f)
(set! from it))
(awhen (option-ref opts 'to #f)
(set! to it))
;; from ∈ { "ical" "xcal" }
;; to ∈ { "ical" "xcal" }
(let ()
(define parser
(case (string->symbol from)
[(ical)
;; read ical
(@ (vcomponent formats ical parse) parse-calendar)]
[(xcal)
;; read xcal
(compose
(@ (vcomponent formats xcal parse) sxcal->vcomponent)
;; TODO strip *TOP*
xml->sxml)]
[else (error "")]
))
(define writer
(case (string->symbol to)
[(ical)
;; write ical
(lambda (component port)
(display ((@ (vcomponent formats ical output) component->ical-string)
component)
port))]
[(xcal)
;; write xcal
(lambda (component port)
(sxml->xml ((@ (vcomponent formats xcal output) vcomponent->sxcal)
component)
port))]
[else (error "")]))
(call-with-output-file outfile
(lambda (p)
(writer (call-with-input-file infile parser)
p)))
(newline)))
|
