;;; si sourcehut avait une ipv6 je pourrais leur envoyer des mails
;;; mais je peux pas donc rde aura pas mes changements
;;;
;;; rde --- Reproducible development environment.
;;;
;;; Copyright © 2022 Andrew Tropin <andrew@trop.in>
;;;
;;; This file is part of rde.
;;;
;;; rde is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; rde is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with rde.  If not, see <http://www.gnu.org/licenses/>.

(define-module (sigils home services wayland)
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:use-module (gnu packages wm)
  #:use-module (gnu services configuration)
  #:use-module (guix packages)
  #:use-module (guix gexp)
  #:use-module (guix diagnostics)
  #:use-module (guix ui)
  #:use-module (sigils home services desktop)

  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-43)
  #:use-module (ice-9 match)

  #:export (home-kanshi-service-type
            home-kanshi-configuration
            sway-config?))


(define sway-config? list?)
(define (serialize-sway-config val)
  (define (aligner nestness)
    (apply string-append
           (map (const "    ") (iota nestness))))

  (define (serialize-sway-term term)
    ;; (format #t "finval. ~a\n" term)
    (match term
      (#t "yes")
      (#f "no")
      ((? symbol? e) (symbol->string e))
      ((? number? e) (number->string e))
      ;; TODO: Change it to ((? string? e) (format #f "~s" e))
      ((? string? e) e)
      ((lst ...)
       (raise (formatted-message
               (G_ "Sway term should be a non-list value (string, \
boolean, number, symbol, or gexp). Provided term is:\n ~a") lst)))
      (e e)))

  (define* (serialize-sway-expression
            expr #:optional (nestness 0))
    ;; (format #t "expres. ~a\n" expr)
    (match expr
      ;; subconfig has the same structure as config,
      ;; the only difference: it's not a top-level form
      ;; can be found at the end of expression.
      ;; (term subconfig)
      ((term ((expressions ...) ...))
       ;; (format #t "subtop. ~a . ~a\n" term expressions)
       (append
        (list (serialize-sway-term term) " {\n")
        (serialize-sway-subconfig expressions (1+ nestness))
        `(,(aligner nestness)
          "}\n")))

      ;; subexpression:
      ;; (term . rest)
      ((term rest ..1)
       ;; (format #t "inside. ~a . ~a\n" term rest)
       (cons* (serialize-sway-term term) " "
              (serialize-sway-expression rest)))

      ;; last element of subexpression
      ((term)
       ;; (format #t "term.   ~a\n" term)
       (list (serialize-sway-term term) "\n"))

      (e
       (raise (formatted-message
               (G_ "Sway expression should be a list of terms \
optionally ending with subconfigs, but provided expression is:\n ~a")
               e)))))

  (define* (serialize-sway-subconfig
            subconfig #:optional (nestness 0))
    (match subconfig
      ;; config:
      ;; ((expr1) (expr2) (expr3))
      (((expressions ...) ...)
       (append-map
        (lambda (e)
          (append (list (aligner nestness))
                  (serialize-sway-expression e nestness)))
        expressions))
      (e
       (raise (formatted-message
               (G_ "Sway (sub)config should be a list of expressions, \
where each expression is also a list, but provided value is:\n ~a") e))) ))

  (serialize-sway-subconfig val))

;;;
;;; kanshi.
;;;

(define (serialize-string field-name value) value)

(define-configuration home-kanshi-configuration
  (kanshi
   (file-like kanshi)
   "kanshi package to use.")
  (config
   (sway-config
    `())
   "This field has the same format as sway's config field, but in reality kanshi
supports only a subset of sway config.  To get the complete list of available
options see @code{man 5 kanshi}.

The example configuration:

@lisp
()
@end lisp"))

(define (add-kanshi-packages config)
  (list (home-kanshi-configuration-kanshi config)))

(define (add-kanshi-configuration config)
  `(("kanshi/config"
     ,(apply
       mixed-text-file
       "kanshi-config"
       (serialize-sway-config (home-kanshi-configuration-config config))))))

(define (home-kanshi-shepherd-service config)
  (let ((kanshi (home-kanshi-configuration-kanshi config)))
    (list
     (shepherd-service
      (provision '(kanshi))
      (requirement '(wayland-display))
      (start #~(make-forkexec-constructor
                (list #$(file-append kanshi "/bin/kanshi"))
                #:log-file (string-append
                            (getenv "XDG_STATE_HOME") "/log"
                            "/kanshi.log")
                #:environment-variables
                (cons (string-append "WAYLAND_DISPLAY="
                                     (getenv "WAYLAND_DISPLAY"))
                      (remove (cut string-prefix? "WAYLAND_DISPLAY=" <>)
                              (default-environment-variables)))))
      (stop #~(make-kill-destructor))
      (documentation "Run Kanshi")))))

(define (home-kanshi-extensions cfg extensions)
  (home-kanshi-configuration
   (inherit cfg)
   (config
    (append (home-kanshi-configuration-config cfg)
            (append-map identity (reverse extensions))))))

(define home-kanshi-service-type
  (service-type (name 'home-kanshi)
                (extensions
                 (list (service-extension
                        home-profile-service-type
                        add-kanshi-packages)
                       (service-extension
                        home-shepherd-service-type
                        home-kanshi-shepherd-service)
                       (service-extension
                        home-xdg-configuration-files-service-type
                        add-kanshi-configuration)))
                (compose identity)
                (extend home-kanshi-extensions)
                (default-value (home-kanshi-configuration))
                (description "\
Install and configure kanshi, output profile manager.")))