Sprinkled in some time prints.

5 files changed, 30 insertions, 0 deletions

diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm
index c08dd72d..55fb0c94 100644
--- a/module/entry-points/html.scm
+++ b/module/entry-points/html.scm
@@ -2,6 +2,7 @@
   :export (main)
   :use-module (output html)
   :use-module (util)
+  :use-module (util time)
   :use-module (vcomponent)
   :use-module (datetime)
   :use-module (datetime util)
@@ -32,6 +33,9 @@
      calendar-files: (cond [(option-ref opts 'file #f) => list]
                            [else (calendar-files)]) ))
 
+
+  (report-time! "Calendars loaded")
+
   (if (option-ref opts 'chunked #f)
       (html-chunked-main count calendars events start)
       (html-generate calendars events start end render-calendar)))
diff --git a/module/main.scm b/module/main.scm
index 15079dc5..bb3fa041 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -13,6 +13,7 @@ exec guile -e main -s $0 "$@"
 
              (util)
              (util io)
+             (util time)
 
              ((entry-points html)      :prefix      html-)
              ((entry-points terminal)  :prefix  terminal-)
@@ -84,6 +85,7 @@ exec guile -e main -s $0 "$@"
 (use-modules (system vm frame))
 
 (define (main args)
+  (report-time! "Program start")
   (with-throw-handler #t
     (lambda () (wrapped-main args))
     (lambda (err . args)
diff --git a/module/util/time.scm b/module/util/time.scm
new file mode 100644
index 00000000..004cb6dc
--- /dev/null
+++ b/module/util/time.scm
@@ -0,0 +1,16 @@
+(define-module (util time)
+  :export (report-time!))
+
+
+(define report-time!
+  (let ((last 0))
+   (lambda (fmt . args)
+     (let ((run (get-internal-run-time))
+                                        ; (real (get-internal-real-time))
+           )
+       (format (current-error-port) "~7,4fs (+ ~,4fs) │ ~?~%"
+               (/ run internal-time-units-per-second)
+               (/ (- run last) internal-time-units-per-second)
+               ;; (/ real internal-time-units-per-second)
+               fmt args)
+       (set! last run)))))
diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm
index 0cb03b42..e3e6f192 100644
--- a/module/vcomponent/load.scm
+++ b/module/vcomponent/load.scm
@@ -1,6 +1,7 @@
 (define-module (vcomponent load)
   :export (load-calendars load-calendars*)
   :use-module (util)
+  :use-module (util time)
   :use-module (srfi srfi-1)
   :use-module (datetime)
   :use-module (datetime util)
@@ -17,7 +18,9 @@
 ;; Reads all calendar files from disk, generate recurence-sets for all repeating events,
 ;; and returns a list of calendars, and a stream of all events "ready" for display.
 (define* (load-calendars #:key (calendar-files (calendar-files)))
+  (report-time! "Parsing ~a calendars" (length calendar-files))
   (let* ((calendars regular repeating (load-calendars* #:calendar-files calendar-files)))
+    (report-time! "Calendars loaded, interleaving and reccurring")
     (values
      calendars
      (interleave-streams
@@ -39,8 +42,10 @@
                                         (children cal)))
                        calendars)))
 
+  (report-time! "Parse done, partitioning...")
   (let* ((repeating regular (partition repeating? events)))
 
+    (report-time! "Sorting")
     ;; NOTE There might be instances where we don't care if the
     ;; collection if sorted, but for the time beieng it's much
     ;; easier to always sort it.
diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm
index 32b368c7..ef31cbd0 100644
--- a/module/vcomponent/parse.scm
+++ b/module/vcomponent/parse.scm
@@ -11,6 +11,7 @@
   :use-module ((ice-9 ftw) :select (scandir ftw))
 
   :use-module (util)
+  :use-module (util time)
   :use-module (util strbuf)
   :use-module (vcomponent base)
   :use-module (vcomponent datetime)
@@ -92,6 +93,7 @@
 
 ;; Reads a vcomponent from the given port.
 (define-public (parse-calendar port)
+  ;; (report-time! "Parsing ~a" port)
   (with-input-from-port port
     (lambda ()
       (let ((component (make-vcomponent))
@@ -359,6 +361,7 @@ row ~a	column ~a	ctx = ~a
         (set! (attr comp 'X-HNH-SOURCETYPE) "file")
         comp) ]
      [(directory)
+      (report-time! "Parsing ~a" path)
       (let ((comp (parse-vdir path)))
         (set! (attr comp 'X-HNH-SOURCETYPE) "vdir")
         comp)]