stackage.scm 7.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
  3. ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
  4. ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
  5. ;;; Copyright © 2021 Xinglu Chem <public@yoctocell.xyz>
  6. ;;; Copyright © 2021, 2023, 2023 Ludovic Courtès <ludo@gnu.org>
  7. ;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
  8. ;;;
  9. ;;; This file is part of GNU Guix.
  10. ;;;
  11. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  12. ;;; under the terms of the GNU General Public License as published by
  13. ;;; the Free Software Foundation; either version 3 of the License, or (at
  14. ;;; your option) any later version.
  15. ;;;
  16. ;;; GNU Guix is distributed in the hope that it will be useful, but
  17. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19. ;;; GNU General Public License for more details.
  20. ;;;
  21. ;;; You should have received a copy of the GNU General Public License
  22. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  23. (define-module (guix import stackage)
  24. #:use-module (ice-9 match)
  25. #:use-module (json)
  26. #:use-module (srfi srfi-1)
  27. #:use-module (srfi srfi-34)
  28. #:use-module (srfi srfi-35)
  29. #:use-module (guix import json)
  30. #:use-module (guix import hackage)
  31. #:autoload (guix import cabal) (eval-cabal)
  32. #:use-module (guix import utils)
  33. #:use-module (guix memoization)
  34. #:use-module (guix packages)
  35. #:use-module (guix upstream)
  36. #:use-module (guix diagnostics)
  37. #:use-module (guix i18n)
  38. #:export (%stackage-url
  39. stackage->guix-package
  40. stackage-recursive-import
  41. %stackage-updater))
  42. ;;;
  43. ;;; Stackage info fetcher and access functions
  44. ;;;
  45. (define %stackage-url
  46. (make-parameter "https://www.stackage.org"))
  47. ;; Latest LTS version compatible with current GHC.
  48. (define %default-lts-version "20.5")
  49. (define-json-mapping <stackage-lts> make-stackage-lts
  50. stackage-lts?
  51. json->stackage-lts
  52. (snapshot stackage-lts-snapshot "snapshot" json->snapshot)
  53. (packages stackage-lts-packages "packages"
  54. (lambda (vector)
  55. (map json->stackage-package (vector->list vector)))))
  56. (define-json-mapping <snapshot> make-snapshot
  57. stackage-snapshot?
  58. json->snapshot
  59. (name snapshot-name)
  60. (ghc-version snapshot-ghc-version)
  61. (compiler snapshot-compiler))
  62. (define-json-mapping <stackage-package> make-stackage-package
  63. stackage-package?
  64. json->stackage-package
  65. (origin stackage-package-origin)
  66. (name stackage-package-name)
  67. (version stackage-package-version)
  68. (synopsis stackage-package-synopsis))
  69. (define stackage-lts-info-fetch
  70. ;; "Retrieve the information about the LTS Stackage release VERSION."
  71. (memoize
  72. (lambda* (#:optional (version ""))
  73. (let* ((url (string-append (%stackage-url)
  74. "/lts-" (if (string-null? version)
  75. %default-lts-version
  76. version)))
  77. (lts-info (and=> (json-fetch url) json->stackage-lts)))
  78. (or lts-info
  79. (raise (formatted-message (G_ "LTS release version not found: ~a")
  80. version)))))))
  81. (define (lts-package-version packages name)
  82. "Return the version of the package with upstream NAME included in PACKAGES."
  83. (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name))
  84. packages)))
  85. (stackage-package-version pkg)))
  86. ;;;
  87. ;;; Importer entry point
  88. ;;;
  89. (define (hackage-name-version name version)
  90. (and version (string-append name "@" version)))
  91. (define stackage->guix-package
  92. (memoize
  93. (lambda* (package-name ; upstream name
  94. #:key
  95. (include-test-dependencies? #t)
  96. (lts-version %default-lts-version)
  97. (packages
  98. (stackage-lts-packages
  99. (stackage-lts-info-fetch lts-version)))
  100. #:allow-other-keys)
  101. "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org. The retrieved
  102. version corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION
  103. release at stackage.org. Return the `package' S-expression corresponding to
  104. that package, or #f on failure. PACKAGES-INFO is the alist with the packages
  105. included in the Stackage LTS release."
  106. (let* ((version (lts-package-version packages package-name))
  107. (name-version (hackage-name-version package-name version)))
  108. (if name-version
  109. (hackage->guix-package name-version
  110. #:include-test-dependencies?
  111. include-test-dependencies?)
  112. (raise (formatted-message (G_ "~a: Stackage package not found")
  113. package-name)))))))
  114. (define (stackage-recursive-import package-name . args)
  115. (recursive-import package-name
  116. #:repo->guix-package (lambda* (name #:key version #:allow-other-keys)
  117. (apply stackage->guix-package (cons name args)))
  118. #:guix-name hackage-name->package-name))
  119. ;;;
  120. ;;; Updater
  121. ;;;
  122. (define latest-lts-release
  123. (let ((packages
  124. (mlambda ()
  125. (stackage-lts-packages
  126. (stackage-lts-info-fetch %default-lts-version)))))
  127. (lambda* (pkg #:key (version #f))
  128. "Return an <upstream-source> for the latest Stackage LTS release of
  129. PACKAGE or #f if the package is not included in the Stackage LTS release."
  130. (when version
  131. (raise
  132. (formatted-message
  133. (G_ "~a updater doesn't support updating to a specific version, sorry.")
  134. "stackage")))
  135. (let* ((hackage-name (package-upstream-name* pkg))
  136. (version (lts-package-version (packages) hackage-name))
  137. (name-version (hackage-name-version hackage-name version)))
  138. (match (and=> name-version hackage-fetch)
  139. (#f
  140. (warning (G_ "failed to parse ~a~%")
  141. (hackage-cabal-url hackage-name))
  142. #f)
  143. (_ (let ((url (hackage-source-url hackage-name version))
  144. (cabal (eval-cabal (hackage-fetch hackage-name) '())))
  145. (upstream-source
  146. (package (package-name pkg))
  147. (version version)
  148. (urls (list url))
  149. (inputs (cabal-package-inputs cabal))))))))))
  150. (define (stackage-lts-package? package)
  151. "Return whether PACKAGE is available on the default Stackage LTS release."
  152. (and (hackage-package? package)
  153. (false-if-networking-error
  154. (let ((packages (stackage-lts-packages
  155. (stackage-lts-info-fetch %default-lts-version)))
  156. (hackage-name (package-upstream-name* package)))
  157. (find (lambda (package)
  158. (string=? (stackage-package-name package) hackage-name))
  159. packages)))))
  160. (define %stackage-updater
  161. (upstream-updater
  162. (name 'stackage)
  163. (description "Updater for Stackage LTS packages")
  164. (pred stackage-lts-package?)
  165. (import latest-lts-release)))
  166. ;;; stackage.scm ends here