From 92b2f429a06ed9b052baff5e27f012397b338f6a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Mon, 23 Dec 2019 23:40:14 +0100
Subject: Rework program initialization.

Old init setup had the fancy idea to parse all files before anything
could be done with them. This however led to problems when a part of the
program which didn't care for the calendar files (such as text
formatting).

It also made testing performance almost impossible since to much code
was run before I had a chance to init statprof.
---
 module/entry-points/html.scm     | 35 ++++++++++++++++
 module/entry-points/ical.scm     | 30 ++++++++++++++
 module/entry-points/import.scm   | 37 +++++++++++++++++
 module/entry-points/info.scm     | 24 +++++++++++
 module/entry-points/server.scm   | 90 ++++++++++++++++++++++++++++++++++++++++
 module/entry-points/terminal.scm | 29 +++++++++++++
 module/entry-points/text.scm     | 19 +++++++++
 7 files changed, 264 insertions(+)
 create mode 100644 module/entry-points/html.scm
 create mode 100644 module/entry-points/ical.scm
 create mode 100644 module/entry-points/import.scm
 create mode 100644 module/entry-points/info.scm
 create mode 100644 module/entry-points/server.scm
 create mode 100644 module/entry-points/terminal.scm
 create mode 100644 module/entry-points/text.scm

(limited to 'module/entry-points')

diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm
new file mode 100644
index 00000000..699eebdb
--- /dev/null
+++ b/module/entry-points/html.scm
@@ -0,0 +1,35 @@
+(define-module (entry-points html)
+  :export (main)
+  :use-module (output html)
+  :use-module (util)
+  :use-module (vcomponent)
+  :use-module (srfi srfi-19)
+  :use-module (srfi srfi-19 util)
+  :use-module (ice-9 getopt-long)
+
+  :use-module (parameters)
+  ;; :use-module (config)
+  )
+
+
+(define opt-spec
+  '((from (value #t) (single-char #\F))
+    (to (value #t) (single-char #\T))
+    (file (value #t) (single-char #\f))
+    (chunked)))
+
+(define (main args)
+  (define opts (getopt-long args opt-spec))
+  (define start (cond [(option-ref opts 'from #f) => parse-freeform-date]
+                      [else (start-of-month (current-date))]))
+  (define end (cond [(option-ref opts 'to  #f) => parse-freeform-date]
+                    [else (normalize-date* (set (date-month start) = (+ 1)))]))
+
+  (define-values (calendars events)
+    (load-calendars
+     calendar-files: (cond [(option-ref opts 'file #f) => list]
+                           [else (calendar-files)]) ))
+
+  (if (option-ref opts 'chunked #f)
+      (html-chunked-main calendars events start)
+      (html-generate calendars events start end)))
diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm
new file mode 100644
index 00000000..99253160
--- /dev/null
+++ b/module/entry-points/ical.scm
@@ -0,0 +1,30 @@
+(define-module (entry-points ical)
+  :export (main)
+  :use-module (util)
+  :use-module (output ical)
+  :use-module ((vcomponent) :select (load-calendars))
+  :use-module ((parameters) :select (calendar-files))
+  :use-module (ice-9 getopt-long)
+  :use-module (srfi srfi-19)
+  :use-module (srfi srfi-19 util)
+  )
+
+(define opt-spec
+  '((from (value #t) (single-char #\F))
+    (to (value #t) (single-char #\T))))
+
+(define (main args)
+  (define opts (getopt-long args opt-spec))
+
+  (define start (cond [(option-ref opts 'from #f) => parse-freeform-date]
+                      [else (start-of-month (current-date))]))
+  (define end   (cond [(option-ref opts 'to  #f) => parse-freeform-date]
+                      [else (normalize-date* (set (date-month start) = (+ 1)))]))
+
+  (define-values (calendars events)
+    (load-calendars
+     calendar-files: (cond [(option-ref opts 'file #f) => list]
+                           [else (calendar-files)]) ))
+
+  (ical-main calendars events start end)
+ )
diff --git a/module/entry-points/import.scm b/module/entry-points/import.scm
new file mode 100644
index 00000000..5558433b
--- /dev/null
+++ b/module/entry-points/import.scm
@@ -0,0 +1,37 @@
+(define-module (entry-points import)
+  :export (main)
+  :use-module (util)
+  :use-module (ice-9 getopt-long)
+  )
+
+(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)
diff --git a/module/entry-points/info.scm b/module/entry-points/info.scm
new file mode 100644
index 00000000..7bc898b2
--- /dev/null
+++ b/module/entry-points/info.scm
@@ -0,0 +1,24 @@
+(define-module (entry-points info)
+  :export (main)
+  :use-module (util))
+
+(use-modules (ice-9 getopt-long)
+             (vcomponent)
+             (vcomponent output)
+             (vulgar color)
+             (srfi srfi-1))
+
+(define (main args)
+  (define-values (calendars events)
+    (load-calendars))
+
+  (format #t "~%Found ~a calendars, named:~%~{ - [~4@a] ~a~a\x1b[m~%~}~%"
+          (length calendars)
+          (concatenate
+           (zip (map (lambda (c) (length (filter (lambda (e) (eq? 'VEVENT (type e)))
+                                            (children c))))
+                     calendars)
+                (map (compose color-escape (extract 'COLOR)) calendars)
+                (map (extract 'NAME) calendars)))))
+
+
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
new file mode 100644
index 00000000..4215ab9a
--- /dev/null
+++ b/module/entry-points/server.scm
@@ -0,0 +1,90 @@
+(define-module (entry-points server)
+  :export (main)
+  :use-module (util))
+
+(use-modules* (web (server request response uri))
+              (output (html))
+              (server (util macro))
+              (sxml (simple))
+              (ice-9 (match control rdelim curried-definitions ftw
+                            getopt-long
+                            iconv regex #| regex here due to bad macros |#  ))
+              (srfi (srfi-1 srfi-19 srfi-88)))
+
+(use-modules (srfi srfi-19 util))
+
+(define (file-extension name)
+  (car (last-pair (string-split name #\.))))
+
+(define (sxml->xml-string sxml)
+  (with-output-to-string
+    (lambda () (sxml->xml sxml))))
+
+(define (directory-table dir)
+  `(table
+    (thead
+     (tr (th "Name") (th "Type") (th "Perm")))
+    (tbody
+     ,@(map (lambda (kv)
+              (let* (((k stat) kv))
+                `(tr (td (a (@ (href ,dir ,k)) ,k))
+                     (td ,(stat:type stat))
+                     (td ,(number->string (stat:perms stat) 8)))))
+            (cddr (file-system-tree dir))))))
+
+
+(define (make-make-routes calendar events)
+  (make-routes
+
+   (GET "/" (y m) ; m in [1, 12]
+        (let* ((cd (current-date))
+               (start (if m
+                          (date year: 2019 day: 1 month: (string->number m))
+                          (current-date)))
+               (end (set (date-month start) = (+ 1))))
+
+          (return '((content-type text/html))
+                  (with-output-to-string
+                    (lambda () (html-generate calendar events start end))))))
+
+   (GET "/static" ()
+        (return
+         '((content-type text/html))
+         (sxml->xml-string
+          (directory-table "static/"))))
+
+   (GET "/static/:filename" (filename)
+        (return
+         `((content-type ,(case (string->symbol (file-extension filename))
+                            ((js) 'text/javascript)
+                            ((css) 'text/css))))
+         (call-with-input-file (string-append "static/" filename) read-string)))
+
+   (GET "/count" ()
+        ;; (sleep 1)
+        (return '((content-type text/plain))
+                (string-append (number->string state) "\n")
+                (1+ state)))
+
+   ))
+
+(define options
+  '((port (value #t) (single-char #\p))
+    (addr (value #t))))
+
+(define-public (server-main c e args)
+
+  (define opts (getopt-long args options))
+  (define port (option-ref opts 'port 8080))
+  (define addr (option-ref opts 'addr INADDR_LOOPBACK))
+
+
+  (format #t "Starting server on ~a:~a~%I'm ~a, runing from ~a~%"
+          (number->string addr 16) port
+          (getpid) (getcwd))
+
+  (run-server (make-make-routes c e)
+              'http
+              `(port: ,port
+                addr: ,addr)
+              0))
diff --git a/module/entry-points/terminal.scm b/module/entry-points/terminal.scm
new file mode 100644
index 00000000..45f9b8eb
--- /dev/null
+++ b/module/entry-points/terminal.scm
@@ -0,0 +1,29 @@
+(define-module (entry-points terminal)
+  :export (main)
+  :use-module (output terminal)
+  :use-module (vcomponent)
+  :use-module (ice-9 getopt-long)
+  :use-module (srfi srfi-19)
+  :use-module (srfi srfi-19 util)
+  :use-module (parameters)
+  :use-module (vulgar)
+  )
+
+(define options
+  '((date (value #t) (single-char #\d))
+    (file (value #t) (single-char #\f))))
+
+(define (main args)
+  (define opts (getopt-long args options))
+  (define-values (calendars events)
+    (load-calendars
+     calendar-files: (cond [(option-ref opts 'file #f) => list]
+                           [else (calendar-files)]) ))
+
+  (let ((time (date->time-utc
+               (drop-time (or (and=> (option-ref opts 'date #f) parse-freeform-date)
+                              (current-date))))))
+    ;; (format (current-error-port) "len(events) = ~a~%" (stream-length events))
+    (with-vulgar
+     (lambda () (main-loop time events))))
+)
diff --git a/module/entry-points/text.scm b/module/entry-points/text.scm
new file mode 100644
index 00000000..a537b6ac
--- /dev/null
+++ b/module/entry-points/text.scm
@@ -0,0 +1,19 @@
+(define-module (entry-points text)
+  :export (main)
+  :use-module (output text)
+  :use-module (ice-9 getopt-long)
+  :use-module (util io)
+  )
+
+
+(define options
+  '((width (value #t) (single-char #\w))
+    (file (value #t) (single-char #\f))
+    ))
+
+(define (main opts)
+ (for-each (lambda (l) (display l) (newline))
+           (flow-text
+            (with-input-from-port (open-input-port (option-ref opts 'file "-"))
+              (@ (ice-9 rdelim) read-string))
+            #:width (or (string->number (option-ref opts 'width "")) 70))))
-- 
cgit v1.2.3