(define-module (gn packages guile)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix git-download)
#:use-module (guix build-system guile)
#:use-module (guix build-system gnu)
#:use-module ((gnu packages autotools) #:select (libltdl autoconf automake libtool))
#:use-module ((gnu packages bash) #:select (bash-minimal))
#:use-module ((gnu packages databases) #:select (mariadb))
#:use-module ((gnu packages compression) #:select (zlib))
#:use-module ((gnu packages perl) #:select (perl))
#:use-module ((gnu packages texinfo) #:select (texinfo))
#:use-module ((gnu packages version-control) #:select (git-minimal))
#:use-module (guix utils)
#:use-module (gnu packages build-tools)
#:use-module (gnu packages package-management)
#:use-module ((gnu packages bash) #:select (bash-minimal))
#:use-module ((gnu packages bioinformatics) #:select (gemma))
#:use-module ((gnu packages certs) #:select (nss-certs))
#:use-module ((gnu packages guile) #:select (guile-json-4 guile-3.0 guile-2.2 guile-readline))
#:use-module ((gnu packages guile-xyz) #:select (guile-dbi guile-dbd-mysql guile-fibers guile-redis guile-hashing guile-commonmark))
#:use-module ((gnu packages parallel) #:select (parallel))
#:use-module ((gnu packages perl) #:select (perl))
#:use-module ((gnu packages tls) #:select (guile-gnutls openssl)))
;; Lifted from:
;; https://lists.gnu.org/archive/html/artanis/2023-03/txtNk7zz7rJAN.txt
(define-public guile3-dbi
(package
(name "guile3-dbi")
(version "2.1.8")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/opencog/guile-dbi")
(commit (string-append "guile-dbi-" version))))
(file-name (git-file-name name version))
(sha256
(base32
"123m4j82bi60s1v95pjh4djb7bh6zdwmljbpyg7zq8ni2gyal7lw"))))
(build-system gnu-build-system)
(arguments
`(#:modules (((guix build guile-build-system)
#:select (target-guile-effective-version))
,@%gnu-build-system-modules)
#:imported-modules ((guix build guile-build-system)
,@%gnu-build-system-modules)
#:configure-flags
(list (string-append
"--with-guile-site-dir=" %output "/share/guile/site/"
(target-guile-effective-version (assoc-ref %build-inputs "guile"))))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'chdir
(lambda _
;; The upstream Git repository contains all the code, so change
;; to the directory specific to guile-dbi.
(chdir "guile-dbi")))
(add-after 'install 'patch-extension-path
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(dbi.scm (string-append out "/share/guile/site/"
(target-guile-effective-version
(assoc-ref inputs "guile"))
"/dbi/dbi.scm"))
(ext (string-append out "/lib/libguile-dbi")))
(substitute* dbi.scm (("libguile-dbi") ext))))))))
(inputs
(list libltdl))
(native-inputs
(list autoconf automake libtool perl texinfo guile-3.0))
(synopsis "Guile database abstraction layer")
(home-page "https://github.com/opencog/guile-dbi")
(description
"guile-dbi is a library for Guile that provides a convenient interface to
SQL databases. Database programming with guile-dbi is generic in that the same
programming interface is presented regardless of which database system is used.
It currently supports MySQL, Postgres and SQLite3.")
(license license:gpl2+)
(native-search-paths
(list (search-path-specification
(variable "GUILE_DBD_PATH")
(files '("lib")))))))
(define-public guile3-dbd-mysql
(package
(inherit guile3-dbi)
(name "guile3-dbd-mysql")
(arguments
(substitute-keyword-arguments (package-arguments guile3-dbi)
((#:phases phases)
`(modify-phases ,phases
(replace 'chdir
(lambda _
;; The upstream Git repository contains all the code, so change
;; to the directory specific to guile-dbd-mysql.
(chdir "guile-dbd-mysql")))
(add-after 'chdir 'patch-src
(lambda _
(substitute* "configure.ac"
(("mariadbclient") "mariadb"))
(substitute* "src/guile-dbd-mysql.c"
(("<mariadb/") "<mysql/"))))
(delete 'patch-extension-path)))))
(inputs
(modify-inputs (package-inputs guile3-dbi)
(prepend `(,mariadb "dev")
`(,mariadb "lib")
zlib)))
(native-inputs
(modify-inputs (package-native-inputs guile3-dbi)
(prepend guile3-dbi ; only required for headers
)))
(synopsis "Guile DBI driver for MySQL")
(description "@code{guile-dbi} is a library for Guile that provides a
convenient interface to SQL databases. This package implements the interface
for MySQL.")
(license license:gpl2+)))
(define-public gn-guile
(let ((commit "99cf7800246f6af0df8407f7595641933891ad85")
(revision "0"))
(package
(name "gn-guile")
(version (git-version "4.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://git.genenetwork.org/gn-guile/")
(commit commit)))
(file-name (string-append name "-" version))
(sha256
(base32
"0sxg3cd69g2sik1x4di20b4da2qn64d82ikmfkas5w2x1nq3r6pj"))))
(build-system guile-build-system)
(native-inputs (list guile-3.0))
(inputs
(list guile-3.0 guile3-dbi guile3-dbd-mysql guile-fibers guile-gnutls guile-readline
guile-commonmark guile-redis openssl nss-certs gemma parallel guile-hashing
guile-json-4 bash-minimal git-minimal))
(arguments
(list
#:not-compiled-file-regexp "(guix|guix/.*)[.]scm$"
#:modules '((srfi srfi-1)
(ice-9 popen)
(guix build guile-build-system)
(guix build utils))
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'patch-git
(lambda* (#:key inputs #:allow-other-keys)
(let ((git (assoc-ref inputs "git-minimal")))
(substitute* "web/view/markdown.scm"
(("\"git\"") (string-append "\"" git "/bin/git" "\""))
(("git -C") (string-append git "/bin/git -C"))))))
(add-after 'build 'install-script
(lambda* _
(let* ((bash #$(this-package-input "bash-minimal"))
(bash (string-append bash "/bin/bash"))
(guile #$(this-package-input "guile"))
(guile (string-append guile "/bin/guile"))
(build-guile #$(this-package-native-input "guile"))
(build-guile (string-append build-guile "/bin/guile"))
(guile3-dbi #$(this-package-input "guile3-dbi"))
(guile3-dbd-mysql #$(this-package-input "guile3-dbd-mysql"))
(guile-fibers #$(this-package-input "guile-fibers"))
(guile-gnutls #$(this-package-input "guile-gnutls"))
(guile-readline #$(this-package-input "guile-readline"))
(guile-commonmark #$(this-package-input "guile-commonmark"))
(guile-redis #$(this-package-input "guile-redis"))
(guile-hashing #$(this-package-input "guile-hashing"))
(guile-json-4 #$(this-package-input "guile-json"))
(out #$output)
(bin (string-append out "/bin"))
(effective (read
(open-pipe* OPEN_READ
build-guile "-c"
"(write (effective-version))")))
(path (list (string-append guile "/bin")))
(webserver (string-append
out
"/share/guile/site/"
effective
"/web/webserver.scm"))
(scm-dir (string-append "/share/guile/site/" effective))
(guile-inputs (list guile3-dbi
guile3-dbd-mysql
guile-fibers
guile-gnutls
guile-readline
guile-commonmark
guile-redis
guile-hashing
guile-json-4))
(scm-path
(map (lambda (x) (string-append x scm-dir))
(cons* out guile-inputs)))
(go-dir (string-append "/lib/guile/" effective
"/site-ccache/"))
(go-path
(map (lambda (x) (string-append x go-dir))
(cons* out guile-inputs))))
(mkdir-p "bin")
(copy-file "gn-guile.sh" "bin/gn-guile")
(substitute* "bin/gn-guile"
(("@SHELL@") bash)
(("guile") guile)
(("web/webserver.scm") webserver))
(chmod "bin/gn-guile" #o755)
(install-file "bin/gn-guile" bin)
(wrap-script
(string-append out "/bin/gn-guile")
`("PATH" ":" prefix ,path)
`("GUILE_AUTO_COMPILE" ":" = ("0"))
`("GUILE_LOAD_PATH" ":" prefix ,scm-path)
`("GUILE_LOAD_COMPILED_PATH" ":" prefix ,go-path))))))))
(home-page "https://git.genenetwork.com/gn-guile")
(synopsis "Next generation GN code in guile")
(description "Use of guile.")
(license license:gpl3))))
