build-from-source: better checkout procedure, messages

diff --git a/extra/build-from-source/build-from-source.factor b/extra/build-from-source/build-from-source.factor
index 2daa4b9ef8e89e8b98eda88c5242d2a9a4722ec2..65511446998febc80c57eb0749dc2621553573fa 100644 (file)
--- a/extra/build-from-source/build-from-source.factor
+++ b/extra/build-from-source/build-from-source.factor
@@ -81,7 +81,7 @@ ERROR: no-output-file path ;
 : gitlab-tag-disk-checkout-path ( base org/user project tag -- path )
     [ gitlab-disk-path ] dip append-path absolute-path ;
 
-: with-build-from-source-gitlab-bare-directory ( base org/user quot -- )
+: with-build-from-source-gitlab-no-checkout-directory ( base org/user quot -- )
     [ build-from-source-directory-gitlab prepend-path dup make-directories ] dip with-directory ; inline
 
 : gitlab-git-uri ( base org/user project -- uri ) "git://%s/%s/%s" sprintf ;
@@ -91,15 +91,15 @@ ERROR: no-output-file path ;
 : gitlab-uri ( base org/user project -- uri )
     use-gitlab-git-uris get [ gitlab-git-uri ] [ gitlab-https-uri ] if ;
 
-: sync-gitlab-bare-repository ( base org/user project -- )
+: sync-gitlab-no-checkout-repository ( base org/user project -- )
     [ 2drop ] [ gitlab-uri ] [ nipd append-path ] 3tri
     '[
-        _ _ sync-bare-repository-as wait-for-success
-    ] with-build-from-source-gitlab-bare-directory ;
+        _ _ sync-no-checkout-repository-as wait-for-success
+    ] with-build-from-source-gitlab-no-checkout-directory ;
 
-: with-bare-gitlab-repo ( base org/user project quot -- )
+: with-no-checkout-gitlab-repo ( base org/user project quot -- )
     [
-        [ sync-gitlab-bare-repository ]
+        [ sync-gitlab-no-checkout-repository ]
         [ gitlab-disk-path ] 3bi
     ] dip with-directory ; inline
 
@@ -113,22 +113,26 @@ ERROR: no-output-file path ;
 : github-tag-disk-checkout-path ( org/user project tag -- path )
     [ github-disk-path ] dip append-path absolute-path ;
 
-: with-build-from-source-github-bare-directory ( org/user quot -- )
+: with-build-from-source-github-no-checkout-directory ( org/user quot -- )
     [ build-from-source-directory-github prepend-path dup make-directories ] dip with-directory ; inline
 
 : github-uri ( org/user project -- uri )
     use-github-git-uris get [ github-git-uri ] [ github-https-uri ] if ;
 
-: sync-github-bare-repository ( org/user project -- )
+: sync-github-no-checkout-repository ( org/user project -- )
     [ drop ] [ github-uri ] [ nip git-directory-name ] 2tri
     '[
-        _ _ sync-bare-repository-as wait-for-success
-    ] with-build-from-source-github-bare-directory ;
+        _ _ sync-no-checkout-repository-as wait-for-success
+    ] with-build-from-source-github-no-checkout-directory ;
+
+: check-build-completed ( path -- path' file-contents/f )
+    "factor-build-completed" append-path
+    dup file-exists? [ dup utf8 file-contents ] [ f ] if ;
 
 : with-github-worktree-tag ( org/user project tag quot -- )
     [
         {
-            [ drop sync-github-bare-repository ]
+            [ drop sync-github-no-checkout-repository ]
             [ drop github-disk-path ]
             [ github-tag-disk-checkout-path ]
             [ 2nip ]
@@ -136,9 +140,9 @@ ERROR: no-output-file path ;
     ] dip
     '[
         _ _
-        over "factor-build-completed" append-path dup file-exists? [
-            utf8 file-contents
-            "%s\n- %s already built at %s" sprintf print
+        over "build-from-source considering github %s" sprintf print
+        over check-build-completed [
+            2nip "- %s already built at %s" sprintf print
         ] [
             [
                 over "%s\n- deleting old build..." sprintf write
@@ -149,23 +153,23 @@ ERROR: no-output-file path ;
                 "done!" print
                 now timestamp>rfc3339
             ] dip utf8 set-file-contents
-        ] if
+        ] if*
     ] with-directory ; inline
 
 : with-gitlab-worktree-tag ( base org/user project tag quot -- )
     [
         {
-            [ drop sync-gitlab-bare-repository ]
+            [ drop sync-gitlab-no-checkout-repository ]
             [ drop gitlab-disk-path ]
             [ gitlab-tag-disk-checkout-path ]
             [ 3nip ]
         } 4cleave
     ] dip
     '[
-        _ _
-        over "factor-build-completed" append-path dup file-exists? [
-            utf8 file-contents
-            "%s\n- %s already built at %s" sprintf print
+        _ 
+        dup "build-from-source considering gitlab %s" sprintf print
+        over check-build-completed [
+            2nip "%s already built at %s" sprintf print
         ] [
             [
                 over "%s\n- deleting old build..." sprintf write
@@ -176,7 +180,7 @@ ERROR: no-output-file path ;
                 "done!" print
                 now timestamp>rfc3339
             ] dip utf8 set-file-contents
-        ] if
+        ] if*
     ] with-directory ; inline
 
 : ?download ( path -- )
@@ -184,11 +188,20 @@ ERROR: no-output-file path ;
 
 : with-tar-gz ( path quot -- )
     '[
-        _
-        [ ?download ]
-        [ file-name { "tar" "xvfz" } swap suffix try-process ]
-        [ file-name ".tar.gz" ?tail drop ] tri
-        prepend-current-path _ with-directory
+        _ dup "build-from-source considering tar.gz %s" sprintf print
+        dup file-name ".tar.gz" ?tail drop check-build-completed [
+            2nip "- already built at %s" sprintf print
+        ] [
+            "- building..." write
+            [
+                [ ?download ]
+                [ file-name { "tar" "xvfz" } swap suffix try-process ]
+                [ file-name ".tar.gz" ?tail drop ] tri
+                prepend-current-path _ with-directory
+                now timestamp>rfc3339
+            ] dip utf8 set-file-contents
+            "done!" print
+        ] if*
     ] with-build-from-source-cpu-directory ; inline
 
 : split-python-version ( version -- array )

diff --git a/extra/build-from-source/windows/windows.factor b/extra/build-from-source/windows/windows.factor
index e29483ad52f8b14b1a0fb10c472f9e270d4b8787..df38ff1f9d1c98c070a969bd4fa0bd43b15560d0 100644 (file)
--- a/extra/build-from-source/windows/windows.factor
+++ b/extra/build-from-source/windows/windows.factor
@@ -116,7 +116,7 @@ IN: build-from-source.windows
 : cairo-versions ( -- seq )
     "gitlab.freedesktop.org" "cairo" "cairo" [
         git-tag*
-    ] with-bare-gitlab-repo
+    ] with-no-checkout-gitlab-repo
     [ [ digit-or-dot? ] all? ] filter
     human-sort ;
 

diff --git a/extra/cli/git/git.factor b/extra/cli/git/git.factor
index 3fc8229c11e95faae0005ff1c9c41137a7794d58..5839c312316ab0ec9731eaca07ac89f73331ee02 100644 (file)
--- a/extra/cli/git/git.factor
+++ b/extra/cli/git/git.factor
@@ -2,8 +2,9 @@
 ! See https://factorcode.org/license.txt for BSD license.
 USING: accessors arrays combinators.short-circuit
 concurrency.combinators concurrency.semaphores io io.directories
-io.encodings.utf8 io.files.info io.launcher io.pathnames kernel
-math namespaces sequences splitting system-info unicode ;
+io.encodings.utf8 io.files io.files.info io.launcher
+io.pathnames kernel math namespaces sequences splitting
+system-info unicode ;
 IN: cli.git
 
 SYMBOL: cli-git-num-parallel
@@ -12,6 +13,8 @@ cli-git-num-parallel [ cpus 2 * ] initialize
 : git-command>string ( desc -- string )
     utf8 <process-reader> stream-contents [ blank? ] trim-tail ;
 
+: git-clone-no-checkout-as ( uri path -- process ) [ { "git" "clone" "--no-checkout" } ] 2dip 2array append run-process ;
+: git-clone-no-checkout ( uri -- process ) [ { "git" "clone" "--no-checkout" } ] dip suffix run-process ;
 : git-clone-bare-as ( uri path -- process ) [ { "git" "clone" "--bare" } ] 2dip 2array append run-process ;
 : git-clone-bare ( uri -- process ) [ { "git" "clone" "--bare" } ] dip suffix run-process ;
 : git-clone-as ( uri path -- process ) [ { "git" "clone" } ] 2dip 2array append run-process ;
@@ -32,6 +35,8 @@ cli-git-num-parallel [ cpus 2 * ] initialize
 : git-fetch-tags ( path -- process ) [ git-fetch-tags* ] with-directory ;
 : git-tag* ( -- process ) { "git" "tag" } process-lines ;
 : git-tag ( path -- process ) [ git-tag* ] with-directory ;
+: git-switch-new-branch* ( branch -- process ) [ { "git" "switch" "-c" } ] dip suffix run-process ;
+: git-switch-new-branch ( path branch -- process ) '[ _ git-switch-new-branch* ] with-directory ;
 : git-checkout-new-branch* ( branch -- process ) [ { "git" "checkout" "-b" } ] dip suffix run-process ;
 : git-checkout-new-branch ( path branch -- process ) '[ _ git-checkout-new-branch* ] with-directory ;
 : git-checkout-existing* ( branch/checksum -- process ) [ { "git" "checkout" } ] dip suffix run-process ;
@@ -53,6 +58,9 @@ cli-git-num-parallel [ cpus 2 * ] initialize
     ".git" append-path current-directory get prepend-path
     ?file-info dup [ directory? ] when ;
 
+: git-no-checkout-directory? ( directory -- ? )
+    current-directory get prepend-path file-exists? ;
+
 : git-current-branch* ( -- name )
     { "git" "rev-parse" "--abbrev-ref" "HEAD" } git-command>string ;
 
@@ -74,6 +82,17 @@ cli-git-num-parallel [ cpus 2 * ] initialize
         [ git-is-bare-repository ]
     } 1&& ;
 
+: sync-no-checkout-repository ( url -- process )
+    dup git-directory-name git-no-checkout-directory?
+    [ git-directory-name git-fetch-all ] [ git-clone-no-checkout ] if ;
+
+: sync-no-checkout-repository-as ( url path -- processes )
+    dup git-no-checkout-directory?
+    [ nip git-fetch-all ] [
+        [ git-clone-no-checkout-as wait-for-success ]
+        [ "factor-build-from-source" git-switch-new-branch ] bi
+    ] if ;
+
 : sync-bare-repository ( url -- process )
     dup git-directory-name git-bare-directory?
     [ git-directory-name git-fetch-all ] [ git-clone-bare ] if ;