;;; 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:
;;
;; Builder-side code of the standard Mix package build procedure.
;;
;; The standard procedure is presented here:
;;   https://elixir-lang.org/getting-started/mix-otp/introduction-to-mix.html#project-compilation
;;
;; It boils down to:
;;   1) MIX_ENV=prod mix compile
;;   2) mix test
;;
;; Most of the code here comes from the necessity to convince mix to compile
;; without accessing the network. Here is the procedure adapted for Guix:
;;   if:
;;     1) `<source>' is an archive of a package downloaded from hex.pm.
;;           See: https://github.com/hexpm/specifications/blob/main/package_tarball.md
;;     2) `<hex-lib>' is the name of the Hex library, e.g. hex-2.0.5.
;;        `<hex-path>' is the path in the store of Hex.
;;          See: `(gnu packages elixir)'
;;
;;   then the steps to build a package pkg are:
;;     1)   tar <source>
;;     2)   tar contents.tar.gz
;;     3)   export MIX_ENV=prod
;;     4)   export MIX_HOME=.mix
;;     5)   export MIX_ARCHIVES="$(MIX_HOME)"/archives
;;     6)   mkdir -p "$(MIX_ARCHIVES)"
;;     7)   ln -snd <hex-path>/lib/<hex-lib> "$(MIX_ARCHIVES)"/<hex-lib>/<hex-lib>
;;     8)   <profile> is either `prod' or `shared' depending on mix.exs
;;            see: `build_per_environment' in mix documentation.
;;     9)   For all Elixir or Erlang package p in inputs, we have <p-name> the name
;;          of the associated library (e.g. hex-2.0.5). We must:
;;            install p under _build/<profile>/lib/<p-name>
;;            install p source _build/<profile>/lib/<p-name>
;;     10)  mix compile --no-deps-check
;;     11)  mix test --no-deps-check
;;     12)  install build artifacts under #$out/lib/elixir/X.Y/
;;            where X and Y are the major and minor version numbers of Elixir.
;;
;; Code:

(define-module (guix build mix-build-system)
  #:use-module (guix build utils)
  #:use-module ((guix build gnu-build-system)
                #:prefix gnu:)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 ftw)
  #:use-module (srfi srfi-1)
  #:export (mix-build strip-elixir-prefix %standard-phases))

;;
;; version
;;

;; XXX: copied from (guix utils) since not available from the build side.
;; XXX: There may be a way to avoid this duplicated code?
(define (version-prefix version-string num-parts)
  "Truncate version-string to the first num-parts components of the version.
For example, (version-prefix \"2.1.47.4.23\" 3) returns \"2.1.47\""
  (string-join (take (string-split version-string #\.) num-parts) "."))

;; XXX: copied from (guix utils) since not available from the build side.
;; XXX: There may be a way to avoid this duplicated code?
(define (version-major+minor version-string)
  "Return \"<major>.<minor>\", where major and minor are the major and
minor version numbers from version-string."
  (version-prefix version-string 2))

;;
;; pkg
;;

;; The prefix of Elixir packages as a regular expression.
(define pkg-elixir-prefix
  "^elixir-")

;; The prefix of Erlang packages as a regular expression.
(define pkg-erlang-prefix
  "^erlang-")

(define (pkg-name->library-name name)
  "Return the name of the Mix project deduced from the name of the Guix package.

For example: elixir-a-pkg-1.0.2 → a_pkg"

  (let* ((re (format #f "~a(.*)" pkg-elixir-prefix))
         (re-match (string-match re name))
         (name-version (if re-match
                           (regexp-substitute #f re-match 1)
                           (error (format #f "AssertionError d722a480
  Assertion: re matches name.
    re = ~a
    name = ~a" re
    name)))))

    ;; A snake_case name.
    (string-join (drop-right (string-split name-version #\-) 1) "_")))

(define (pkg->dir-install elixir-store pkg-store pkg-name)
  "Return the path under the path PKG-STORE where to install the package named PKG-NAME given the path of the Elixir used to build ELIXIR-STORE.

Example:
  - if:
    - elixir-store = /gnu/store/…elixir-1.14.0
    - pkg-store = /gnu/store/…kv-1.0.0
    - pkg-name = elixir-kv
  - then:
    - (pkg->dir-install elixir-store pkg-store pkg-name) = /gnu/store/…kv-1.0.0/lib/elixir/1.14/kv"
  (let ((X.Y (path->elixir-X.Y elixir-store))
        (lib-name (pkg-name->library-name pkg-name)))
    (string-append (path->elixir-lib pkg-store X.Y) "/" lib-name)))

;;
;; mix
;;

;; See: https://hexdocs.pm/mix/1.15.7/Mix.html#module-environments
(define mix-MIX_HOME
  "MIX_HOME")
(define mix-MIX_ENV
  "MIX_ENV")
(define mix-MIX_ENV-prod
  "prod")

(define (mix-target-dir)
  "Return the directory where build artifacts are to be installed according to
MIX_ENV in the current directory."

  (format #f "_build/~a/lib"
          (getenv mix-MIX_ENV)))

;;
;; path
;;

(define (path->elixir-lib path X.Y)
  "Return the path of the directory where libraries of an Elixir package are installed in the store."
  (string-append path "/lib/elixir/" X.Y))

(define (path->erlang-lib path)
  "Return the path of the directory where libraries of an Erlang package are installed in the store."
  (string-append path "/lib/erlang/lib"))

(define (path->elixir-X.Y elixir)
  "Given a path in the store where elixir has been installed, return its
version as X.Y where X and Y are its major and minor versions."
  (let ((version (last (string-split elixir #\-))))
    (version-major+minor version)))

;;
;; phase
;;

(define* (phase-unpack #:key source #:allow-other-keys)
  "Unpack SOURCE."
  (invoke "tar" "xvf" source)
  (invoke "tar" "xvf" "contents.tar.gz"))

(define* (phase-configure-mix-env #:key (mix-env mix-MIX_ENV-prod)
                                  #:allow-other-keys)
  "Set default MIX_ENV."

  (let ((values (list mix-MIX_ENV-prod "shared")))
    (when (not (member mix-env values string=?))
      (error (format #f "AssertionError 45f9a67d
  Assertion: mix-env is one of values.
    values = ~a
" values)))
    (setenv mix-MIX_ENV mix-env)))

(define* (phase-install-hex #:key inputs name #:allow-other-keys)
  "Install Hex."

  (let* ((hex-lib (string-append (assoc-ref inputs "mix-hex") "/lib"))
         (hex-name (last (scandir hex-lib)))
         (MIX_ARCHIVES "MIX_ARCHIVES")
         (hex-archive-path ""))

    (setenv mix-MIX_HOME ".mix")
    (setenv MIX_ARCHIVES
            (string-append (getenv mix-MIX_HOME) "/archives"))
    (set! hex-archive-path
          (string-append (getenv MIX_ARCHIVES) "/" hex-name))
    (mkdir-p hex-archive-path)
    (symlink (string-append hex-lib "/" hex-name)
             (string-append hex-archive-path "/" hex-name))))

;; Below are definitions useful to understand the following code.
;;
;; - « p : StorePath » means that « p is a String that represents a path of a
;;   package in the store ».
;;
;; - « i : Input » means that i has the form (key . path) where key : String that
;;   represent the name of a package and path : StorePath.
;;
;; - « al : AList » means that « al is an Association List ».
;;
;; - « al : AList Input » means that « al is an Association List of Input ».
;;
;; - « p : Pkg » means that p has the form (type . path) where type is either
;;   'erlang or 'elixir and path : StorePath.
;;
;; - « l : Lib » means that p has the form (lib-name . lib-path) where
;;   lib-name is the name of an Erlang or Elixir library and lib-path is its path.
(define* (phase-install-dependencies #:key inputs #:allow-other-keys)
  "Install dependencies."

  (let ((target-dir (mix-target-dir))
        (X.Y (path->elixir-X.Y (assoc-ref inputs "elixir"))))

    ;; Where to install the dependencies.
    (mkdir-p target-dir)

    (define (install-lib lib)
      "Install a Lib LIB under target-dir."
      ;; XXX: use match
      (let ((lib-name (car lib))
            (lib-path (cdr lib)))
        (let ((target (string-append target-dir "/" lib-name)))
          (symlink lib-path target))))

    (define (install-libs libraries)
      "Install the set of the list of Lib LIBRARIES under target-dir."
      (for-each (lambda (lib)
                  (install-lib lib)) libraries))

    (define (pkg->libraries pkg)
      "Return the list of Lib libraries associated to a Pkg."
      ;; XXX: use match
      (let* ((pkg-type (car pkg))
             (pkg-path (cdr pkg))
             (lib-folder (cond
                          ((eq? pkg-type
                                'elixir)
                           (path->elixir-lib pkg-path X.Y))
                          ((eq? pkg-type
                                'erlang)
                           (path->erlang-lib pkg-path)))))
        (map (lambda (lib-name)
               (cons lib-name
                     (string-append lib-folder "/" lib-name)))
             (drop (scandir lib-folder) 2))))

    (define (install-pkg-libraries pkg)
      "Install all libraries of a given Pkg PKG under target-dir."
      (install-libs (pkg->libraries pkg)))

    (define (input->pkg input)
      "Return a Pkg if Input INPUT is an Erlang or Elixir Input else #f."
      (let ((type? (cond
                    ((string-match pkg-erlang-prefix
                                   (car input))
                     'erlang)
                    ((string-match pkg-elixir-prefix
                                   (car input))
                     'elixir)
                    (#t #f))))
        (if type?
            (cons type?
                  (cdr input)) #f)))

    (define (inputs->pkgs inputs)
      "Return the a list of Pkg, one for each Erlang or Elixir Input in INPUTS."
      (filter pair?
              (map input->pkg inputs)))

    (for-each (lambda (pkg)
                (install-pkg-libraries pkg))
              (inputs->pkgs inputs))))

(define* (phase-build . args_ignored)
  "Builds the Mix project according to MIX_ENV."
  (invoke "mix" "compile" "--no-deps-check"))

(define* (phase-check #:key (tests? #t) name #:allow-other-keys)
  "Test the Mix project."
  (if tests?
      (begin
        (let ((mix-env (getenv mix-MIX_ENV)))
          (setenv mix-MIX_ENV "test")
          (invoke "mix" "test" "--no-deps-check")
          (setenv mix-MIX_ENV mix-env)))
      (format #t "Tests have been skipped since test? parameter value was: ~a.
"
              tests?)))

(define* (phase-remove-mix-dirs . ignored_args)
  "Remove all .mix/ directories."
  (let ((mix-dirs (find-files "."
                              (file-name-predicate (format #f "\\~a$"
                                                           (getenv
                                                            mix-MIX_HOME)))
                              #:directories? #t)))
    (for-each (lambda (mix-dir)
                (delete-file-recursively mix-dir)) mix-dirs)))

(define* (phase-install #:key inputs outputs name #:allow-other-keys)
  "Install build artifacts in the store."
  (let ((dir-build (string-append (mix-target-dir) "/"
                                  (pkg-name->library-name name)))
        (dir-install (pkg->dir-install (assoc-ref inputs "elixir")
                                       (assoc-ref outputs "out") name)))
    (mkdir-p dir-install)
    (copy-recursively dir-build dir-install
                      #:follow-symlinks? #t)))

(define mix-%standard-phases
  (modify-phases gnu:%standard-phases
    (delete 'bootstrap)
    (delete 'configure)
    (replace 'unpack
      phase-unpack)
    (add-after 'unpack 'condifure-mix-env
      phase-configure-mix-env)
    (add-after 'patch-generated-file-shebangs 'install-hex
      phase-install-hex)
    (add-after 'install-hex 'install-dependencies
      phase-install-dependencies)
    (replace 'build
      phase-build)
    (replace 'check
      phase-check)
    (add-before 'install 'remove-mix-dirs
      phase-remove-mix-dirs)
    (replace 'install
      phase-install)))

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

;;
;; This section gather exports.
;;

(define (strip-elixir-prefix name)
  (let* ((re (format #f "~a(.*)" pkg-elixir-prefix))
         (re-match (string-match re name)))

    (if re-match
        (regexp-substitute #f re-match 1)
        (error (format #f "AssertionError d722a480
  Assertion: re matches name.
    re = ~a
    name = ~a" re name)))))

(define %standard-phases
  mix-%standard-phases)

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