blob: 18cf6d097a2127f30a02da6963e52826130eb9c4 (
plain) (
blame)
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
|
; QuickLisp-to-Nix export
; Requires QuickLisp to be loaded
; Installs the QuickLisp version of all the packages processed (in the
; QuickLisp instance it uses)
(ql:quickload :cl-emb)
(ql:quickload :external-program)
(ql:quickload :cl-ppcre)
(ql:quickload :alexandria)
(ql:quickload :md5)
(defvar testnames (make-hash-table :test 'equal))
(defun nix-prefetch-url (url)
(let*
((stdout nil)
(stderr nil))
(setf
stdout
(with-output-to-string (so)
(setf
stderr
(with-output-to-string (se)
(external-program:run
"nix-prefetch-url"
(list url)
:search t :output so :error se)))))
(let*
((path-line (first (last (cl-ppcre:split (format nil "~%") stderr))))
(path (cl-ppcre:regex-replace-all "path is .(.*)." path-line "\\1")))
(list
:sha256 (first (cl-ppcre:split (format nil "~%") stdout))
:path path
:md5 (string-downcase
(format nil "~{~16,2,'0r~}"
(map 'list 'identity (md5:md5sum-file path))))))))
(defun escape-filename (s)
(format nil "~{~a~}"
(loop
for x in (map 'list 'identity s)
collect
(case x
(#\/ "_slash_")
(#\\ "_backslash_")
(#\_ "__")
(t x)))))
(defun system-data (system)
(let*
((asdf-system (asdf:find-system system))
(ql-system (ql-dist:find-system system))
(ql-release (ql-dist:release ql-system))
(ql-sibling-systems (ql-dist:provided-systems ql-release))
(url (ql-dist:archive-url ql-release))
(local-archive (ql-dist:local-archive-file ql-release))
(local-url (format nil "file://~a" (pathname local-archive)))
(archive-data
(progn
(ql-dist:ensure-local-archive-file ql-release)
(nix-prefetch-url local-url)))
(ideal-md5 (ql-dist:archive-md5 ql-release))
(file-md5 (getf archive-data :md5))
(raw-dependencies (ql-dist:required-systems ql-system))
(name (string-downcase (format nil "~a" system)))
(ql-sibling-names
(remove name (mapcar 'ql-dist:name ql-sibling-systems)
:test 'equal))
(dependencies
(set-difference
(remove-duplicates
(remove-if-not 'ql-dist:find-system raw-dependencies)
:test 'equal)
ql-sibling-names
:test 'equal))
(deps (mapcar (lambda (x) (list :name x)) dependencies))
(description (asdf:system-description asdf-system))
(release-name (ql-dist:short-description ql-release))
(version (cl-ppcre:regex-replace-all
(format nil "~a-" name) release-name "")))
(assert (equal ideal-md5 file-md5))
(list
:system system
:description description
:sha256 (getf archive-data :sha256)
:url url
:md5 file-md5
:name name
:testname (gethash name testnames)
:filename (escape-filename name)
:deps deps
:dependencies dependencies
:version version
:siblings ql-sibling-names)))
(defmacro this-file ()
(or *compile-file-truename*
*load-truename*))
(defun nix-expression (system)
(cl-emb:execute-emb
(merge-pathnames #p"nix-package.emb" (this-file))
:env (system-data system)))
(defun nix-invocation (system)
(cl-emb:execute-emb
(merge-pathnames #p"invocation.emb" (this-file))
:env (system-data system)))
(defun systems-closure (systems)
(let*
((seen (make-hash-table :test 'equal)))
(loop
with queue := systems
with res := nil
while queue
for next := (pop queue)
for old := (gethash next seen)
for data := (unless old (system-data next))
for deps := (getf data :dependencies)
for siblings := (getf data :siblings)
unless old do
(progn
(push next res)
(setf queue (append queue deps)))
do (setf (gethash next seen) t)
finally (return res))))
(defun ql-to-nix (target-directory)
(load (format nil "~a/quicklisp-to-nix-overrides.lisp" target-directory))
(let*
((systems
(cl-ppcre:split
(format nil "~%")
(alexandria:read-file-into-string
(format nil "~a/quicklisp-to-nix-systems.txt" target-directory))))
(closure (systems-closure systems))
(invocations
(loop for s in closure
collect (list :code (nix-invocation s)))))
(loop
for s in closure
do (alexandria:write-string-into-file
(nix-expression s)
(format nil "~a/quicklisp-to-nix-output/~a.nix"
target-directory (escape-filename s))
:if-exists :supersede))
(alexandria:write-string-into-file
(cl-emb:execute-emb
(merge-pathnames
#p"top-package.emb"
(this-file))
:env (list :invocations invocations))
(format nil "~a/quicklisp-to-nix.nix" target-directory)
:if-exists :supersede)))
|