(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 nss) #:select (nss-certs))
  #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
  #: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 guile-lmdb guile-lib guile-uuid))
  #: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))
                  ,@%default-gnu-imported-modules)
       #:imported-modules ((guix build guile-build-system)
                           ,@%default-gnu-imported-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 "454244b774ece37f04f146c74353ea4ec35d43e1")
	(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
                  "1n1zjpwfksq8bf42d7xr7lnblgsbqc0yszkbid253s943fyxzhfn"))))
      (build-system guile-build-system)
      (native-inputs (list guile-3.0))
      (propagated-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 guile-lmdb guile-lib))
      (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"))
		       (guile-lmdb #$(this-package-input "guile-lmdb"))
		       (guile-lib #$(this-package-input "guile-lib"))
		       (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-lmdb
					   guile-lib
					   guile-fibers
					   guile-gnutls
					   guile-readline
					   guile-commonmark
					   guile-redis
					   guile-hashing
					   guile-json-4))
		       (scm-dev-path
			(cons*
			 "./"
			 (map (lambda (x) (string-append x scm-dir))
			      guile-inputs)))
		       (scm-path
			(map (lambda (x) (string-append x scm-dir))
			     (cons* out guile-inputs)))
                       (go-dir (string-append "/lib/guile/" effective
                                              "/site-ccache/"))
		       (go-dev-path
			(map (lambda (x) (string-append x go-dir))
			     guile-inputs))
		       (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")
		  (copy-file "gn-guile.sh" "bin/gn-guile-dev")
		  (copy-file "scripts/lmdb-publishdata-export.scm"
			     "bin/lmdb-publishdata-export")
		  (substitute* "bin/gn-guile"
			       (("@SHELL@") bash)
			       (("guile") guile)
			       (("web/webserver.scm") webserver))
		  (substitute* "bin/gn-guile-dev"
		    (("@SHELL@") bash)
		    (("guile") guile)
		    (("web/webserver.scm") "./web/webserver.scm"))
		  (chmod "bin/gn-guile" #o755)
		  (chmod "bin/gn-guile-dev" #o755)
		  (chmod "bin/lmdb-publishdata-export" #o755)
		  (install-file "bin/gn-guile" bin)
		  (install-file "bin/gn-guile-dev" bin)
		  (install-file "bin/lmdb-publishdata-export" 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))
		  (wrap-script
		   (string-append out "/bin/gn-guile-dev")
                   `("PATH" ":" prefix ,path)
                   `("GUILE_AUTO_COMPILE" ":" = ("0"))
                   `("GUILE_LOAD_PATH" ":" prefix ,scm-dev-path)
                   `("GUILE_LOAD_COMPILED_PATH" ":" prefix ,go-dev-path))
		  (wrap-program
		   (string-append out "/bin/lmdb-publishdata-export")
                   `("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))))

(define-public guile-sheepdog
  (let ((commit "1426617d58f305a4126bb867202843e8cf7dd4b2")
	(revision "0"))
    (package
     (name "guile-sheepdog")
     (version "0.0.0")
     (source (origin
	      (method git-fetch)
	      (uri (git-reference
		    (url "https://github.com/BonfaceKilz/guile-sheepdog.git")
		    (commit commit)))
	      (file-name (string-append name "-" version))
	      (sha256
	       (base32
                "1z0xzg11p75s2hk312akxlg2h5278w2abma27dhzjf981g3lcqvr"))))
     (build-system guile-build-system)
     (native-inputs (list guile-3.0))
     (propagated-inputs
      (list bash-minimal guile-3.0 guile-uuid guile-hashing guile-fibers guile-json-4 guile-gcrypt guile-gnutls guile-redis))
     (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-before 'build 'remove-conf
				    (lambda* _
				      (delete-file "conf.example.scm")))
			(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"))
					    (guile-uuid #$(this-package-input "guile-uuid"))
					    (guile-gnutls #$(this-package-input "guile-gnutls"))
					    (guile-hashing #$(this-package-input "guile-hashing"))
					    (guile-fibers #$(this-package-input "guile-fibers"))
					    (guile-redis #$(this-package-input "guile-redis"))
					    (guile-json-4 #$(this-package-input "guile-json"))
					    (guile-gcrypt #$(this-package-input "guile-gcrypt"))
					    (guile-lib #$(this-package-input "guile-lib"))
					    (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")))
					    (guile-sheepdog (string-append
							     out
							     "/share/guile/site/"
							     effective
							     "/gn-monitor.scm"))
					    (scm-dir (string-append "/share/guile/site/" effective))
					    (guile-inputs (list guile-fibers
								guile-hashing
								guile-uuid
								guile-gnutls
								guile-gcrypt
								guile-redis
								guile-json-4))
					    (scm-path
					     (cons*
					      scm-dir
					      (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 "sheepdog.sh" "bin/guile-sheepdog")
				       (substitute* "bin/guile-sheepdog"
						    (("@SHELL@") bash)
						    (("guile") guile)
						    (("gn-monitor.scm") guile-sheepdog))
				       (chmod "bin/guile-sheepdog" #o755)
				       (install-file "bin/guile-sheepdog" bin)
				       (wrap-script
					(string-append out "/bin/guile-sheepdog")
					`("PATH" ":" prefix ,path)
					`("GUILE_AUTO_COMPILE" ":" = ("0"))
					`("GUILE_LOAD_PATH" ":" prefix ,scm-path)
					`("GUILE_LOAD_COMPILED_PATH" ":" prefix ,go-path))))))))
     (home-page "https://github.com/BonfaceKilz/guile-sheepdog.git")
     (synopsis "Genenetwork monitoring tool")
     (description "Genenetwork monitoring tool")
     (license license:gpl3))))