;;; 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:
;;
;; Code:

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

(define (f-join . paths)
  "Return a path (a string) formed from joining each component in PATHS (list of strings).
Example: \"a\" \"b\" \"c\" → \"a/b/c\""
  (string-join paths file-name-separator-string))

(define (strip-prefix prefix name)
  "Return NAME without the prefix PREFIX."
  (if (string-prefix? prefix name)
      (string-drop name (string-length prefix))
      name))

;; All Elixir package names start with this prefix. If a package name starts
;; with this prefix, then it is an Elixir package.
(define %elixir-prefix "elixir-")

(define (path->elixir-lib path X.Y)
  "Return the path to the directory within PATH where libraries of an Elixir
package are installed. Here, X.Y represents the major and minor version
numbers of Elixir used for compilation."
  (f-join path "lib" "elixir" X.Y))

(define (elixir-name? name)
  "Determines if NAME is the name or the label associated to an Elixir
package."
  (string-prefix? %elixir-prefix name))

(define (elixir-input? X.Y input)
  "Determines if the given INPUT is an Elixir input."
  (match input
    ((label . path)
     ;; XXX: The second condition may be enough.
     (and (elixir-name? label)
          (directory-exists? (path->elixir-lib path X.Y))))))

(define (strip-elixir-prefix name)
  "Strip %elixir-prefix from NAME."
  (strip-prefix %elixir-prefix name))

;; All Erlang package names start with this prefix. If a package name starts
;; with this prefix, then it is an Erlang package.
(define %erlang-prefix "erlang-")

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

(define (erlang-name? name)
  "Determines if NAME is the name or the label associated to an Erlang
package."
  (string-prefix? %erlang-prefix name))

(define (erlang-input? input)
  "Determines if the given INPUT is an Erlang input."
  (match input
    ((label . path)
     ;; XXX: one condition may be enough. Without the first one, the erlang
     ;; input is considered an input when we just want Erlang packages.
     (and (erlang-name? label)
          (directory-exists? (path->erlang-lib path))))))

(define (strip-erlang-prefix name)
  "Strip %erlang-prefix from NAME."
  (strip-prefix %erlang-prefix name))

(define (erlang-or-elixir-input? X.Y input)
  "Determines if the given INPUT is an Erlang or Elixir input."
  (or (erlang-input? input)
      (elixir-input? X.Y input)))

(define (snakecase-name name)
  "Return a snakecase version of NAME."
  (string-replace-substring (string-downcase name) "-" "_"))

(define (label->library-name label)
  "Return the library name associated to an input label LABEL."
  (define stripped-label
    (cond
     ((erlang-name? label)
      (strip-erlang-prefix label))
     ((elixir-name? label)
      (strip-elixir-prefix label))
     (#t (error "Invalid label: expected an Erlang or Elixir label." 'label label))))
  (snakecase-name stripped-label))

(define (pkg-name->library-name name)
  "Return the name of the library deduced from the name of the Guix package.
Example: elixir-a-pkg-1.0.2 → a_pkg
See: https://www.erlang.org/doc/man/code#code-path"
  ((compose
    label->library-name
    (cut string-join <> "-")
    (cut drop-right <> 1)
    (cut string-split <> #\-))
   name))

;; We fix as many variables as possible.
;; See: https://hexdocs.pm/mix/1.15.7/Mix.html#module-environment-variables
(define MIX_HOME "MIX_HOME")

(define MIX_ARCHIVES "MIX_ARCHIVES")
(define (%mix-archives mix-home) (f-join mix-home "archives"))
(define MIX_BUILD_ROOT "MIX_BUILD_ROOT")
(define %mix-build-root "_build")
(define MIX_DEPS_PATH "MIX_DEPS_PATH")
(define %mix-deps-path "deps")
(define MIX_PATH "MIX_PATH")
(define MIX_REBAR3 "MIX_REBAR3")
(define MIX_EXS "MIX_EXS")
(define %mix-exs "mix.exs")
;; XXX: if different architecture are needed, then use this variable.
(define MIX_TARGET "MIX_TARGET")
(define MIX_ENV "MIX_ENV")
(define %mix-env-prod "prod")
(define %mix-env-test "test")
(define %mix-env-shared "shared")

;; The name of the directory where compiled libraries by mix are stored.
(define %mix-lib "lib")

;; Useful because Elixir expects a UTF-8 locale.
(define LC_ALL "LC_ALL")

(define (mix-build-dir mix-env)
  "Return the directory where build artifacts are to be installed according to
en environment MIX-ENV in the current directory."
  (f-join %mix-build-root mix-env %mix-lib))

(define* (unpack #:key source mix-path #:allow-other-keys)
  "Unpack SOURCE in the working directory, and change directory within the
source.  When SOURCE is a directory, copy it in a sub-directory of the current
working directory."
  (let ((gnu-unpack (assoc-ref gnu:%standard-phases 'unpack)))
    (gnu-unpack #:source source)
    (let ((contents "contents.tar.gz"))
      (when (file-exists? contents)
        (invoke "tar" "xvf" contents)))))

(define* (configure #:key inputs mix-path mix-exs #:allow-other-keys)
  "Set environment variables."
  (setenv LC_ALL "en_US.UTF-8")
  (setenv MIX_HOME (getcwd))
  (setenv MIX_ARCHIVES (%mix-archives (getenv MIX_HOME)))
  (setenv MIX_BUILD_ROOT %mix-build-root)
  (setenv MIX_DEPS_PATH %mix-deps-path)
  (setenv MIX_PATH (or mix-path ""))
  (setenv MIX_REBAR3 (f-join (assoc-ref inputs "rebar3") "bin" "rebar3"))
  (setenv MIX_EXS mix-exs))

(define* (install-hex #:key inputs name elixir-X.Y #:allow-other-keys)
  "Install Hex."
  (define hex-name "hex")
  (define hex-path (assoc-ref inputs "elixir-hex"))
  (define hex-lib (f-join (path->elixir-lib hex-path elixir-X.Y) hex-name))
  (define hex-archive-path (f-join (getenv MIX_ARCHIVES) hex-name))
  (mkdir-p hex-archive-path)
  (symlink hex-lib (f-join hex-archive-path hex-name)))

(define* (install-dependencies #:key
                               name
                               tests?
                               build-per-environment
                               (inputs '())
                               (native-inputs '())
                               elixir-X.Y
                               mix-environments
                               #:allow-other-keys
                               #:rest rest)
  "Install dependencies.
Given an environment mix-env, we define all-inputs(mix-env) as the set of all
necessary Erlang and Elixir inputs and associated propagated inputs (and
transitive propagated inputs).

For example, all-inputs(prod) represents all the Erlang and Elixir inputs and
propagated inputs necessary to compile the Mix project for the prod
environment.

If dep belongs to all-inputs(mix-env) and its library name is dep-name, then
it is installed under (f-join (mix-build-dir mix-env) dep-name) as a symbolic
link."
  (define (all-inputs mix-env)
    (define env-inputs
      (cond
       ((string=? mix-env %mix-env-prod)
        inputs)
       ((member mix-env (list %mix-env-test %mix-env-shared))
        (append inputs native-inputs))
       (#t (error "Unexpected Mix environment." 'mix-env mix-env))))
    (filter (cut erlang-or-elixir-input? elixir-X.Y <>) env-inputs))

  (define (install-input mix-env input)
    (let ((dir (mix-build-dir mix-env)))
      (mkdir-p dir)
      (match input
        ((label . path)
         (let ((lib-name (label->library-name label)))
           (symlink
            (f-join (path->elixir-lib path elixir-X.Y) lib-name)
            (f-join dir lib-name)))))))

  (define (install-inputs mix-env)
    (for-each (cut install-input mix-env <>)
              (all-inputs mix-env)))

  (for-each install-inputs mix-environments))

(define* (build #:key mix-environments #:allow-other-keys)
  "Builds the Mix project."
  (define (compile mix-env)
    (setenv MIX_ENV mix-env)
    (invoke "mix" "compile" "--no-deps-check"))
  (for-each compile mix-environments))

(define* (check #:key (tests? #t) #:allow-other-keys)
  "Test the Mix project."
  (if tests?
      (invoke "mix" "test" "--no-deps-check")
      (format #t "tests? = ~a~%" tests?)))

(define* (remove-mix-dirs . _)
  "Remove all .mix/ directories.
We do not want to copy them to the installation directory."
  (define mix-dirs
    (find-files "."
                (file-name-predicate "\\.mix$")
                #:directories? #t))
  (for-each delete-file-recursively mix-dirs))

(define* (install #:key
                  inputs
                  outputs
                  name
                  build-per-environment
                  elixir-X.Y
                  #:allow-other-keys)
  "Install build artifacts in the store."
  (define lib-name (pkg-name->library-name name))

  (define dir-build
    (f-join (mix-build-dir (if build-per-environment %mix-env-prod %mix-env-shared))
            lib-name))

  (define dir-install
    (f-join (path->elixir-lib (assoc-ref outputs "out") elixir-X.Y)
            lib-name))
  (mkdir-p dir-install)

  (copy-recursively dir-build dir-install
                    #:follow-symlinks? #t))

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

(define* (mix-build #:key inputs (phases %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))

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