diff options
Diffstat (limited to 'pkgs/development/lisp-modules-new-obsolete/import')
8 files changed, 0 insertions, 581 deletions
diff --git a/pkgs/development/lisp-modules-new-obsolete/import/api.lisp b/pkgs/development/lisp-modules-new-obsolete/import/api.lisp deleted file mode 100644 index ea5f3bcc19347..0000000000000 --- a/pkgs/development/lisp-modules-new-obsolete/import/api.lisp +++ /dev/null @@ -1,18 +0,0 @@ -(defpackage org.lispbuilds.nix/api - (:documentation "Public interface of org.lispbuilds.nix") - (:use :cl) - (:export - :import-lisp-packages - :database->nix-expression)) - -(in-package org.lispbuilds.nix/api) - -(defgeneric import-lisp-packages (repository database) - (:documentation - "Import Lisp packages (ASDF systems) from repository (Quicklisp, - Ultralisp etc.) into a package database.")) - -(defgeneric database->nix-expression (database outfile) - (:documentation - "Generate a nix expression from the package database and write it - into outfile.")) diff --git a/pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp b/pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp deleted file mode 100644 index 0fd0807fc6b9b..0000000000000 --- a/pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp +++ /dev/null @@ -1,162 +0,0 @@ -(defpackage org.lispbuilds.nix/database/sqlite - (:use :cl) - (:import-from :str) - (:import-from :sqlite) - (:import-from :alexandria :read-file-into-string) - (:import-from :arrow-macros :->>) - (:import-from - :org.lispbuilds.nix/util - :replace-regexes) - (:import-from - :org.lispbuilds.nix/nix - :nix-eval - :system-master - :nixify-symbol - :make-pname - :*nix-attrs-depth*) - (:import-from - :org.lispbuilds.nix/api - :database->nix-expression) - (:export :sqlite-database :init-db) - (:local-nicknames - (:json :com.inuoe.jzon))) - -(in-package org.lispbuilds.nix/database/sqlite) - -(defclass sqlite-database () - ((url :initarg :url - :reader database-url - :initform (error "url required")) - (init-file :initarg :init-file - :reader init-file - :initform (error "init file required")))) - -(defun init-db (db init-file) - (let ((statements (->> (read-file-into-string init-file) - (replace-regexes '(".*--.*") '("")) - (substitute #\Space #\Newline) - (str:collapse-whitespaces) - (str:split #\;) - (mapcar #'str:trim) - (remove-if #'str:emptyp)))) - (sqlite:with-transaction db - (dolist (s statements) - (sqlite:execute-non-query db s))))) - - -;; Writing Nix - -(defparameter prelude " -# This file was auto-generated by nix-quicklisp.lisp - -{ runCommand, fetchzip, pkgs, ... }: - -# Ensures that every non-slashy `system` exists in a unique .asd file. -# (Think cl-async-base being declared in cl-async.asd upstream) -# -# This is required because we're building and loading a system called -# `system`, not `asd`, so otherwise `system` would not be loadable -# without building and loading `asd` first. -# -let createAsd = { url, sha256, asd, system }: - let - src = fetchzip { inherit url sha256; }; - in runCommand \"source\" {} '' - mkdir -pv $out - cp -r ${src}/* $out - find $out -name \"${asd}.asd\" | while read f; do mv -fv $f $(dirname $f)/${system}.asd || true; done - ''; - -getAttr = builtins.getAttr; - -in {") - -;; Random compilation errors -(defparameter +broken-packages+ - (list - ;; no dispatch function defined for #\t - "hu.dwim.logger" - "hu.dwim.serializer" - "hu.dwim.quasi-quote" - ;; Tries to write in $HOME - "ubiquitous" - "math" - ;; Upstream bad packaging, multiple systems in clml.blas.asd - "clml.blas.hompack" - ;; Fails on SBCL due to heap exhaustion - "magicl" - ;; Probably missing dependency in QL data - "mcclim-bezier" - ;; Missing dependency on c2ffi cffi extension - "hu.dwim.zlib" - ;; Missing libgvc.so native library - "hu.dwim.graphviz" - ;; These require libRmath.so, but I don't know where to get it from - "cl-random" - "cl-random-tests" - )) - -(defmethod database->nix-expression ((database sqlite-database) outfile) - (sqlite:with-open-database (db (database-url database)) - (with-open-file (f outfile - :direction :output - :if-exists :supersede) - - ;; Fix known problematic packages before dumping the nix file. - (sqlite:execute-non-query db - "create temp table fixed_systems as select * from system_view") - - (sqlite:execute-non-query db - "alter table fixed_systems add column systems") - - (sqlite:execute-non-query db - "update fixed_systems set systems = json_array(name)") - - (sqlite:execute-non-query db - "alter table fixed_systems add column asds") - - (sqlite:execute-non-query db - "update fixed_systems set asds = json_array(name)") - - (format f prelude) - - (dolist (p (sqlite:execute-to-list db "select * from fixed_systems")) - (destructuring-bind (name version asd url sha256 deps systems asds) p - (format f "~% ") - (let ((*nix-attrs-depth* 1)) - (format - f - "~a = ~a;" - (nix-eval `(:symbol ,name)) - (nix-eval - `(:attrs - ("pname" (:string ,(make-pname name))) - ("version" (:string ,version)) - ("asds" (:list - ,@(mapcar (lambda (asd) - `(:string ,(system-master asd))) - (coerce (json:parse asds) 'list)))) - ("src" (:funcall - "createAsd" - (:attrs - ("url" (:string ,url)) - ("sha256" (:string ,sha256)) - ("system" (:string ,(system-master name))) - ("asd" (:string ,asd))))) - ("systems" (:list - ,@(mapcar (lambda (sys) - `(:string ,sys)) - (coerce (json:parse systems) 'list)))) - ("lispLibs" (:list - ,@(mapcar (lambda (dep) - `(:funcall - "getAttr" - (:string ,(nixify-symbol dep)) - (:symbol "pkgs"))) - (remove "asdf" - (str:split-omit-nulls #\, deps) - :test #'string=)))) - ,@(when (or (find #\/ name) - (find name +broken-packages+ :test #'string=)) - '(("meta" (:attrs ("broken" (:symbol "true")))))))))))) - (format f "~%}~%")))) diff --git a/pkgs/development/lisp-modules-new-obsolete/import/init.sql b/pkgs/development/lisp-modules-new-obsolete/import/init.sql deleted file mode 100644 index 872d51d598ffb..0000000000000 --- a/pkgs/development/lisp-modules-new-obsolete/import/init.sql +++ /dev/null @@ -1,41 +0,0 @@ -CREATE TABLE IF NOT EXISTS sha256 ( - id integer PRIMARY KEY AUTOINCREMENT, - url text UNIQUE, - hash text NOT NULL, - created real DEFAULT (julianday('now')) -); - -CREATE TABLE IF NOT EXISTS system ( - id integer PRIMARY KEY AUTOINCREMENT, - name text NOT NULL, - version text NOT NULL, - asd text NOT NULL, - created real DEFAULT (julianday('now')), - UNIQUE(name, version) -); - -CREATE TABLE IF NOT EXISTS dep ( - system_id integer NOT NULL REFERENCES system(id), - dep_id integer NOT NULL REFERENCES system(id), - PRIMARY KEY (system_id, dep_id) -); - -CREATE TABLE IF NOT EXISTS src ( - sha256_id integer REFERENCES sha256(id), - system_id integer UNIQUE REFERENCES system(id) -); - -DROP VIEW IF EXISTS system_view; -CREATE VIEW IF NOT EXISTS system_view AS - SELECT - sys.name, - sys.version, - sys.asd, - sha.url, - sha.hash, - group_concat((SELECT name FROM system WHERE id = dep.dep_id)) as deps - FROM system sys - JOIN src ON src.system_id = sys.id - JOIN sha256 sha ON sha.id = src.sha256_id - LEFT JOIN dep ON dep.system_id = sys.id - GROUP BY sys.name; diff --git a/pkgs/development/lisp-modules-new-obsolete/import/main.lisp b/pkgs/development/lisp-modules-new-obsolete/import/main.lisp deleted file mode 100644 index c36db3731c8a6..0000000000000 --- a/pkgs/development/lisp-modules-new-obsolete/import/main.lisp +++ /dev/null @@ -1,40 +0,0 @@ -(defpackage org.lispbuilds.nix/main - (:use :common-lisp - :org.lispbuilds.nix/database/sqlite - :org.lispbuilds.nix/repository/quicklisp - :org.lispbuilds.nix/api)) - -(in-package org.lispbuilds.nix/main) - -(defun resource (name type) - (make-pathname - :defaults (asdf:system-source-directory :org.lispbuilds.nix) - :name name - :type type)) - -(defvar *sqlite* - (make-instance - 'sqlite-database - :init-file (resource "init" "sql") - :url "packages.sqlite")) - -(defvar *quicklisp* - (make-instance - 'quicklisp-repository - :dist-url - "https://beta.quicklisp.org/dist/quicklisp/2022-11-07/")) - -(defun run-importers () - (import-lisp-packages *quicklisp* *sqlite*) - (format t "Imported packages from quicklisp to ~A~%" - (truename "packages.sqlite"))) - -(defun gen-nix-file () - (database->nix-expression *sqlite* "imported.nix") - (format t "Dumped nix file to ~a~%" - (truename "imported.nix"))) - -(defun main () - (format t "~%") - (run-importers) - (gen-nix-file)) diff --git a/pkgs/development/lisp-modules-new-obsolete/import/nix.lisp b/pkgs/development/lisp-modules-new-obsolete/import/nix.lisp deleted file mode 100644 index c6de5a4c9932d..0000000000000 --- a/pkgs/development/lisp-modules-new-obsolete/import/nix.lisp +++ /dev/null @@ -1,81 +0,0 @@ -(defpackage org.lispbuilds.nix/nix - (:documentation "Utilities for generating Nix code") - (:use :cl) - (:import-from :str) - (:import-from :ppcre) - (:import-from :arrow-macros :->>) - (:import-from :org.lispbuilds.nix/util :replace-regexes) - (:export - :nix-eval - :system-master - :nixify-symbol - :make-pname - :*nix-attrs-depth*)) - -(in-package org.lispbuilds.nix/nix) - -;; Path names are alphanumeric and can include the symbols +-._?= and -;; must not begin with a period. -(defun make-pname (string) - (replace-regexes '("^[.]" "[^a-zA-Z0-9+-._?=]") - '("_" "_") - string)) - -(defun system-master (system) - (first (str:split "/" system))) - -;;;; Nix generation - -(defun nix-eval (exp) - (assert (consp exp)) - (ecase (car exp) - (:string (nix-string (cadr exp))) - (:list (apply #'nix-list (rest exp))) - (:funcall (apply #'nix-funcall (rest exp))) - (:attrs (nix-attrs (cdr exp))) - (:merge (apply #'nix-merge (cdr exp))) - (:symbol (nix-symbol (cadr exp))))) - -(defun nix-string (object) - (format nil "\"~a\"" object)) - -(defun nixify-symbol (string) - (flet ((fix-special-chars (str) - (replace-regexes '("[+]$" "[+][/]" "[+]" "[.]" "[/]") - '("_plus" "_plus/" "_plus_" "_dot_" "_slash_") - str))) - (if (ppcre:scan "^[0-9]" string) - (str:concat "_" (fix-special-chars string)) - (fix-special-chars string)))) - - -(defun nix-symbol (object) - (nixify-symbol (format nil "~a" object))) - -(defun nix-list (&rest things) - (format nil "[ ~{~A~^ ~} ]" (mapcar 'nix-eval things))) -(defvar *nix-attrs-depth* 0) - -(defun nix-attrs (keyvals) - (let ((*nix-attrs-depth* (1+ *nix-attrs-depth*))) - (format - nil - (->> "{~%*depth*~{~{~A = ~A;~}~^~%*depth*~}~%*depth-1*}" - (str:replace-all "*depth*" (str:repeat *nix-attrs-depth* " ")) - (str:replace-all "*depth-1*" (str:repeat (1- *nix-attrs-depth*) " "))) - (mapcar (lambda (keyval) - (let ((key (car keyval)) - (val (cadr keyval))) - (list (nix-symbol key) - (nix-eval val)))) - keyvals)))) - -(defun nix-funcall (fun &rest args) - (format nil "(~a ~{~a~^ ~})" - (nixify-symbol fun) - (mapcar 'nix-eval args))) - -(defun nix-merge (a b) - (format nil "(~a // ~b)" - (nix-eval a) - (nix-eval b))) diff --git a/pkgs/development/lisp-modules-new-obsolete/import/org.lispbuilds.nix.asd b/pkgs/development/lisp-modules-new-obsolete/import/org.lispbuilds.nix.asd deleted file mode 100644 index 1a67452312d4c..0000000000000 --- a/pkgs/development/lisp-modules-new-obsolete/import/org.lispbuilds.nix.asd +++ /dev/null @@ -1,24 +0,0 @@ -(defsystem org.lispbuilds.nix - :class :package-inferred-system - :description "Utilities for importing ASDF systems into Nix" - :depends-on ( - :alexandria - :str - :cl-ppcre - :sqlite - :dexador - :arrow-macros - :com.inuoe.jzon - :org.lispbuilds.nix/api - :org.lispbuilds.nix/repository/quicklisp - :org.lispbuilds.nix/database/sqlite - )) - - -(register-system-packages - "cl-ppcre" - '(:ppcre)) - -(register-system-packages - "dexador" - '(:dex)) diff --git a/pkgs/development/lisp-modules-new-obsolete/import/repository/quicklisp.lisp b/pkgs/development/lisp-modules-new-obsolete/import/repository/quicklisp.lisp deleted file mode 100644 index 3a45e06c3aa37..0000000000000 --- a/pkgs/development/lisp-modules-new-obsolete/import/repository/quicklisp.lisp +++ /dev/null @@ -1,199 +0,0 @@ -(defpackage org.lispbuilds.nix/repository/quicklisp - (:use :cl) - (:import-from :dex) - (:import-from :alexandria :read-file-into-string :ensure-list) - (:import-from :arrow-macros :->>) - (:import-from :str) - (:import-from - :org.lispbuilds.nix/database/sqlite - :sqlite-database - :init-db - :database-url - :init-file) - (:import-from - :org.lispbuilds.nix/api - :import-lisp-packages) - (:import-from - :org.lispbuilds.nix/util - :replace-regexes) - (:export :quicklisp-repository) - (:local-nicknames - (:json :com.inuoe.jzon))) - -(in-package org.lispbuilds.nix/repository/quicklisp) - -(defclass quicklisp-repository () - ((dist-url :initarg :dist-url - :reader dist-url - :initform (error "dist url required")))) - -(defun clear-line () - (write-char #\Return *error-output*) - (write-char #\Escape *error-output*) - (write-char #\[ *error-output*) - (write-char #\K *error-output*)) - -(defun status (&rest format-args) - (clear-line) - (apply #'format (list* *error-output* format-args)) - (force-output *error-output*)) - -;; TODO: This should not know about the imported.nix file. -(defun init-tarball-hashes (database) - (status "no packages.sqlite - will pre-fill tarball hashes from ~A to save time~%" - (truename "imported.nix")) - (let* ((lines (uiop:read-file-lines "imported.nix")) - (lines (remove-if-not - (lambda (line) - (let ((trimmed (str:trim-left line))) - (or (str:starts-with-p "url = " trimmed) - (str:starts-with-p "sha256 = " trimmed)))) - lines)) - (lines (mapcar - (lambda (line) - (multiple-value-bind (whole groups) - (ppcre:scan-to-strings "\"\(.*\)\"" line) - (declare (ignore whole)) - (svref groups 0))) - lines))) - (sqlite:with-open-database (db (database-url database)) - (init-db db (init-file database)) - (sqlite:with-transaction db - (loop while lines do - (sqlite:execute-non-query db - "insert or ignore into sha256(url,hash) values (?,?)" - (prog1 (first lines) (setf lines (rest lines))) - (prog1 (first lines) (setf lines (rest lines)))))) - (status "OK, imported ~A hashes into DB.~%" - (sqlite:execute-single db - "select count(*) from sha256"))))) - -(defmethod import-lisp-packages ((repository quicklisp-repository) - (database sqlite-database)) - - ;; If packages.sqlite is missing, we should populate the sha256 - ;; table to speed things up. - (unless (probe-file (database-url database)) - (init-tarball-hashes database)) - - (let* ((db (sqlite:connect (database-url database))) - (systems-url (str:concat (dist-url repository) "systems.txt")) - (releases-url (str:concat (dist-url repository) "releases.txt")) - (systems-lines (rest (butlast (str:split #\Newline (dex:get systems-url))))) - (releases-lines (rest (butlast (str:split #\Newline (dex:get releases-url)))))) - - (flet ((sql-query (sql &rest params) - (apply #'sqlite:execute-to-list (list* db sql params)))) - - ;; Ensure database schema - (init-db db (init-file database)) - - ;; Prepare temporary tables for efficient access - (sql-query "create temp table if not exists quicklisp_system - (project, asd, name unique, deps)") - - (sql-query "create temp table if not exists quicklisp_release - (project unique, url, size, md5, sha1, prefix not null, asds)") - - (sqlite:with-transaction db - (dolist (line systems-lines) - (destructuring-bind (project asd name &rest deps) - (str:words line) - (sql-query - "insert or ignore into quicklisp_system values(?,?,?,?)" - project asd name (json:stringify (coerce deps 'vector)))))) - - (sqlite:with-transaction db - (dolist (line releases-lines) - (destructuring-bind (project url size md5 sha1 prefix &rest asds) - (str:words line) - (sql-query - "insert or ignore into quicklisp_release values(?,?,?,?,?,?,?)" - project url size md5 sha1 prefix (json:stringify (coerce - asds - 'vector)))))) - - (sqlite:with-transaction db - ;; Should these be temp tables, that then get queried by - ;; system name? This looks like it uses a lot of memory. - (let ((systems - (sql-query - "with pkg as ( - select - name, asd, url, deps, - ltrim(replace(prefix, r.project, ''), '-_') as version - from quicklisp_system s, quicklisp_release r - where s.project = r.project - ) - select - name, version, asd, url, - (select json_group_array( - json_array(value, (select version from pkg where name=value)) - ) - from json_each(deps)) as deps - from pkg" - ))) - - ;; First pass: insert system and source tarball informaton. - ;; Can't insert dependency information, because this works - ;; on system ids in the database and they don't exist - ;; yet. Could it be better to just base dependencies on - ;; names? But then ACID is lost. - (dolist (system systems) - (destructuring-bind (name version asd url deps) system - (declare (ignore deps)) - (status "importing system '~a-~a'" name version) - (let ((hash (nix-prefetch-tarball url db))) - (sql-query - "insert or ignore into system(name,version,asd) values (?,?,?)" - name version asd) - (sql-query - "insert or ignore into sha256(url,hash) values (?,?)" - url hash) - (sql-query - "insert or ignore into src values - ((select id from sha256 where url=?), - (select id from system where name=? and version=?))" - url name version)))) - - ;; Second pass: connect the in-database systems with - ;; dependency information - (dolist (system systems) - (destructuring-bind (name version asd url deps) system - (declare (ignore asd url)) - (dolist (dep (coerce (json:parse deps) 'list)) - (destructuring-bind (dep-name dep-version) (coerce dep 'list) - (if (eql dep-version 'NULL) - (warn "Bad data in Quicklisp: ~a has no version" dep-name) - (sql-query - "insert or ignore into dep values - ((select id from system where name=? and version=?), - (select id from system where name=? and version=?))" - name version - dep-name dep-version)))))))))) - - (write-char #\Newline *error-output*)) - -(defun shell-command-to-string (cmd) - ;; Clearing the library path is needed to prevent a bug, where the - ;; called subprocess uses a different glibc than the SBCL process - ;; is. In that case, the call to execve attempts to load the - ;; libraries used by SBCL from LD_LIBRARY_PATH using a different - ;; glibc than they expect, which errors out. - (let ((ld-library-path (uiop:getenv "LD_LIBRARY_PATH"))) - (setf (uiop:getenv "LD_LIBRARY_PATH") "") - (unwind-protect - (uiop:run-program cmd :output '(:string :stripped t)) - (setf (uiop:getenv "LD_LIBRARY_PATH") ld-library-path)))) - -(defun nix-prefetch-tarball (url db) - (restart-case - (compute-sha256 url db) - (try-again () - :report "Try downloading again" - (nix-prefetch-tarball url db)))) - -(defun compute-sha256 (url db) - (or (sqlite:execute-single db "select hash from sha256 where url=?" url) - (let ((sha256 (shell-command-to-string (str:concat "nix-prefetch-url --unpack " url)))) - sha256))) diff --git a/pkgs/development/lisp-modules-new-obsolete/import/util.lisp b/pkgs/development/lisp-modules-new-obsolete/import/util.lisp deleted file mode 100644 index 043276305e023..0000000000000 --- a/pkgs/development/lisp-modules-new-obsolete/import/util.lisp +++ /dev/null @@ -1,16 +0,0 @@ -(defpackage org.lispbuilds.nix/util - (:use :cl) - (:import-from :ppcre) - (:export - :replace-regexes)) - -(in-package org.lispbuilds.nix/util) - -(defun replace-regexes (from to str) - (assert (= (length from) (length to))) - (if (null from) - str - (replace-regexes - (rest from) - (rest to) - (ppcre:regex-replace-all (first from) str (first to))))) |