(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 "~%}~%"))))