;;; Tyreunom's system administration and configuration tools.

;;;

;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>

;;;

;;; This program 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.

;;;

;;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

(define-module (home openbox)

  #:use-module (guix build utils)

  #:use-module (guix build-system trivial)

  #:use-module (guix gexp)

  #:use-module (guix licenses)

  #:use-module (guix packages)

  #:use-module (guix records)

  #:use-module (gnu packages lxde)

  #:use-module (ice-9 match)

  #:export (openbox-configuration

	    openbox-configuration?

	    openbox-configuration-autostart

	    openbox-configuration-environ

	    openbox-configuration-menu

	    openbox-configuration-rc

	    openbox-menu

            openbox-menu-id

            openbox-menu-label

            opebnox-menu-elements

            openbox-element-menu

            openbox-element-execute

            openbox-home))

(define-record-type* <openbox-configuration>

  openbox-configuration make-openbox-configuration

  openbox-configuration?

  (autostart     openbox-configuration-autostart

		 (default #f))

  (environ       openbox-configuration-environ

		 (default #f))

  (menus         openbox-configuration-menus

		 (default '()))

  (root-elements openbox-configuration-root-elements

		 (default '()))

  (rc            openbox-configuration-rc

		 (default #f)))

(define-record-type* <openbox-menu>

  openbox-menu make-openbox-menu

  openbox-menu?

  (id       openbox-menu-id)

  (label    openbox-menu-label)

  (elements openbox-menu-elements))

(define-record-type* <openbox-element-menu>

  openbox-element-menu make-openbox-element-menu

  openbox-element-menu?

  (id openbox-element-menu-id))

(define-record-type* <openbox-element-execute>

  openbox-element-execute make-openbox-element-execute

  openbox-element-execute?

  (label   openbox-element-execute-label)

  (command openbox-element-execute-command)

  (notify? openbox-element-execute-notify?

           (default #t)))

(define (generate-openbox-menu menus root-menu)

  (define (element->item element)

    (match element

      (($ <openbox-element-menu> id)

       `(menu (@ (id ,id))))

      (($ <openbox-element-execute> label command notify?)

       `(item (@ (label ,label))

          (action (@ (name "Execute"))

            (command ,command)

            ,@(if notify? '(startupnotify (enabled "yes")) '()))))))

  #~(begin

      (use-modules (sxml simple))

      (with-output-to-file #$output

         (lambda _

           (sxml->xml

             `(openbox_menu (@ (xmlns "http://openbox.org/3.4/menu"))

                #$(map

                   (lambda (menu)

                     `(menu (@ (id ,(openbox-menu-id menu)) (label ,(openbox-menu-label menu)))

                        ,(map element->item (openbox-menu-elements menu))))

                   menus)

                (menu (@ (id "root-menu") (label "Openbox 3"))

                  #$(map element->item root-menu))))))))

(define (openbox-autostart autostart)

  (match autostart

    (#f (plain-file "autostart" ""))

    (_ autostart)))

(define (openbox-environment environ)

  (match environ

    (#f (plain-file "environ" ""))

    (_ environ)))

(define (openbox-rc rc)

  (match rc

    (#f (plain-file "rc.xml" ""))

    (_ rc)))

(define (openbox-home config)

  (computed-file "openbox-home"

    (match config

      (($ <openbox-configuration> autostart environ menus root-elements rc)

       #~(let ((menu.xml #$(computed-file "menu.xml" (generate-openbox-menu menus root-elements)))

	       (autostart #$(openbox-autostart autostart))

	       (environ #$(openbox-environment environ))

	       (rc #$(openbox-rc rc))

	       (openbox-dir (string-append #$output "/.config/openbox")))

	   (use-modules (guix build utils))

	   (mkdir-p openbox-dir)

	   (copy-file autostart (string-append openbox-dir "/autostart"))

	   (copy-file environ (string-append openbox-dir "/environment"))

	   (copy-file menu.xml (string-append openbox-dir "/menu.xml"))

	   (copy-file rc (string-append openbox-dir "/rc.xml")))))

    #:options

    '(#:local-build? #t

      #:modules ((guix build utils)))))