<commit_before>;;;; SPDX-FileCopyrightText: Atlas Engineer LLC
;;;; SPDX-License-Identifier: BSD-3-Clause

(in-package :ospama)

(define-class guix-manager (manager)
  ()
  (:export-class-name-p t))

(define-class guix-package-output (os-package-output)
  ((parent-package nil
                   :type (or null guix-package))
   (path ""
         :type (or string pathname)
         :documentation "The path is not automatically filled in `make-guix-package'.
Call `expand-outputs' to fill this field for all the outputs of a package.
Also see `expand-output-p' and `expand-outputs-p'.")
   (size 0
         :accessor nil
         :documentation "Apparent size in bytes of outputs, in order.
This can only be derived if `path' has been derived."))
  (:export-class-name-p t)
  (:export-accessor-names-p t)
  (:accessor-name-transformer #'class*:name-identity)
  (:documentation "OS package outputs are meaningful mostly for functional
package managers like Nix or Guix."))

(detect-manager "guix" 'guix-manager)

;; TODO: Call read-from-string in `guix-eval'?
(declaim (ftype (function (t) string)))
(defun cl->scheme-syntax (form)
  #+ccl
  ;; Escape symbols are printed as \\NAME while they should be printed as NAME.
  (str:replace-all "\\" "" (format nil "~s" form))
  #+(not ccl)
  ;; Escaped symbols (e.g. '\#t) are printed as '|NAME| but should be
  ;; printed as NAME.
  (ppcre:regex-replace-all "'\\|([^|]*)\\|" (format nil "~s" form) "\\1"))

(defun guix-eval (form &rest more-forms)
  ;; TODO: "guix repl" is a reliable way to execute Guix code, sadly it does not
  ;; seem to support standard input.  Report upstream?  Alternatively, use Guile
  ;; the way emacs-guix.el does it, but it does not seem reliable.
  "Evaluate forms in Guix REPL.
Return the REPL output (including the error output) as a string."
  (let ((*package* (find-package :ospama)) ; Need to be in this package to avoid prefixing symbols with current package.
        (*print-case* :downcase))
    (uiop:with-temporary-file (:pathname p)
      (with-open-file (s p :direction :output :if-exists :append)
        (dolist (f (cons form more-forms))
          (write-string
           ;; Backslashes in Common Lisp are doubled, unlike Guile.
           (str:replace-all
            "\\\\" "\\"
            (cl->scheme-syntax f))
           s)))
      (uiop:run-program `(,(path *manager*) "repl" ,(namestring p))
                        :output '(:string :stripped t)
                        :error-output :output))))

(defvar %find-package
  ;; TODO: Use upstream's way to find packages.
  '(lambda (name)
    (let ((result (list)))
      (fold-packages
       (lambda (package count)
         (when (string=? (package-name package)
                         name)
           (set! result package))
         (+ 1 count))
       1)
      result)))

;; TODO: Find a fast way to compute the output-paths.
(defun package-output-paths (name)
  "Computing the output-paths in `generate-database' is too slow, so we do it
just-in-time instead."
  (guix-eval
   '(use-modules
     (guix store)
     (guix derivations)
     (guix monads)
     (guix grafts)
     (guix gexp)
     (guix packages)
     (guix utils)
     (gnu packages))<commit_msg>libraries/ospama: Read Guix forms from standard input instead of temporary file.<commit_after>;;;; SPDX-FileCopyrightText: Atlas Engineer LLC
;;;; SPDX-License-Identifier: BSD-3-Clause

(in-package :ospama)

(define-class guix-manager (manager)
  ()
  (:export-class-name-p t))

(define-class guix-package-output (os-package-output)
  ((parent-package nil
                   :type (or null guix-package))
   (path ""
         :type (or string pathname)
         :documentation "The path is not automatically filled in `make-guix-package'.
Call `expand-outputs' to fill this field for all the outputs of a package.
Also see `expand-output-p' and `expand-outputs-p'.")
   (size 0
         :accessor nil
         :documentation "Apparent size in bytes of outputs, in order.
This can only be derived if `path' has been derived."))
  (:export-class-name-p t)
  (:export-accessor-names-p t)
  (:accessor-name-transformer #'class*:name-identity)
  (:documentation "OS package outputs are meaningful mostly for functional
package managers like Nix or Guix."))

(detect-manager "guix" 'guix-manager)

;; TODO: Call read-from-string in `guix-eval'?
(declaim (ftype (function (t) string)))
(defun cl->scheme-syntax (form)
  #+ccl
  ;; Escape symbols are printed as \\NAME while they should be printed as NAME.
  (str:replace-all "\\" "" (format nil "~s" form))
  #+(not ccl)
  ;; Escaped symbols (e.g. '\#t) are printed as '|NAME| but should be
  ;; printed as NAME.
  (ppcre:regex-replace-all "'\\|([^|]*)\\|" (format nil "~s" form) "\\1"))

(defun guix-eval (form &rest more-forms)
  "Evaluate forms in Guix REPL.
Return the REPL output (including the error output) as a string."
  (let ((*package* (find-package :ospama)) ; Need to be in this package to avoid prefixing symbols with current package.
        (*print-case* :downcase))
    (with-input-from-string (s (str:join (string #\newline)
                                         (mapcar (lambda (form)
                                                   (str:replace-all
                                                    ;; Backslashes in Common Lisp are doubled, unlike Guile.
                                                    "\\\\" "\\"
                                                    (cl->scheme-syntax form)))
                                                 (cons form more-forms))))
      ;; REVIEW: Upstream bug causes REPL information to be displayed unless
      ;; /dev/stdin is passed as argument.
      ;; https://issues.guix.info/issue/44612
      ;; TODO: Instead of spawning a process all the time, we could keep it alive with
      ;; https://github.com/archimag/cl-popen/.
      ;; The following snippet shows how we can write multiple times to the
      ;; input of a same process:
      ;; (popen:with-popen2 ("guix repl -t machine /dev/stdin" guix in out)
      ;;   (write-line "(display \"Hello...\\n\")" in)
      ;;   (write-line "(display \"...World!\\n\")" in)
      ;;   (close in)
      ;;   (list (read-line out nil :eod)
      ;;         (read-line out nil :eof)
      ;;         (read-line out nil :eof)))
      (uiop:run-program '("guix" "repl" "-q" "--type=machine" "/dev/stdin")
                        :input s
                        :output '(:string :stripped t)
                        :error-output :output))))

(defvar %find-package
  ;; TODO: Use upstream's way to find packages.
  '(lambda (name)
    (let ((result (list)))
      (fold-packages
       (lambda (package count)
         (when (string=? (package-name package)
                         name)
           (set! result package))
         (+ 1 count))
       1)
      result)))

;; TODO: Find a fast way to compute the output-paths.
(defun package-output-paths (name)
  "Computing the output-paths in `generate-database' is too slow, so we do it
just-in-time instead."
  (guix-eval
   '(use-modules
     (guix store)
     (guix derivations)
     (guix monads)
     (guix grafts)
     (guix gexp)
     (guix packages)
     (guix utils)
     (gnu packages))
{'fraction_non_alphanumeric': 0.1344770337576093, 'fraction_numerical': 0.002213613724405091, 'mean_word_length': 2.3221507352941178, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 7, 'https://': 2, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 12, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6014433', 'n_tokens_mistral': 2268, 'n_tokens_neox': 2158, 'n_words': 742}