kanshi overhaul

1 files changed, 47 insertions, 108 deletions

diff --git a/sigils/home/services/wayland.scm b/sigils/home/services/wayland.scm
index 070c0c7..6c2dc9d 100644
--- a/sigils/home/services/wayland.scm
+++ b/sigils/home/services/wayland.scm
@@ -1,25 +1,3 @@
-;;; 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)
@@ -37,105 +15,66 @@
   #: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))
+            home-kanshi-configuration))
 
 ;;;
 ;;; kanshi.
 ;;;
 
-(define (serialize-string field-name value) value)
+(define kanshi-config? list?)
+
+(define (serialize-kanshi-config config)
+  (define serialize-term
+    (match-lambda
+      ((? symbol? e) `(" " ,(symbol->string e)))
+      ((? number? e) `(" " ,(number->string e)))
+      ((? string? e) `(" " ,(format #f "~s" e)))
+      (e `(" " ,e))))
+
+  (define serialize-statement
+    (match-lambda
+      ((cmd . lst)
+       `(,(symbol->string cmd)
+         ,@(append-map serialize-term lst)))))
+
+  (define serialize-profile
+    (match-lambda
+      ((name ((expressions ...) ...))
+       `("profile " ,(symbol->string name) " {\n"
+         ,@(append-map
+            (lambda (expr) `("    " ,@(serialize-statement expr) "\n"))
+            expressions)
+         "}\n"))))
+
+  (append-map serialize-profile config))
 
 (define-configuration home-kanshi-configuration
   (kanshi
    (file-like kanshi)
    "kanshi package to use.")
   (config
-   (sway-config
+   (kanshi-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 kanshi configuration is a list of profiles with output and exec fields.
+@lisp
+'((static ((output LVDS-1 disable)
+           (output \"Some Company ASDF 4242\" mode 1600x900 position 0,0)))
+  (portable ((output LVDS-1 enable scale 2))))
+@end lisp
 
-The example configuration:
+serializes to
 
-@lisp
-()
-@end lisp"))
+@code
+profile static {
+	output LVDS-1 disable
+	output \"Some Company ASDF 4242\" mode 1600x900 position 0,0
+}
+
+profile portable {
+	output LVDS-1 enable scale 2
+}
+@end code
+"))
 
 (define (add-kanshi-packages config)
   (list (home-kanshi-configuration-kanshi config)))
@@ -145,7 +84,7 @@ The example configuration:
      ,(apply
        mixed-text-file
        "kanshi-config"
-       (serialize-sway-config (home-kanshi-configuration-config config))))))
+       (serialize-kanshi-config (home-kanshi-configuration-config config))))))
 
 (define (home-kanshi-shepherd-service config)
   (let ((kanshi (home-kanshi-configuration-kanshi config)))