devops (get-core-version): search src/runtime/version.scm once
authorMatt Birkholz <matt@birchwood-abbey.net>
Thu, 25 Jan 2018 19:38:51 +0000 (12:38 -0700)
committerMatt Birkholz <matt@birchwood-abbey.net>
Thu, 25 Jan 2018 19:38:51 +0000 (12:38 -0700)
src/devops/devops.scm

index 8d64b31f542eef7e31a1904603e176fdcb257b45..9993800e1b914bed7d961ebc50fbc5d94fd4f5b2 100644 (file)
@@ -41,14 +41,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (shell-lines "git status --porcelain --untracked-files=no"))
 
 (define (status)
-  (let ((dirt (dirt)))
-    (if (file-exists? "src/runtime/version.scm")
-       (core-status dirt))
+  (let ((dirt (dirt))
+       (version (get-core-version)))
+    (if version
+       (core-status version dirt))
     (for-each (lambda (p) (plugin-status p dirt)) plugin-list)))
 
-(define (core-status dirt)
-  (let* ((version (core-version))
-        (lint (core-lint version (or (core-changes) '()) dirt)))
+(define (core-status version dirt)
+  (let ((lint (core-lint version (or (get-core-changes) '()) dirt)))
     (if (not (null? lint))
        (begin
          (log "\n# core "(version-string version)"\n")
@@ -199,19 +199,22 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                         (group version (+ (alt #\space (char-in numeric))))
                         ")")))
 
-(define (core-version)
-  (call-with-input-file "src/runtime/version.scm"
-    (lambda (in)
-      (let loop ()
-       (let* ((line (read-line in))
-              (match (and (string? line)
-                          (regsexp-match-string core-version-pattern line))))
-         (if match
-             (map (lambda (s) (string->number s 10))
-                  (burst-string (match-extract match 'version) #\space #t))
-             (if (eof-object? line)
-                 (error "could not find core version")
-                 (loop))))))))
+(define (get-core-version)
+  (and (file-exists? "src/runtime/version.scm")
+       (call-with-input-file "src/runtime/version.scm"
+        (lambda (in)
+          (let loop ()
+            (let* ((line (read-line in))
+                   (match (and (string? line)
+                               (regsexp-match-string core-version-pattern
+                                                     line))))
+              (if match
+                  (map (lambda (s) (string->number s 10))
+                       (burst-string (match-extract match 'version)
+                                     #\space #t))
+                  (if (eof-object? line)
+                      (error "could not find core version")
+                      (loop)))))))))
 
 (define (make-news-pattern fullname)
   (compile-regsexp `(seq ,fullname
@@ -283,7 +286,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (and (pair? tags)
         (caar tags))))
 
-(define (core-changes)
+(define (get-core-changes)
   (let ((start-hash (released-hash (project-name))))
     (and start-hash
         (append-map!
@@ -371,7 +374,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (devops:release #!optional plugin)
   (let ((dirt (shell-lines "git status --porcelain --untracked-files=no")))
     (cond ((default-object? plugin)
-          (release-core (core-version) (core-changes) dirt #f))
+          (release-core (get-core-version) (get-core-changes) dirt #f))
          ((or (equal? "snapshot" plugin)
               (eq? 'snapshot plugin))
           (snapshot-core dirt)
@@ -446,9 +449,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (run "rm -rf devops/"pkgvers)))
     (delete-file logfile)))
 
-(define (snapshot-core dirt)
-  (let* ((changes (or (core-changes) '()))
-        (version (core-version))
+(define (snapshot-core version dirt)
+  (let* ((changes (or (get-core-changes) '()))
         (released (released-version (project-name)))
         (vers (version-string version))
         (source-filename (string "devops/"(project-name)"-"vers".tar.gz")))