redo reindexing to be more erlangy

3 files changed, 55 insertions, 59 deletions

diff --git a/src/tekuti b/src/tekuti
index c3dccfa..2873ff6 100755
--- a/src/tekuti
+++ b/src/tekuti
@@ -39,33 +39,43 @@ exec guile $GUILE_FLAGS -l $0 -e main "$@"
              (tekuti mod-lisp)
              (tekuti web))
 
-(define (handle-request headers post-data)
-  (let ((heads (fetch-heads `(posts . ,reindex-posts)
-                            `(categories . ,reindex-categories))))
-    (let-headers
-     headers ((method "method") (path "url"))
-     (url-relative-path-case
-      method path
-      ((POST admin new-post)
-       (unimplemented 'new-post))
-      ((POST admin modify-post)
-       (unimplemented 'modify-post))
-      ((POST admin new-comment)
-       (unimplemented 'new-comment))
-      ((POST admin delete-comment)
-       (unimplemented 'delete-comment))
-      ((POST admin delete-post)
-       (unimplemented 'delete-post))
-      ((GET)
-       (unimplemented 'index))
-      ((GET archives year? month? day? post?)
-       (unimplemented 'archives))
-      ((GET debug)
-       (page-debug headers))
-      ((POST search)
-       (unimplemented 'search))
-      (else (page-not-found path))))))
-     
+(define (handle-request headers post-data index)
+  (let-headers headers ((method "method") (path "url"))
+    (url-relative-path-case
+     method path
+     ((POST admin new-post)
+      (unimplemented 'new-post))
+     ((POST admin modify-post)
+      (unimplemented 'modify-post))
+     ((POST admin new-comment)
+      (unimplemented 'new-comment))
+     ((POST admin delete-comment)
+      (unimplemented 'delete-comment))
+     ((POST admin delete-post)
+      (unimplemented 'delete-post))
+     ((GET)
+      (unimplemented 'index))
+     ((GET archives year? month? day? post?)
+      (unimplemented 'archives))
+     ((GET debug)
+      (page-debug headers))
+     ((POST search)
+      (unimplemented 'search))
+     (else (page-not-found path)))))
+
+(define (maybe-reindex old-master old-index)
+  (let ((master (git-rev-parse "master")))
+    (values
+     master 
+     (if (equal? master old-master)
+         old-index
+         (acons 'master master
+                (map (lambda (k reindex)
+                       (cons k (reindex master)))
+                     (list 'posts 'categories)
+                     (list reindex-posts reindex-categories)))))))
+
 (define (main args)
   (ensure-git-repo)
-  (event-loop handle-request))
+  (event-loop handle-request maybe-reindex))
+
diff --git a/tekuti/git.scm b/tekuti/git.scm
index 0ebf26c..162ba8a 100644
--- a/tekuti/git.scm
+++ b/tekuti/git.scm
@@ -34,7 +34,7 @@
   #:use-module (ice-9 regex) ; hack
   #:export (git git* ensure-git-repo git-ls-tree git-ls-subdirs
             parse-metadata parse-commit commit-utc-timestamp
-            commit-parents make-tree fetch-heads))
+            commit-parents make-tree git-rev-parse))
 
 (define (call-with-pipe pipe proc)
   (unwind-protect
@@ -148,25 +148,3 @@
 
 (define (git-rev-parse rev)
   (string-trim-both (git "rev-parse" rev)))
-
-(define (fetch-heads . heads)
-  (let ((master (git-rev-parse "master")))
-    (acons
-     'master master
-     (map (lambda (spec)
-            (let ((ref (car spec)) (reindex (cdr spec)))
-              (let ((head (false-if-exception
-                           (git-rev-parse (car spec)))))
-                (cons
-                 ref
-                 (if (and head (member master (commit-parents head)))
-                     head
-                     (and=> (reindex master)
-                            (lambda (new)
-                              (if (not (false-if-exception 
-                                        (if head
-                                            (git "update-ref" ref new head)
-                                            (git "branch" ref new))))
-                                  (dbg "couldn't update ref ~a to ~a" ref new))
-                              new)))))))
-          heads))))
diff --git a/tekuti/mod-lisp.scm b/tekuti/mod-lisp.scm
index 613bda9..585c393 100644
--- a/tekuti/mod-lisp.scm
+++ b/tekuti/mod-lisp.scm
@@ -26,6 +26,7 @@
 
 (define-module (tekuti mod-lisp)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 receive)
   #:use-module (sxml simple)
   #:use-module (sxml transform)
   #:use-module (tekuti url)
@@ -57,14 +58,14 @@
    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" "
    "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n"))
 
-(define (connection-received socket sockaddr handle-request)
+(define (connection-received socket sockaddr index handle-request)
   (let ((headers (read-headers socket))
         (post-data "")) ;; blocks: (read-delimited "" socket)))
 
     (dbg "~a" headers)
     (catch #t
            (lambda ()
-             (let ((sxml (handle-request headers post-data)))
+             (let ((sxml (handle-request headers post-data index)))
                (write-headers '(("Status" . "200 OK")
                                 ("Content-Type" . "text/html"))
                               socket)
@@ -78,16 +79,23 @@
              
     (close-port socket)))
 
-(define (event-loop handle-request)
+(define (with-socket proc)
   (pk 'listening)
   (let ((socket (socket PF_INET SOCK_STREAM 0)))
     (bind socket AF_INET (inet-aton *host*) *port*)
     (listen socket *backlog*)
     (unwind-protect
-     (let lp ((pair (accept socket)))
-       (pk pair)
-       (connection-received (car pair) (cdr pair) handle-request)
-       (pk 'done)
-       (lp (accept socket)))
+     (proc socket)
      (shutdown socket 2))))
 
+(define (event-loop handle-request maybe-reindex)
+  (with-socket
+   (lambda (socket)
+     (let lp ((old-cookie #f) (old-index #f))
+       (let* ((pair (accept socket))
+              (fd (car pair))
+              (sockaddr (cdr pair)))
+         (receive
+          (cookie index) (maybe-reindex old-cookie old-index)
+          (connection-received (car pair) (cdr pair) index handle-request)
+          (lp cookie index)))))))