From 3ddbd6c7430337534fe5207d8bfe0eb4bd20a5cd Mon Sep 17 00:00:00 2001
From: Tom Willemse
Date: Sun, 5 May 2013 16:31:16 +0200
Subject: Use lazy evaluation to speed-up startup

Before using goops the relevant information was gathered when it was
needed, but now with goops everything is gathered at startup. So use
lazy evaluation to defer that gathering until it is needed.
---
 gitto/main.scm | 63 +++++++++++++++++++++++++++++++++-------------------------
 1 file changed, 36 insertions(+), 27 deletions(-)

diff --git a/gitto/main.scm b/gitto/main.scm
index 23bdf42..f38b309 100644
--- a/gitto/main.scm
+++ b/gitto/main.scm
@@ -30,23 +30,30 @@
 (define-generic same-repository?)
 
 (define-class <repository> ()
-  (name #:accessor repo-name)
-  (location #:init-keyword #:location #:accessor repo-location)
-  (state #:accessor repo-state)
-  (pushable #:accessor repo-pushable)
-  (pullable #:accessor repo-pullable)
-  (updated #:accessor repo-updated))
+  (name #:getter repo-name)
+  (location #:getter repo-location)
+  (state #:getter repo-state)
+  (pushable #:getter repo-pushable)
+  (pullable #:getter repo-pullable)
+  (updated #:getter repo-updated))
 
 (define-method (initialize (repo <repository>) args)
-  (let ((cwd (getcwd)))
-    (chdir (car args))
-    (slot-set! repo 'name (basename (car args)))
-    (slot-set! repo 'location (car args))
-    (slot-set! repo 'state (git-clean?))
-    (slot-set! repo 'pushable (git-revs-to-push))
-    (slot-set! repo 'pullable (git-revs-to-pull))
-    (slot-set! repo 'updated (git-last-update))
-    (chdir cwd)))
+  (let ((dir (car args)))
+    (slot-set! repo 'name (basename dir))
+    (slot-set! repo 'location dir)
+    (slot-set! repo 'state (delay (git-clean? dir)))
+    (slot-set! repo 'pushable (delay (git-revs-to-push dir)))
+    (slot-set! repo 'pullable (delay (git-revs-to-pull dir)))
+    (slot-set! repo 'updated (delay (git-last-update dir)))))
+
+(define-method (repo-state (repo <repository>))
+  (force (slot-ref repo 'state)))
+(define-method (repo-pushable (repo <repository>))
+  (force (slot-ref repo 'pushable)))
+(define-method (repo-pullable (repo <repository>))
+  (force (slot-ref repo 'pullable)))
+(define-method (repo-updated (repo <repository>))
+  (force (slot-ref repo 'updated)))
 
 (define (storage-dir xdg-env fallback)
   (let ((xdg (getenv xdg-env)))
@@ -97,7 +104,7 @@ gitto [options]
 (define (known? repo)
   "Do we know REPO?"
   (or (member repo repositories same-repository?)
-      (member (realpath (repo-location repo))
+      (member (realpath (if (string? repo) repo (repo-location repo)))
               repositories same-repository?)))
 
 (define (save-repositories-list)
@@ -153,34 +160,36 @@ gitto [options]
    #t "~a:~15t~d to push, ~d to pull and is ~a. Last update: ~a\n"
    name pushable pullable (if clean? "clean" "dirty") updated))
 
-(define (git-revs-to-push)
+(define (git-revs-to-push dir)
   "Check how many commits should be pushed upstream."
-  (let* ((pipe (open-input-pipe
-                "git log --pretty=oneline @{u}.. 2>/dev/null | wc -l"))
+  (let* ((pipe (start-git dir "log --pretty=oneline @{u}.." "| wc -l"))
          (num (string->number (read-line pipe))))
     (close-pipe pipe)
     num))
 
-(define (git-revs-to-pull)
+(define (git-revs-to-pull dir)
   "Check how many commits should be pulled/merged from upstream."
-  (let* ((pipe (open-input-pipe
-              "git log --pretty=oneline ..@{u} 2>/dev/null | wc -l"))
+  (let* ((pipe (start-git dir "log --pretty=oneline ..@{u}" "| wc -l"))
          (num (string->number (read-line pipe))))
     (close-pipe pipe)
     num))
 
-(define (git-clean?)
+(define* (start-git dir args #:optional (extra ""))
+  (open-input-pipe
+   (format #f "git --work-tree=~s --git-dir=\"~a/.git\" ~a 2>/dev/null ~a"
+           dir dir args extra)))
+
+(define (git-clean? dir)
   "Check whether a repository is clean, meaning there are no changes
 to the tracked files. Utracked files will not register."
-  (let* ((pipe (open-input-pipe "git status -suno 2>/dev/null"))
+  (let* ((pipe (start-git dir "status -suno"))
          (clean? (eof-object? (read-delimited "" pipe))))
     (close-pipe pipe)
     clean?))
 
-(define (git-last-update)
+(define (git-last-update dir)
   "Check when the last update upstream was."
-  (let* ((pipe (open-input-pipe
-                "git log -1 --format=%ar @{u} 2>/dev/null"))
+  (let* ((pipe (start-git dir "log -1 --format=%ar @{u}"))
          (relative-last-update (read-line pipe)))
     (close-pipe pipe)
     (if (eof-object? relative-last-update)
-- 
cgit v1.2.3-54-g00ecf