import: cabal: Support library names

* guix/import/cabal.scm (make-cabal-parser): Add name to section.
(is-lib): Add optional name to regular expression.
(lex-rx-res): Support selecting different substring.
(lex-lib): Match 2nd substring from IS-LIB.
(lex-line): Adapt to changes for lex-lib.
(cabal-library): Add name field and export CABAL-LIBRARY-NAME.
(eval): Remove special case for 'library, which is not required any more.
(make-cabal-section): Move special case for LIBRARY.
* tests/hackage.scm (test-read-cabal-library-name): New variable.
("read-cabal test 1"): Adapt testcase to changed internal structure.
("read-cabal test: library name"): New testcase.

2 files changed, 34 insertions, 14 deletions

diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 8f59a63cb9..4410c12500 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -74,6 +74,7 @@
             cabal-executable-dependencies
 
             cabal-library?
+            cabal-library-name
             cabal-library-dependencies
 
             cabal-test-suite?
@@ -189,8 +190,8 @@ to the stack."
                 (bm-sec)                : (list $1))
    (bm-sec      (BENCHMARK OCURLY exprs CCURLY) : `(section benchmark ,$1 ,$3)
                 (BENCHMARK open exprs close)    : `(section benchmark ,$1 ,$3))
-   (lib-sec     (LIB OCURLY exprs CCURLY) : `(section library ,$3)
-                (LIB open exprs close)    : `(section library ,$3))
+   (lib-sec     (LIB OCURLY exprs CCURLY) : `(section library ,$1 ,$3)
+                (LIB open exprs close)    : `(section library ,$1 ,$3))
    (exprs       (exprs PROPERTY)         : (append $1 (list $2))
                 (PROPERTY)               : (list $1)
                 (exprs elif-else)          : (append $1 (list ($2 '(()))))
@@ -382,7 +383,8 @@ matching a string against the created regexp."
 (define is-benchmark (make-rx-matcher "^benchmark +([a-z0-9_-]+)"
                                       regexp/icase))
 
-(define is-lib (make-rx-matcher "^library *" regexp/icase))
+;; Libraries can have optional names since Cabal 2.0.
+(define is-lib (make-rx-matcher "^library(\\s+([a-z0-9_-]+))?\\s*" regexp/icase))
 
 (define (is-else s) (string-ci=? s "else"))
 
@@ -476,8 +478,9 @@ string with the read characters."
      'PROPERTY loc
      (list key `(,(read-braced-value port))))))
 
-(define (lex-rx-res rx-res token loc)
-  (let ((name (string-downcase (match:substring rx-res 1))))
+(define* (lex-rx-res rx-res token loc #:optional (substring-id 1))
+  (let* ((match (match:substring rx-res substring-id))
+         (name (if match (string-downcase match) match)))
     (make-lexical-token token loc name)))
 
 (define (lex-flag flag-rx-res loc) (lex-rx-res flag-rx-res 'FLAG loc))
@@ -495,7 +498,7 @@ string with the read characters."
 
 (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))
+(define (lex-lib lib-rx-res loc) (lex-rx-res lib-rx-res 'LIB loc 2))
 
 (define (lex-else loc) (make-lexical-token 'ELSE loc #f))
 
@@ -599,7 +602,7 @@ the current port location."
      ((is-common s) => (cut lex-common <> loc))
      ((is-custom-setup s) => (cut lex-custom-setup <> loc))
      ((is-benchmark s) => (cut lex-benchmark <> loc))
-     ((is-lib s) (lex-lib loc))
+     ((is-lib s) => (cut lex-lib <> loc))
      (else (unread-string s port) #f))))
 
 (define (lex-property port loc)
@@ -729,8 +732,9 @@ If #f use the function 'port-filename' to obtain it."
   (dependencies cabal-executable-dependencies)) ; list of <cabal-dependency>
 
 (define-record-type <cabal-library>
-  (make-cabal-library dependencies)
+  (make-cabal-library name dependencies)
   cabal-library?
+  (name cabal-library-name)
   (dependencies cabal-library-dependencies)) ; list of <cabal-dependency>
 
 (define-record-type <cabal-test-suite>
@@ -861,9 +865,6 @@ the ordering operation and the version."
        (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)))
       (('section type name parameters)
        (list 'section type name (eval parameters)))
       (((? string? name) values)
@@ -923,6 +924,8 @@ pertaining to SECTION-TYPE sections.  SECTION-TYPE must be one of:
                                             name
                                             (lookup-join parameters "type")
                                             (lookup-join parameters "location")))
+                      ((library) (make-cabal-library name
+                                                     (dependencies parameters)))
                       ((flag)
                        (let* ((default (lookup-join parameters "default"))
                               (default-true-or-false
@@ -939,8 +942,6 @@ pertaining to SECTION-TYPE sections.  SECTION-TYPE must be one of:
                                           default-true-or-false
                                           manual-true-or-false)))
                       (else #f)))
-                   (('section (? (cut equal? <> section-type) lib) parameters)
-                    (make-cabal-library (dependencies parameters)))
                    (_ #f))
               sexp))
 
diff --git a/tests/hackage.scm b/tests/hackage.scm
index d7ecd0cc21..85a5c2115c 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -172,6 +172,15 @@ common defaults
     }
 ")
 
+;; Test library with (since Cabal 2.0) and without names.
+(define test-read-cabal-library-name
+  "name: test-me
+library foobar
+    build-depends: foo, bar
+library
+    build-depends: bar, baz
+")
+
 (test-begin "hackage")
 
 (define-syntax-rule (define-package-matcher name pattern)
@@ -507,7 +516,7 @@ executable cabal
 (test-assert "read-cabal test 1"
   (match (call-with-input-string test-read-cabal-1 read-cabal)
     ((("name" ("test-me"))
-      ('section 'library
+      ('section 'library #f
                 (('if ('flag "base4point8")
                       (("build-depends" ("base >= 4.8 && < 5")))
                       (('if ('flag "base4")
@@ -543,6 +552,16 @@ executable cabal
      #t)
     (x (pk 'fail x #f))))
 
+(test-assert "read-cabal test: library name"
+  (match (call-with-input-string test-read-cabal-library-name read-cabal)
+    ((("name" ("test-me"))
+        ('section 'library "foobar"
+          (("build-depends" ("foo, bar"))))
+        ('section 'library #f
+          (("build-depends" ("bar, baz")))))
+     #t)
+    (x (pk 'fail x #f))))
+
 (define test-cabal-import
   "name: foo
 version: 1.0.0