;;; 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)
  #: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))

(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 config)
  (computed-file "hexchat-home"
    (match config
      (($ <hexchat-configuration> servlist log-dir scrollback-dir)
       #~(let ((servlist.conf #$(plain-file "servlist.conf" (generate-hexchat-servlist servlist)))
               (hexchat-dir (string-append #$output "/.config/hexchat")))
           (use-modules (guix build utils))
           (mkdir-p hexchat-dir)
           (symlink #$log-dir (string-append hexchat-dir "/logs"))
           (symlink #$scrollback-dir (string-append hexchat-dir "/scrollback"))
           (copy-file servlist.conf (string-append hexchat-dir "/servlist.conf")))))
    #:options
    '(#:local-build? #t
      #:modules ((guix build utils)))))