~ruther/guix-local

14dfdf2e0e4d1f18bcc1becf87aef932d5721d91 — Federico Beffa 11 years ago 5868a8b
build-system: Add haskell-build-system.

* guix/build-system/haskell.scm: New file.
* guix/build/haskell-build-system.scm: New file.
* doc/guix.texi: Add section on 'haskell-build-system'.
3 files changed, 374 insertions(+), 0 deletions(-)

M doc/guix.texi
A guix/build-system/haskell.scm
A guix/build/haskell-build-system.scm
M doc/guix.texi => doc/guix.texi +19 -0
@@ 1955,6 1955,25 @@ Python package is used to run the script can be specified with the
@code{#:python} parameter.
@end defvr

@defvr {Scheme Variable} haskell-build-system
This variable is exported by @code{(guix build-system haskell)}.  It
implements the Cabal build procedure used by Haskell packages, which
involves running @code{runhaskell Setup.hs configure
--prefix=/gnu/store/@dots{}} and @code{runhaskell Setup.hs build}.
Instead of installing the package by running @code{runhaskell Setup.hs
install}, to avoid trying to register libraries in the read-only
compiler store directory, the build system uses @code{runhaskell
Setup.hs copy}, followed by @code{runhaskell Setup.hs register}.  In
addition, the build system generates the package documentation by
running @code{runhaskell Setup.hs haddock}, unless @code{#:haddock? #f}
is passed.  Optional Haddock parameters can be passed with the help of
the @code{#:haddock-flags} parameter.  If the file @code{Setup.hs} is
not found, the build system looks for @code{Setup.lhs} instead.

Which Haskell compiler is used can be specified with the @code{#:haskell}
parameter which defaults to @code{ghc}. 
@end defvr

Lastly, for packages that do not need anything as sophisticated, a
``trivial'' build system is provided.  It is trivial in the sense that
it provides basically no support: it does not pull any implicit inputs,

A guix/build-system/haskell.scm => guix/build-system/haskell.scm +135 -0
@@ 0,0 1,135 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system haskell)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-26)
  #:export (haskell-build
            haskell-build-system))

;; Commentary:
;;
;; Standard build procedure for Haskell packages using 'Setup.hs'.  This is
;; implemented as an extension of 'gnu-build-system'.
;;
;; Code:

(define (default-haskell)
  "Return the default Haskell package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((haskell (resolve-interface '(gnu packages haskell))))
    (module-ref haskell 'ghc)))

(define* (lower name
                #:key source inputs native-inputs outputs system target
                (haskell (default-haskell))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:target #:haskell #:inputs #:native-inputs))

  (and (not target)                               ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("haskell" ,haskell)
                         ,@native-inputs))
         (outputs outputs)
         (build haskell-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (haskell-build store name inputs
                        #:key source
                        (haddock? #t)
                        (haddock-flags ''())
                        (tests? #t)
                        (test-target "test")
                        (configure-flags ''())
                        (phases '(@ (guix build haskell-build-system)
                                    %standard-phases))
                        (outputs '("out"))
                        (search-paths '())
                        (system (%current-system))
                        (guile #f)
                        (imported-modules '((guix build haskell-build-system)
                                            (guix build gnu-build-system)
                                            (guix build utils)))
                        (modules '((guix build haskell-build-system)
                                   (guix build utils))))
  "Build SOURCE using HASKELL, and with INPUTS.  This assumes that SOURCE
provides a 'Setup.hs' file as its build system."
  (define builder
    `(begin
       (use-modules ,@modules)
       (haskell-build #:name ,name
                      #:source ,(match (assoc-ref inputs "source")
                                  (((? derivation? source))
                                   (derivation->output-path source))
                                  ((source)
                                   source)
                                  (source
                                   source))
                      #:configure-flags ,configure-flags
                      #:haddock-flags ,haddock-flags
                      #:system ,system
                      #:test-target ,test-target
                      #:tests? ,tests?
                      #:haddock? ,haddock?
                      #:phases ,phases
                      #:outputs %outputs
                      #:search-paths ',(map search-path-specification->sexp
                                            search-paths)
                      #:inputs %build-inputs)))

  (define guile-for-build
    (match guile
      ((? package?)
       (package-derivation store guile system #:graft? #f))
      (#f                                         ; the default
       (let* ((distro (resolve-interface '(gnu packages commencement)))
              (guile  (module-ref distro 'guile-final)))
         (package-derivation store guile system #:graft? #f)))))

  (build-expression->derivation store name builder
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build))

(define haskell-build-system
  (build-system
    (name 'haskell)
    (description "The standard Haskell build system")
    (lower lower)))

;;; haskell.scm ends here

A guix/build/haskell-build-system.scm => guix/build/haskell-build-system.scm +220 -0
@@ 0,0 1,220 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build haskell-build-system)
  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
  #:use-module (guix build utils)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 match)
  #:export (%standard-phases
            haskell-build))

;; Commentary:
;;
;; Builder-side code of the standard Haskell package build procedure.
;;
;; The Haskell compiler, to find libraries, relies on a library database with
;; a binary cache. For GHC the cache has to be named 'package.cache'. If every
;; library would generate the cache at build time, then they would clash in
;; profiles. For this reason we do not generate the cache when we generate
;; libraries substitutes. Instead:
;;
;; - At build time we use the 'setup-compiler' phase to generate a temporary
;;   library database and its cache.
;;
;; - We generate the cache when a profile is created.
;;
;; Code:

;; Directory where we create the temporary libraries database with its cache
;; as required by the compiler.
(define %tmp-db-dir
  (string-append (or (getenv "TMP") "/tmp")
                 "/package.conf.d"))

(define (run-setuphs command params)
  (let ((setup-file (cond
                     ((file-exists? "Setup.hs")
                      "Setup.hs")
                     ((file-exists? "Setup.lhs")
                      "Setup.lhs")
                     (else
                      #f))))
    (if setup-file
        (begin
          (format #t "running \"runhaskell Setup.hs\" with command ~s \
and parameters ~s~%"
                  command params)
          (zero? (apply system* "runhaskell" setup-file command params)))
        (error "no Setup.hs nor Setup.lhs found"))))

(define* (configure #:key outputs inputs tests? (configure-flags '())
                    #:allow-other-keys)
  "Configure a given Haskell package."
  (let* ((out (assoc-ref outputs "out"))
         (input-dirs (match inputs
                       (((_ . dir) ...)
                        dir)
                       (_ '())))
         (params (append `(,(string-append "--prefix=" out))
                         `(,(string-append
                             "--docdir=" out "/share/doc/"
                             (package-name-version out)))
                         `(,(string-append "--package-db=" %tmp-db-dir))
                         '("--global")
                         `(,(string-append
                             "--extra-include-dirs="
                             (list->search-path-as-string
                              (search-path-as-list '("include") input-dirs)
                              ":")))
                         `(,(string-append
                             "--extra-lib-dirs="
                             (list->search-path-as-string
                              (search-path-as-list '("lib") input-dirs)
                              ":")))
                         (if tests?
                             '("--enable-tests")
                             '())
                         configure-flags)))
    (run-setuphs "configure" params)))

(define* (build #:rest empty)
  "Build a given Haskell package."
  (run-setuphs "build" '()))

(define* (install #:rest empty)
  "Install a given Haskell package."
  (run-setuphs "copy" '()))

(define (package-name-version store-dir)
  "Given a store directory STORE-DIR return 'name-version' of the package."
  (let* ((base (basename store-dir)))
    (string-drop base
                 (+ 1 (string-index base #\-)))))

(define (grep rx port)
  "Given a regular-expression RX including a group, read from PORT until the
first match and return the content of the group."
  (let ((line (read-line port)))
    (if (eof-object? line)
        #f
        (let ((rx-result (regexp-exec rx line)))
          (if rx-result
              (match:substring rx-result 1)
              (grep rx port))))))

(define* (setup-compiler #:key system inputs outputs #:allow-other-keys)
  "Setup the compiler environment."
  (let* ((haskell (assoc-ref inputs "haskell"))
         (name-version (package-name-version haskell)))
    (cond
     ((string-match "ghc" name-version)
      (make-ghc-package-database system inputs outputs))
     (else
      (format #t
              "Compiler ~a not supported~%" name-version)))))

(define (make-ghc-package-database system inputs outputs)
  "Generate the GHC package database."
  (let* ((haskell  (assoc-ref inputs "haskell"))
         (input-dirs (match inputs
                       (((_ . dir) ...)
                        dir)
                       (_ '())))
         (conf-dirs (search-path-as-list
                     `(,(string-append "lib/" system "-"
                                       (package-name-version haskell)
                                       "/package.conf.d"))
                     input-dirs))
         (conf-files (append-map (cut find-files <> "\\.conf$") conf-dirs)))
    (mkdir-p %tmp-db-dir)
    (for-each (lambda (file)
                (copy-file file
                           (string-append %tmp-db-dir "/" (basename file))))
              conf-files)
    (zero? (system* "ghc-pkg"
                    (string-append "--package-db=" %tmp-db-dir)
                    "recache"))))

(define* (register #:key name system inputs outputs #:allow-other-keys)
  "Generate the compiler registration file for a given Haskell package.  Don't
generate the cache as it would clash in user profiles."
  (let* ((out (assoc-ref outputs "out"))
         (haskell  (assoc-ref inputs "haskell"))
         (lib (string-append out "/lib"))
         (config-dir (string-append lib "/" system
                                    "-" (package-name-version haskell)
                                    "/package.conf.d"))
         (id-rx (make-regexp "^id: *(.*)$"))
         (lib-rx (make-regexp "lib.*\\.(a|so)"))
         (config-file (string-append config-dir "/" name ".conf"))
         (params
          (list (string-append "--gen-pkg-config=" config-file))))
    (unless (null? (find-files lib lib-rx))
      (mkdir-p config-dir)
      (run-setuphs "register" params)
      (let ((config-file-name+id
             (call-with-ascii-input-file config-file (cut grep id-rx <>))))
        (rename-file config-file
                     (string-append config-dir "/" config-file-name+id
                                    ".conf"))))
    #t))

(define* (check #:key tests? test-target #:allow-other-keys)
  "Run the test suite of a given Haskell package."
  (if tests?
      (run-setuphs test-target '())
      (begin
        (format #t "test suite not run~%")
        #t)))

(define* (haddock #:key outputs haddock? haddock-flags #:allow-other-keys)
  "Run the test suite of a given Haskell package."
  (if haddock?
      (let* ((out (assoc-ref outputs "out"))
             (doc-src (string-append (getcwd) "/dist/doc"))
             (doc-dest (string-append out "/share/doc/"
                                      (package-name-version out))))
        (if (run-setuphs "haddock" haddock-flags)
            (begin
              (copy-recursively doc-src doc-dest)
              #t)
            #f))
      #t))

(define %standard-phases
  (modify-phases gnu:%standard-phases
    (add-before configure setup-compiler setup-compiler)
    (add-after install haddock haddock)
    (add-after install register register)
    (replace install install)
    (replace check check)
    (replace build build)
    (replace configure configure)))

(define* (haskell-build #:key inputs (phases %standard-phases)
                        #:allow-other-keys #:rest args)
  "Build the given Haskell package, applying all of PHASES in order."
  (apply gnu:gnu-build
         #:inputs inputs #:phases phases
         args))

;;; haskell-build-system.scm ends here