Add structure for importing events.

1 files changed, 51 insertions, 30 deletions

diff --git a/module/entry-points/import.scm b/module/entry-points/import.scm
index 5558433b..3d372f8a 100644
--- a/module/entry-points/import.scm
+++ b/module/entry-points/import.scm
@@ -1,37 +1,58 @@
 (define-module (entry-points import)
   :export (main)
   :use-module (util)
+  :use-module (util app)
+  :use-module (util options)
   :use-module (ice-9 getopt-long)
+  :use-module (ice-9 rdelim)
+  :use-module (vcomponent)
+  :use-module (srfi srfi-1)
   )
 
 (define options
-  '((calendar (value #t) (single-char #\c))
-    (source (value #t) (single-char #\f))
-    ))
-
-(define (import-main calenadrs events args)
-  (define opts (getopt-long args options))
-
-  (define calendar (option-ref opts 'calendar #f))
-
-  (unless calendar
-    (format (current-error-port)
-            "Everything wroong~%"))
-
-
-  ;; TODO save sourcetype and dir for vdir calendars
-
-  #;
-  (let ((component (make-vcomponent (option-ref args 'source "/dev/stdin")))) ;
-                                        ;
-    ;; Check UID                        ;
-    ;; Add to calendar                  ;
-    ;; Allocate file, save there        ;
-                                        ;
-  )
-
-
-  )
-
-(define (main . _)
-  'noop)
+  '((calendar (value #t) (single-char #\c)
+              (description "Name of calendar to import into"))
+    (file (value #t) (single-char #\f)
+          (description "ics file to import"))
+    (help (single-char #\h)
+          (description "Print this help."))))
+
+(define (main args)
+  (define opts (getopt-long args (getopt-opt options)))
+
+  (define cal-name (option-ref opts 'calendar #f))
+  (define fname (option-ref opts 'file "/dev/stdin"))
+
+  (when (option-ref opts 'help #f)
+    (print-arg-help options)
+    (throw 'return))
+
+  (let* ((calendars (getf 'calendars))
+         (calendar
+          (and cal-name
+               (find (lambda (c) (string=? cal-name (attr c 'NAME)))
+                     (getf 'calendars)))))
+
+    (unless calendar
+      (format (current-error-port) "No calendar named ~s~%" cal-name)
+      (throw 'return))
+
+    (let ((new-events (parse-cal-path fname)))
+
+      (format #t "About to the following ~a events into ~a~%~{~a~^~%~}~%"
+              (length (children new-events))
+              (attr calendar 'NAME)
+              (map (extract 'SUMMARY) (children new-events)))
+
+      (format #t "Continue? [Y/n] ")
+
+      (let loop ((c #\space))
+        (case c
+          [(#\n #\N) (throw 'return)]
+          [(#\y #\Y) (map (lambda (e) (calendar-import calendar e))
+                          (children new-events))]
+          [else
+           (let ((line (read-line)))
+             (loop (if (string-null? line)
+                       #\Y (string-ref line 0))))]))
+      )))