(define-module (manifest)
  #:autoload (gnu packages)        (specifications->manifest)
  #:autoload (srfi srfi-1)         (drop fold-right)
  #:autoload (ice-9 textual-ports) (get-string-all))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LIBRARY

(define el/default-block
;;   "Default list of packages, as symbols, which will be blocked. It's a subset
;; default features provided by GNU Emacs."
  '(emacs hl-line outline savehist))

(define* (el/file->specifications content-f #:key (block el/default-block))
  "Given the file-path CONTENT-F, interprete it as an Emacs-Lisp source-code
and extract a list of package-names, as strings, that have been loaded using
(use-package PACKAGE [...])."
  (call-with-input-file content-f
    (lambda (input) (el/port->specifications input #:block block))))

(define* (el/string->specifications content-s #:key (block el/default-block))
  "Given a string CONTENT-S, interprete it as an Emacs-Lispsource-code and
extract a list of package-names, as strings, that have been loaded using
(use-package PACKAGE [...])."
  (call-with-input-string content-s
    (lambda (input) (el/port->specifications input #:block block))))

(define* (el/port->specifications content-p #:key (block el/default-block))
  "Given the input-port CONTENT-P, interprete it as an Emacs-Lisp source-code
and extract a list of package-names, as strings, that have been loaded using
(use-package PACKAGE [...])."
  (let*
    ((content-string-or-eof
       (get-string-all content-p))
      (content-string
        (if
          (eof-object? content-string-or-eof)
          ""
          content-string-or-eof))
      ;; let's wrap the file into a (quote ...) so that a single invocation of ~read~ will read the whole file
      (quoted-content-string
        (string-append "(quote " content-string "\n)"))
      (content-expression
        (with-input-from-string quoted-content-string read)))
    (map
      (lambda (package-string) (string-append "emacs-" package-string))
      (map
        symbol->string
        (filter
          (lambda (package-expression) (not (member package-expression block)))
          (el/find-used-packages content-expression (list)))))))

(define (el/find-used-packages expression accumulator)
  "Given a quoted expression EXPRESSION and an accumulator ACCUMULATOR,
being a list of package names, add all package-names into ACCUMULATOR, that
have been loaded with (use-package PACKAGE [...]), and return that possibly
expanded list."
  (cond
    ;; in case of no s-expression, return accumulator
    ((not (list? (peek expression))) accumulator)
    ;; in case of an empty s-expression, (), return accumulator
    ((nil? expression) accumulator)
    ;; in case of an s-expression with a single element, (X), walk into that element
    ((nil? (cdr expression))
      (el/find-used-packages (car expression) accumulator))
    ;; in case of an use-package s-expression, (use-package PACKAGE [...]), add PACKAGE to the accumulator and also add those elements which possibly result from walking through the remaining elements
    ((and
       (eq? (car expression) 'use-package)
       (symbol? (cadr expression)))
      (fold-right
        el/find-used-packages
        (let
          ((package (cadr expression)))
          (if
            (member package accumulator)
            accumulator
            (cons package accumulator)))
        (drop expression 2)))
    ;; in case of a s-expression with at least two elements, (X Y [...]), walk through all of them
    (#t
      (fold-right
        el/find-used-packages
        accumulator
        expression))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MANIFEST

(specifications->manifest
  (append

    (el/file->specifications "/home/user/.emacs.d/configuration.el" #:block
      ;; block some packages as they won't be loaded on this host:
      (cons*
        'gist
        'guix-emacs
        'hide-lines
        'json
        'kubernetes
        'vertico-directory
        el/default-block))

    (list
      "emacs"
      "git"
      "isync"
      "mu")))