;;; Guix Home Manager.
;;;
;;; 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 hexchat)
  #:use-module (guix build utils)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (gnu packages lxde)
  #:use-module (ice-9 match)
  #:use-module (home)
  #:export (hexchat-configuration
            hexchat-configuration-servlist
            hexchat-configuration-log-dir
            hexchat-configuration-scrollback-dir

            hexchat-server
            hexchat-server-name
            hexchat-server-identities
            hexchat-server-real-name
            hexchat-server-encoding
            hexchat-server-servers
            hexchat-server-flags

            hexchat-home-type))

(define-record-type* <hexchat-server>
  hexchat-server make-hexchat-server
  hexchat-server?
  (name       hexchat-server-name)
  (identities hexchat-server-identities
              (default '()))
  (real-name  hexchat-server-real-name
              (default #f))
  (encoding   hexchat-server-encoding
              (default 'utf8))
  (servers    hexchat-server-servers)
  (flags      hexchat-server-flags
              (default '(cycle global honor-proxy))))


(define (generate-hexchat-servlist servers)
  (define (generate-encoding encoding)
    (match encoding
      ((? string? e) e)
      ('utf8 "UTF-8 (Unicode)")
      ('UTF8 "UTF-8 (Unicode)")
      ('utf-8 "UTF-8 (Unicode)")
      ('UTF-8 "UTF-8 (Unicode)")))
  (define (generate-flags flags)
    (apply + 0 0
      ;; Values according to src/common/servlist.h
      (map (lambda (f)
             (match f
               ('cycle 1)
               ('global 2)
               ('ssl 4)
               ('auto-connect 8)
               ('honor-proxy 16)
               ('allow-invalid-certificates 32)
               ('favorite 64)))
           flags)))
  (define (generate-hexchat-server server)
    (match server
      (($ <hexchat-server> name identities real-name encoding servers flags)
       (apply
         string-append
         "N=" name "\n"
         (match identities
           ('() "")
           ((I) (string-append "I=" I "\n"))
           ((I i) (string-append "I=" I "\n" "i=" i "\n")))
         (if real-name
             (string-append "R=" real-name "\n")
             "")
         "E=" (generate-encoding encoding) "\n"
         "F=" (number->string (generate-flags flags)) "\n"
         (map
           (lambda (server)
             (string-append "S=" server "\n"))
           servers)))))
  (string-join (map generate-hexchat-server servers) "\n"))

(define-record-type* <hexchat-configuration>
  hexchat-configuration make-hexchat-configuration
  hexchat-configuration?
  (servlist       hexchat-configuration-servlist)
  (log-dir        hexchat-configuration-log-dir)
  (scrollback-dir hexchat-configuraton-scrollback-dir))

(define hexchat-home-type
  (home-type
    (name 'hexchat)
    (extensions
      (list
        (home-extension
          (target root-home-type)
          (compute
            (lambda (config)
              (match config
                (($ <hexchat-configuration> servlist log-dir scrollback-dir)
                 (let ((servlist.conf (plain-file "servlist.conf" (generate-hexchat-servlist servlist))))
                   `((".config/hexchat/servlist.conf" ,servlist.conf)
                     (".config/hexchat/logs" ,log-dir)
                     (".config/hexchat/scrollback" ,scrollback-dir))))))))))))