GNU bug report logs - #32123
[PATCH] import: hackage: Support "custom-setup" field.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 32123 in the body.
You can then email your comments to 32123 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: guix-patches <at> gnu.org
Cc: Danny Milosavljevic <dannym <at> scratchpost.org>
Subject: [PATCH] import: hackage: Support "custom-setup" field.
Date: Wed, 11 Jul 2018 02:42:11 +0200

* guix/import/cabal.scm (make-cabal-parser): Modify.
(is-custom-setup): New variable.
(lex-custom-setup): New procedure.
(is-id): Modify.
(lex-version): Modify.
(<cabal-custom-setup>): New record type.
(eval-cabal): Modify.
(dependencies): Add parameter.
---
 guix/import/cabal.scm | 37 +++++++++++++++++++++++++++++--------
 1 file changed, 29 insertions(+), 8 deletions(-)

diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 09130e449..1775c3879 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -140,7 +140,7 @@ to the stack."
   (lalr-parser
    ;; --- token definitions
    (CCURLY VCCURLY OPAREN CPAREN TEST ID VERSION RELATION TRUE FALSE
-           (right: IF FLAG EXEC TEST-SUITE SOURCE-REPO BENCHMARK LIB OCURLY)
+           (right: IF FLAG EXEC TEST-SUITE CUSTOM-SETUP SOURCE-REPO BENCHMARK LIB OCURLY)
            (left: OR)
            (left: PROPERTY AND)
            (right: ELSE NOT))
@@ -150,6 +150,7 @@ to the stack."
                 (sections source-repo)  : (append $1 (list $2))
                 (sections executables)  : (append $1 $2)
                 (sections test-suites)  : (append $1 $2)
+                (sections custom-setup) : (append $1 $2)
                 (sections benchmarks)   : (append $1 $2)
                 (sections lib-sec)      : (append $1 (list $2))
                 ()                      : '())
@@ -172,6 +173,7 @@ to the stack."
                 (ts-sec)                : (list $1))
    (ts-sec      (TEST-SUITE OCURLY exprs CCURLY) : `(section test-suite ,$1 ,$3)
                 (TEST-SUITE open exprs close)    : `(section test-suite ,$1 ,$3))
+   (custom-setup (CUSTOM-SETUP exprs) : (list `(section custom-setup ,$1 ,$2)))
    (benchmarks  (benchmarks bm-sec)     : (append $1 (list $2))
                 (bm-sec)                : (list $1))
    (bm-sec      (BENCHMARK OCURLY exprs CCURLY) : `(section benchmark ,$1 ,$3)
@@ -349,6 +351,9 @@ matching a string against the created regexp."
 (define is-test-suite (make-rx-matcher "^test-suite +([a-z0-9_-]+)"
                                        regexp/icase))
 
+(define is-custom-setup (make-rx-matcher "^(custom-setup)"
+                                         regexp/icase))
+
 (define is-benchmark (make-rx-matcher "^benchmark +([a-z0-9_-]+)"
                                       regexp/icase))
 
@@ -368,7 +373,7 @@ matching a string against the created regexp."
 
 (define (is-id s port)
   (let ((cabal-reserved-words
-         '("if" "else" "library" "flag" "executable" "test-suite"
+         '("if" "else" "library" "flag" "executable" "test-suite" "custom-setup"
            "source-repository" "benchmark"))
         (spaces (read-while (cut char-set-contains? char-set:blank <>) port))
         (c (peek-char port)))
@@ -392,8 +397,11 @@ matching a string against the created regexp."
 
 (define (lex-version loc port)
   (make-lexical-token 'VERSION loc
-                      (read-while char-numeric? port
-                                  (cut char=? #\. <>) char-numeric?)))
+                      (read-while (lambda (x)
+                                    (or (char-numeric? x)
+                                        (char=? x #\*)
+                                        (char=? x #\.)))
+                                  port)))
 
 (define* (read-while is? port #:optional
                      (is-if-followed-by? (lambda (c) #f))
@@ -435,6 +443,8 @@ string with the read characters."
 
 (define (lex-test-suite ts-rx-res loc) (lex-rx-res ts-rx-res 'TEST-SUITE loc))
 
+(define (lex-custom-setup ts-rx-res loc) (lex-rx-res ts-rx-res 'CUSTOM-SETUP loc))
+
 (define (lex-benchmark bm-rx-res loc) (lex-rx-res bm-rx-res 'BENCHMARK loc))
 
 (define (lex-lib loc) (make-lexical-token 'LIB loc #f))
@@ -529,6 +539,7 @@ the current port location."
      ((is-src-repo s) => (cut lex-src-repo <> loc))
      ((is-exec s) => (cut lex-exec <> loc))
      ((is-test-suite s) => (cut lex-test-suite <> loc))
+     ((is-custom-setup s) => (cut lex-custom-setup <> loc))
      ((is-benchmark s) => (cut lex-benchmark <> loc))
      ((is-lib s) (lex-lib loc))
      ((is-else s) (lex-else loc))
@@ -658,6 +669,12 @@ If #f use the function 'port-filename' to obtain it."
   (name cabal-test-suite-name)
   (dependencies cabal-test-suite-dependencies)) ; list of <cabal-dependency>
 
+(define-record-type <cabal-custom-setup>
+  (make-cabal-custom-setup name dependencies)
+  cabal-custom-setup?
+  (name cabal-custom-setuo-name)
+  (dependencies cabal-custom-setup-dependencies)) ; list of <cabal-dependency>
+
 (define (cabal-flags->alist flag-list)
     "Retrun an alist associating the flag name to its default value from a
 list of <cabal-flag> objects."
@@ -728,7 +745,6 @@ the ordering operation and the version."
     (let ((value (or (assoc-ref env name)
                      (assoc-ref (cabal-flags->alist (cabal-flags)) name))))
       (if (eq? value 'false) #f #t)))
-  
   (define (eval sexp)
     (match sexp
       (() '())
@@ -755,6 +771,8 @@ the ordering operation and the version."
       ;; no need to evaluate flag parameters
       (('section 'flag name parameters)
        (list 'section 'flag name parameters))
+      (('section 'custom-setup parameters)
+       (list 'section 'custom-setup parameters))
       ;; library does not have a name parameter
       (('section 'library parameters)
        (list 'section 'library (eval parameters)))
@@ -795,12 +813,15 @@ See the manual for limitations.")))))))
 (define (make-cabal-section sexp section-type)
   "Given an SEXP as produced by 'read-cabal', produce a list of objects
 pertaining to SECTION-TYPE sections.  SECTION-TYPE must be one of:
-'executable, 'flag, 'test-suite, 'source-repository or 'library."
+'executable, 'flag, 'test-suite, 'custom-setup, 'source-repository or
+'library."
   (filter-map (cut match <>
                    (('section (? (cut equal? <> section-type)) name parameters)
                     (case section-type
                       ((test-suite) (make-cabal-test-suite
                                       name (dependencies parameters)))
+                      ((custom-setup) (make-cabal-custom-setup
+                                       name (dependencies parameters "setup-depends")))
                       ((executable) (make-cabal-executable
                                       name (dependencies parameters)))
                       ((source-repository) (make-cabal-source-repository
@@ -843,10 +864,10 @@ to be added between the values found in different key/value pairs."
 (define dependency-name-version-rx
   (make-regexp "([a-zA-Z0-9_-]+) *(.*)"))
 
-(define (dependencies key-values-list)
+(define* (dependencies key-values-list #:optional (key "build-depends"))
   "Return a list of 'cabal-dependency' objects for the dependencies found in
 KEY-VALUES-LIST."
-  (let ((deps (string-tokenize (lookup-join key-values-list "build-depends" ",")
+  (let ((deps (string-tokenize (lookup-join key-values-list key ",")
                                (char-set-complement (char-set #\,)))))
     (map (lambda (d)
            (let ((rx-result (regexp-exec dependency-name-version-rx d)))

Message #8 received at 32123 <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: 32123 <at> debbugs.gnu.org
Cc: Danny Milosavljevic <dannym <at> scratchpost.org>
Subject: [PATCH v2 0/2] Improve Cabal importer.
Date: Wed, 11 Jul 2018 22:28:12 +0200

Danny Milosavljevic (2):
  import: hackage: Support "custom-setup" field.
  import: hackage: Support "-any" and "-none" version comparison
    operators.

 guix/import/cabal.scm | 68 +++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 55 insertions(+), 13 deletions(-)

Message #11 received at 32123 <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: 32123 <at> debbugs.gnu.org
Cc: Danny Milosavljevic <dannym <at> scratchpost.org>
Subject: [PATCH v2 1/2] import: hackage: Support "custom-setup" field.
Date: Wed, 11 Jul 2018 22:28:13 +0200

* guix/import/cabal.scm (make-cabal-parser): Modify.
(is-custom-setup): New variable.
(lex-custom-setup): New procedure.
(is-id): Modify.
(lex-version): Modify.
(<cabal-custom-setup>): New record type.
(eval-cabal): Modify.
(dependencies): Add parameter.
---
 guix/import/cabal.scm | 37 +++++++++++++++++++++++++++++--------
 1 file changed, 29 insertions(+), 8 deletions(-)

diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 09130e449..1775c3879 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -140,7 +140,7 @@ to the stack."
   (lalr-parser
    ;; --- token definitions
    (CCURLY VCCURLY OPAREN CPAREN TEST ID VERSION RELATION TRUE FALSE
-           (right: IF FLAG EXEC TEST-SUITE SOURCE-REPO BENCHMARK LIB OCURLY)
+           (right: IF FLAG EXEC TEST-SUITE CUSTOM-SETUP SOURCE-REPO BENCHMARK LIB OCURLY)
            (left: OR)
            (left: PROPERTY AND)
            (right: ELSE NOT))
@@ -150,6 +150,7 @@ to the stack."
                 (sections source-repo)  : (append $1 (list $2))
                 (sections executables)  : (append $1 $2)
                 (sections test-suites)  : (append $1 $2)
+                (sections custom-setup) : (append $1 $2)
                 (sections benchmarks)   : (append $1 $2)
                 (sections lib-sec)      : (append $1 (list $2))
                 ()                      : '())
@@ -172,6 +173,7 @@ to the stack."
                 (ts-sec)                : (list $1))
    (ts-sec      (TEST-SUITE OCURLY exprs CCURLY) : `(section test-suite ,$1 ,$3)
                 (TEST-SUITE open exprs close)    : `(section test-suite ,$1 ,$3))
+   (custom-setup (CUSTOM-SETUP exprs) : (list `(section custom-setup ,$1 ,$2)))
    (benchmarks  (benchmarks bm-sec)     : (append $1 (list $2))
                 (bm-sec)                : (list $1))
    (bm-sec      (BENCHMARK OCURLY exprs CCURLY) : `(section benchmark ,$1 ,$3)
@@ -349,6 +351,9 @@ matching a string against the created regexp."
 (define is-test-suite (make-rx-matcher "^test-suite +([a-z0-9_-]+)"
                                        regexp/icase))
 
+(define is-custom-setup (make-rx-matcher "^(custom-setup)"
+                                         regexp/icase))
+
 (define is-benchmark (make-rx-matcher "^benchmark +([a-z0-9_-]+)"
                                       regexp/icase))
 
@@ -368,7 +373,7 @@ matching a string against the created regexp."
 
 (define (is-id s port)
   (let ((cabal-reserved-words
-         '("if" "else" "library" "flag" "executable" "test-suite"
+         '("if" "else" "library" "flag" "executable" "test-suite" "custom-setup"
            "source-repository" "benchmark"))
         (spaces (read-while (cut char-set-contains? char-set:blank <>) port))
         (c (peek-char port)))
@@ -392,8 +397,11 @@ matching a string against the created regexp."
 
 (define (lex-version loc port)
   (make-lexical-token 'VERSION loc
-                      (read-while char-numeric? port
-                                  (cut char=? #\. <>) char-numeric?)))
+                      (read-while (lambda (x)
+                                    (or (char-numeric? x)
+                                        (char=? x #\*)
+                                        (char=? x #\.)))
+                                  port)))
 
 (define* (read-while is? port #:optional
                      (is-if-followed-by? (lambda (c) #f))
@@ -435,6 +443,8 @@ string with the read characters."
 
 (define (lex-test-suite ts-rx-res loc) (lex-rx-res ts-rx-res 'TEST-SUITE loc))
 
+(define (lex-custom-setup ts-rx-res loc) (lex-rx-res ts-rx-res 'CUSTOM-SETUP loc))
+
 (define (lex-benchmark bm-rx-res loc) (lex-rx-res bm-rx-res 'BENCHMARK loc))
 
 (define (lex-lib loc) (make-lexical-token 'LIB loc #f))
@@ -529,6 +539,7 @@ the current port location."
      ((is-src-repo s) => (cut lex-src-repo <> loc))
      ((is-exec s) => (cut lex-exec <> loc))
      ((is-test-suite s) => (cut lex-test-suite <> loc))
+     ((is-custom-setup s) => (cut lex-custom-setup <> loc))
      ((is-benchmark s) => (cut lex-benchmark <> loc))
      ((is-lib s) (lex-lib loc))
      ((is-else s) (lex-else loc))
@@ -658,6 +669,12 @@ If #f use the function 'port-filename' to obtain it."
   (name cabal-test-suite-name)
   (dependencies cabal-test-suite-dependencies)) ; list of <cabal-dependency>
 
+(define-record-type <cabal-custom-setup>
+  (make-cabal-custom-setup name dependencies)
+  cabal-custom-setup?
+  (name cabal-custom-setuo-name)
+  (dependencies cabal-custom-setup-dependencies)) ; list of <cabal-dependency>
+
 (define (cabal-flags->alist flag-list)
     "Retrun an alist associating the flag name to its default value from a
 list of <cabal-flag> objects."
@@ -728,7 +745,6 @@ the ordering operation and the version."
     (let ((value (or (assoc-ref env name)
                      (assoc-ref (cabal-flags->alist (cabal-flags)) name))))
       (if (eq? value 'false) #f #t)))
-  
   (define (eval sexp)
     (match sexp
       (() '())
@@ -755,6 +771,8 @@ the ordering operation and the version."
       ;; no need to evaluate flag parameters
       (('section 'flag name parameters)
        (list 'section 'flag name parameters))
+      (('section 'custom-setup parameters)
+       (list 'section 'custom-setup parameters))
       ;; library does not have a name parameter
       (('section 'library parameters)
        (list 'section 'library (eval parameters)))
@@ -795,12 +813,15 @@ See the manual for limitations.")))))))
 (define (make-cabal-section sexp section-type)
   "Given an SEXP as produced by 'read-cabal', produce a list of objects
 pertaining to SECTION-TYPE sections.  SECTION-TYPE must be one of:
-'executable, 'flag, 'test-suite, 'source-repository or 'library."
+'executable, 'flag, 'test-suite, 'custom-setup, 'source-repository or
+'library."
   (filter-map (cut match <>
                    (('section (? (cut equal? <> section-type)) name parameters)
                     (case section-type
                       ((test-suite) (make-cabal-test-suite
                                       name (dependencies parameters)))
+                      ((custom-setup) (make-cabal-custom-setup
+                                       name (dependencies parameters "setup-depends")))
                       ((executable) (make-cabal-executable
                                       name (dependencies parameters)))
                       ((source-repository) (make-cabal-source-repository
@@ -843,10 +864,10 @@ to be added between the values found in different key/value pairs."
 (define dependency-name-version-rx
   (make-regexp "([a-zA-Z0-9_-]+) *(.*)"))
 
-(define (dependencies key-values-list)
+(define* (dependencies key-values-list #:optional (key "build-depends"))
   "Return a list of 'cabal-dependency' objects for the dependencies found in
 KEY-VALUES-LIST."
-  (let ((deps (string-tokenize (lookup-join key-values-list "build-depends" ",")
+  (let ((deps (string-tokenize (lookup-join key-values-list key ",")
                                (char-set-complement (char-set #\,)))))
     (map (lambda (d)
            (let ((rx-result (regexp-exec dependency-name-version-rx d)))

Message #14 received at 32123 <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: 32123 <at> debbugs.gnu.org
Cc: Danny Milosavljevic <dannym <at> scratchpost.org>
Subject: [PATCH v2 2/2] import: hackage: Support "-any" and "-none" version
 comparison operators.
Date: Wed, 11 Jul 2018 22:28:14 +0200

* guix/import/cabal.scm (make-cabal-parser): Modify.
(is-any): New variable.
(is-none): New variable.
(lex-any): New procedure.
(lex-none): New procedure.
(lex-word): Modify.
(eval-cabal): Modify.
---
 guix/import/cabal.scm | 31 ++++++++++++++++++++++++++-----
 1 file changed, 26 insertions(+), 5 deletions(-)

diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 1775c3879..cd0a2953c 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -139,7 +139,7 @@ to the stack."
   "Generate a parser for Cabal files."
   (lalr-parser
    ;; --- token definitions
-   (CCURLY VCCURLY OPAREN CPAREN TEST ID VERSION RELATION TRUE FALSE
+   (CCURLY VCCURLY OPAREN CPAREN TEST ID VERSION RELATION TRUE FALSE -ANY -NONE
            (right: IF FLAG EXEC TEST-SUITE CUSTOM-SETUP SOURCE-REPO BENCHMARK LIB OCURLY)
            (left: OR)
            (left: PROPERTY AND)
@@ -213,6 +213,10 @@ to the stack."
                 (FALSE)                        : 'false
                 (TEST OPAREN ID RELATION VERSION CPAREN)
                 : `(,$1 ,(string-append $3 " " $4 " " $5))
+                (TEST OPAREN ID -ANY CPAREN)
+                : `(,$1 ,(string-append $3 " -any"))
+                (TEST OPAREN ID -NONE CPAREN)
+                : `(,$1 ,(string-append $3 " -none"))
                 (TEST OPAREN ID RELATION VERSION AND RELATION VERSION CPAREN)
                 : `(and (,$1 ,(string-append $3 " " $4 " " $5))
                         (,$1 ,(string-append $3 " " $7 " " $8)))
@@ -367,6 +371,10 @@ matching a string against the created regexp."
 
 (define (is-false s) (string-ci=? s "false"))
 
+(define (is-any s) (string-ci=? s "-any"))
+
+(define (is-none s) (string-ci=? s "-none"))
+
 (define (is-and s) (string=? s "&&"))
 
 (define (is-or s) (string=? s "||"))
@@ -457,6 +465,10 @@ string with the read characters."
 
 (define (lex-false loc) (make-lexical-token 'FALSE loc #f))
 
+(define (lex-any loc) (make-lexical-token '-ANY loc #f))
+
+(define (lex-none loc) (make-lexical-token '-NONE loc #f))
+
 (define (lex-and loc) (make-lexical-token 'AND loc #f))
 
 (define (lex-or loc) (make-lexical-token 'OR loc #f))
@@ -524,6 +536,8 @@ LOC is the current port location."
           ((is-test w port) (lex-test w loc))
           ((is-true w) (lex-true loc))
           ((is-false w) (lex-false loc))
+          ((is-any w) (lex-any loc))
+          ((is-none w) (lex-none loc))
           ((is-and w) (lex-and loc))
           ((is-or w) (lex-or loc))
           ((is-id w port) (lex-id w loc))
@@ -711,13 +725,20 @@ the ordering operation and the version."
     (let* ((with-ver-matcher-fn (make-rx-matcher
                                  "([a-zA-Z0-9_-]+) *([<>=]+) *([0-9.]+) *"))
            (without-ver-matcher-fn (make-rx-matcher "([a-zA-Z0-9_-]+)"))
+           (without-ver-matcher-fn-2 (make-rx-matcher "([a-zA-Z0-9_-]+) (-any|-none)"))
            (name (or (and=> (with-ver-matcher-fn spec)
                             (cut match:substring <> 1))
+                     (and=> (without-ver-matcher-fn-2 spec)
+                            (cut match:substring <> 1))
                      (match:substring (without-ver-matcher-fn spec) 1)))
-           (operator (and=> (with-ver-matcher-fn spec)
-                            (cut match:substring <> 2)))
-           (version (and=> (with-ver-matcher-fn spec)
-                           (cut match:substring <> 3))))
+           (operator (or (and=> (with-ver-matcher-fn spec)
+                                (cut match:substring <> 2))
+                         (and=> (without-ver-matcher-fn-2 spec)
+                                (cut match:substring <> 2))))
+           (version (or (and=> (with-ver-matcher-fn spec)
+                               (cut match:substring <> 3))
+                        (and=> (without-ver-matcher-fn-2 spec)
+                               (cut match:substring <> 2)))))
       (values name operator version)))
   
   (define (impl haskell)

Message #17 received at 32123 <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: Danny Milosavljevic <dannym <at> scratchpost.org>
Cc: 32123 <at> debbugs.gnu.org
Subject: Re: [bug#32123] [PATCH v2 0/2] Improve Cabal importer.
Date: Thu, 12 Jul 2018 00:03:54 +0200

Hello Danny,

Danny Milosavljevic <dannym <at> scratchpost.org> skribis:

> Danny Milosavljevic (2):
>   import: hackage: Support "custom-setup" field.
>   import: hackage: Support "-any" and "-none" version comparison
>     operators.

Really great you’re working on this!  This piece of code needs love.

Could you add a test to tests/hackage.scm?  If it fixes some of the
‘guix import hackage’ limitations reported have on bugs.gnu.org/guix,
please mention it in the commit log.

Thank you!

Ludo’.

Message #22 received at 32123-done <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: 32123-done <at> debbugs.gnu.org
Subject: Re: [PATCH v2 0/2] Improve Cabal importer.
Date: Thu, 12 Jul 2018 09:07:50 +0200

[Message part 1 (text/plain, inline)]

Edited commit message to mention bug# and pushed to master as

314b63e0b4372681aec165113ae2a0349eaaa357

and

ecba50bb79a49b317c4b1e718f4732b36438227f.

[Message part 2 (application/pgp-signature, inline)]

Message #25 received at 32123 <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: 32123 <at> debbugs.gnu.org
Cc: dannym <at> scratchpost.org
Subject: Re: bug#32123: [PATCH v2 0/2] Improve Cabal importer.
Date: Thu, 12 Jul 2018 10:42:26 +0200

Danny Milosavljevic <dannym <at> scratchpost.org> skribis:

> Edited commit message to mention bug# and pushed to master as
>
> 314b63e0b4372681aec165113ae2a0349eaaa357
>
> and
>
> ecba50bb79a49b317c4b1e718f4732b36438227f.

What about the test?  :-)  Or is it already covered by the existing
tests?

Thanks,
Ludo’.

Message #28 received at 32123 <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: ludo <at> gnu.org (Ludovic Courtès)
Cc: 32123 <at> debbugs.gnu.org
Subject: Re: bug#32123: [PATCH v2 0/2] Improve Cabal importer.
Date: Thu, 12 Jul 2018 10:50:42 +0200

[Message part 1 (text/plain, inline)]

I'm at it.  Some complications ;)

[Message part 2 (application/pgp-signature, inline)]

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.