···11-Want to add a package? There are 3 simple steps!
22-1. Add the needed system names to quicklisp-to-nix-systems.txt.
33-2. cd <path to quicklisp-to-nix-systems.txt> ; nix-shell --pure --run 'quicklisp-to-nix .'
44- You might want to specify also the --cacheSystemInfoDir and --cacheFaslDir
55- parameters to preserve some data between runs. For example, it is very
66- useful when you add new packages with native dependencies and fail to
77- specify the native dependencies correctly the first time.
88- (Might be nice to ensure the cache directories exist)
99-3. Add native libraries and whatever else is needed to quicklisp-to-nix-overrides.nix.
1010- If libraries are needed during package analysis then add them to shell.nix, too.
1111-4. Sometimes there are problems with loading implementation-provided systems.
1212- In this case you might need to add more systems in the implementation's (so
1313- SBCL's) entry into *implementation-systems* in quicklisp-to-nix/system-info.lisp
1414-1515-To update to a more recent quicklisp dist modify
1616-lispPackages.quicklisp to have a more recent distinfo.
1717-1818-quicklisp-to-nix-system-info is responsible for installing a quicklisp
1919-package into an isolated environment and figuring out which packages
2020-are required by that system. It also extracts other information that
2121-is readily available once the system is loaded. The information
2222-produced by this program is fed into quicklisp-to-nix. You usually
2323-don't need to run this program unless you're trying to understand why
2424-quicklisp-to-nix failed to handle a system. The technique used by
2525-quicklisp-to-nix-system-info is described in its source.
2626-2727-quicklisp-to-nix is responsible for reading
2828-quicklisp-to-nix-systems.txt, running quicklisp-to-nix-system-info,
2929-and generating the nix packages associated with the closure of
3030-quicklisp systems.
···11-/* Generated file. */
22-args @ { fetchurl, ... }:
33-rec {
44- baseName = "cl-ppcre-template";
55- version = "cl-unification-20200925-git";
66-77- description = "A system used to conditionally load the CL-PPCRE Template.
88-99-This system is not required and it is handled only if CL-PPCRE is
1010-available. If it is, then the library provides the
1111-REGULAR-EXPRESSION-TEMPLATE.";
1212-1313- deps = [ args."cl-ppcre" args."cl-unification" ];
1414-1515- src = fetchurl {
1616- url = "http://beta.quicklisp.org/archive/cl-unification/2020-09-25/cl-unification-20200925-git.tgz";
1717- sha256 = "05i1bmbabfgym9v28cbl37yr0r1m4a4k4a844z6wlq6qf45vzais";
1818- };
1919-2020- packageName = "cl-ppcre-template";
2121-2222- asdFilesToKeep = ["cl-ppcre-template.asd"];
2323- overrides = x: x;
2424-}
2525-/* (SYSTEM cl-ppcre-template DESCRIPTION
2626- A system used to conditionally load the CL-PPCRE Template.
2727-2828-This system is not required and it is handled only if CL-PPCRE is
2929-available. If it is, then the library provides the
3030-REGULAR-EXPRESSION-TEMPLATE.
3131- SHA256 05i1bmbabfgym9v28cbl37yr0r1m4a4k4a844z6wlq6qf45vzais URL
3232- http://beta.quicklisp.org/archive/cl-unification/2020-09-25/cl-unification-20200925-git.tgz
3333- MD5 90588d566c2e12dac3530b65384a87ab NAME cl-ppcre-template FILENAME
3434- cl-ppcre-template DEPS
3535- ((NAME cl-ppcre FILENAME cl-ppcre)
3636- (NAME cl-unification FILENAME cl-unification))
3737- DEPENDENCIES (cl-ppcre cl-unification) VERSION cl-unification-20200925-git
3838- SIBLINGS (cl-unification-lib cl-unification-test cl-unification) PARASITES
3939- NIL) */
···11-/* Generated file. */
22-args @ { fetchurl, ... }:
33-rec {
44- baseName = "closer-mop";
55- version = "20211209-git";
66-77- description = "Closer to MOP is a compatibility layer that rectifies many of the absent or incorrect CLOS MOP features across a broad range of Common Lisp implementations.";
88-99- deps = [ ];
1010-1111- src = fetchurl {
1212- url = "http://beta.quicklisp.org/archive/closer-mop/2021-12-09/closer-mop-20211209-git.tgz";
1313- sha256 = "1zrjsibbph8dz8k0qjawp9c22094rag3aasd4r761m2r482xf5zl";
1414- };
1515-1616- packageName = "closer-mop";
1717-1818- asdFilesToKeep = ["closer-mop.asd"];
1919- overrides = x: x;
2020-}
2121-/* (SYSTEM closer-mop DESCRIPTION
2222- Closer to MOP is a compatibility layer that rectifies many of the absent or incorrect CLOS MOP features across a broad range of Common Lisp implementations.
2323- SHA256 1zrjsibbph8dz8k0qjawp9c22094rag3aasd4r761m2r482xf5zl URL
2424- http://beta.quicklisp.org/archive/closer-mop/2021-12-09/closer-mop-20211209-git.tgz
2525- MD5 0b2a02f6b6a57b5b707df5e1d51950cd NAME closer-mop FILENAME closer-mop
2626- DEPS NIL DEPENDENCIES NIL VERSION 20211209-git SIBLINGS NIL PARASITES NIL) */
···11-(unless (find-package :ql-to-nix-util)
22- (load "ql-to-nix-util.lisp"))
33-(defpackage :ql-to-nix-quicklisp-bootstrap
44- (:use :common-lisp :ql-to-nix-util)
55- (:export #:with-quicklisp)
66- (:documentation
77- "This package provides a way to create a temporary quicklisp installation."))
88-(in-package :ql-to-nix-quicklisp-bootstrap)
99-1010-(declaim (optimize (debug 3) (speed 0) (space 0) (compilation-speed 0) (safety 3)))
1111-1212-;; This file cannot have any dependencies beyond quicklisp and asdf.
1313-;; Otherwise, we'll miss some dependencies!
1414-1515-(defvar *quicklisp*
1616- (namestring (pathname-as-directory (uiop:getenv "quicklisp")))
1717- "The path to the nix quicklisp package.")
1818-1919-(defun prepare-quicklisp-dir (target-dir quicklisp-prototype-dir)
2020- "Install quicklisp into the specified `target-dir'.
2121-2222-`quicklisp-prototype-dir' should be the path to the quicklisp nix
2323-package."
2424- (ensure-directories-exist target-dir)
2525- (dolist (subdir '(#P"dists/quicklisp/" #P"tmp/" #P"local-projects/" #P"quicklisp/"))
2626- (ensure-directories-exist (merge-pathnames subdir target-dir)))
2727- (with-open-file (s (merge-pathnames #P"dists/quicklisp/enabled.txt" target-dir) :direction :output :if-exists :supersede)
2828- (format s "1~%"))
2929- (uiop:copy-file
3030- (merge-pathnames #P"lib/common-lisp/quicklisp/quicklisp-distinfo.txt" quicklisp-prototype-dir)
3131- (merge-pathnames #P"dists/quicklisp/distinfo.txt" target-dir))
3232- (uiop:copy-file
3333- (merge-pathnames #P"lib/common-lisp/quicklisp/asdf.lisp" quicklisp-prototype-dir)
3434- (merge-pathnames #P"asdf.lisp" target-dir))
3535- (uiop:copy-file
3636- (merge-pathnames #P"lib/common-lisp/quicklisp/setup.lisp" quicklisp-prototype-dir)
3737- (merge-pathnames #P"setup.lisp" target-dir))
3838- (copy-directory-tree
3939- (merge-pathnames #P"lib/common-lisp/quicklisp/quicklisp/" quicklisp-prototype-dir)
4040- (merge-pathnames #P"quicklisp/" target-dir)))
4141-4242-(defun call-with-quicklisp (function &key (target-dir :temp) (cache-dir :temp))
4343- "Invoke the given function with the path to a quicklisp installation.
4444-4545-Quicklisp will be loaded before the function is called. `target-dir'
4646-can either be a pathname for the place where quicklisp should be
4747-installed or `:temp' to request installation in a temporary directory.
4848-`cache-dir' can either be a pathname for a place to store fasls or
4949-`:temp' to request caching in a temporary directory."
5050- (when (find-package :ql)
5151- (error "Already loaded quicklisp in this process"))
5252- (labels
5353- ((make-ql (ql-dir)
5454- (prepare-quicklisp-dir ql-dir *quicklisp*)
5555- (with-temporary-asdf-cache (ql-dir)
5656- (load (merge-pathnames #P"setup.lisp" ql-dir))
5757- (if (eq :temp cache-dir)
5858- (funcall function ql-dir)
5959- (with-asdf-cache (ql-dir cache-dir)
6060- (funcall function ql-dir))))))
6161- (if (eq :temp target-dir)
6262- (with-temporary-directory (dir)
6363- (make-ql dir))
6464- (make-ql target-dir))))
6565-6666-(defmacro with-quicklisp ((quicklisp-dir) (&key (cache-dir :temp)) &body body)
6767- "Install quicklisp in a temporary directory, load it, bind
6868-`quicklisp-dir' to the path where quicklisp was installed, and then
6969-evaluate `body'.
7070-7171-`cache-dir' can either be a pathname for a place to store fasls or
7272-`:temp' to request caching in a temporary directory."
7373- `(call-with-quicklisp
7474- (lambda (,quicklisp-dir)
7575- ,@body)
7676- :cache-dir ,cache-dir))
···11-(unless (find-package :ql-to-nix-util)
22- (load "util.lisp"))
33-(unless (find-package :ql-to-nix-quicklisp-bootstrap)
44- (load "quicklisp-bootstrap.lisp"))
55-(defpackage :ql-to-nix-system-info
66- (:use :common-lisp :ql-to-nix-quicklisp-bootstrap :ql-to-nix-util)
77- (:export #:dump-image))
88-(in-package :ql-to-nix-system-info)
99-1010-(eval-when (:compile-toplevel :load-toplevel :execute)
1111- (defparameter *implementation-systems*
1212- (append
1313- #+sbcl(list :sb-posix :sb-bsd-sockets :sb-rotate-byte :sb-cltl2
1414- :sb-introspect :sb-rt :sb-concurrency)))
1515- (mapcar (function require) *implementation-systems*))
1616-1717-(declaim (optimize (debug 3) (speed 0) (space 0) (compilation-speed 0) (safety 3)))
1818-1919-;; This file cannot have any dependencies beyond quicklisp and asdf.
2020-;; Otherwise, we'll miss some dependencies!
2121-2222-;; (Implementation-provided dependencies are special, though)
2323-2424-;; We can't load quicklisp until runtime (at which point we'll create
2525-;; an isolated quicklisp installation). These wrapper functions are
2626-;; nicer than funcalling intern'd symbols every time we want to talk
2727-;; to quicklisp.
2828-(wrap :ql apply-load-strategy)
2929-(wrap :ql compute-load-strategy)
3030-(wrap :ql show-load-strategy)
3131-(wrap :ql quicklisp-systems)
3232-(wrap :ql ensure-installed)
3333-(wrap :ql quicklisp-releases)
3434-(wrap :ql-dist archive-md5)
3535-(wrap :ql-dist archive-url)
3636-(wrap :ql-dist ensure-local-archive-file)
3737-(wrap :ql-dist find-system)
3838-(wrap :ql-dist local-archive-file)
3939-(wrap :ql-dist name)
4040-(wrap :ql-dist provided-systems)
4141-(wrap :ql-dist release)
4242-(wrap :ql-dist short-description)
4343-(wrap :ql-dist system-file-name)
4444-(wrap :ql-impl-util call-with-quiet-compilation)
4545-4646-(defvar *version* (uiop:getenv "version")
4747- "The version number of this program")
4848-4949-(defvar *main-system* nil
5050- "The name of the system we're trying to extract info from.")
5151-5252-(defvar *found-parasites* (make-hash-table :test #'equalp)
5353- "Names of systems which have been identified as parasites.
5454-5555-A system is parasitic if its name doesn't match the name of the file
5656-it is defined in. So, for example, if foo and foo-bar are both
5757-defined in a file named foo.asd, foo would be the host system and
5858-foo-bar would be a parasitic system.
5959-6060-Parasitic systems are not generally loaded without loading the host
6161-system first.
6262-6363-Keys are system names. Values are unspecified.")
6464-6565-(defvar *found-dependencies* (make-hash-table :test #'equalp)
6666- "Hash table containing the set of dependencies discovered while installing a system.
6767-6868-Keys are system names. Values are unspecified.")
6969-7070-(defun decode-asdf-dependency (name)
7171- "Translates an asdf system dependency description into a system name.
7272-7373-For example, translates (:version :foo \"1.0\") into \"foo\"."
7474- (etypecase name
7575- (symbol
7676- (setf name (symbol-name name)))
7777- (string)
7878- (cons
7979- (ecase (first name)
8080- (:version
8181- (warn "Discarding version information ~A" name)
8282- ;; There's nothing we can do about this. If the version we
8383- ;; have around is good enough, then we're golden. If it isn't
8484- ;; good enough, then we'll error out and let a human figure it
8585- ;; out.
8686- (setf name (second name))
8787- (return-from decode-asdf-dependency
8888- (decode-asdf-dependency name)))
8989-9090- (:feature
9191- (if (find (second name) *features*)
9292- (return-from decode-asdf-dependency
9393- (decode-asdf-dependency (third name)))
9494- (progn
9595- (warn "Dropping dependency due to missing feature: ~A" name)
9696- (return-from decode-asdf-dependency nil))))
9797-9898- (:require
9999- ;; This probably isn't a dependency we can satisfy using
100100- ;; quicklisp, but we might as well try anyway.
101101- (return-from decode-asdf-dependency
102102- (decode-asdf-dependency (second name)))))))
103103- (string-downcase name))
104104-105105-(defun found-new-parasite (system-name)
106106- "Record that the given system has been identified as a parasite."
107107- (setf system-name (decode-asdf-dependency system-name))
108108- (setf (gethash system-name *found-parasites*) t)
109109- (when (nth-value 1 (gethash system-name *found-dependencies*))
110110- (error "Found dependency on parasite")))
111111-112112-(defun known-parasite-p (system-name)
113113- "Have we previously identified this system as a parasite?"
114114- (nth-value 1 (gethash system-name *found-parasites*)))
115115-116116-(defun found-parasites ()
117117- "Return a vector containing all identified parasites."
118118- (let ((systems (make-array (hash-table-size *found-parasites*) :fill-pointer 0)))
119119- (loop :for system :being :the :hash-keys :of *found-parasites* :do
120120- (vector-push system systems))
121121- systems))
122122-123123-(defvar *track-dependencies* nil
124124- "When this variable is nil, found-new-dependency will not record
125125-depdendencies.")
126126-127127-(defun parasitic-relationship-p (potential-host potential-parasite)
128128- "Returns t if potential-host and potential-parasite have a parasitic relationship.
129129-130130-See `*found-parasites*'."
131131- (let ((host-ql-system (find-system potential-host))
132132- (parasite-ql-system (find-system potential-parasite)))
133133- (and host-ql-system parasite-ql-system
134134- (not (equal (name host-ql-system)
135135- (name parasite-ql-system)))
136136- (equal (system-file-name host-ql-system)
137137- (system-file-name parasite-ql-system)))))
138138-139139-(defun found-new-dependency (name)
140140- "Record that the given system has been identified as a dependency.
141141-142142-The named system may not be recorded as a dependency. It may be left
143143-out for any number of reasons. For example, if `*track-dependencies*'
144144-is nil then this function does nothing. If the named system isn't a
145145-quicklisp system, this function does nothing."
146146- (setf name (decode-asdf-dependency name))
147147- (unless name
148148- (return-from found-new-dependency))
149149- (unless *track-dependencies*
150150- (return-from found-new-dependency))
151151- (when (known-parasite-p name)
152152- (return-from found-new-dependency))
153153- (when (parasitic-relationship-p *main-system* name)
154154- (found-new-parasite name)
155155- (return-from found-new-dependency))
156156- (unless (find-system name)
157157- (return-from found-new-dependency))
158158- (setf (gethash name *found-dependencies*) t))
159159-160160-(defun forget-dependency (name)
161161- "Whoops. Did I say that was a dependency? My bad.
162162-163163-Be very careful using this function! You can remove a system from the
164164-dependency list, but you can't remove other effects associated with
165165-this system. For example, transitive dependencies might still be in
166166-the dependency list."
167167- (setf name (decode-asdf-dependency name))
168168- (remhash name *found-dependencies*))
169169-170170-(defun found-dependencies ()
171171- "Return a vector containing all identified dependencies."
172172- (let ((systems (make-array (hash-table-size *found-dependencies*) :fill-pointer 0)))
173173- (loop :for system :being :the :hash-keys :of *found-dependencies* :do
174174- (vector-push system systems))
175175- systems))
176176-177177-(defun host-system (system-name)
178178- "If the given system is a parasite, return the name of the system that is its host.
179179-180180-See `*found-parasites*'."
181181- (let* ((system (find-system system-name))
182182- (host-file (system-file-name system)))
183183- (unless (equalp host-file system-name)
184184- host-file)))
185185-186186-(defun get-loaded (system)
187187- "Try to load the named system using quicklisp and record any
188188-dependencies quicklisp is aware of.
189189-190190-Unlike `our-quickload', this function doesn't attempt to install
191191-missing dependencies."
192192- ;; Let's get this party started!
193193- (let* ((strategy (compute-load-strategy system))
194194- (ql-systems (quicklisp-systems strategy)))
195195- (dolist (dep ql-systems)
196196- (found-new-dependency (name dep)))
197197- (show-load-strategy strategy)
198198- (labels
199199- ((make-go ()
200200- (apply-load-strategy strategy)))
201201- (call-with-quiet-compilation #'make-go)
202202- (let ((asdf-system (asdf:find-system system)))
203203- ;; If ASDF says that it needed a system, then we should
204204- ;; probably track that.
205205- (dolist (asdf-dep (asdf:component-sideway-dependencies asdf-system))
206206- (found-new-dependency asdf-dep))
207207- (dolist (asdf-dep (asdf:system-defsystem-depends-on asdf-system))
208208- (found-new-dependency asdf-dep))))))
209209-210210-(defun our-quickload (system)
211211- "Attempt to install a package like quicklisp would, but record any
212212-dependencies that are detected during the install."
213213- (setf system (string-downcase system))
214214- ;; Load it quickly, but do it OUR way. Turns out our way is very
215215- ;; similar to the quicklisp way...
216216- (let ((already-tried (make-hash-table :test #'equalp))) ;; Case insensitive
217217- (tagbody
218218- retry
219219- (handler-case
220220- (get-loaded system)
221221- (asdf/find-component:missing-dependency (e)
222222- (let ((required-by (asdf/find-component:missing-required-by e))
223223- (missing (asdf/find-component:missing-requires e)))
224224- (unless (typep required-by 'asdf:system)
225225- (error e))
226226- (when (gethash missing already-tried)
227227- (error "Dependency loop? ~A" missing))
228228- (setf (gethash missing already-tried) t)
229229- (let ((parasitic-p (parasitic-relationship-p *main-system* missing)))
230230- (if parasitic-p
231231- (found-new-parasite missing)
232232- (found-new-dependency missing))
233233- ;; We always want to track the dependencies of systems
234234- ;; that share an asd file with the main system. The
235235- ;; whole asd file should be loadable. Otherwise, we
236236- ;; don't want to include transitive dependencies.
237237- (let ((*track-dependencies* parasitic-p))
238238- (our-quickload missing)))
239239- (format t "Attempting to load ~A again~%" system)
240240- (go retry)))))))
241241-242242-(defvar *blacklisted-parasites*
243243- #("hu.dwim.stefil/documentation" ;; This system depends on :hu.dwim.stefil.test, but it should depend on hu.dwim.stefil/test
244244- "named-readtables/doc" ;; Dependency cycle between named-readtabes and mgl-pax
245245- "symbol-munger-test" ;; Dependency cycle between lisp-unit2 and symbol-munger
246246- "cl-postgres-simple-date-tests" ;; Dependency cycle between cl-postgres and simple-date
247247- "cl-containers/with-variates" ;; Symbol conflict between cl-variates:next-element, metabang.utilities:next-element
248248- "serapeum/docs" ;; Weird issue with FUN-INFO redefinition
249249- "spinneret/cl-markdown" ;; Weird issue with FUN-INFO redefinition
250250- "spinneret/ps" ;; Weird issue with FUN-INFO redefinition
251251- "spinneret/tests") ;; Weird issue with FUN-INFO redefinition
252252- "A vector of systems that shouldn't be loaded by `quickload-parasitic-systems'.
253253-254254-These systems are known to be troublemakers. In some sense, all
255255-parasites are troublemakers (you shouldn't define parasitic systems!).
256256-However, these systems prevent us from generating nix packages and are
257257-thus doubly evil.")
258258-259259-(defvar *blacklisted-parasites-table*
260260- (let ((ht (make-hash-table :test #'equalp)))
261261- (loop :for system :across *blacklisted-parasites* :do
262262- (setf (gethash system ht) t))
263263- ht)
264264- "A hash table where each entry in `*blacklisted-parasites*' is an
265265-entry in the table.")
266266-267267-(defun blacklisted-parasite-p (system-name)
268268- "Returns non-nil if the named system is blacklisted"
269269- (nth-value 1 (gethash system-name *blacklisted-parasites-table*)))
270270-271271-(defun quickload-parasitic-systems (system)
272272- "Attempt to load all the systems defined in the same asd as the named system.
273273-274274-Blacklisted systems are skipped. Dependencies of the identified
275275-parasitic systems will be tracked."
276276- (let* ((asdf-system (asdf:find-system system))
277277- (source-file (asdf:system-source-file asdf-system)))
278278- (cond
279279- (source-file
280280- (loop :for system-name :being :the :hash-keys :of asdf/find-system::*registered-systems* :do
281281- ; for an unclear reason, a literal 0 which is not a key in the hash table gets observed
282282- (when (and (gethash system-name asdf/find-system::*registered-systems*)
283283- (parasitic-relationship-p system system-name)
284284- (not (blacklisted-parasite-p system-name)))
285285- (found-new-parasite system-name)
286286- (let ((*track-dependencies* t))
287287- (our-quickload system-name)))))
288288- (t
289289- (unless (or (equal "uiop" system)
290290- (equal "asdf" system))
291291- (warn "No source file for system ~A. Can't identify parasites." system))))))
292292-293293-(defun determine-dependencies (system)
294294- "Load the named system and return a sorted vector containing all the
295295-quicklisp systems that were loaded to satisfy dependencies.
296296-297297-This function should probably only be called once per process!
298298-Subsequent calls will miss dependencies identified by earlier calls."
299299- (tagbody
300300- retry
301301- (restart-case
302302- (let ((*standard-output* (make-broadcast-stream))
303303- (*trace-output* (make-broadcast-stream))
304304- (*main-system* system)
305305- (*track-dependencies* t))
306306- (our-quickload system)
307307- (quickload-parasitic-systems system))
308308- (try-again ()
309309- :report "Start the quickload over again"
310310- (go retry))
311311- (die ()
312312- :report "Just give up and die"
313313- (uiop:quit 1))))
314314-315315- ;; Systems can't depend on themselves!
316316- (forget-dependency system)
317317- (values))
318318-319319-(defun parasitic-system-data (parasite-system)
320320- "Return a plist of information about the given known-parastic system.
321321-322322-Sometimes we are asked to provide information about a system that is
323323-actually a parasite. The only correct response is to point them
324324-toward the host system. The nix package for the host system should
325325-have all the dependencies for this parasite already recorded.
326326-327327-The plist is only meant to be consumed by other parts of
328328-quicklisp-to-nix."
329329- (let ((host-system (host-system parasite-system)))
330330- (list
331331- :system parasite-system
332332- :host host-system
333333- :name (string-downcase (format nil "~a" parasite-system))
334334- :host-name (string-downcase (format nil "~a" host-system)))))
335335-336336-(defun system-data (system)
337337- "Produce a plist describing a system.
338338-339339-The plist is only meant to be consumed by other parts of
340340-quicklisp-to-nix."
341341- (when (host-system system)
342342- (return-from system-data
343343- (parasitic-system-data system)))
344344-345345- (determine-dependencies system)
346346- (let*
347347- ((dependencies (sort (found-dependencies) #'string<))
348348- (parasites (coerce (sort (found-parasites) #'string<) 'list))
349349- (ql-system (find-system system))
350350- (ql-release (release ql-system))
351351- (ql-sibling-systems (provided-systems ql-release))
352352- (url (archive-url ql-release))
353353- (local-archive (local-archive-file ql-release))
354354- (local-url (format nil "file://~a" (pathname local-archive)))
355355- (archive-data
356356- (progn
357357- (ensure-local-archive-file ql-release)
358358- ;; Stuff this archive into the nix store. It was almost
359359- ;; certainly going to end up there anyway (since it will
360360- ;; probably be fetchurl'd for a nix package). Also, putting
361361- ;; it into the store also gives us the SHA we need.
362362- (nix-prefetch-url local-url)))
363363- (ideal-md5 (archive-md5 ql-release))
364364- (raw-dependencies (coerce dependencies 'list))
365365- (name (string-downcase (format nil "~a" system)))
366366- (ql-sibling-names
367367- (remove name (mapcar 'name ql-sibling-systems)
368368- :test 'equal))
369369- (dependencies raw-dependencies)
370370- (description
371371- (or
372372- (ignore-errors (asdf:system-description (asdf:find-system system)))
373373- "System lacks description"))
374374- (release-name (short-description ql-release)))
375375- (list
376376- :system system
377377- :description description
378378- :sha256 (getf archive-data :sha256)
379379- :url url
380380- :md5 ideal-md5
381381- :name name
382382- :dependencies dependencies
383383- :siblings ql-sibling-names
384384- :release-name release-name
385385- :parasites parasites)))
386386-387387-(defvar *error-escape-valve* *error-output*
388388- "When `*error-output*' is rebound to inhibit spew, this stream will
389389-still produce output.")
390390-391391-(defun print-usage-and-quit ()
392392- "Describe how to use this program... and then exit."
393393- (format *error-output* "Usage:
394394- ~A [--cacheDir <dir>] [--silent] [--debug] [--help|-h] <system-name>
395395-Arguments:
396396- --cacheDir Store (and look for) compiled lisp files in the given directory
397397- --verbose Show compilation output
398398- --debug Enter the debugger when a fatal error is encountered
399399- --help Print usage and exit
400400- <system-name> The quicklisp system to examine
401401-" (or (uiop:argv0) "quicklisp-to-nix-system-info"))
402402- (uiop:quit 2))
403403-404404-(defun main ()
405405- "Make it go."
406406- (let ((argv (uiop:command-line-arguments))
407407- cache-dir
408408- target-system
409409- verbose-p
410410- debug-p)
411411- (handler-bind
412412- ((warning
413413- (lambda (w)
414414- (format *error-escape-valve* "~A~%" w)))
415415- (error
416416- (lambda (e)
417417- (if debug-p
418418- (invoke-debugger e)
419419- (progn
420420- (format *error-escape-valve* "~
421421-Failed to extract system info. Details are below. ~
422422-Run with --debug and/or --verbose for more info.
423423-~A~%" e)
424424- (uiop:quit 1))))))
425425- (loop :while argv :do
426426- (cond
427427- ((equal "--cacheDir" (first argv))
428428- (pop argv)
429429- (unless argv
430430- (error "--cacheDir expects an argument"))
431431- (setf cache-dir (first argv))
432432- (pop argv))
433433-434434- ((equal "--verbose" (first argv))
435435- (setf verbose-p t)
436436- (pop argv))
437437-438438- ((equal "--debug" (first argv))
439439- (setf debug-p t)
440440- (pop argv))
441441-442442- ((or (equal "--help" (first argv))
443443- (equal "-h" (first argv)))
444444- (print-usage-and-quit))
445445-446446- (t
447447- (setf target-system (pop argv))
448448- (when argv
449449- (error "Can only operate on one system")))))
450450-451451- (unless target-system
452452- (print-usage-and-quit))
453453-454454- (when cache-dir
455455- (setf cache-dir (pathname-as-directory (parse-namestring cache-dir))))
456456-457457- (mapcar (function require) *implementation-systems*)
458458-459459- (with-quicklisp (dir) (:cache-dir (or cache-dir :temp))
460460- (declare (ignore dir))
461461-462462- (let (system-data)
463463- (let ((*error-output* (if verbose-p
464464- *error-output*
465465- (make-broadcast-stream)))
466466- (*standard-output* (if verbose-p
467467- *standard-output*
468468- (make-broadcast-stream)))
469469- (*trace-output* (if verbose-p
470470- *trace-output*
471471- (make-broadcast-stream))))
472472- (format *error-output*
473473- "quicklisp-to-nix-system-info ~A~%ASDF ~A~%Quicklisp ~A~%Compiler ~A ~A~%"
474474- *version*
475475- (asdf:asdf-version)
476476- (funcall (intern "CLIENT-VERSION" :ql))
477477- (lisp-implementation-type)
478478- (lisp-implementation-version))
479479- (setf system-data (system-data target-system)))
480480-481481- (cond
482482- (system-data
483483- (format t "~W~%" system-data)
484484- (uiop:quit 0))
485485- (t
486486- (format *error-output* "Failed to determine system data~%")
487487- (uiop:quit 1))))))))
488488-489489-(defun dump-image ()
490490- "Make an executable"
491491- (setf uiop:*image-entry-point* #'main)
492492- (setf uiop:*lisp-interaction* nil)
493493- (uiop:dump-image "quicklisp-to-nix-system-info" :executable t))