tjh.dev
nixpkgs mirror (for testing)
github.com/NixOS/nixpkgs
nix
1(defpackage org.lispbuilds.nix/database/sqlite
2 (:use :cl)
3 (:import-from :str)
4 (:import-from :sqlite)
5 (:import-from :alexandria :read-file-into-string)
6 (:import-from :arrow-macros :->>)
7 (:import-from
8 :org.lispbuilds.nix/util
9 :replace-regexes)
10 (:import-from
11 :org.lispbuilds.nix/nix
12 :nix-eval
13 :system-master
14 :nixify-symbol
15 :make-pname
16 :*nix-attrs-depth*)
17 (:import-from
18 :org.lispbuilds.nix/api
19 :database->nix-expression)
20 (:export :sqlite-database :init-db)
21 (:local-nicknames
22 (:json :com.inuoe.jzon)))
23
24(in-package org.lispbuilds.nix/database/sqlite)
25
26(defclass sqlite-database ()
27 ((url :initarg :url
28 :reader database-url
29 :initform (error "url required"))
30 (init-file :initarg :init-file
31 :reader init-file
32 :initform (error "init file required"))))
33
34(defun init-db (db init-file)
35 (let ((statements (->> (read-file-into-string init-file)
36 (replace-regexes '(".*--.*") '(""))
37 (substitute #\Space #\Newline)
38 (str:collapse-whitespaces)
39 (str:split #\;)
40 (mapcar #'str:trim)
41 (remove-if #'str:emptyp))))
42 (sqlite:with-transaction db
43 (dolist (s statements)
44 (sqlite:execute-non-query db s)))))
45
46
47;; Writing Nix
48
49(defparameter prelude "
50# This file was auto-generated by nix-quicklisp.lisp
51
52{ runCommand, fetchzip, pkgs, ... }:
53
54# Ensures that every non-slashy `system` exists in a unique .asd file.
55# (Think cl-async-base being declared in cl-async.asd upstream)
56#
57# This is required because we're building and loading a system called
58# `system`, not `asd`, so otherwise `system` would not be loadable
59# without building and loading `asd` first.
60#
61let createAsd = { url, sha256, asd, system }:
62 let
63 src = fetchzip { inherit url sha256; };
64 in runCommand \"source\" {} ''
65 mkdir -pv $out
66 cp -r ${src}/* $out
67 find $out -name \"${asd}.asd\" | while read f; do mv -fv $f $(dirname $f)/${system}.asd || true; done
68 '';
69
70getAttr = builtins.getAttr;
71
72in {")
73
74(defmethod database->nix-expression ((database sqlite-database) outfile)
75 (sqlite:with-open-database (db (database-url database))
76 (with-open-file (f outfile
77 :direction :output
78 :if-exists :supersede)
79
80 ;; Fix known problematic packages before dumping the nix file.
81 (sqlite:execute-non-query db
82 "create temp table fixed_systems as select * from system_view")
83
84 (sqlite:execute-non-query db
85 "alter table fixed_systems add column systems")
86
87 (sqlite:execute-non-query db
88 "update fixed_systems set systems = json_array(name)")
89
90 (sqlite:execute-non-query db
91 "alter table fixed_systems add column asds")
92
93 (sqlite:execute-non-query db
94 "update fixed_systems set asds = json_array(name)")
95
96 (format f prelude)
97
98 (dolist (p (sqlite:execute-to-list db "select * from fixed_systems"))
99 (destructuring-bind (name version asd url sha256 deps systems asds) p
100 (format f "~% ")
101 (let ((*nix-attrs-depth* 1))
102 (format
103 f
104 "~a = ~a;"
105 (nix-eval `(:symbol ,name))
106 (nix-eval
107 `(:attrs
108 ("pname" (:string ,(make-pname name)))
109 ("version" (:string ,version))
110 ("asds" (:list
111 ,@(mapcar (lambda (asd)
112 `(:string ,(system-master asd)))
113 (coerce (json:parse asds) 'list))))
114 ("src" (:funcall
115 "createAsd"
116 (:attrs
117 ("url" (:string ,url))
118 ("sha256" (:string ,sha256))
119 ("system" (:string ,(system-master name)))
120 ("asd" (:string ,asd)))))
121 ("systems" (:list
122 ,@(mapcar (lambda (sys)
123 `(:string ,sys))
124 (coerce (json:parse systems) 'list))))
125 ("lispLibs" (:list
126 ,@(mapcar (lambda (dep)
127 `(:funcall
128 "getAttr"
129 (:string ,(nixify-symbol dep))
130 (:symbol "pkgs")))
131 (remove "asdf"
132 (str:split-omit-nulls #\, deps)
133 :test #'string=))))))))))
134 (format f "~%}~%"))))