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

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

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

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

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

(define (command-dispatcher command)
  (match command
    ("help" dispatch-help)
    ("repl" dispatch-repl)
    ("server" dispatch-server)
    ("compile" dispatch-compile)
    ("strip" dispatch-strip)
    (_ #f)))

(define (dispatch-repl args)
  (define %options
    (list %version-option
          (option '(#\h "help") #f #f
                  (lambda (opt name arg result)
                    (display "Usage: hoot repl [OPTION] ...

Run a Hoot REPL, either locally using Hoot's repl.wasm running on Node,
or connecting to a remote REPL hosted by \"hoot server\".

Available options:
  -h, --help             print this help message
  -v, --version          print version
  -L, --load-path=DIR    add DIR to module load path
  -c, --connect[=PORT]   connect to REPL server listening on PORT or 37146

See \"Invoking hoot repl\" in the manual, for more.
")
                    (exit 0)))
          (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)))))

  (define opts (parse-args %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 "--experimental-wasm-exnref" runner "--"
             %reflect-js-dir %reflect-wasm-dir repl-wasm load-path)))))

(define (dispatch-server args)
  (define %options
    (list %version-option
          (option '(#\h "help") #f #f
                  (lambda (opt name arg result)
                    (display "Usage: hoot server [OPTION] ...

Development web server with REPL proxy from browser.

Available options:
  -h, --help             print this help message
  -v, --version          print version
  -p, --port=PORT        listen for HTTP requests on PORT
  --repl-port=PORT       listen for REPL clients on PORT

See \"Invoking hoot server\" in the manual, for more.
")
                    (exit 0)))
          (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)))))

  (define default
    `((port . ,%default-http-port)
      (repl-port . ,%default-repl-port)))
  (define opts (parse-args %options args #:default default))
  (serve #:port (assq-ref opts 'port)
         #:repl-port (assq-ref opts 'repl-port)))

(define (dispatch-strip args)
  (define %options
    (list %version-option
          (option '(#\h "help") #f #f
                  (lambda (opt name arg result)
                    (display "Usage: hoot strip [OPTION] IN.WASM

Strip debugging information from a WebAssembly file.  By default, the
debugging information is written to a separate file, with a reference to
it inserted into the stripped file.

Available options:
  -h, --help              print this help message
  -v, --version           print version
  -o, --output=FILE       write output to FILE insted of stripping in-place
  --debug-output=FILE     specify name for separate debug info file
  --discard               discard debug info instead of writing to separate file

See \"Invoking hoot strip\" in the manual, for more.
")
                    (exit 0)))
          (option '(#\o "output") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'output arg result)))
          (option '("debug-output") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'debug-output arg result)))
          (option '("discard") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'discard? #t result)))))

  (define default '())
  (define opts (parse-args %options args #:positional 'input-file))
  (define (replace-suffix filename old-suffix new-suffix)
    (string-append (if (string-suffix? old-suffix filename)
                       (substring filename 0 (- (string-length filename)
                                                (string-length old-suffix)))
                       filename)
                   new-suffix))
  (define (fail msg)
    (format (current-error-port) "hoot strip: error: ~a\n" msg)
    (exit 1))

  (match (collect opts 'input-file)
    ((input)
     (let* ((output (or (assq-ref opts 'output) input))
            (debug-output (or (assq-ref opts 'debug-output)
                              (replace-suffix output
                                              ".wasm" ".debug.wasm")))
            (discard? (assq-ref opts 'discard?)))
       (when (and discard? debug-output)
         (fail "--discard and --debug-output options are incompatible"))
       (when (equal? debug-output output)
         (fail "--output and --debug-output files are the same"))
       (call-with-values (lambda ()
                           (call-with-input-file input
                             (lambda (port)
                               (strip port
                                      #:external-debug-info debug-output))))
         (lambda (out-bv debug-bv)
           (when debug-output
             (unless debug-bv
               (fail "input file had no debug info"))
             (call-with-output-file debug-output
               (lambda (port)
                 (put-bytevector port debug-bv)))
             (format #t "wrote debug info to ~a\n" debug-output))
           (call-with-output-file output
             (lambda (port)
               (put-bytevector port out-bv)))
           (format #t "wrote stripped file to ~a\n" output)
           (exit 0)))))
    (_
     (fail "expected a single input file
Try \"hoot help strip\", for usage information."))))

(define (dispatch-help args)
  (match args
    (((= command-dispatcher (and dispatch (not #f))) . args)
     (dispatch (cons "--help" args)))
    (((or "-v" "--version") . _)
     (display %version)
     (newline))
    (_
     (display "Usage: hoot COMMAND [OPTION] ...

Hoot WebAssembly toolkit.

Available commands:
  compile
  help
  repl 
  server
  strip

Try \"hoot help COMMAND\" for more on a specific command.
")
     (newline))))

(define (dispatch-main args)
  (match args
    ;; Strip off argv0.
    ((_ . args)
     (match args
       ((or ()
            ((or "-h" "--help" "-v" "--version") . _))
        (dispatch-help args))
       (((= command-dispatcher dispatch) . args)
        (dispatch args)
        (exit 0))
       ((arg . _)
        (if (string-prefix? "-" arg)
            (format (current-error-port) "Invalid option: ~a\n" arg)
            (format (current-error-port) "Unknown subcommand: ~a\n" arg))
        (format (current-error-port)
                "Run `hoot --help' for more information.\n")
        (exit 1))))))

(when (batch-mode?)
  (dispatch-main (command-line)))
