From cf5d90a257b30d14bd18961e52cf624150a216be Mon Sep 17 00:00:00 2001
From: Tom Willemsen <tom@ryuslash.org>
Date: Tue, 11 Sep 2012 21:44:34 +0200
Subject: [PATCH] Show subfolders separately

Recurse into subfolders when showing project list.
---
 tekuti/projects.scm | 51 ++++++++++++++++++++++++++-------------------
 1 file changed, 29 insertions(+), 22 deletions(-)

diff --git a/tekuti/projects.scm b/tekuti/projects.scm
index 1caa908..20b4dd6 100644
--- a/tekuti/projects.scm
+++ b/tekuti/projects.scm
@@ -19,12 +19,11 @@
     (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))))))))
+  (remove-stat
+   (file-system-tree
+    *projects-dir*
+    (lambda (name stat)
+      (not (file-exists? (string-append name "/config")))))))
 
 (define (project-description project)
   (let ((dfile-name
@@ -49,21 +48,29 @@
         "never"
         relative-last-update)))
 
+(define (project->row project)
+  `(tr
+    (td ,project)
+    (td ,(project-description project))
+    (td ,(git-last-update project))
+    (td "")))
+
+(define (project-list->table list lvl)
+  (let ((head (car list))
+        (body (cadr list)))
+    `((,(string->symbol (string-append "h" (number->string lvl))) ,head)
+      (table (@ (class "table table-condensed table-striped"))
+             (thead
+              (tr
+               (th "Name")
+               (th "Description")
+               (th "Last update")
+               (th "")))
+             (tbody
+              ,@(map project->row (filter string? body))))
+      ,@(map (lambda (elt) (project-list->table elt (1+ lvl)))
+             (filter list? body)))))
+
 (define (page-projects request body index)
-  (respond `((table (@ (class "table table-condensed table-striped"))
-                    (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)))))
+  (respond (project-list->table (list-projects) 1)
            #:extra-headers '((pragma . (no-cache (broccoli . "tastyy"))))))