From 8c52717d5dab16eb628b823ffad914d44761459b Mon Sep 17 00:00:00 2001
From: Andy Wingo
Date: Tue, 12 Feb 2008 23:09:55 +0100
Subject: redo reindexing to be more erlangy

---
 src/tekuti | 66 ++++++++++++++++++++++++++++++++++++--------------------------
 1 file changed, 38 insertions(+), 28 deletions(-)

(limited to 'src')

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))
+
-- 
cgit v1.2.3-54-g00ecf