104 lines
3.9 KiB
Scheme
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))
|