(library (sph storage dg server)
  (export
    dg-server-client
    dg-server-default-port
    dg-server-start
    dg-server-stop
    sph-storage-dg-server-description)
  (import
    (guile)
    (rnrs eval)
    (sph)
    (sph alist)
    (sph cli)
    (sph filesystem)
    (sph io)
    (sph lang scheme)
    (sph list)
    (sph log)
    (sph server)
    (sph storage dg)
    (sph storage dg one))

  (define sph-storage-dg-server-description
    "start a server with a server that evaluates scheme code with a loaded dg database.
     one use case is inter-process communication")

  (define-as dg-server-default-env-libraries list-q
    (sph common) (sph storage dg)
    (sph storage dg one) (sph storage dg relation path-find) (sph storage dg server))

  (define dg-server-default-address
    (let (dir (ensure-trailing-slash (dirname (tmpnam))))
      (nullary (string-append dir (number->string (getuid)) "/dg-server"))))

  (define dg-server-default-port 6501)
  (define dg-server-default-env (apply environment dg-server-default-env-libraries))
  (define (dg-server-stop) (raise (q dg-server-exit)))

  (define (startup-message address port) "any any -> unspecified"
    (display-line
      (string-append "start listening on " address
        (if port (string-append ":" (number->string port)) "") "\nexit with ctrl+c")))

  (define (default-server-error-handler obj resume)
    "any procedure -> unspecified
     exit when obj is the symbol dg-server-exit, log and resume otherwise"
    (if (not (eq? (q dg-server-exit) obj)) (begin (log-message (q error) obj) (resume))))

  (define (remove-unix-socket a) (if (and (string-prefix? "/" a) (file-exists? a)) (delete-file a)))

  (define* (dg-server-start #:key address port env threads socket error-handler)
    "procedure:{list:header:((string . string) ...) port:client-socket ->} socket/false false/integer string boolean ->
     start listening on a socket and call proc for each incoming request.
     the socket protocol-family depends on the address: if it starts with a slash a local unix socket is used, if it contains colons ip6, otherwise ip4.
     if socket is false, a socket is created with (socket AF_UNIX SOCK_STREAM 0). default port for tcp sockets is 6500"
    (let
      ( (env (or env dg-server-default-env))
        (address (or address (make-path-unique (dg-server-default-address)))))
      (startup-message address port)
      (server-listen
        (l (client) (let (query (port->datums client)) (write (eval query env) client)))
        (or socket
          (socket-create-bound address #:port
            (or port dg-server-default-port) #:set-options
            (l (a) (setsockopt a SOL_SOCKET SO_REUSEADDR 1)
              (setsockopt a SOL_SOCKET SO_SNDBUF 0) (setsockopt a SOL_SOCKET SO_RCVBUF 0))))
        #:parallelism (or threads 1))
      (remove-unix-socket address)))

  (define* (dg-server-client proc #:optional address port)
    (let
      ((address (or address (dg-server-default-address))) (port (or port dg-server-default-port)))
      (let*
        ( (socket (socket PF_UNIX SOCK_STREAM 0))
          (result (and (connect socket AF_UNIX address) (proc socket))))
        (close socket) result))))