Something went wrong. Try again.
lol
Something went wrong. Try again.
6.2 kB · 175 lines
at master
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176(defpackage org.lispbuilds.nix/database/sqlite (:use :cl) (:import-from :str) (:import-from :sqlite) (:import-from :alexandria :read-file-into-string) (:import-from :alexandria-2 :line-up-first) (:import-from :arrow-macros :->>) (:import-from :org.lispbuilds.nix/util :replace-regexes) (:import-from :org.lispbuilds.nix/nix :nix-eval :nixify-symbol :system-master :make-pname :*nix-attrs-depth*) (:import-from :org.lispbuilds.nix/api :database->nix-expression) (:export :sqlite-database :init-db) (:local-nicknames (:hydra :org.lispbuilds.nix/hydra) (: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, pkgs, lib, fetchzip, build-asdf-system, ... }:
let
inherit (builtins) getAttr;
# 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.# createAsd = { url, sha256, asd, system }: let src = fetchzip { inherit url sha256; }; in if asd == system then src else 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 '';in lib.makeScope pkgs.newScope (self: {")
;; 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" ;; Upstream bad packaging, multiple systems in clml.blas.asd "clml.blas.hompack" ;; Fails on SBCL due to heap exhaustion "magicl" ;; Missing dependency on c2ffi cffi extension "hu.dwim.zlib" ;; 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)")
(sqlite:execute-non-query db "delete from fixed_systems where name in ('asdf', 'uiop')")
(sqlite:execute-non-query db "delete from fixed_systems where instr(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 `(:funcall "build-asdf-system" (: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 "self"))) (line-up-first (str:split-omit-nulls #\, deps) (set-difference '("asdf" "uiop") :test #'string=) (sort #'string<))))) ("meta" (:attrs ,@(when (or (find #\/ name) (find name +broken-packages+ :test #'string=)) '(("broken" (:symbol "true")))) ,@(unless (find name hydra:+allowlist+ :test #'string=) '(("hydraPlatforms" (:list))))))))))))) (format f "~%})~%"))))