(use-modules (ice-9 match)
             (srfi srfi-1)
             (system repl server))

(define-syntax-rule (forever body ...)
  (while #t body ...))

(define-syntax-rule (with-fork body ...)
  (match (primitive-fork)
    (0 (begin body ...))
    (pid pid)))

(define provided-by (@@ (shepherd service) provided-by))
(define deregister-service (@@ (shepherd service) deregister-service))

(define deregister-service*
  (compose deregister-service symbol->string))

(define (register-services* . services)
  (for-each deregister-service* (append-map provided-by services))
  (apply register-services services))

(define-syntax-rule (define-service name service)
  (define name (begin (register-services* service) service)))

(define (touch-file file)
  (close-port (open-file file "a0b")))

(define (run-command command)
  (zero? (status:exit-val (apply system* command))))

(define (make-system-constructor command)
  (lambda _
    (run-command command)))

(define (make-system-destructor command)
  (lambda _
    (not (run-command command))))

(define (simple-service program)
  (make <service>
    #:provides (list (string->symbol program))
    #:requires '()
    #:start (make-forkexec-constructor (list program))
    #:stop (make-kill-destructor)))

(define %home (getenv "HOME"))

(define (rbenv-bin version)
  "Return the binary path for the VERSION of Ruby managed by rbenv."
  (string-append %home "/.rbenv/versions/" version "/bin"))

(define (ruby-environment version gemset)
  "Return the environment variables needed to run Ruby applications
that use a specific VERSION of Ruby, whose dependencies are stored in
GEMSET."
  (let ((gem-home (string-append %home "/.gems/" gemset)))
    (list "RAILS_ENV=development"
          "HOME=/home/dthompson"
          (string-append "GEM_PATH=" gem-home)
          (string-append "GEM_HOME=" gem-home)
          (string-append "PATH=" gem-home "/bin:"
                         (rbenv-bin version) ":"
                         (getenv "PATH")))))

(define* (rails-service name port ruby-version #:optional (requires '()))
  "Create a service that runs the Rails application NAME located in
DIR.  The application runs with RUBY, the file name of the necessary
Ruby version, and listens on PORT."
  (define gem-home
    (string-append %home "/.gems/" name))

  (make <service>
    #:provides (list (string->symbol name))
    #:requires requires
    #:start (make-forkexec-constructor
             `("passenger" "start"
               "--address" "127.0.0.1"
               "--port" ,port
               "--ruby" ,(string-append (rbenv-bin ruby-version) "/ruby"))
             #:directory (string-append %home "/Code/" name)
             #:environment-variables (ruby-environment ruby-version name))
    #:stop (make-kill-destructor)))

(define (gpg-agent-service name pinentry-program)
  (make <service>
    #:provides (list name 'gpg-agent)
    #:requires '()
    #:start (make-system-constructor
             (list "gpg-agent" "--daemon" "--enable-ssh-support"
                   "--default-cache-ttl=10800" ; cache for 3 hours
                   "--pinentry-program"
                   (string-append %home "/.guix-profile/bin/"
                                  pinentry-program)))
    #:stop (make-system-destructor
            '("gpg-connect-agent" "killagent" "/bye"))))

;; (define-service vhl-tunnel
;;   (make <service>
;;     #:provides '(vhl-tunnel)
;;     #:requires '()
;;     #:start (make-forkexec-constructor
;;              '("ssh" "-N" "-L" "1234:7VWJD42.vhl.dom:22" "vhl"))
;;     #:stop (make-kill-destructor)))

;; (define-service vhl-proxy
;;   (make <service>
;;     #:provides '(vhl-proxy)
;;     #:requires '(vhl-tunnel)
;;     #:start (make-forkexec-constructor
;;              '("ssh" "-N" "-D8080" "-p1234" "dthompson@localhost"))
;;     #:stop (make-kill-destructor)))

(register-services
 ;; VHL applications
 (rails-service "api" "3002" "2.2.2")
 (rails-service "ua" "3000" "2.1.5" '(api))
 (rails-service "m3" "3001" "2.2.2" '(api ua punjab openfire sidekiq))

 ;; M3 DB replica
 (make <service>
   #:provides '(m3-replica)
   #:start (make-forkexec-constructor
            `("mysqld"
              "--defaults-file=/home/dthompson/Code/m3/replica/etc/my.cnf"
              "--user=dthompson"))
   #:stop (make-kill-destructor))

 ;; Punjab (BOSH)
 (let* ((punjab-home (string-append %home "/Code/vhl-bosh"))
        (punjab-config (string-append punjab-home "/conf/development.tac")))
   (make <service>
     #:provides '(punjab)
     #:requires '()
     #:start (make-forkexec-constructor
              (list "twistd" "--nodaemon" "-y" punjab-config)
              #:directory punjab-home)
     #:stop (make-kill-destructor)))

 ;; Openfire (XMPP)
 (let ((openfire-home (string-append %home "/Code/vhl-xmpp/target/openfire")))
   (make <service>
     #:provides '(openfire)
     #:requires '()
     #:start (make-forkexec-constructor
              (list "java" "-server"
                    (string-append "-DopenfireHome=" openfire-home)
                    (string-append "-Dopenfire.lib.dir=" openfire-home "/lib")
                    "-jar" (string-append openfire-home "/lib/startup.jar"))
              #:directory openfire-home)
     #:stop (make-kill-destructor)))

 ;; Redis
 (make <service>
   #:provides '(redis)
   #:requires '()
   #:start (make-forkexec-constructor '("redis-server"))
   #:stop (make-kill-destructor))

 ;; Sidekiq
 (make <service>
    #:provides '(sidekiq)
    #:requires '(redis)
    #:start (make-forkexec-constructor
             '("sidekiq")
             #:directory (string-append %home "/Code/m3")
             #:environment-variables
             (ruby-environment "1.9.3-p551" "m3"))
    #:stop (make-kill-destructor))

 ;; Emacs
 (make <service>
   #:provides '(emacs)
   #:requires '()
   #:start (make-system-constructor '("emacs" "--daemon"))
   #:stop (make-system-destructor '("emacsclient" "--eval" "(kill-emacs)")))

 ;; Xorg
 (make <service>
   #:provides '(xmodmap)
   #:requires '()
   #:start (make-forkexec-constructor
            (list "xmodmap" (string-append %home "/.xmodmap"))))

 ;; GPG/SSH Agent
 (gpg-agent-service 'gpg-agent-gtk "pinentry-gtk-2")
 (gpg-agent-service 'gpg-agent-tty "pinentry-tty")

 ;; Mail
 (simple-service "davmail") ; for dealing with Exchange at work.
 (make <service>
   #:provides '(offlineimap)
   #:requires '()
   #:start (lambda args
             (with-fork
              ;; OfflineIMAP's "autorefresh" mode consistently
              ;; consumes all of the RAM on my machine, so let's just
              ;; run it in a loop instead.
              (forever
               (system* "offlineimap")
               (sleep 40))))
   #:stop (make-kill-destructor))

 ;; FUSE
 (make <service>
   #:provides '(sshfs)
   #:requires '()
   #:start (make-forkexec-constructor
            (list "sshfs" "aigis:Music" (string-append %home "/Music"))))

 ;; Music
 (make <service>
   #:provides '(mpd)
   #:requires '()
   #:start (lambda args
             (define (scope file)
               (string-append %home "/.config/mpd/" file))

             (unless (file-exists? (scope "playlists"))
               (mkdir (scope "playlists")))
             (touch-file (scope "database"))
             (fork+exec-command
              (list "mpd" "--no-daemon"(scope "mpd.conf"))))
   #:stop (make-kill-destructor))
 (simple-service "mpdscribble"))

;; Send shepherd into the background.
(action 'shepherd 'daemonize)

;; Start the REPL server.
;; (spawn-server (make-tcp-server-socket #:port 37148))

;; Services to start when shepherd starts:
(for-each start '(xmodmap emacs))