compile-as-derivation.scm 2.5 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. ;; Build Guix using Guix.
  19. (use-modules (srfi srfi-26))
  20. ;; Add ~/.config/guix/current to the search path.
  21. (eval-when (expand load eval)
  22. (and=> (or (getenv "XDG_CONFIG_HOME")
  23. (and=> (getenv "HOME")
  24. (cut string-append <> "/.config/guix/current")))
  25. (lambda (current)
  26. (set! %load-path
  27. (cons (string-append current "/share/guile/site/"
  28. (effective-version))
  29. %load-path))
  30. (set! %load-compiled-path
  31. (cons (string-append current "/lib/guile/" (effective-version)
  32. "/site-ccache")
  33. %load-compiled-path)))))
  34. (use-modules (guix) (guix ui)
  35. (guix git-download)
  36. (ice-9 match))
  37. (match (command-line)
  38. ((program source)
  39. (with-error-handling
  40. (with-store store
  41. (let* ((script (string-append source "/build-aux/build-self.scm"))
  42. (build (primitive-load script))
  43. (git? (git-predicate source)))
  44. (run-with-store store
  45. ;; TODO: Extract #:version and #:commit using Guile-Git.
  46. (mlet* %store-monad ((source (interned-file source "guix-source"
  47. #:select? git?
  48. #:recursive? #t))
  49. (drv (build source #:pull-version 1)))
  50. (mbegin %store-monad
  51. (show-what-to-build* (list drv))
  52. (built-derivations (list drv))
  53. (with-monad %store-monad
  54. (display (derivation->output-path drv))
  55. (newline)
  56. (return drv))))))))))