;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016, 2017 Pjotr Prins <pjotr.guix@thebird.nl>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Nikita <nikita@n0.is>
;;; Copyright © 2020-2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2021 Oskar Köök <oskar@maatriks.ee>
;;; Copyright © 2021 Cees de Groot <cg@evrl.com>
;;; Copyright © 2022 jgart <jgart@dismail.de>
;;; Copyright © 2023 wrobell <wrobell@riseup.net>
;;; Copyright © 2023 Tim Johann <t1m@phrogstar.de>
;;; 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/>.

(define-module (gnu packages erlang)
  #:use-module ((guix licenses)
                #:prefix license:)
  #:use-module (gnu packages elixir)
  #:use-module (gnu packages fontutils)
  #:use-module (gnu packages gl)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages erlang-xyz)
  #:use-module (gnu packages version-control)
  #:use-module (gnu packages wxwidgets)
  #:use-module (gnu packages)
  #:use-module (guix build utils)
  #:use-module (guix build-system emacs)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system rebar)
  #:use-module (guix download)
  #:use-module (guix gexp)
  #:use-module (guix git-download)
  #:use-module (guix packages)
  #:use-module (guix utils))

(define-public erlang
  (package
    (name "erlang")
    (version "25.3.2")
    (source
     (origin
       (method git-fetch)
       ;; The tarball from http://erlang.org/download contains many
       ;; pre-compiled files, so we use this snapshot of the source
       ;; repository.
       (uri (git-reference
             (url "https://github.com/erlang/otp")
             (commit (string-append "OTP-" version))))
       (file-name (git-file-name name version))
       (sha256
        (base32 "092lym5a181gz89nscw7kqhw1wa6qvgcpkj80q4i9p79mxmsr1nj"))
       (patches (search-patches "erlang-man-path.patch"))))
    (build-system gnu-build-system)
    (native-inputs `(("perl" ,perl)

                     ;; Erlang's documentation is distributed in a separate tarball.
                     ("erlang-manpages" ,(origin
                                           (method url-fetch)
                                           (uri (string-append
                                                 "http://erlang.org/download/otp_doc_man_"
                                                 (version-major+minor version)
                                                 ".tar.gz"))
                                           (sha256 (base32
                                                    "0vnpds5q17xc4jjj3sbsllpx68wyhgvx70714vkzyd68rbjmhmk7"))))))
    (inputs (list ncurses openssl wxwidgets))
    (propagated-inputs (list fontconfig glu mesa))
    (arguments
     `(#:test-target "release_tests"
       #:configure-flags (list "--disable-saved-compile-time"
                               "--enable-dynamic-ssl-lib"
                               "--enable-native-libs"
                               "--enable-shared-zlib"
                               "--enable-smp-support"
                               "--enable-threads"
                               "--enable-wx"
                               (string-append "--with-ssl="
                                              (assoc-ref %build-inputs
                                                         "openssl")))
       #:modules ((srfi srfi-19)
                                        ;make-time, et cetera.
                  (guix build utils)
                  (guix build gnu-build-system))
       #:phases (modify-phases %standard-phases
                  (delete 'bootstrap)
                  ;; The are several code fragments that embed timestamps into the
                  ;; output. Here, we alter those fragments to use the value of
                  ;; SOURCE_DATE_EPOCH instead.
                  (add-after 'unpack 'remove-timestamps
                    (lambda _
                      (let ((source-date-epoch (time-utc->date (make-time
                                                                time-utc 0
                                                                (string->number
                                                                 (getenv
                                                                  "SOURCE_DATE_EPOCH"))))))
                        (substitute* "lib/reltool/src/reltool_target.erl"
                          (("Date = date\\(\\),")
                           (string-append "Date = "
                                          (date->string source-date-epoch
                                                        "'{~Y,~m,~d}',"))))
                        (substitute* "lib/reltool/src/reltool_target.erl"
                          (("Time = time\\(\\),")
                           (string-append "Time = "
                                          (date->string source-date-epoch
                                                        "'{~H,~M,~S}',"))))
                        (substitute* '("lib/reltool/src/reltool_target.erl"
                                       "lib/sasl/src/systools_make.erl")
                          (("date\\(\\), time\\(\\),")
                           (date->string source-date-epoch
                                         "{~Y,~m,~d}, {~H,~M,~S},")))
                        (substitute* "lib/dialyzer/test/small_SUITE_data/src/gs_make.erl"
                          (("tuple_to_list\\(date\\(\\)\\),tuple_to_list\\(time\\(\\)\\)")
                           (date->string source-date-epoch
                                         "tuple_to_list({~Y,~m,~d}), tuple_to_list({~H,~M,~S})")))
                        (substitute* "lib/snmp/src/compile/snmpc_mib_to_hrl.erl"
                          (("\\{Y,Mo,D\\} = date\\(\\),")
                           (date->string source-date-epoch
                                         "{Y,Mo,D} = {~Y,~m,~d},")))
                        (substitute* "lib/snmp/src/compile/snmpc_mib_to_hrl.erl"
                          (("\\{H,Mi,S\\} = time\\(\\),")
                           (date->string source-date-epoch
                                         "{H,Mi,S} = {~H,~M,~S},"))))))
                  (add-after 'unpack 'patch-/bin/sh
                    (lambda* (#:key inputs #:allow-other-keys)
                      (let ((sh (search-input-file inputs "/bin/sh")))
                        (substitute* "erts/etc/unix/run_erl.c"
                          (("sh = \"/bin/sh\";")
                           (string-append "sh = \"" sh "\";")))
                        (substitute* "erts/emulator/sys/unix/sys_drivers.c"
                          (("SHELL \"/bin/sh\"")
                           (string-append "SHELL \"" sh "\"")))
                        (substitute* "erts/emulator/sys/unix/erl_child_setup.c"
                          (("SHELL \"/bin/sh\"")
                           (string-append "SHELL \"" sh "\"")))
                        (substitute* "lib/kernel/src/os.erl"
                          (("/bin/sh")
                           sh)))))
                  (add-after 'patch-source-shebangs 'patch-source-env
                    (lambda _
                      (let ((escripts (append (find-files "." "\\.escript")
                                              (find-files
                                               "lib/stdlib/test/escript_SUITE_data/")
                                              '("erts/lib_src/utils/make_atomics_api"
                                                "erts/preloaded/src/add_abstract_code"
                                                "lib/diameter/bin/diameterc"
                                                "lib/reltool/examples/display_args"
                                                "lib/reltool/examples/mnesia_core_dump_viewer"
                                                "lib/snmp/src/compile/snmpc.src"
                                                "make/verify_runtime_dependencies"
                                                "make/emd2exml.in"))))
                        (substitute* escripts
                          (("/usr/bin/env")
                           (which "env"))))))
                  (add-before 'configure 'set-erl-top
                    (lambda _
                      (setenv "ERL_TOP"
                              (getcwd))))
                  (add-after 'install 'patch-erl
                    ;; This only works after install.
                    (lambda* (#:key outputs #:allow-other-keys)
                      (let ((out (assoc-ref outputs "out")))
                        (substitute* (string-append out "/bin/erl")
                          (("basename")
                           (which "basename"))
                          (("dirname")
                           (which "dirname"))))))
                  (add-after 'patch-erl 'wrap-programs
                    (lambda* (#:key inputs outputs #:allow-other-keys)
                      (let* ((out (assoc-ref outputs "out"))
                             (programs '("erl" "erlc" "escript")))
                        (for-each (lambda (program)
                                    (wrap-program (string-append out "/bin/"
                                                                 program)
                                      '("ERL_LIBS" ":" prefix
                                        ("${GUIX_ERL_LIBS}")))) programs))))
                  (add-after 'wrap-programs 'install-doc
                    (lambda* (#:key inputs outputs #:allow-other-keys)
                      (let* ((out (assoc-ref outputs "out"))
                             (manpages (assoc-ref inputs "erlang-manpages"))
                             (share (string-append out "/share/")))
                        (mkdir-p share)
                        (with-directory-excursion share
                          (invoke "tar" "xvf" manpages))))))))
    (native-search-paths
     (list (search-path-specification
            (variable "GUIX_ERL_LIBS")
            (files (list "lib/erlang/lib"
                         (string-append "lib/elixir/"
                                        (version-major+minor (package-version
                                                              elixir))))))))
    (home-page "https://www.erlang.org/")
    (synopsis "The Erlang programming language")
    (description
     "Erlang is a programming language used to build massively
scalable soft real-time systems with requirements on high
availability.  Some of its uses are in telecoms, banking, e-commerce,
computer telephony and instant messaging.  Erlang's runtime system has
built-in support for concurrency, distribution and fault tolerance.")
    ;; Erlang is distributed under the Apache License 2.0, but some components
    ;; have other licenses. See 'system/COPYRIGHT' in the source distribution.
    (license (list license:asl2.0
                   license:bsd-2
                   license:bsd-3
                   license:expat
                   license:lgpl2.0+
                   license:tcl/tk
                   license:zlib))))

(define-public rebar3
  (package
    (name "rebar3")
    (version "3.18.0")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/erlang/rebar3")
             (commit version)))
       (file-name (git-file-name name version))
       (sha256
        (base32 "09648hzc2mnjwf9klm20cg4hb5rn2xv2gmzcg98ffv37p5yfl327"))))
    (build-system gnu-build-system)
    ;; TODO: remove vendored modules, install man-page, install lib(?)
    (arguments
     `(#:phases (modify-phases %standard-phases
                  (delete 'bootstrap)
                  (add-after 'unpack 'unpack-dependency-sources
                    (lambda* (#:key inputs #:allow-other-keys)
                      (for-each (lambda (pkgname)
                                  (let* ((src (string-append pkgname "-source"))
                                         (input (assoc-ref inputs src))
                                         (checkouts-dir (string-append
                                                         "_checkouts/" pkgname))
                                         (lib-dir (string-append
                                                   "_build/default/lib/"
                                                   pkgname)))
                                    (mkdir-p checkouts-dir)
                                    (invoke "tar" "-xf" input "-C"
                                            checkouts-dir)
                                    (invoke "tar" "-xzf"
                                            (pk (string-append checkouts-dir
                                                               "/contents.tar.gz")) "-C"
                                                               checkouts-dir)
                                    (mkdir-p lib-dir)
                                    (copy-recursively checkouts-dir lib-dir)))
                                (list "bbmustache"
                                      "certifi"
                                      "cf"
                                      "cth_readable"
                                      "eunit_formatters"
                                      "getopt"
                                      "hex_core"
                                      "erlware_commons"
                                      "parse_trans"
                                      "relx"
                                      "ssl_verify_fun"
                                      "providers"))))
                  (delete 'configure)
                  (replace 'build
                    (lambda _
                      (setenv "HOME"
                              (getcwd))
                      (invoke "./bootstrap")))
                  (replace 'install
                    (lambda* (#:key outputs #:allow-other-keys)
                      (let* ((out (assoc-ref outputs "out")))
                        (install-file "rebar3"
                                      (string-append out "/bin")))))
                  (delete 'check))))
    (native-inputs (list erlang))
    (inputs `(("bbmustache-source" ,(package-source erlang-bbmustache))
              ("certifi-source" ,(package-source erlang-certifi))
              ("cf-source" ,(package-source erlang-cf))
              ("cth_readable-source" ,(package-source erlang-cth-readable))
              ("erlware_commons-source" ,(package-source
                                          erlang-erlware-commons))
              ("eunit_formatters-source" ,(package-source
                                           erlang-eunit-formatters))
              ("getopt-source" ,(package-source erlang-getopt))
              ("hex_core-source" ,(package-source erlang-hex-core))
              ("parse_trans-source" ,(package-source erlang-parse-trans))
              ("relx-source" ,(package-source erlang-relx))
              ("ssl_verify_fun-source" ,(package-source erlang-ssl-verify-fun))
              ("providers-source" ,(package-source erlang-providers))))
    (home-page "https://rebar3.org/")
    (synopsis "Sophisticated build-tool for Erlang projects that follows OTP
principles")
    (description
     "@code{rebar3} is an Erlang build tool that makes it easy to
compile and test Erlang applications, port drivers and releases.

@code{rebar3} is a self-contained Erlang script, so it's easy to distribute or
even embed directly in a project.  Where possible, rebar uses standard
Erlang/OTP conventions for project structures, thus minimizing the amount of
build configuration work.  @code{rebar3} also provides dependency management,
enabling application writers to easily re-use common libraries from a variety
of locations (git, hg, etc).")
    (license license:asl2.0)))

(define-public erlang-lfe
  (package
    (name "erlang-lfe")
    (version "2.1.2")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/lfe/lfe")
             (commit "v2.1.2")))
       (file-name (git-file-name name version))
       (sha256
        (base32 "180hz1p2v3vb6yyzcfwircmljlnd86ln8z80lzy3mwlyrcxblvxy"))))
    (build-system gnu-build-system)
    (arguments
     (list
      #:modules '((ice-9 ftw)
                  (srfi srfi-26)
                  (guix build gnu-build-system)
                  (guix build utils))
      #:make-flags #~(list (string-append "PREFIX="
                                          #$output) "CC=gcc")
      #:phases #~(modify-phases %standard-phases
                   (delete 'configure)
                   ;; The following is inspired by rebar-build-system.scm
                   (add-before 'check 'erlang-depends
                     (lambda* (#:key inputs #:allow-other-keys)
                       (define input-directories
                         (list #$(this-package-native-input "rebar3-proper")
                               #$(this-package-native-input "erlang-proper")))
                       (mkdir-p "_checkouts")
                       (for-each
                        (lambda (input-dir)
                          (let ((elibdir (string-append input-dir "/lib/erlang/lib")))
                            (when (directory-exists? elibdir)
                              (for-each
                               (lambda (dirname)
                                 (let ((src (string-append elibdir "/" dirname))
                                       (dest (string-append "_checkouts/" dirname)))
                                   (when (not (file-exists? dest))
                                     ;; Symlinking will not work, since rebar3 will try
                                     ;; to overwrite the _build directory several times
                                     ;; with the contents of _checkout, so we copy the
                                     ;; directory tree to _checkout and make it
                                     ;; writable.
                                     (copy-recursively src dest #:follow-symlinks? #t)
                                     (for-each (cut chmod <> 511) (find-files dest)))))
                               (scandir elibdir
                                        (lambda (file)
                                          (and (not (member file '("." "..")))
                                               (file-is-directory? (string-append elibdir "/" file)))))))))
                        input-directories)))
                   (replace 'check
                     (lambda* (#:key tests? #:allow-other-keys)
                       (when tests?
                         (begin
                           (setenv "REBAR_CACHE_DIR" "/tmp")
                           (invoke "make" "-j"
                                   (number->string (parallel-job-count))
                                   "tests"))))))))
    (native-inputs (list rebar3 erlang-rebar3-proper erlang-proper))
    (propagated-inputs (list erlang))
    (home-page "https://github.com/lfe/lfe")
    (synopsis "Lisp Flavoured Erlang")
    (description
     "LFE, Lisp Flavoured Erlang, is a Lisp syntax front-end to the Erlang
compiler.  Code produced with it is compatible with \"normal\" Erlang
 code.  An LFE evaluator and shell is also included.")
    (license license:asl2.0)))

;;;
;;; Avoid adding new packages to the end of this file. To reduce the chances
;;; of a merge conflict, place them above by existing packages with similar
;;; functionality or similar names.
;;;