diff options
Diffstat (limited to 'pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp')
-rw-r--r-- | pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp | 162 |
1 files changed, 0 insertions, 162 deletions
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 "~%}~%")))) |