about summary refs log tree commit diff
path: root/pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp')
-rw-r--r--pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp162
1 files changed, 0 insertions, 162 deletions
diff --git a/pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp b/pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp
deleted file mode 100644
index 0fd0807fc6b9b..0000000000000
--- a/pkgs/development/lisp-modules-new-obsolete/import/database/sqlite.lisp
+++ /dev/null
@@ -1,162 +0,0 @@
-(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 "~%}~%"))))