;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2023 Pierre-Henry Fröhring <phfrohring@deeplinks.com>
;;;
;;; 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/>.

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

(define-module (guix build-system mix)
  #:use-module (gnu packages base)
  #:use-module (gnu packages elixir)
  #:use-module (gnu packages elixir-xyz)
  #:use-module (gnu packages erlang)
  #:use-module (guix build mix-build-system)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system)
  #:use-module (guix gexp)
  #:use-module (guix monads)
  #:use-module (guix packages)
  #:use-module (guix search-paths)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (mix-build-system hexpm-uri))

(define (hexpm-uri name version)
  "Return the URI where to fetch the sources of a Hex package NAME at VERSION.
See: https://github.com/hexpm/specifications/blob/main/endpoints.md"
  (string-append "https://repo.hex.pm/tarballs/"
                 (string-replace-substring (strip-elixir-prefix name) "-" "_")
                 "-" version ".tar"))

(define glibc-utf8-locales
  (make-glibc-utf8-locales glibc
                           #:locales (list "en_US")
                           #:name "glibc-utf8-locales"))

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

(define imported-modules
  `((guix build mix-build-system)
    ,@%gnu-build-system-modules))

(define modules
  '((guix build mix-build-system)
    (guix build utils)))

;; The prefix of Elixir packages.
(define %elixir-prefix "elixir-")

;; The prefix of Erlang packages.
(define %erlang-prefix "erlang-")

(define (erlang-package? package)
  "Tell whether PACKAGE is an Erlang package."
  (string-prefix? %erlang-prefix (package-name package)))

(define (elixir-package? package)
  "Tell whether PACKAGE is an Elixir package."
  (string-prefix? %elixir-prefix (package-name package)))

(define (erlang-or-elixir-pkg? package)
  "Tell whether PACKAGE is an Elixir or an Erlang package."
  (or (erlang-package? package)
      (elixir-package? package)))

(define (erlang-or-elixir-input? input)
  "Tell whether INPUT is an Elixir or an Erlang input."
  (match input
    ((_ package)
     (erlang-or-elixir-pkg? package))))

(define (input=? input1 input2)
  "Tell whether inputs INPUT1 and INPUT2 are equal."
  (define pkg1 (match input1 ((_ pkg) pkg)))
  (define pkg2 (match input2 ((_ pkg) pkg)))
  (string=? (package-name pkg1) (package-name pkg2)))

;; A number of environment variables specific to the Mix build system are reflected here.
;; They are documented here: https://hexdocs.pm/mix/1.15.7/Mix.html#module-environment-variables.
;; Other parameters located in mix.exs are defined here:
;; https://hexdocs.pm/mix/1.15.7/Mix.Project.html#module-configuration
(define* (mix-build name
                    inputs
                    #:key
                    source
                    elixir-X.Y ;The major and minor of Elixir.
                    (tests? #t)
                    (mix-path #f) ;See MIX_PATH.
                    (mix-exs "mix.exs") ;See MIX_EXS.
                    (build-per-environment #t) ;See :build_per_environment.
                    (phases '%standard-phases)
                    (outputs '("out"))
                    (search-paths '())
                    (system (%current-system))
                    (guile #f)
                    (imported-modules imported-modules)
                    (modules modules))
  "Build SOURCE using Elixir, and with INPUTS."

  ;; Check the documentation of :build_per_environment here:
  ;; https://hexdocs.pm/mix/1.15.7/Mix.Project.html#module-configuration And
  ;; "Environments" here:
  ;; https://hexdocs.pm/mix/1.15.7/Mix.html#module-environments
  (define mix-environments
    (if build-per-environment
        `("prod" ,@(if tests? '("test") '()))
        '("shared")))

  (define builder
    (with-imported-modules imported-modules
      #~(begin

          (use-modules #$@(sexp->gexp modules))

          #$(with-build-variables inputs outputs
              #~(mix-build #:name #$name
                           #:source #+source
                           #:system #$system
                           #:tests? #$tests?
                           #:mix-path #$mix-path
                           #:mix-exs #$mix-exs
                           #:elixir-X.Y #$elixir-X.Y
                           #:mix-environments '#$mix-environments
                           #:build-per-environment #$build-per-environment
                           #:phases #$(if (pair? phases)
                                          (sexp->gexp phases)
                                          phases)
                           #:outputs %outputs
                           #:search-paths '#$(sexp->gexp
                                              (map
                                               search-path-specification->sexp
                                               search-paths))
                           #:inputs
                           %build-inputs)))))

  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                  system
                                                  #:graft? #f)))
    (gexp->derivation name
                      builder
                      #:system system
                      #:graft? #f       ;consistent with 'gnu-build'
                      #:target #f
                      #:guile-for-build guile)))

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

  ;; Libraries are compiled using a given version of Elixir. This fact is
  ;; encoded by the name of a sub-directory like lib/elixir/X.Y. We compute
  ;; the value of X.Y here which is valid for the whole build.
  (define elixir-X.Y (version-major+minor (package-version elixir)))

  ;; Elixir depends on a specific version of Erlang, this one.
  (define erlang (lookup-package-input elixir "erlang"))

  ;; For mix to compile and test a package, it needs to find all inputs,
  ;; native-inputs and propagated-inputs (including the transitive ones) under
  ;; _build directories like _build/prod/lib.
  ;;
  ;; Given inputs and native-inputs of the package, we need to compute the
  ;; transitive closure of all Erlang and Elixir propagated inputs and add
  ;; them to the build inputs.
  (define all-propagated-inputs
    ((compose
      (cut delete-duplicates <> input=?)
      (cut filter erlang-or-elixir-input? <>)
      (cut append-map package-transitive-propagated-inputs <>)
      (cut map cadr <>))
     (append inputs native-inputs)))

  (define build-inputs
    `(,@(standard-packages)
      ("glibc-utf8-locales" ,glibc-utf8-locales)
      ("erlang" ,erlang)
      ("rebar3" ,rebar3)
      ("elixir" ,elixir)
      ("elixir-hex" ,elixir-hex)
      ,@all-propagated-inputs
      ,@inputs
      ,@native-inputs))

  ;; Some inputs, such as C programs, may be architecture dependent.
  (define host-inputs (if target inputs '()))

  (bag (name name)
       (system system)
       (build-inputs build-inputs)
       (host-inputs host-inputs)
       (outputs outputs)
       (build mix-build)
       (arguments (append `(#:elixir-X.Y ,elixir-X.Y)
                          (strip-keyword-arguments private-keywords arguments)))))

(define mix-build-system
  (build-system (name 'mix)
                (description "The standard Mix build system")
                (lower lower)))

;;; mix.scm ends here