DATARAMA

Output manifest files

April 30, 2016
Project: goon

This revision adds manifest files; s-exps with the contents of each branch: A list of commits, list of tags and file tree.

1 files changed, 39 insertions / 23 deletions

diff --git a/goon.scm b/goon.scm
index c31b8f8..50cb157 100755
--- a/goon.scm
+++ b/goon.scm
@@ -30,7 +30,7 @@
 (define repositories-dir "")
 (define output-dir "")
 (define url-prefix "")
-(define goon-releases-path "")
+(define goon-manifest-dir "")
 
 ; == UTILITIES ================================================================
 (define (clamp-list lst size)
@@ -254,6 +254,19 @@
           ,(filetree-lists 
              (sort-filetree (filetree (tree-entries (commit-tree head))))))))
 
+(define (manifest-file entry)
+  (if (list? entry)
+    (cons (car entry) (map manifest-file (cdr entry)))
+    (list
+      (tree-entry-path entry)
+      (tree-entry-name entry)
+      (filesize entry))))
+
+(define (manifest-filetree tree)
+  (map manifest-file
+    (sort-filetree tree)))
+
+
 ; == TARBALLS ================================================================
 (define (prep-tarball prefix repo commit tree)
   (tree-fold
@@ -459,7 +472,30 @@
      (a (@ (class "commithist-link") (href ,(string-append (branch-name branch) "-commits.html")))
         "History →"))))
 
+(define (commit-mentry comm)
+  (list (commit-path comm)
+        (commit-time comm)
+        (commitmsg-first-line comm)))
+
+(define (tag-mentry repo tag)
+  (list 
+    (tag-name tag)
+    (commit-time (tag-peel tag))
+    (tarball-path repo tag)))
+
+(define (branch-manifest repo branch)
+  (let ((outfile (string-append 
+                   goon-manifest-dir "/"
+                   (repository-name repo) "-" (branch-name branch) ".goon"))
+        (contents
+          (list (map commit-mentry (repo-commits repo branch))
+                (map (lambda (x) (tag-mentry repo x)) (tags repo))
+                (manifest-filetree (filetree (tree-entries (commit-tree (latest-commit repo branch))))))))
+    (with-output-to-file outfile
+      (lambda () (write contents)))))
+
 (define (render-branch repo branch)
+  (branch-manifest repo branch)
   (render-commitlist repo branch)
   (render-releasepage repo tags)
   (mktarballs repo)
@@ -628,38 +664,18 @@
     ((exn) #f)
     (var () #t)))
 
-(define (make-releaselist repos)
-  (with-output-to-file goon-releases-path
-    (lambda () 
-      (write
-    (flatten (map 
-      (lambda (repo) 
-        (let ((repo-releases (tags repo)))
-          (map 
-            (lambda (rel) 
-              (cons (string-append (repository-name repo) " " (tag-name rel))
-                (cons (seconds->date (commit-time (tag-peel rel)))
-                      (cons "goon" 
-                            (if (release-file rel)
-                              (string-append (repository-name repo) "/" 
-                                             (repository-name repo) "-" (tag-name rel))
-                              (string-append (repository-name repo) "/" "master.html"))))))
-
-            repo-releases)))
-      repos))))))
-
 (define (run args)
+; TODO: Output commitlist & releases for each project
   (begin
     (set! repositories-dir (car args))
     (set! output-dir (cadr args))
     (set! url-prefix (caddr args))
-    (set! goon-releases-path (cadddr args))
+    (set! goon-manifest-dir (cadddr args))
     (change-directory repositories-dir)
     (set! page-template 
       (make-sxml-template 
         (read (open-input-file "goon-template.scm"))))
     (render-repository-list (read-categories))
-    (make-releaselist (flatten (map cdr (read-categories))))
     (map render-repo (flatten (map cdr (read-categories))))))
 
 (run (command-line-arguments))
 
Powered by Plutonium