diff options
| -rw-r--r-- | tekuti/projects.scm | 47 |
1 files changed, 30 insertions, 17 deletions
diff --git a/tekuti/projects.scm b/tekuti/projects.scm index 20b4dd6..0017d35 100644 --- a/tekuti/projects.scm +++ b/tekuti/projects.scm @@ -25,9 +25,12 @@ (lambda (name stat) (not (file-exists? (string-append name "/config"))))))) +(define (project-dir project) + (string-append *projects-dir* "/" project)) + (define (project-description project) (let ((dfile-name - (string-append *projects-dir* "/" project "/description"))) + (string-append (project-dir project) "/description"))) (if (file-exists? dfile-name) (with-input-from-file dfile-name (lambda () @@ -36,8 +39,7 @@ (define (git-last-update project) "Check when the last update upstream was." - (let* ((dfile-name - (string-append *projects-dir* "/" project)) + (let* ((dfile-name (project-dir project)) (pipe (open-input-pipe (string-append "git --git-dir=" dfile-name @@ -48,29 +50,40 @@ "never" relative-last-update))) -(define (project->row project) +(define (project->row dir project) `(tr (td ,project) (td ,(project-description project)) (td ,(git-last-update project)) (td ""))) -(define (project-list->table list lvl) +(define (project-list->table top-dir 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))))) + (table + (@ (class "table table-condensed table-striped")) + (thead + (tr + (th "Name") + (th "Description") + (th "Last update") + (th ""))) + (tbody + ,@(map (lambda (elt) + (project->row top-dir elt)) + (filter (lambda (elt) + (and (string? elt) + (access? (string-append top-dir "/" elt) R_OK))) + body)))) + ,@(map (lambda (elt) (project-list->table + (string-append top-dir (car elt)) elt (1+ lvl))) + (filter + (lambda (elt) + (and (list? elt) + (access? (string-append top-dir (car elt)) X_OK))) + body))))) (define (page-projects request body index) - (respond (project-list->table (list-projects) 1) + (respond (project-list->table *projects-dir* (list-projects) 1) #:extra-headers '((pragma . (no-cache (broccoli . "tastyy")))))) |