;;; WebSockets
;;; Copyright (C) 2026 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

;;; Commentary:
;;;
;;; WebSockets as ports.
;;;
;;; Code:

(define-module (web socket)
  #:use-module (fibers)
  #:use-module (fibers channels)
  #:use-module (fibers conditions)
  #:use-module (fibers operations)
  #:use-module (hoot ffi)
  #:use-module (hoot ports)
  #:use-module (hoot typed-arrays)
  #:use-module (ice-9 match)
  #:use-module (rnrs bytevectors)
  #:export (websocket))

;; string -> WebSocket
(define-foreign make-websocket
  "rt" "make_websocket" (ref string) -> (ref extern))
;; WebSocket function -> none
(define-foreign set-websocket-on-message!
  "rt" "websocket_set_onmessage"
  (ref extern) (ref extern) -> none)
;; WebSocket function -> none
(define-foreign set-websocket-on-open!
  "rt" "websocket_set_onopen"
  (ref extern) (ref extern) -> none)
;; WebSocket function -> none
(define-foreign set-websocket-on-close!
  "rt" "websocket_set_onclose"
  (ref extern) (ref extern) -> none)
;; WebSocket Uint8Array -> none
(define-foreign websocket-send
  "rt" "websocket_send"
  (ref extern) (ref extern) -> none)
;; WebSocket -> none
(define-foreign websocket-close
  "rt" "websocket_close"
  (ref extern) -> none)

;; In the future, when WebSocketStream is supported across all major
;; browsers, we should probably just use that via (fibers streams).
(define (websocket url)
  (define ws (make-websocket url))
  (define ch (make-channel))
  (define open? (make-condition))
  (define done? #f)
  (define pos 0)
  (define chunk #f)
  (define chunk-len 0)
  (define (read dst start count)
    (if done?
        0
        (if (eq? pos chunk-len)
            (match (get-message ch)
              (#f
               (set! chunk #f)
               (set! chunk-len 0)
               (set! pos 0)
               (set! done? #t)
               0)
              (next
               (set! chunk next)
               (set! chunk-len (uint8array-length next))
               (set! pos 0)
               (read dst start count)))
            (let ((len (min count (- chunk-len pos))))
              (let lp ((i 0))
                (when (< i len)
                  (bytevector-u8-set! dst (+ start i)
                                      (uint8array-ref chunk (+ pos i)))
                  (lp (1+ i))))
              (set! pos (+ pos len))
              len))))
  (define (write src start count)
    (unless (zero? count)
      (let ((msg (make-uint8array count)))
        (let lp ((i 0))
          (when (< i count)
            (uint8array-set! msg i (bytevector-u8-ref src (+ start i)))
            (lp (1+ i))))
        (websocket-send ws msg)))
    count)
  (define (close)
    (websocket-close ws))
  (define (on-message msg)
    (let ((msg (if (string? msg) (string->utf8 msg) msg)))
      (put-message ch msg)))
  (define (on-open)
    (signal-condition! open?))
  (define (on-close)
    (put-message ch #f))
  (set-websocket-on-message! ws (procedure->external on-message))
  (set-websocket-on-open! ws (procedure->external on-open))
  (set-websocket-on-close! ws (procedure->external on-close))
  (wait open?)
  (make-port #:read read
             #:write write
             #:close close
             #:repr "WebSocket"))
