124 lines
4.6 KiB
Scheme
Executable File
124 lines
4.6 KiB
Scheme
Executable File
#!/usr/bin/env -S gosh -r7
|
|
; vi: ft=scheme
|
|
|
|
(import (scheme base)
|
|
(scheme read)
|
|
(scheme write)
|
|
(scheme file)
|
|
(scheme process-context)
|
|
(srfi 1)
|
|
(srfi 13)
|
|
(srfi 14))
|
|
|
|
(include "licenses.data-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 "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)))
|
|
(not (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 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 "share/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))))
|
|
(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))
|