snow-fort-guix-channel/build.scm

126 lines
4.7 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 module-file-path "packages/snow-fort.scm")
(when (file-exists? module-file-path) (delete-file module-file-path))
(define module-file (open-output-file module-file-path))
(define snow-libraries (list))
(for-each
(lambda (item)
(when (equal? (car item) 'package)
(for-each
(lambda (item)
(when (equal? (car item) 'library)
(set! snow-libraries (append snow-libraries (list (cadr (assoc 'name (cdr item))))))))
(cdr item))))
(cdr repository))
(define snow-dependencies->guix-dependencies
(lambda (dependencies)
(map
(lambda (dependency)
(string->symbol
(string-join (cons "snow" (map symbol->string dependency)) "-")))
(filter
(lambda (dependency)
(and (not (equal? (car dependency) 'scheme))
(not (equal? (car dependency) 'srfi))
(not (equal? dependency '(chibi)))
(member dependency snow-libraries)))
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 module-definition
'(define-module (snow-fort)
#:use-module (guix licenses)
#:use-module (guix search-paths)
#:use-module ((guix packages) #:select (package origin base32))
#:use-module (guix build-system copy)
#:use-module ((guix download) #:select (url-fetch))))
(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))))
(source-path (string-append (symbol->string (car (cadr (assoc 'name lib)))) "/"))
(target-path (string-append "/usr/lib/snow/" source-path))
(description (if (assoc 'description lib) (cadr (assoc 'description lib)) ""))
(guix-package
`(package
(name ,name)
(version ,version)
(source (origin
(method url-fetch)
(uri ,url)
(sha256 (base32 ,sha-256))))
(build-system copy-build-system)
(arguments (list #:install-plan ''((,source-path ,target-path))))
(synopsis ,description)
(description ,description)
(home-page "")
(license ,license)
(search-paths
(list (search-path-specification
(variable "SNOW_LIBRARY_PATH")
(files '("usr/lib/snow"))))))))
(if (null? dependencies)
(write `(define-public ,(string->symbol name) ,guix-package) module-file)
(write `(define-public
,(string->symbol name)
,(append
guix-package
`((propagated-inputs ,(cons 'list dependencies)))))
module-file))
(newline module-file)
(newline module-file))))
(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))))
(write module-definition module-file)
(newline module-file)
(newline module-file)
(for-each
(lambda (item)
(when (equal? (car item) 'package)
(snow-package->guix-libraries (cdr item))))
(cdr repository))