snow-fort-guix-channel/build.scm

104 lines
3.9 KiB
Scheme

(import (scheme base)
(scheme read)
(scheme write)
(scheme file)
(scheme process-context)
(srfi 1)
(srfi 13)
(srfi 14))
(include "licenses.scm")
(define tmpdir (list-ref (command-line) 1))
(if (not (file-exists? "repo.scm")) (error "No repo.scm found"))
(define repository (with-input-from-file "repo.scm" (lambda () (read))))
(define base-url "https://snow-fort.org")
(define snow-dependencies->guix-dependencies
(lambda (dependencies)
(map
(lambda (dependency)
(string-join (cons "snow" (map symbol->string dependency)) "-"))
(filter
(lambda (dependency)
(and (not (equal? (car dependency) 'scheme))
(not (equal? (car dependency) 'srfi))))
dependencies))))
(define snow-license->guix-license
(lambda (license-pair)
(cond ((not license-pair) 'public-domain)
((assoc (cadr license-pair) license-connections)
(cadr (assoc (cadr license-pair) license-connections)))
(else (error "Unconnected license" license-pair)))))
(define to-string
(lambda (item)
(cond ((symbol? item)
(symbol->string item))
((number? item)
(number->string item)))))
(define snow-library->guix-library
(lambda (lib version url sha-256 license)
(let* ((name (string-join (cons "snow" (map to-string (cadr (assoc 'name lib)))) "-"))
(dependencies (snow-dependencies->guix-dependencies (cdr (assoc 'depends lib))))
(file-path (string-append "packages/" name ".scm"))
(source-path (string-append (symbol->string (car (cadr (assoc 'name lib)))) "/"))
(target-path (string-append "share/snow/" source-path))
(description (if (assoc 'description lib) (cadr (assoc 'description lib)) ""))
(guix-module `(define-module (,(string->symbol name))
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix build-system copy)
#:use-module (guix download)))
(guix-package
`(define-public
,(string->symbol name)
(package
(name ,name)
(version ,version)
(source (origin
(method url-fetch)
(uri ,url)
(hash (base32 ,sha-256))))
(build-system copy-build-system)
(arguments (list #:install-plan '((,source-path ,target-path))))
(synopsis ,description)
(description ,description)
(home-page "https://gitea.scheme.org/Rinne/snow-fort-guix-channel")
(license ,license)))))
(when (file-exists? file-path) (delete-file file-path))
(with-output-to-file
file-path
(lambda ()
(write guix-module)
(newline)
(newline)
(write guix-package)
(newline)
(newline)
(display name)
(newline))))))
(define snow-package->guix-libraries
(lambda (package)
(let* ((version (cadr (assoc 'version package)))
(license (snow-license->guix-license (assoc 'license package)))
(url (string-append base-url (car (cdr (assoc 'url package)))))
(filename (car (reverse (string-tokenize url (char-set-delete char-set:ascii #\/)))))
(sha-256 (with-input-from-file
(string-append tmpdir "/hashes/" filename ".hash")
(lambda () (read-line)))))
(for-each
(lambda (item)
(when (equal? (car item) 'library)
(snow-library->guix-library (cdr item) version url sha-256 license)))
package))))
(for-each
(lambda (item)
(when (equal? (car item) 'package)
(snow-package->guix-libraries (cdr item))))
(cdr repository))