committer.scm

committer.scm

[jgart]

Hi,

Does anyone know how to use the committer.scm script or how it is intended to be used?

This is what my unstaged area looks like:

$ guix-shell  git status
On branch master
Your branch is ahead of 'origin/master' by 4 commits.
  (use "git push" to publish your local commits)

Changes not staged for commit:
  (use "git add <file>..." to update what will be committed)
  (use "git restore <file>..." to discard changes in working directory)
        modified:   gnu/packages/crates-io.scm
        modified:   gnu/packages/rust-apps.scm

no changes added to commit (use "git add" and/or "git commit -a")

This is what it looks like when I call the script in a guix shell:

$ ./etc/committer.scm
committer.scm     committer.scm.in
 guix-shell  etc/committer.scm the-way
Backtrace:
In ice-9/eval.scm:
   721:20 19 (primitive-eval (use-modules ((sxml xpath) #:prefix …) …))
In ice-9/psyntax.scm:
  1218:36 18 (expand-top-sequence (#<syntax:committer.scm:32:0 (us…>) …)
  1210:19 17 (parse _ (("placeholder" placeholder)) ((top) #(# # …)) …)
   259:10 16 (parse _ (("placeholder" placeholder)) (()) _ c&e (eval) …)
In ice-9/boot-9.scm:
  3935:20 15 (process-use-modules _)
   222:29 14 (map1 (((sxml xpath) #:prefix xpath:) ((srfi srfi-1)) …))
   222:29 13 (map1 (((srfi srfi-1)) ((srfi srfi-2)) ((srfi #)) (#) …))
   222:29 12 (map1 (((srfi srfi-2)) ((srfi srfi-9)) ((srfi #)) (#) …))
   222:29 11 (map1 (((srfi srfi-9)) ((srfi srfi-11)) ((srfi #)) (#) …))
   222:29 10 (map1 (((srfi srfi-11)) ((srfi srfi-26)) ((ice-9 #)) # …))
   222:29  9 (map1 (((srfi srfi-26)) ((ice-9 format)) ((ice-9 #)) # …))
   222:29  8 (map1 (((ice-9 format)) ((ice-9 popen)) ((ice-9 #)) # …))
   222:29  7 (map1 (((ice-9 popen)) ((ice-9 match)) ((ice-9 #)) (#) …))
   222:29  6 (map1 (((ice-9 match)) ((ice-9 rdelim)) ((ice-9 #)) # #))
   222:29  5 (map1 (((ice-9 rdelim)) ((ice-9 regex)) ((ice-9 #)) (#)))
   222:29  4 (map1 (((ice-9 regex)) ((ice-9 textual-ports)) ((# #))))
   222:29  3 (map1 (((ice-9 textual-ports)) ((guix gexp))))
   222:17  2 (map1 (((guix gexp))))
  3936:31  1 (_ ((guix gexp)))
   3330:6  0 (resolve-interface (guix gexp) #:select _ #:hide _ # _ # …)

ice-9/boot-9.scm:3330:6: In procedure resolve-interface:
no code for module (guix gexp)

Re: committer.scm

[Julien Lepiller]

Try calling it with pre-inst-env.

Le 1 novembre 2022 02:42:55 GMT+01:00, jgart <jgart@dismail.de> a écrit :
>Hi,
>
>Does anyone know how to use the committer.scm script or how it is intended to be used?
>
>This is what my unstaged area looks like:
>
>$ guix-shell  git status
>On branch master
>Your branch is ahead of 'origin/master' by 4 commits.
>  (use "git push" to publish your local commits)
>
>Changes not staged for commit:
>  (use "git add <file>..." to update what will be committed)
>  (use "git restore <file>..." to discard changes in working directory)
>        modified:   gnu/packages/crates-io.scm
>        modified:   gnu/packages/rust-apps.scm
>
>no changes added to commit (use "git add" and/or "git commit -a")
>
>This is what it looks like when I call the script in a guix shell:
>
>$ ./etc/committer.scm
>committer.scm     committer.scm.in
> guix-shell  etc/committer.scm the-way
>Backtrace:
>In ice-9/eval.scm:
>   721:20 19 (primitive-eval (use-modules ((sxml xpath) #:prefix …) …))
>In ice-9/psyntax.scm:
>  1218:36 18 (expand-top-sequence (#<syntax:committer.scm:32:0 (us…>) …)
>  1210:19 17 (parse _ (("placeholder" placeholder)) ((top) #(# # …)) …)
>   259:10 16 (parse _ (("placeholder" placeholder)) (()) _ c&e (eval) …)
>In ice-9/boot-9.scm:
>  3935:20 15 (process-use-modules _)
>   222:29 14 (map1 (((sxml xpath) #:prefix xpath:) ((srfi srfi-1)) …))
>   222:29 13 (map1 (((srfi srfi-1)) ((srfi srfi-2)) ((srfi #)) (#) …))
>   222:29 12 (map1 (((srfi srfi-2)) ((srfi srfi-9)) ((srfi #)) (#) …))
>   222:29 11 (map1 (((srfi srfi-9)) ((srfi srfi-11)) ((srfi #)) (#) …))
>   222:29 10 (map1 (((srfi srfi-11)) ((srfi srfi-26)) ((ice-9 #)) # …))
>   222:29  9 (map1 (((srfi srfi-26)) ((ice-9 format)) ((ice-9 #)) # …))
>   222:29  8 (map1 (((ice-9 format)) ((ice-9 popen)) ((ice-9 #)) # …))
>   222:29  7 (map1 (((ice-9 popen)) ((ice-9 match)) ((ice-9 #)) (#) …))
>   222:29  6 (map1 (((ice-9 match)) ((ice-9 rdelim)) ((ice-9 #)) # #))
>   222:29  5 (map1 (((ice-9 rdelim)) ((ice-9 regex)) ((ice-9 #)) (#)))
>   222:29  4 (map1 (((ice-9 regex)) ((ice-9 textual-ports)) ((# #))))
>   222:29  3 (map1 (((ice-9 textual-ports)) ((guix gexp))))
>   222:17  2 (map1 (((guix gexp))))
>  3936:31  1 (_ ((guix gexp)))
>   3330:6  0 (resolve-interface (guix gexp) #:select _ #:hide _ # _ # …)
>
>ice-9/boot-9.scm:3330:6: In procedure resolve-interface:
>no code for module (guix gexp)
>
>

Re: committer.scm

[jgart]

On Tue, 01 Nov 2022 07:57:28 +0100 Julien Lepiller <julien@lepiller.eu> wrote:
> Try calling it with pre-inst-env.

Ohhh, yes that was it. I stopped calling it with pre-inst-env for some reason ;()

THNX

Now I just need to see how I am going to sort these 150+ crates in an automated fashion...

Re: committer.scm

[Csepp]

[-- Attachment #1: Type: text/plain, Size: 580 bytes --]


jgart <jgart@dismail.de> writes:

> On Tue, 01 Nov 2022 07:57:28 +0100 Julien Lepiller <julien@lepiller.eu> wrote:
>> Try calling it with pre-inst-env.
>
> Ohhh, yes that was it. I stopped calling it with pre-inst-env for some reason ;()
>
> THNX
>
> Now I just need to see how I am going to sort these 150+ crates in an automated fashion...

If you have some graph theory and Guix know-how you might be able to get
my commit sorter script working.  Currently it's broken, as in it does
not sort commits in the way they should be sorted, but it has a lot of
useful bits already.

[-- Attachment #2: commit sorter guile script --]
[-- Type: text/plain, Size: 7818 bytes --]

(use-modules
 (gnu installer utils)
 (graph topological-sort)
 (guix build utils)
 (ice-9 exceptions)
 (ice-9 hash-table)
 (ice-9 match)
 (ice-9 popen)
 (ice-9 rdelim)
 (oop goops)
 (srfi srfi-1)
 (srfi srfi-13)
 (srfi srfi-2)
 (srfi srfi-26)
 (gnu packages)
 (guix packages))

(with-exception-handler
    exception-irritants
  (lambda ()
    (package-propagated-inputs
     (module-ref
      (reload-module (resolve-module '(gnu packages ocaml-mirage) #:ensure #f))
      'ocaml-ppx-cstruct)))
  #:unwind? #t
  #:unwind-for-type &undefined-variable)

(define from-commit "raingloom/mirageos-rebase")
(define to-commit "after-dune")

;; The set (sorted list) of variables (symbols) we care about.
(define variables-of-interest
  ;; starts out as #f to catch errors
  (make-parameter #f))

(define variable->commit-mapping
 (make-parameter #f))

(define dependency-digraph
  (make-parameter #f))

(define commit->log-index
  (make-parameter #f))

(define (with-input-from-make thunk)
  (lambda _
    (with-input-from-port
        (open-pipe* OPEN_READ "make")
      thunk)))

(define (set-current-commit! commit)
  (invoke "git" "checkout" commit))

(define (missing-variable-on-line line)
  (and-let*
      ((words (string-split line #\space))
       (prefixed-var (find-tail (cut string=? "variable" <>) words))
       ;; so cadr doesn't error
       (prefixed-var-ok? (equal? 2 (length prefixed-var)))
       (var-quoted (cadr prefixed-var))
       (var-quoted-ok? (and (string-suffix? "'" var-quoted)
                            (string-prefix? "`" var-quoted)))
       (var (string-drop-right (string-drop var-quoted 1) 1)))
    var))

(define (with-input-from-command thunk command)
  ;; TODO this is ugly, but run-external-command-with-handler does not return
  ;; the value that the handler returns, only the command's exit status
  (define ret #f)
  (define (handler port)
    (set! ret (with-input-from-port port thunk)))
  (run-external-command-with-handler handler command)
  ret)

(define (current-commit-missing-definitions)
  (define (go)
    (let ((line (read-line)))
      (if (eof-object? line)
          '()
          (let ((variable (missing-variable-on-line line)))
            (if variable
                (cons variable (go))
                (go))))))
  (map string->symbol
       (with-input-from-command go '("make"))))

(define (name->commit name)
   (define (go)
     (define hash (read-line))
     (unless (eof-object? (read-line))
       (error "unexpected additional output"))
     hash)
   (with-input-from-command
    go
    `("git" "show" "--format=%H" "--quiet" ,name)))

(define (current-commit)
  (name->commit "HEAD"))

(define (commits-since commit-name)
  (define commit (name->commit commit-name))
  (define (go)
    (let ((line (read-line)))
      (cond
       ((eof-object? line) (error "ancestor commit does not exist"))
       ((string=? line commit) '())
       (else (cons line (go))))))
  (reverse (with-input-from-command go '("git" "log" "--format=%H"))))

(define (files-changed commit)
  (cdr (with-input-from-command
        read-lines
        `("git" "show" "--oneline" "--name-only" ,commit))))

(define (module-file? file)
  (string-suffix? ".scm" file))

(define (path->module path)
  "Assumes PATH is a valid Scheme file."
  (let* ((components-rev (reverse (string-split path #\/)))
         (base (car components-rev))
         (last-component (string-drop-right base (string-length ".scm"))))
    (map string->symbol (reverse (cons last-component (cdr components-rev))))))

(define (modules-changed commit)
  (map path->module
       (filter module-file?
               (files-changed commit))))

(define (touch-changed-files! commit)
  (apply invoke (cons "touch" (files-changed commit))))

(define (commits+missing-definitions commits)
  (map (lambda (commit)
         (set-current-commit! commit)
         (touch-changed-files! commit)
         (cons commit (current-commit-missing-definitions)))
       commits))

(define (set-insert set x)
  "Insert element X into the sorted list SET."
  (match set
    (() (list x))
    ((a) (if (< a x)
             (list a x)
             (list x a)))
    ((a b . rest)
     (cond
      ((and (< a x) (< x b)) (cons* a x b rest))
      ((equal? a x) set)
      ((< x a) (cons* x a (cdr set)))
      (else (cons a (set-insert (cdr set) x)))))))

(define (add-dependent! dependency-graph commit dependent)
  (assoc-set! dependency-graph commit
              (set-insert dependent
                          (or (assoc-ref dependency-graph commit)
                              '()))))

(define (deduplicate lst)
  (define ret '())
  (for-each (lambda (x) (set! ret (assoc-set! ret x #t))) lst)
  (map car ret))

(define (current-commit-defined-vars-of-interest)
  (let ((vars-of-interest (variables-of-interest)))
    (deduplicate
     (concatenate
      (filter identity
              (map (lambda (module-name)
                     (let ((module (reload-module
                                    (resolve-module module-name))))
                       (map (lambda (var)
                              (and (module-variable
                                    module var) var))
                            vars-of-interest)))
                   (modules-changed (current-commit))))))))

;; : alist symbol (list string)
(define (compute-variable->commit-mapping! commits)
  (fold
   (lambda (commit vars->commits)
     (set-current-commit! commit)
     (fold
      (lambda (var vars->commits)
        (assoc-set! vars->commits var
                    (cons commit
                          (or (assoc-ref vars->commits var) '()))))
      vars->commits
      (current-commit-defined-vars-of-interest)))
   '()
   commits))

(define (order-in-topology  commit)
  (hash-ref (topology-vector) commit))

(define (order-in-log commit)
  (hash-ref (commit->log-index) commit))

(define (depends? commit dependency)
  "Does COMMIT depend on DEPENDENCY?"
  (sorted? (map order-in-topology (list commit dependency)) <))

(define (predates? a b)
  "Does commit A come before commit B in the original history?"
  (sorted? (map order-in-log (list a b)) <))

(define (commits-ordered? a b)
  "Commit A should come before B iff B has a direct dependency on A or if it
comes before B in the git history, in that order of precedence."
  (or (depends? a b)
      (predates? a b)))

(define (list->index-lookup-hash-table lst)
  (define mapping (make-hash-table))
  (fold (lambda (x i)
          (hash-set! mapping x i)
          (+ 1 i))
        0 lst)
  mapping)

(define (hash->alist hsh)
  (hash-fold acons '() hsh))

(set-current-commit! from-commit)
;; edges go from commits to variables
(define commits (commits-since to-commit))
(commit->log-index (list->index-lookup-hash-table commits))
(define commits->missing-definitions (commits+missing-definitions commits))
(variables-of-interest
 (deduplicate
  (apply append (map cdr commits->missing-definitions))))
(define var->comm
  (compute-variable->commit-mapping! commits))
(variable->commit-mapping (alist->hash-table var->comm))

(define graph-n (length commits))
(define graph (make-bitvector (expt graph-n 2)))
(define (coord->offset row col)
  (+ col (* graph-n row)))
(define (connected? a b)
  (bitvector-bit-set? graph (coord->offset a b)))
(define (connect! a b)
  (bitvector-set-bit! graph (coord->offset a b)))
(let ((variable->commit-mapping (variable->commit-mapping)))
  (for-each
   (match-lambda
     ((commit . vars)
      (let ((commit-log-id (order-in-log commit)))
        (for-each
         (lambda (var)
           (let* ((dependencies (hash-ref variable->commit-mapping var)))
             (for-each
              (lambda (dependency)
                (connect! commit-log-id (order-in-log dependency))))))
         vars))))
   commits->missing-definitions))