#!/usr/bin/guile-3.0 --no-auto-compile
-*- scheme -*-
!#

(use-modules (hoot config)
             (hoot frontend)
             (hoot web-server)
             (ice-9 binary-ports)
             (ice-9 match)
             (srfi srfi-1)
             (srfi srfi-37))

(define %default-http-port 8080)
(define %default-repl-port 37146)

(define %info-options
  (list (option '(#\v "version") #f #f
                (lambda (opt name arg result)
                  (display %version)
                  (newline)
                  (exit 0)))
        (option '(#\h "help") #f #f
                (lambda (opt name arg result)
                  (display "hoot SUBCOMMAND [OPTION] ...

subcommands:
  repl
  server

common:
  -h, --help             print this help message
  -v, --version          print version

repl:
  -L, --load-path=DIR    add DIR to module load path
  -c, --connect[=PORT]   connect to REPL server listening on PORT or 37146

server:
  -p, --port=PORT        listen for HTTP requests on PORT
  --repl-port=PORT       listen for REPL clients on PORT
")
                  (exit 0)))))

(define %repl-options
  (cons* (option '(#\L "load-path") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'load-path arg result)))
         (option '(#\c "connect") #f #t
                 (lambda (opt name arg result)
                   (define port
                     (if arg (string->number arg) %default-repl-port))
                   (alist-cons 'port port result)))
         %info-options))

(define %server-options
  (cons* (option '(#\p "port") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'port (string->number arg) result)))
         (option '("repl-port") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'repl-port (string->number arg) result)))
         %info-options))

(define* (parse-args options args #:optional (default '()))
  (args-fold args options
             (lambda (opt name arg result)
               (format (current-error-port) "~A: unrecognized option~%" name)
	       (exit 1))
             (lambda (arg result)
               (format (current-error-port) "~A: unrecognized option~%" arg))
             default))

(define (collect alist key)
  (match alist
    (() '())
    (((k . v) . alist)
     (if (eq? k key)
         (cons v (collect alist key))
         (collect alist key)))))

(match (command-line)
  ((_ "repl" . args)
   (define opts (parse-args %repl-options args))
   (define load-path (append (hoot-load-path) (collect opts 'load-path)))
   (define port (assq-ref opts 'port))
   (cond
    ;; Connect to a remote REPL.
    (port
     (let* ((sock (socket PF_INET SOCK_STREAM IPPROTO_TCP))
            (pollset (vector (current-input-port) sock)))
       ;; XXX: Not using fibers here since it's currently an optional
       ;; dependency.
       (setsockopt sock IPPROTO_TCP TCP_NODELAY 1)
       (setvbuf sock 'block 1024)
       (connect sock AF_INET INADDR_LOOPBACK port)
       (let lp ()
         (match (select pollset #() #())
           ((#(in) _ _)
            (match (get-bytevector-some in)
              ((? eof-object?)
               (values))
              (bv
               (let ((out (if (eq? in sock) (current-output-port) sock)))
                 (put-bytevector out bv)
                 (force-output out)
                 (lp)))))))))
    ;; Spawn a local REPL.
    (else
     (let ((node (or %node "node"))
           (runner (in-vicinity %repl-dir "repl.js"))
           (repl-wasm (in-vicinity %repl-dir "repl.wasm")))
       (apply execlp node node runner "--"
              %reflect-js-dir %reflect-wasm-dir repl-wasm load-path)))))
  ((_ "server" . args)
   (define default
     `((port . ,%default-http-port)
       (repl-port . ,%default-repl-port)))
   (define opts (parse-args %server-options args default))
   (serve #:port (assq-ref opts 'port)
          #:repl-port (assq-ref opts 'repl-port)))
  ((_ . args)
   ;; Parse args in case of --help or --version.
   (parse-args %info-options args)
   (display "Run `hoot --help' for more information.\n")
   (exit 1)))
