[PATCH 1/7] guix: git: Support shallow git clones if a tag is available

[PATCH 1/7] guix: git: Support shallow git clones if a tag is available

[Andy Wingo]

* guix/build/git.scm (git-fetch): Instead of cloning the remote repo, use the
  lower-level "init" / "fetch" / "checkout" operations.  This lets us make a
  shallow checkout if we are checking out a tag.

* guix/git-download.scm (<git-reference>): Add tag field.
  (git-fetch): Support git references with tags but no commits.
---
 guix/build/git.scm    | 58 ++++++++++++++++++++++++++++++++++-----------------
 guix/git-download.scm | 10 +++++++--
 2 files changed, 47 insertions(+), 21 deletions(-)

diff --git a/guix/build/git.scm b/guix/build/git.scm
index 121f07a..1af547f 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -28,32 +28,52 @@
 ;;; Code:
 
 (define* (git-fetch url commit directory
-                    #:key (git-command "git") recursive?)
+                    #:key tag (git-command "git") recursive?)
   "Fetch COMMIT from URL into DIRECTORY.  COMMIT must be a valid Git commit
 identifier.  When RECURSIVE? is true, all the sub-modules of URL are fetched,
 recursively.  Return #t on success, #f otherwise."
-
   ;; Disable TLS certificate verification.  The hash of the checkout is known
   ;; in advance anyway.
   (setenv "GIT_SSL_NO_VERIFY" "true")
 
-  (let ((args `("clone" ,@(if recursive? '("--recursive") '())
-                ,url ,directory)))
-    (and (zero? (apply system* git-command args))
-         (with-directory-excursion directory
-           (system* git-command "tag" "-l")
-           (and (zero? (system* git-command "checkout" commit))
-                (begin
-                  ;; The contents of '.git' vary as a function of the current
-                  ;; status of the Git repo.  Since we want a fixed output, this
-                  ;; directory needs to be taken out.
-                  (delete-file-recursively ".git")
+  (mkdir directory)
+  (with-directory-excursion directory
+    (and (zero? (system* git-command "init"))
+         (zero? (system* git-command "remote" "add" "origin" url))
+         (cond
+          ;; If there's a tag, do a shallow fetch.  Otherwise we do a full
+          ;; fetch.
+          (tag
+           (and (zero? (system* git-command "fetch" "--depth=1" "origin" tag))
+                ;; Either there is no commit specified, in which case we are
+                ;; good, or there is a commit and it is the same as the tag,
+                ;; in which case we're still good, or there's a commit and
+                ;; it's under the tag so we have to unshallow the checkout and
+                ;; try again.
+                (if commit
+                    (or (zero? (system* git-command "checkout" commit))
+                        (and (zero? (system* git-command "fetch" "--unshallow"))
+                             (zero? (system* git-command "checkout" commit))))
+                    (zero? (system* git-command "checkout" "FETCH_HEAD")))))
+          (else
+           ;; Fall back to a full fetch.  In that case print available tags.
+           (and (zero? (system* git-command "fetch" "origin"))
+                (zero? (system* git-command "tag" "-l"))
+                (zero? (system* git-command "checkout" commit)))))
+         (or (not recursive?)
+             (zero? (system* git-command
+                             "submodule" "update" "--init" "--recursive")))
+         (begin
+           ;; The contents of '.git' vary as a function of the current
+           ;; status of the Git repo.  Since we want a fixed output, this
+           ;; directory needs to be taken out.
+           (delete-file-recursively ".git")
 
-                  (when recursive?
-                    ;; In sub-modules, '.git' is a flat file, not a directory,
-                    ;; so we can use 'find-files' here.
-                    (for-each delete-file-recursively
-                              (find-files directory "^\\.git$")))
-                  #t))))))
+           (when recursive?
+             ;; In sub-modules, '.git' is a flat file, not a directory,
+             ;; so we can use 'find-files' here.
+             (for-each delete-file-recursively
+                       (find-files directory "^\\.git$")))
+           #t))))
 
 ;;; git.scm ends here
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 0f2218c..43bc466 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -28,6 +28,7 @@
             git-reference?
             git-reference-url
             git-reference-commit
+            git-reference-tag
             git-reference-recursive?
 
             git-fetch))
@@ -44,7 +45,8 @@
   git-reference make-git-reference
   git-reference?
   (url        git-reference-url)
-  (commit     git-reference-commit)
+  (commit     git-reference-commit (default #f))
+  (tag        git-reference-tag (default #f))
   (recursive? git-reference-recursive?   ; whether to recurse into sub-modules
               (default #f)))
 
@@ -81,8 +83,12 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                                           dirs)))
 
         (git-fetch '#$(git-reference-url ref)
-                   '#$(git-reference-commit ref)
+                   (or '#$(git-reference-commit ref)
+                       '#$(git-reference-tag ref))
                    #$output
+                   ;; FIXME: Pass #:tag when fixed daemons are widely
+                   ;; deployed.
+                   ;; #:tag '#$(git-reference-tag ref)
                    #:recursive? '#$(git-reference-recursive? ref)
                    #:git-command (string-append #+git "/bin/git"))))
 
-- 
2.4.3

Re: [PATCH 1/7] guix: git: Support shallow git clones if a tag is available

[Ludovic Courtès]

Andy Wingo <wingo@igalia.com> skribis:

> * guix/build/git.scm (git-fetch): Instead of cloning the remote repo, use the
>   lower-level "init" / "fetch" / "checkout" operations.  This lets us make a
>   shallow checkout if we are checking out a tag.
>
> * guix/git-download.scm (<git-reference>): Add tag field.
>   (git-fetch): Support git references with tags but no commits.

This sounds like a nice improvement.  Please move the “This lets us”
sentence to a comment, and drop the newline between entries.

> --- a/guix/build/git.scm
> +++ b/guix/build/git.scm

Make sure to add a copyright line in there.

[...]

>    git-reference make-git-reference
>    git-reference?
>    (url        git-reference-url)
> -  (commit     git-reference-commit)
> +  (commit     git-reference-commit (default #f))
> +  (tag        git-reference-tag (default #f))

So far we’ve been using ‘commit’ to denote commits or tags.  I guess a
bunch of packages will need to be updated.

There’s the issue that one could erroneously specify both ‘commit’ and
‘tag’, and then one of them would be ignored.

What about doing something like:

  1. renaming ‘commit’ to ‘spec’;
  2. adding a ‘type’ field which would default to 'commit and could be
     changed to 'tag

?

> +                   ;; FIXME: Pass #:tag when fixed daemons are widely
> +                   ;; deployed.
> +                   ;; #:tag '#$(git-reference-tag ref)

The daemon is not involved here, AFAICS, so you can uncomment the line.

Thanks,
Ludo’.

Re: [PATCH 1/7] guix: git: Support shallow git clones if a tag is available

[Christopher Allan Webber]

Ludovic Courtès writes:

> Andy Wingo <wingo@igalia.com> skribis:
>
>> * guix/build/git.scm (git-fetch): Instead of cloning the remote repo, use the
>>   lower-level "init" / "fetch" / "checkout" operations.  This lets us make a
>>   shallow checkout if we are checking out a tag.
>>
>> * guix/git-download.scm (<git-reference>): Add tag field.
>>   (git-fetch): Support git references with tags but no commits.
>
> This sounds like a nice improvement.  Please move the “This lets us”
> sentence to a comment, and drop the newline between entries.

This does look like a nice improvement!  It seems like it kind of got
dropped on the floor.  Is there still interest?

>> --- a/guix/build/git.scm
>> +++ b/guix/build/git.scm
>
> Make sure to add a copyright line in there.
>
> [...]
>
>>    git-reference make-git-reference
>>    git-reference?
>>    (url        git-reference-url)
>> -  (commit     git-reference-commit)
>> +  (commit     git-reference-commit (default #f))
>> +  (tag        git-reference-tag (default #f))
>
> So far we’ve been using ‘commit’ to denote commits or tags.  I guess a
> bunch of packages will need to be updated.
>
> There’s the issue that one could erroneously specify both ‘commit’ and
> ‘tag’, and then one of them would be ignored.
>
> What about doing something like:
>
>   1. renaming ‘commit’ to ‘spec’;
>   2. adding a ‘type’ field which would default to 'commit and could be
>      changed to 'tag
>
> ?
>
>> +                   ;; FIXME: Pass #:tag when fixed daemons are widely
>> +                   ;; deployed.
>> +                   ;; #:tag '#$(git-reference-tag ref)
>
> The daemon is not involved here, AFAICS, so you can uncomment the line.
>
> Thanks,
> Ludo’.

Re: [PATCH 1/7] guix: git: Support shallow git clones if a tag is available

[Ludovic Courtès]

Christopher Allan Webber <cwebber@dustycloud.org> skribis:

> Ludovic Courtès writes:
>
>> Andy Wingo <wingo@igalia.com> skribis:
>>
>>> * guix/build/git.scm (git-fetch): Instead of cloning the remote repo, use the
>>>   lower-level "init" / "fetch" / "checkout" operations.  This lets us make a
>>>   shallow checkout if we are checking out a tag.
>>>
>>> * guix/git-download.scm (<git-reference>): Add tag field.
>>>   (git-fetch): Support git references with tags but no commits.
>>
>> This sounds like a nice improvement.  Please move the “This lets us”
>> sentence to a comment, and drop the newline between entries.
>
> This does look like a nice improvement!  It seems like it kind of got
> dropped on the floor.  Is there still interest?

Yes!  Would you like to look into it?  :-)

Ludo’.

Re: [PATCH 1/7] guix: git: Support shallow git clones if a tag is available

[Andy Wingo]

Hi,

On Sun 25 Oct 2015 21:30, ludo@gnu.org (Ludovic Courtès) writes:

> Christopher Allan Webber <cwebber@dustycloud.org> skribis:
>
>> Ludovic Courtès writes:
>>
>>> Andy Wingo <wingo@igalia.com> skribis:
>>>
>>>> * guix/build/git.scm (git-fetch): Instead of cloning the remote repo, use the
>>>>   lower-level "init" / "fetch" / "checkout" operations.  This lets us make a
>>>>   shallow checkout if we are checking out a tag.
>>>>
>>>> * guix/git-download.scm (<git-reference>): Add tag field.
>>>>   (git-fetch): Support git references with tags but no commits.
>>>
>>> This sounds like a nice improvement.  Please move the “This lets us”
>>> sentence to a comment, and drop the newline between entries.
>>
>> This does look like a nice improvement!  It seems like it kind of got
>> dropped on the floor.  Is there still interest?
>
> Yes!  Would you like to look into it?  :-)

I can do it :)  I just rebased and updated after a couple months, and so
I have the patch fresh :)  Sorry for the delay; I am a creature of habit
and using Guix on the machine with that patch broke all my habits :P

Andy

Re: [PATCH 1/7] guix: git: Support shallow git clones if a tag is available

[ng0]

Ludovic Courtès writes:

> Andy Wingo <wingo@igalia.com> skribis:
>
>> * guix/build/git.scm (git-fetch): Instead of cloning the remote repo, use the
>>   lower-level "init" / "fetch" / "checkout" operations.  This lets us make a
>>   shallow checkout if we are checking out a tag.
>>
>> * guix/git-download.scm (<git-reference>): Add tag field.
>>   (git-fetch): Support git references with tags but no commits.
>
> This sounds like a nice improvement.  Please move the “This lets us”
> sentence to a comment, and drop the newline between entries.
>
>> --- a/guix/build/git.scm
>> +++ b/guix/build/git.scm
>
> Make sure to add a copyright line in there.
>
> [...]
>
>>    git-reference make-git-reference
>>    git-reference?
>>    (url        git-reference-url)
>> -  (commit     git-reference-commit)
>> +  (commit     git-reference-commit (default #f))
>> +  (tag        git-reference-tag (default #f))
>
> So far we’ve been using ‘commit’ to denote commits or tags.  I guess a
> bunch of packages will need to be updated.
>
> There’s the issue that one could erroneously specify both ‘commit’ and
> ‘tag’, and then one of them would be ignored.
>
> What about doing something like:
>
>   1. renaming ‘commit’ to ‘spec’;
>   2. adding a ‘type’ field which would default to 'commit and could be
>      changed to 'tag
>
> ?

Was the idea here to change the code to make use of spec inside
the package definitions and other modules which use git-fetch, so
that all instances of "commit" have to be replaced?

I have Andy's patch applied now, but to debug the outcome of this
(commit is no longer a bound variable), I need to know what the
intention was.

>> +                   ;; FIXME: Pass #:tag when fixed daemons are widely
>> +                   ;; deployed.
>> +                   ;; #:tag '#$(git-reference-tag ref)
>
> The daemon is not involved here, AFAICS, so you can uncomment the line.
>
> Thanks,
> Ludo’.


-- 
ng0 . https://www.inventati.org/patternsinthechaos/

[PATCH 1/7] guix: git: Support shallow git clones if a tag is available

[Andy Wingo]

* guix/build/git.scm (git-fetch): Instead of cloning the remote repo, use the
  lower-level "init" / "fetch" / "checkout" operations.  This lets us make a
  shallow checkout if we are checking out a tag.

* guix/git-download.scm (<git-reference>): Add tag field.
  (git-fetch): Support git references with tags but no commits.
---
 guix/build/git.scm    | 58 ++++++++++++++++++++++++++++++++++-----------------
 guix/git-download.scm | 10 +++++++--
 2 files changed, 47 insertions(+), 21 deletions(-)

diff --git a/guix/build/git.scm b/guix/build/git.scm
index 121f07a..1af547f 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -28,32 +28,52 @@
 ;;; Code:
 
 (define* (git-fetch url commit directory
-                    #:key (git-command "git") recursive?)
+                    #:key tag (git-command "git") recursive?)
   "Fetch COMMIT from URL into DIRECTORY.  COMMIT must be a valid Git commit
 identifier.  When RECURSIVE? is true, all the sub-modules of URL are fetched,
 recursively.  Return #t on success, #f otherwise."
-
   ;; Disable TLS certificate verification.  The hash of the checkout is known
   ;; in advance anyway.
   (setenv "GIT_SSL_NO_VERIFY" "true")
 
-  (let ((args `("clone" ,@(if recursive? '("--recursive") '())
-                ,url ,directory)))
-    (and (zero? (apply system* git-command args))
-         (with-directory-excursion directory
-           (system* git-command "tag" "-l")
-           (and (zero? (system* git-command "checkout" commit))
-                (begin
-                  ;; The contents of '.git' vary as a function of the current
-                  ;; status of the Git repo.  Since we want a fixed output, this
-                  ;; directory needs to be taken out.
-                  (delete-file-recursively ".git")
+  (mkdir directory)
+  (with-directory-excursion directory
+    (and (zero? (system* git-command "init"))
+         (zero? (system* git-command "remote" "add" "origin" url))
+         (cond
+          ;; If there's a tag, do a shallow fetch.  Otherwise we do a full
+          ;; fetch.
+          (tag
+           (and (zero? (system* git-command "fetch" "--depth=1" "origin" tag))
+                ;; Either there is no commit specified, in which case we are
+                ;; good, or there is a commit and it is the same as the tag,
+                ;; in which case we're still good, or there's a commit and
+                ;; it's under the tag so we have to unshallow the checkout and
+                ;; try again.
+                (if commit
+                    (or (zero? (system* git-command "checkout" commit))
+                        (and (zero? (system* git-command "fetch" "--unshallow"))
+                             (zero? (system* git-command "checkout" commit))))
+                    (zero? (system* git-command "checkout" "FETCH_HEAD")))))
+          (else
+           ;; Fall back to a full fetch.  In that case print available tags.
+           (and (zero? (system* git-command "fetch" "origin"))
+                (zero? (system* git-command "tag" "-l"))
+                (zero? (system* git-command "checkout" commit)))))
+         (or (not recursive?)
+             (zero? (system* git-command
+                             "submodule" "update" "--init" "--recursive")))
+         (begin
+           ;; The contents of '.git' vary as a function of the current
+           ;; status of the Git repo.  Since we want a fixed output, this
+           ;; directory needs to be taken out.
+           (delete-file-recursively ".git")
 
-                  (when recursive?
-                    ;; In sub-modules, '.git' is a flat file, not a directory,
-                    ;; so we can use 'find-files' here.
-                    (for-each delete-file-recursively
-                              (find-files directory "^\\.git$")))
-                  #t))))))
+           (when recursive?
+             ;; In sub-modules, '.git' is a flat file, not a directory,
+             ;; so we can use 'find-files' here.
+             (for-each delete-file-recursively
+                       (find-files directory "^\\.git$")))
+           #t))))
 
 ;;; git.scm ends here
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 0f2218c..43bc466 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -28,6 +28,7 @@
             git-reference?
             git-reference-url
             git-reference-commit
+            git-reference-tag
             git-reference-recursive?
 
             git-fetch))
@@ -44,7 +45,8 @@
   git-reference make-git-reference
   git-reference?
   (url        git-reference-url)
-  (commit     git-reference-commit)
+  (commit     git-reference-commit (default #f))
+  (tag        git-reference-tag (default #f))
   (recursive? git-reference-recursive?   ; whether to recurse into sub-modules
               (default #f)))
 
@@ -81,8 +83,12 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                                           dirs)))
 
         (git-fetch '#$(git-reference-url ref)
-                   '#$(git-reference-commit ref)
+                   (or '#$(git-reference-commit ref)
+                       '#$(git-reference-tag ref))
                    #$output
+                   ;; FIXME: Pass #:tag when fixed daemons are widely
+                   ;; deployed.
+                   ;; #:tag '#$(git-reference-tag ref)
                    #:recursive? '#$(git-reference-recursive? ref)
                    #:git-command (string-append #+git "/bin/git"))))
 
-- 
2.4.3

[PATCH 1/7] guix: git: Support shallow git clones if a tag is available

[Andy Wingo]

* guix/build/git.scm (git-fetch): Instead of cloning the remote repo, use the
  lower-level "init" / "fetch" / "checkout" operations.  This lets us make a
  shallow checkout if we are checking out a tag.

* guix/git-download.scm (<git-reference>): Add tag field.
  (git-fetch): Support git references with tags but no commits.
---
 guix/build/git.scm    | 58 ++++++++++++++++++++++++++++++++++-----------------
 guix/git-download.scm | 10 +++++++--
 2 files changed, 47 insertions(+), 21 deletions(-)

diff --git a/guix/build/git.scm b/guix/build/git.scm
index 121f07a..1af547f 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -28,32 +28,52 @@
 ;;; Code:
 
 (define* (git-fetch url commit directory
-                    #:key (git-command "git") recursive?)
+                    #:key tag (git-command "git") recursive?)
   "Fetch COMMIT from URL into DIRECTORY.  COMMIT must be a valid Git commit
 identifier.  When RECURSIVE? is true, all the sub-modules of URL are fetched,
 recursively.  Return #t on success, #f otherwise."
-
   ;; Disable TLS certificate verification.  The hash of the checkout is known
   ;; in advance anyway.
   (setenv "GIT_SSL_NO_VERIFY" "true")
 
-  (let ((args `("clone" ,@(if recursive? '("--recursive") '())
-                ,url ,directory)))
-    (and (zero? (apply system* git-command args))
-         (with-directory-excursion directory
-           (system* git-command "tag" "-l")
-           (and (zero? (system* git-command "checkout" commit))
-                (begin
-                  ;; The contents of '.git' vary as a function of the current
-                  ;; status of the Git repo.  Since we want a fixed output, this
-                  ;; directory needs to be taken out.
-                  (delete-file-recursively ".git")
+  (mkdir directory)
+  (with-directory-excursion directory
+    (and (zero? (system* git-command "init"))
+         (zero? (system* git-command "remote" "add" "origin" url))
+         (cond
+          ;; If there's a tag, do a shallow fetch.  Otherwise we do a full
+          ;; fetch.
+          (tag
+           (and (zero? (system* git-command "fetch" "--depth=1" "origin" tag))
+                ;; Either there is no commit specified, in which case we are
+                ;; good, or there is a commit and it is the same as the tag,
+                ;; in which case we're still good, or there's a commit and
+                ;; it's under the tag so we have to unshallow the checkout and
+                ;; try again.
+                (if commit
+                    (or (zero? (system* git-command "checkout" commit))
+                        (and (zero? (system* git-command "fetch" "--unshallow"))
+                             (zero? (system* git-command "checkout" commit))))
+                    (zero? (system* git-command "checkout" "FETCH_HEAD")))))
+          (else
+           ;; Fall back to a full fetch.  In that case print available tags.
+           (and (zero? (system* git-command "fetch" "origin"))
+                (zero? (system* git-command "tag" "-l"))
+                (zero? (system* git-command "checkout" commit)))))
+         (or (not recursive?)
+             (zero? (system* git-command
+                             "submodule" "update" "--init" "--recursive")))
+         (begin
+           ;; The contents of '.git' vary as a function of the current
+           ;; status of the Git repo.  Since we want a fixed output, this
+           ;; directory needs to be taken out.
+           (delete-file-recursively ".git")
 
-                  (when recursive?
-                    ;; In sub-modules, '.git' is a flat file, not a directory,
-                    ;; so we can use 'find-files' here.
-                    (for-each delete-file-recursively
-                              (find-files directory "^\\.git$")))
-                  #t))))))
+           (when recursive?
+             ;; In sub-modules, '.git' is a flat file, not a directory,
+             ;; so we can use 'find-files' here.
+             (for-each delete-file-recursively
+                       (find-files directory "^\\.git$")))
+           #t))))
 
 ;;; git.scm ends here
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 0f2218c..43bc466 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -28,6 +28,7 @@
             git-reference?
             git-reference-url
             git-reference-commit
+            git-reference-tag
             git-reference-recursive?
 
             git-fetch))
@@ -44,7 +45,8 @@
   git-reference make-git-reference
   git-reference?
   (url        git-reference-url)
-  (commit     git-reference-commit)
+  (commit     git-reference-commit (default #f))
+  (tag        git-reference-tag (default #f))
   (recursive? git-reference-recursive?   ; whether to recurse into sub-modules
               (default #f)))
 
@@ -81,8 +83,12 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                                           dirs)))
 
         (git-fetch '#$(git-reference-url ref)
-                   '#$(git-reference-commit ref)
+                   (or '#$(git-reference-commit ref)
+                       '#$(git-reference-tag ref))
                    #$output
+                   ;; FIXME: Pass #:tag when fixed daemons are widely
+                   ;; deployed.
+                   ;; #:tag '#$(git-reference-tag ref)
                    #:recursive? '#$(git-reference-recursive? ref)
                    #:git-command (string-append #+git "/bin/git"))))
 
-- 
2.4.3