Move my git functions to projects.scmpersonal

I have not (yet) set them up in the best way and they're only used
there, so keep them there for now.

2 files changed, 41 insertions, 40 deletions

diff --git a/tekuti/git.scm b/tekuti/git.scm
index b17c963..3c9df31 100644
--- a/tekuti/git.scm
+++ b/tekuti/git.scm
@@ -41,8 +41,7 @@
 
             git git* ensure-git-repo git-ls-tree git-ls-subdirs
             git-mktree git-rev-parse git-hash-object git-update-ref
-            git-commit-tree git-rev-list git-revert git-last-update
-            git-latest-commits
+            git-commit-tree git-rev-list git-revert
 
             munge-tree munge-tree1 parse-commit commit-utc-timestamp
 
@@ -192,35 +191,6 @@
                 (error "bad line2" line2))
                (error "bad line1" line1)))))))
 
-(define* (git-latest-commits rev n #:optional (git-dir *git-dir*))
-  (let lp ((lines (string-split
-                   (git "--git-dir" (expanduser git-dir)
-                        "rev-list" "--pretty=format:%ar\t%s\t%an"
-                        "-n" (number->string n) rev) #\newline))
-           (ret '()))
-    (if (or (null? lines)
-            (and (null? (cdr lines)) (string-null? (car lines))))
-        (reverse ret)
-        (lp (cddr lines)
-            (let ((line (cadr lines)))
-              (match-bind
-                "^([^\t]+)\t([^\t]+)\t(.*)$" line (_ sha1 subject author)
-                (cons `(,sha1 ,subject ,author) ret)
-                (error "bad line" line)))))))
-
-
-(define* (git-last-update #:optional (git-dir *git-dir*))
-  (let lp ((lines (string-split
-                   (git "--git-dir" (expanduser git-dir)
-                        "rev-list" "--pretty=format:%ar" "-n" "1" "HEAD")
-                   #\newline))
-           (ret '()))
-    (if (or (null? lines)
-            (and (null? (cdr lines)) (string-null? (car lines))))
-        ret
-        (lp (cddr lines)
-            (cadr lines)))))
-
 (define (git-hash-object contents)
   (string-trim-both
    (git* '("hash-object" "-w" "--stdin") #:input contents)))
diff --git a/tekuti/projects.scm b/tekuti/projects.scm
index bc0d7a6..bca78e2 100644
--- a/tekuti/projects.scm
+++ b/tekuti/projects.scm
@@ -1,14 +1,16 @@
 (define-module (tekuti projects)
-  #:use-module ((tekuti config) #:select (*projects-dir*))
+  #:use-module ((tekuti config) #:select (*projects-dir* *git-dir*))
   #:use-module ((tekuti page) #:select (page-not-found))
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
   #:use-module (tekuti git)
+  #:use-module (tekuti match-bind)
   #:use-module (tekuti page-helpers)
-  #:use-module (web uri)
+  #:use-module (tekuti util)
   #:use-module (web request)
+  #:use-module (web uri)
   #:export (page-projects page-project))
 
 (define remove-stat
@@ -44,6 +46,18 @@
   (uri-encode
    (string-append prefix (if (string-null? prefix) "" "/") name)))
 
+(define* (last-update #:optional (git-dir *git-dir*))
+  (let lp ((lines (string-split
+                   (git "--git-dir" (expanduser git-dir)
+                        "rev-list" "--pretty=format:%ar" "-n" "1" "HEAD")
+                   #\newline))
+           (ret '()))
+    (if (or (null? lines)
+            (and (null? (cdr lines)) (string-null? (car lines))))
+        ret
+        (lp (cddr lines)
+            (cadr lines)))))
+
 (define (project->row dir project prefix)
   (let ((project-dir (string-append dir "/" project))
         (project-name (remove-suffix project ".git")))
@@ -52,7 +66,7 @@
           (a (@ (href ,(project-url prefix project-name)))
              ,project-name))
       (td (@ (class "span6")) ,(project-description project-dir))
-      (td (@ (class "span2")) ,(git-last-update project-dir))
+      (td (@ (class "span2")) ,(last-update project-dir))
       (td (@ (class "span1")) ""))))
 
 (define (project-list->table top-dir list lvl prefix)
@@ -103,15 +117,32 @@
                                         (string-capitalize elm))))
                        page-list)))))))
 
-(define* (page-project request body index project page)
-  (let ((project-dir (string-append *projects-dir* project ".git")))
+(define* (latest-commits rev n #:optional (git-dir *git-dir*))
+  (let lp ((lines (string-split
+                   (git "--git-dir" (expanduser git-dir)
+                        "rev-list" "--pretty=format:%ar\t%s\t%an"
+                        "-n" (number->string n) rev) #\newline))
+           (ret '()))
+    (if (or (null? lines)
+            (and (null? (cdr lines)) (string-null? (car lines))))
+        (reverse ret)
+        (lp (cddr lines)
+            (let ((line (cadr lines)))
+              (match-bind
+                "^([^\t]+)\t([^\t]+)\t(.*)$" line (_ sha1 subject author)
+                (cons `(,sha1 ,subject ,author) ret)
+                (error "bad line" line)))))))
+
+(define (page-project request body index project page)
+  (let ((project-dir (string-append *projects-dir* project ".git"))
+        (page (or page "summary")))
     (if (file-exists? project-dir)
         (respond
-         `(,(project-pages-menu request project (or page "summary"))
+         `(,(project-pages-menu request project page)
            (p "Goto: "
               (a (@ (href "http://code.ryuslash.org/cgit.cgi/"
-                          ,project "/" ,(or page "")))
-                 "cgit " ,(or page "summary")))
+                          ,project "/" ,page))
+                 "cgit " ,page))
            ,@(case (string->symbol page)
                ((summary)
                 `((h2 "Last 10 commits")
@@ -126,6 +157,6 @@
                               (td ,(car elm))
                               (td ,(cadr elm))
                               (td ,(caddr elm))))
-                          (git-latest-commits "HEAD" 10 project-dir)))))
+                          (latest-commits "HEAD" 10 project-dir)))))
                (else '()))))
         (page-not-found request body index))))