Add simple project list

4 files changed, 73 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index 521c995..924c2d1 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -18,6 +18,7 @@ SOURCES =					\
 	tekuti/tags.scm				\
 	tekuti/template.scm			\
 	tekuti/util.scm				\
+	tekuti/projects.scm         \
 	tekuti/web.scm
 
 GOBJECTS = $(SOURCES:%.scm=%.go)
diff --git a/tekuti/config.scm b/tekuti/config.scm
index d050920..da004be 100644
--- a/tekuti/config.scm
+++ b/tekuti/config.scm
@@ -57,6 +57,7 @@
 (define *index-content*
   '((h1 "Hello, World!")
     "I am here to show you something new."))
+(define *projects-dir* "~/projects")
 
 (define *server-impl* 'http)
 (define *server-impl-args*
diff --git a/tekuti/projects.scm b/tekuti/projects.scm
new file mode 100644
index 0000000..9c0af36
--- /dev/null
+++ b/tekuti/projects.scm
@@ -0,0 +1,69 @@
+(define-module (tekuti projects)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (tekuti page-helpers)
+  #:use-module ((tekuti config) #:select (*projects-dir*))
+  #:use-module (ice-9 rdelim)
+  #:use-module (tekuti git)
+  #:use-module (ice-9 popen)
+  #:export (page-projects))
+
+(use-modules (ice-9 ftw)
+             (ice-9 match))
+
+(define remove-stat
+  (match-lambda
+   ((name stat)
+    name)
+   ((name stat children ...)
+    (list name (map remove-stat children)))))
+
+(define (list-projects)
+  (let ((start #t))
+    (cadr (remove-stat (file-system-tree
+                        *projects-dir*
+                        (lambda params
+                          (and start
+                               (begin (set! start #f) #t))))))))
+
+(define (project-description project)
+  (let ((dfile-name
+         (string-append *projects-dir* "/" project "/description")))
+    (if (file-exists? dfile-name)
+        (with-input-from-file dfile-name
+          (lambda ()
+            (read-line)))
+        "Unknown")))
+
+(define (git-last-update project)
+  "Check when the last update upstream was."
+  (let* ((dfile-name
+          (string-append *projects-dir* "/" project))
+         (pipe (open-input-pipe
+                (string-append
+                 "git --git-dir=" dfile-name
+                 " log -1 --format=%ar 2>/dev/null")))
+         (relative-last-update (read-line pipe)))
+    (close-pipe pipe)
+    (if (eof-object? relative-last-update)
+        "never"
+        relative-last-update)))
+
+(define (page-projects request body index)
+  (respond `((table (@ (class "table"))
+                    (thead
+                     (tr
+                      (th "Name")
+                      (th "Description")
+                      (th "Last update")
+                      (th "")))
+                    (tbody
+                     ,@(map
+                        (lambda (elt)
+                          `(tr
+                            (td ,elt)
+                            (td ,(project-description elt))
+                            (td ,(git-last-update elt))
+                            (td "")))
+                        (list-projects)))))
+           #:extra-headers '((pragma . (no-cache (broccoli . "tastyy"))))))
diff --git a/tekuti/web.scm b/tekuti/web.scm
index 57b8424..3ba12d7 100644
--- a/tekuti/web.scm
+++ b/tekuti/web.scm
@@ -31,6 +31,7 @@
   #:use-module (tekuti index)
   #:use-module (tekuti page)
   #:use-module (tekuti config)
+  #:use-module (tekuti projects)
   #:export (main-loop))
 
 (define (choose-handler request)
@@ -59,6 +60,7 @@
    ((GET tags) page-show-tags)
    ((GET tags tag!) page-show-tag)
    ((GET debug) page-debug)
+   ((GET projects) page-projects)
    (else page-not-found)))
 
 (define (cache-ref index request)