diff options
Diffstat (limited to 'guix/import/hackage.scm')
-rw-r--r-- | guix/import/hackage.scm | 703 |
1 files changed, 82 insertions, 621 deletions
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 1b27803dba..b5574a8d9f 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -18,28 +18,19 @@ (define-module (guix import hackage) #:use-module (ice-9 match) - #:use-module (ice-9 regex) - #:use-module (ice-9 rdelim) - #:use-module (ice-9 receive) - #:use-module (ice-9 pretty-print) #:use-module (srfi srfi-26) - #:use-module (srfi srfi-34) - #:use-module (srfi srfi-35) #:use-module (srfi srfi-11) #:use-module (srfi srfi-1) #:use-module ((guix download) #:select (download-to-store)) #:use-module ((guix utils) #:select (package-name->name+version)) #:use-module (guix import utils) + #:use-module (guix import cabal) #:use-module (guix store) #:use-module (guix hash) #:use-module (guix base32) #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:export (hackage->guix-package)) -;; Part 1: -;; -;; Functions used to read a Cabal file. - (define ghc-standard-libraries ;; List of libraries distributed with ghc (7.8.4). We include GHC itself as ;; some packages list it. @@ -75,588 +66,12 @@ (define package-name-prefix "ghc-") -(define key-value-rx - ;; Regular expression matching "key: value" - (make-regexp "([a-zA-Z0-9-]+):[ \t]*(\\w?.*)$")) - -(define sections-rx - ;; Regular expression matching a section "head sub-head ..." - (make-regexp "([a-zA-Z0-9\\(\\)-]+)")) - -(define comment-rx - ;; Regexp matching Cabal comment lines. - (make-regexp "^ *--")) - -(define (has-key? line) - "Check if LINE includes a key." - (regexp-exec key-value-rx line)) - -(define (comment-line? line) - "Check if LINE is a comment line." - (regexp-exec comment-rx line)) - -(define (line-indentation+rest line) - "Returns two results: The number of indentation spaces and the rest of the -line (without indentation)." - (let loop ((line-lst (string->list line)) - (count 0)) - ;; Sometimes values are spread over multiple lines and new lines start - ;; with a comma ',' with the wrong indentation. See e.g. haddock-api. - (if (or (null? line-lst) - (not (or - (eqv? (first line-lst) #\space) - (eqv? (first line-lst) #\,) ; see, e.g., haddock-api.cabal - (eqv? (first line-lst) #\tab)))) - (values count (list->string line-lst)) - (loop (cdr line-lst) (+ count 1))))) - -(define (multi-line-value lines seed) - "Function to read a value split across multiple lines. LINES are the -remaining input lines to be read. SEED is the value read on the same line as -the key. Return two values: A list with values and the remaining lines to be -processed." - (define (multi-line-value-with-min-indent lines seed min-indent) - (if (null? lines) - (values '() '()) - (let-values (((current-indent value) (line-indentation+rest (first lines))) - ((next-line-indent next-line-value) - (if (null? (cdr lines)) - (values #f "") - (line-indentation+rest (second lines))))) - (if (or (not next-line-indent) (< next-line-indent min-indent) - (regexp-exec condition-rx next-line-value)) - (values (reverse (cons value seed)) (cdr lines)) - (multi-line-value-with-min-indent (cdr lines) (cons value seed) - min-indent))))) - - (let-values (((current-indent value) (line-indentation+rest (first lines)))) - (multi-line-value-with-min-indent lines seed current-indent))) - -(define (read-cabal port) - "Parses a Cabal file from PORT. Return a list of list pairs: - -(((head1 sub-head1 ... key1) (value)) - ((head2 sub-head2 ... key2) (value2)) - ...). - -We try do deduce the Cabal format from the following document: -https://www.haskell.org/cabal/users-guide/developing-packages.html - -Keys are case-insensitive. We therefore lowercase them. Values are -case-sensitive. Currently only indentation-structured files are parsed. -Braces structured files are not handled." ;" <- make emacs happy. - (define (read-and-trim-line port) - (let ((line (read-line port))) - (if (string? line) - (string-trim-both line #\return) - line))) - - (define (strip-insignificant-lines port) - (let loop ((line (read-and-trim-line port)) - (result '())) - (cond - ((eof-object? line) - (reverse result)) - ((or (string-null? line) (comment-line? line)) - (loop (read-and-trim-line port) result)) - (else - (loop (read-and-trim-line port) (cons line result)))))) - - (let loop - ((lines (strip-insignificant-lines port)) - (indents '()) ; only includes indents at start of section heads. - (sections '()) - (result '())) - (let-values - (((current-indent line) - (if (null? lines) - (values 0 "") - (line-indentation+rest (first lines)))) - ((next-line-indent next-line) - (if (or (null? lines) (null? (cdr lines))) - (values 0 "") - (line-indentation+rest (second lines))))) - (if (null? lines) - (reverse result) - (let ((rx-result (has-key? line))) - (cond - (rx-result - (let ((key (string-downcase (match:substring rx-result 1))) - (value (match:substring rx-result 2))) - (cond - ;; Simple single line "key: value". - ((= next-line-indent current-indent) - (loop (cdr lines) indents sections - (cons - (list (reverse (cons key sections)) (list value)) - result))) - ;; Multi line "key: value\n value cont...". - ((> next-line-indent current-indent) - (let*-values (((value-lst lines) - (multi-line-value (cdr lines) - (if (string-null? value) - '() - `(,value))))) - ;; multi-line-value returns to the first line after the - ;; multi-value. - (loop lines indents sections - (cons - (list (reverse (cons key sections)) value-lst) - result)))) - ;; Section ended. - (else - ;; Indentation is reduced. Check by how many levels. - (let* ((idx (and=> (list-index - (lambda (x) (= next-line-indent x)) - indents) - (cut + <> - (if (has-key? next-line) 1 0)))) - (sec - (if idx - (drop sections idx) - (raise - (condition - (&message - (message "unable to parse Cabal file")))))) - (ind (drop indents idx))) - (loop (cdr lines) ind sec - (cons - (list (reverse (cons key sections)) (list value)) - result))))))) - ;; Start of a new section. - ((or (null? indents) - (> current-indent (first indents))) - (loop (cdr lines) (cons current-indent indents) - (cons (string-downcase line) sections) result)) - (else - (loop (cdr lines) indents - (cons (string-downcase line) (cdr sections)) - result)))))))) - -(define condition-rx - ;; Regexp for conditionals. - (make-regexp "^if +(.*)$")) - -(define (split-section section) - "Split SECTION in individual words with exception for the predicate of an -'if' conditional." - (let ((rx-result (regexp-exec condition-rx section))) - (if rx-result - `("if" ,(match:substring rx-result 1)) - (map match:substring (list-matches sections-rx section))))) - -(define (join-sections sec1 sec2) - (fold-right cons sec2 sec1)) - -(define (pre-process-keys key) - (match key - (() '()) - ((sec1 rest ...) - (join-sections (split-section sec1) (pre-process-keys rest))))) - -(define (pre-process-entry-keys entry) - (match entry - ((key value) - (list (pre-process-keys key) value)) - (() '()))) - -(define (pre-process-entries-keys entries) - "ENTRIES is a list of list pairs, a keys list and a valules list, as -produced by 'read-cabal'. Split each element of the keys list into individual -words. This pre-processing is used to read flags." - (match entries - ((entry rest ...) - (cons (pre-process-entry-keys entry) - (pre-process-entries-keys rest))) - (() - '()))) - -(define (get-flags pre-processed-entries) - "PRE-PROCESSED-ENTRIES is a list of list pairs, a keys list and a values -list, as produced by 'read-cabal' and pre-processed by -'pre-process-entries-keys'. Return a list of pairs with the name of flags and -their default value (one of \"False\" or \"True\") as specified in the Cabal file: - -((\"flag1-name\" . \"False-or-True\") ...)." ;" <- make emacs happy - (match pre-processed-entries - (() '()) - (((("flag" flag-name "default") (flag-val)) rest ...) - (cons (cons flag-name flag-val) - (get-flags rest))) - ((entry rest ... ) - (get-flags rest)) - (_ #f))) - -;; Part 2: -;; -;; Functions to read information from the Cabal object created by 'read-cabal' -;; and convert Cabal format dependencies conditionals into equivalent -;; S-expressions. - -(define tests-rx - ;; Cabal test keywords - (make-regexp "(os|arch|flag|impl) *\\(([ a-zA-Z0-9_.<>=-]+)\\)")) - -(define parens-rx - ;; Parentheses within conditions - (make-regexp "\\((.+)\\)")) - -(define or-rx - ;; OR operator in conditions - (make-regexp " +\\|\\| +")) - -(define and-rx - ;; AND operator in conditions - (make-regexp " +&& +")) - -(define not-rx - ;; NOT operator in conditions - (make-regexp "^!.+")) - -(define (bi-op-args str match-lst) - "Return a list with the arguments of (logic) bianry operators. MATCH-LST -is the result of 'list-match' against a binary operator regexp on STR." - (let ((operators (length match-lst))) - (map (lambda (from to) - (substring str from to)) - (cons 0 (map match:end match-lst)) - (append (map match:start match-lst) (list (string-length str)))))) - -(define (bi-op->sexp-like bi-op args) - "BI-OP is a string with the name of a Scheme operator which in a Cabal file -is represented by a binary operator. ARGS are the arguments of said operator. -Return a string representing an S-expression of the operator applied to its -arguments." - (if (= (length args) 1) - (first args) - (string-append "(" bi-op - (fold (lambda (arg seed) (string-append seed " " arg)) - "" args) ")"))) - -(define (not->sexp-like arg) - "If the string ARG is prefixed by a Cabal negation operator, convert it to -an equivalent Scheme S-expression string." - (if (regexp-exec not-rx arg) - (string-append "(not " - (substring arg 1 (string-length arg)) - ")") - arg)) - -(define (parens-less-cond->sexp-like conditional) - "Convert a Cabal CONDITIONAL string into a string with equivalent Scheme -syntax. This procedure accepts only simple conditionals without parentheses." - ;; The outher operation is the one with the lowest priority: OR - (bi-op->sexp-like - "or" - ;; each OR argument may be an AND operation - (map (lambda (or-arg) - (let ((m-lst (list-matches and-rx or-arg))) - ;; is there an AND operation? - (if (> (length m-lst) 0) - (bi-op->sexp-like - "and" - ;; expand NOT operators when there are ANDs - (map not->sexp-like (bi-op-args or-arg m-lst))) - ;; ... and when there aren't. - (not->sexp-like or-arg)))) - ;; list of OR arguments - (bi-op-args conditional (list-matches or-rx conditional))))) - -(define test-keyword-ornament "__") - -(define (conditional->sexp-like conditional) - "Convert a Cabal CONDITIONAL string into a string with equivalent Scheme -syntax." - ;; First we substitute TEST-KEYWORD-ORNAMENT for parentheses around tests - ;; keywords so that parentheses are only used to set precedences. This - ;; substantially simplify parsing. - (let ((conditional - (regexp-substitute/global #f tests-rx conditional - 'pre 1 test-keyword-ornament 2 - test-keyword-ornament 'post))) - (let loop ((sub-cond conditional)) - (let ((rx-result (regexp-exec parens-rx sub-cond))) - (cond - (rx-result - (parens-less-cond->sexp-like - (string-append - (match:prefix rx-result) - (loop (match:substring rx-result 1)) - (match:suffix rx-result)))) - (else - (parens-less-cond->sexp-like sub-cond))))))) - -(define (eval-flags sexp-like-cond flags) - "SEXP-LIKE-COND is a string representing an S-expression conditional. FLAGS -is a list of flag name and value pairs as produced by 'get-flags'. Substitute -\"#t\" or \"#f\" according to the value of flags. (Default to \"True\")." - (fold-right - (lambda (flag sexp) - (match flag - ((name . value) - (let ((rx (make-regexp - (string-append "flag" test-keyword-ornament name - test-keyword-ornament)))) - (regexp-substitute/global - #f rx sexp - 'pre (if (string-ci= value "False") "#f" "#t") 'post))) - (_ sexp))) - sexp-like-cond - (cons '("[a-zA-Z0-9_-]+" . "True") flags))) - -(define (eval-tests->sexp sexp-like-cond) - "In the string SEXP-LIKE-COND substitute test keywords \"os(...)\" and -\"arch(...)\" with equivalent Scheme checks. Retrun an S-expression." - (with-input-from-string - (fold-right - (lambda (test sexp) - (match test - ((type pre-match post-match) - (let ((rx (make-regexp - (string-append type test-keyword-ornament "(\\w+)" - test-keyword-ornament)))) - (regexp-substitute/global - #f rx sexp - 'pre pre-match 2 post-match 'post))) - (_ sexp))) - sexp-like-cond - ;; (%current-system) returns, e.g., "x86_64-linux" or "i686-linux". - '(("(os|arch)" "(string-match \"" "\" (%current-system))"))) - read)) - -(define (eval-impl sexp-like-cond) - "Check for the Cabal test \"impl(...)\" in the string SEXP-LIKE-COND. -Assume the module declaring the generated package includes a local variable -called \"haskell-implementation\" with a string value of the form NAME-VERSION -against which we compare." - (with-output-to-string - (lambda () - (write - (with-input-from-string - (fold-right - (lambda (test sexp) - (match test - ((pre-match post-match) - (let ((rx-with-version - (make-regexp - (string-append - "impl" test-keyword-ornament - "([a-zA-Z0-9_-]+) *([<>=]+) *([0-9.]+) *" - test-keyword-ornament))) - (rx-without-version - (make-regexp - (string-append "impl" test-keyword-ornament "(\\w+)" - test-keyword-ornament)))) - (if (regexp-exec rx-with-version sexp) - (regexp-substitute/global - #f rx-with-version sexp - 'pre pre-match 2 " " post-match " \"" 1 "-" 3 "\")" 'post) - (regexp-substitute/global - #f rx-without-version sexp - 'pre pre-match "-match \"" 1 "\" " post-match ")" 'post)))) - (_ sexp))) - sexp-like-cond - '(("(string" "haskell-implementation"))) - read))))) - -(define (eval-cabal-keywords sexp-like-cond flags) - ((compose eval-tests->sexp eval-impl (cut eval-flags <> flags)) - sexp-like-cond)) - -(define (key->values meta key) - "META is the representation of a Cabal file as produced by 'read-cabal'. -Return the list of values associated with a specific KEY (a string)." - (match meta - (() '()) - (((((? (lambda(x) (equal? x key)))) v) r ...) - v) - (((k v) r ...) - (key->values (cdr meta) key)) - (_ "key Not fount"))) - -(define (key-start-end->entries meta key-start-rx key-end-rx) - "META is the representation of a Cabal file as produced by 'read-cabal'. -Return all entries whose keys list starts with KEY-START and ends with -KEY-END." - (let ((pred - (lambda (x) - (and (regexp-exec key-start-rx (first x)) - (regexp-exec key-end-rx (last x)))))) - ;; (equal? (list key-start key-end) (list (first x) (last x)))))) - (match meta - (() '()) - ((((? pred k) v) r ...) - (cons `(,k ,v) - (key-start-end->entries (cdr meta) key-start-rx key-end-rx))) - (((k v) r ...) - (key-start-end->entries (cdr meta) key-start-rx key-end-rx)) - (_ "key Not fount")))) - -(define else-rx - (make-regexp "^else$")) - -(define (count-if-else rx-result-ls) - (apply + (map (lambda (m) (if m 1 0)) rx-result-ls))) - -(define (analyze-entry-cond entry) - (let* ((keys (first entry)) - (vals (second entry)) - (rx-cond-result - (map (cut regexp-exec condition-rx <>) keys)) - (rx-else-result - (map (cut regexp-exec else-rx <>) keys)) - (cond-no (count-if-else rx-cond-result)) - (else-no (count-if-else rx-else-result)) - (cond-idx (list-index (lambda (rx) (if rx #t #f)) rx-cond-result)) - (else-idx (list-index (lambda (rx) (if rx #t #f)) rx-else-result)) - (key-cond - (cond - ((or (and cond-idx else-idx (< cond-idx else-idx)) - (and cond-idx (not else-idx))) - (match:substring - (receive (head tail) - (split-at rx-cond-result cond-idx) (first tail)))) - ((or (and cond-idx else-idx (> cond-idx else-idx)) - (and (not cond-idx) else-idx)) - (match:substring - (receive (head tail) - (split-at rx-else-result else-idx) (first tail)))) - (else - "")))) - (values keys vals rx-cond-result - rx-else-result cond-no else-no key-cond))) - -(define (remove-cond entry cond) - (match entry - ((k v) - (list (cdr (member cond k)) v)))) - -(define (group-and-reduce-level entries group group-cond) - (let loop - ((true-group group) - (false-group '()) - (entries entries)) - (if (null? entries) - (values (reverse true-group) (reverse false-group) entries) - (let*-values (((entry) (first entries)) - ((keys vals rx-cond-result rx-else-result - cond-no else-no key-cond) - (analyze-entry-cond entry))) - (cond - ((and (>= (+ cond-no else-no) 1) (string= group-cond key-cond)) - (loop (cons (remove-cond entry group-cond) true-group) false-group - (cdr entries))) - ((and (>= (+ cond-no else-no) 1) (string= key-cond "else")) - (loop true-group (cons (remove-cond entry "else") false-group) - (cdr entries))) - (else - (values (reverse true-group) (reverse false-group) entries))))))) - -(define dependencies-rx - (make-regexp "([a-zA-Z0-9_-]+) *[^,]*,?")) - (define (hackage-name->package-name name) + "Given the NAME of a Cabal package, return the corresponding Guix name." (if (string-prefix? package-name-prefix name) (string-downcase name) (string-append package-name-prefix (string-downcase name)))) -(define (split-and-filter-dependencies ls names-to-filter) - "Split the comma separated list of dependencies LS coming from the Cabal -file, filter packages included in NAMES-TO-FILTER and return a list with -inputs suitable for the Guix package. Currently the version information is -discarded." - (define (split-at-comma-and-filter d) - (fold - (lambda (m seed) - (let* ((name (string-downcase (match:substring m 1))) - (pkg-name (hackage-name->package-name name))) - (if (member name names-to-filter) - seed - (cons (list pkg-name (list 'unquote (string->symbol pkg-name))) - seed)))) - '() - (list-matches dependencies-rx d))) - - (fold (lambda (d p) (append (split-at-comma-and-filter d) p)) '() ls)) - -(define* (dependencies-cond->sexp meta #:key (include-test-dependencies? #t)) - "META is the representation of a Cabal file as produced by 'read-cabal'. -Return an S-expression containing the list of dependencies as expected by the -'inputs' field of a package. The generated S-expressions may include -conditionals as defined in the cabal file. During this process we discard the -version information of the packages." - (define (take-dependencies meta) - (let ((key-start-exe (make-regexp "executable")) - (key-start-lib (make-regexp "library")) - (key-start-tests (make-regexp "test-suite")) - (key-end (make-regexp "build-depends"))) - (append - (key-start-end->entries meta key-start-exe key-end) - (key-start-end->entries meta key-start-lib key-end) - (if include-test-dependencies? - (key-start-end->entries meta key-start-tests key-end) - '())))) - - (let ((flags (get-flags (pre-process-entries-keys meta))) - (augmented-ghc-std-libs (append (key->values meta "name") - ghc-standard-libraries))) - (delete-duplicates - (let loop ((entries (take-dependencies meta)) - (result '())) - (if (null? entries) - (reverse result) - (let*-values (((entry) (first entries)) - ((keys vals rx-cond-result rx-else-result - cond-no else-no key-cond) - (analyze-entry-cond entry))) - (cond - ((= (+ cond-no else-no) 0) - (loop (cdr entries) - (append - (split-and-filter-dependencies vals - augmented-ghc-std-libs) - result))) - (else - (let-values (((true-group false-group entries) - (group-and-reduce-level entries '() - key-cond)) - ((cond-final) (eval-cabal-keywords - (conditional->sexp-like - (last (split-section key-cond))) - flags))) - (loop entries - (cond - ((or (eq? cond-final #t) (equal? cond-final '(not #f))) - (append (loop true-group '()) result)) - ((or (eq? cond-final #f) (equal? cond-final '(not #t))) - (append (loop false-group '()) result)) - (else - (let ((true-group-result (loop true-group '())) - (false-group-result (loop false-group '()))) - (cond - ((and (null? true-group-result) - (null? false-group-result)) - result) - ((null? false-group-result) - (cons `(unquote-splicing - (when ,cond-final ,true-group-result)) - result)) - ((null? true-group-result) - (cons `(unquote-splicing - (unless ,cond-final ,false-group-result)) - result)) - (else - (cons `(unquote-splicing - (if ,cond-final - ,true-group-result - ,false-group-result)) - result)))))))))))))))) - -;; Part 3: -;; -;; Retrive the desired package and its Cabal file from -;; http://hackage.haskell.org and construct the Guix package S-expression. - (define (hackage-fetch name-version) "Return the Cabal file for the package NAME-VERSION, or #f on failure. If the version part is omitted from the package name, then return the latest @@ -696,33 +111,63 @@ version." ((lst ...) `(list ,@(map string->license lst))) (_ #f))) -(define* (hackage-module->sexp meta #:key (include-test-dependencies? #t)) - "Return the `package' S-expression for a Cabal package. META is the + +(define (cabal-dependencies->names cabal include-test-dependencies?) + "Return the list of dependencies names from the CABAL package object. If +INCLUDE-TEST-DEPENDENCIES? is #f, do not include dependencies required by test +suites." + (let* ((lib (cabal-package-library cabal)) + (lib-deps (if (pair? lib) + (map cabal-dependency-name + (append-map cabal-library-dependencies lib)) + '())) + (exe (cabal-package-executables cabal)) + (exe-deps (if (pair? exe) + (map cabal-dependency-name + (append-map cabal-executable-dependencies exe)) + '())) + (ts (cabal-package-test-suites cabal)) + (ts-deps (if (pair? ts) + (map cabal-dependency-name + (append-map cabal-test-suite-dependencies ts)) + '()))) + (if include-test-dependencies? + (delete-duplicates (append lib-deps exe-deps ts-deps)) + (delete-duplicates (append lib-deps exe-deps))))) + +(define (filter-dependencies dependencies own-name) + "Filter the dependencies included with the GHC compiler from DEPENDENCIES, a +list with the names of dependencies. OWN-NAME is the name of the Cabal +package being processed and is used to filter references to itself." + (filter (lambda (d) (not (member (string-downcase d) + (cons own-name ghc-standard-libraries)))) + dependencies)) + +(define* (hackage-module->sexp cabal #:key (include-test-dependencies? #t)) + "Return the `package' S-expression for a Cabal package. CABAL is the representation of a Cabal file as produced by 'read-cabal'." (define name - (first (key->values meta "name"))) + (cabal-package-name cabal)) (define version - (first (key->values meta "version"))) - - (define description - (let*-values (((description) (key->values meta "description")) - ((lines last) - (split-at description (- (length description) 1)))) - (fold-right (lambda (line seed) (string-append line "\n" seed)) - (first last) lines))) + (cabal-package-version cabal)) (define source-url (string-append "http://hackage.haskell.org/package/" name "/" name "-" version ".tar.gz")) - ;; Several packages do not have an official home-page other than on Hackage. - (define home-page - (let ((home-page-entry (key->values meta "homepage"))) - (if (null? home-page-entry) - (string-append "http://hackage.haskell.org/package/" name) - (first home-page-entry)))) + (define dependencies + (let ((names + (map hackage-name->package-name + ((compose (cut filter-dependencies <> + (cabal-package-name cabal)) + (cut cabal-dependencies->names <> + include-test-dependencies?)) + cabal)))) + (map (lambda (name) + (list name (list 'unquote (string->symbol name)))) + names))) (define (maybe-inputs input-type inputs) (match inputs @@ -732,6 +177,11 @@ representation of a Cabal file as produced by 'read-cabal'." (list (list input-type (list 'quasiquote inputs)))))) + (define (maybe-arguments) + (if (not include-test-dependencies?) + '((arguments `(#:tests? #f))) + '())) + (let ((tarball (with-store store (download-to-store store source-url)))) `(package @@ -746,22 +196,33 @@ representation of a Cabal file as produced by 'read-cabal'." (bytevector->nix-base32-string (file-sha256 tarball)) "failed to download tar archive"))))) (build-system haskell-build-system) - ,@(maybe-inputs 'inputs - (dependencies-cond->sexp meta - #:include-test-dependencies? - include-test-dependencies?)) - (home-page ,home-page) - (synopsis ,@(key->values meta "synopsis")) - (description ,description) - (license ,(string->license (key->values meta "license")))))) - -(define* (hackage->guix-package module-name - #:key (include-test-dependencies? #t)) - "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, and return -the `package' S-expression corresponding to that package, or #f on failure." - (let ((module-meta (hackage-fetch module-name))) - (and=> module-meta (cut hackage-module->sexp <> - #:include-test-dependencies? - include-test-dependencies?)))) + ,@(maybe-inputs 'inputs dependencies) + ,@(maybe-arguments) + (home-page ,(cabal-package-home-page cabal)) + (synopsis ,(cabal-package-synopsis cabal)) + (description ,(cabal-package-description cabal)) + (license ,(string->license (cabal-package-license cabal)))))) + +(define* (hackage->guix-package package-name #:key + (include-test-dependencies? #t) + (port #f) + (cabal-environment '())) + "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the +called with keyword parameter PORT, from PORT. Return the `package' +S-expression corresponding to that package, or #f on failure. +CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal +conditionals are evaluated. The accepted keys are: \"os\", \"arch\", \"impl\" +and the name of a flag. The value associated with a flag has to be either the +symbol 'true' or 'false'. The value associated with other keys has to conform +to the Cabal file format definition. The default value associated with the +keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\" +respectively." + (let ((cabal-meta (if port + (read-cabal port) + (hackage-fetch package-name)))) + (and=> cabal-meta (compose (cut hackage-module->sexp <> + #:include-test-dependencies? + include-test-dependencies?) + (cut eval-cabal <> cabal-environment))))) ;;; cabal.scm ends here |