1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
(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 "~%}~%"))))
|
