#lang racket/base

(require ffi/unsafe
         ffi/unsafe/define
         ffi/unsafe/atomic
         racket/async-channel
         racket/runtime-path
         racket/port
         data/queue
         json
         racket/string
         racket/path
         "mimetypes.rkt"
         )

(provide webui-new-window
         webui-show
         webui-bind
         webui-wait-async
         )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FFI Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define lib-type 'release)

(define-runtime-path lib-dir "lib")

(define libname (let ((os (system-type 'os*)))
                  (cond ((eq? os 'windows) (format "dll/webui-2-~a.dll" lib-type))
                        (else (error (format "OS ~a not supported" os)))))
  )

(define webui-lib-file (build-path lib-dir libname))


(define webui-lib (ffi-lib webui-lib-file))
(define-ffi-definer define-webui webui-lib)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Types
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define _size_t _int64)

(define _webui_config_t
  (_enum '(show-wait-connection = 0
           ui-event-blocking
           folder-monitor
           multi-client
           use-cookies
           asynchronous-response
           )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Handling events
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define-cstruct _Webui_event_t
  (
   [win _size_t]
   [event_type _size_t]
   [element _string/utf-8]
   [event_number _size_t]
   [bind_id _size_t]
   [client_id _size_t]
   [connection_id _size_t]
   [cookies _string/utf-8]
   ))

(define-struct webui-evt
  (win event-type element event-number bind-id client-id connection-id cookies
       (data #:mutable))
  #:transparent
  )

; ---------------------------------------------------------------------------
; Thread-safe queue — dispatches C callbacks onto a Racket thread
; async-channel is safe to put to from any OS thread (including WebUI's
; WebSocket threads) and never allocates inside a GC atomic section.
; ---------------------------------------------------------------------------

;(define callback-queue (make-async-channel))

(define (enqueue-callback thunk)
  ; This does not work, as C memory will already be deallocated when the racket thread handles
  ; the callback. 
  ;(async-channel-put callback-queue thunk))
  (thunk))

; Any C callback created from a Racket procedure via (_fun #:keep callback-store ...)
; is stored here, making it a permanent GC root. Without this, Racket CS's moving
; GC can collect/relocate the trampoline between webui_interface_bind and invocation.
(define callback-store (box '()))

;(void
;  (thread (lambda ()
;            (let loop ()
;              ((async-channel-get callback-queue))
;              (loop)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Handling of bind events.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define bind-event-queue (make-queue))
(define bind-event-sem   (make-semaphore))
(define bind-callbacks   (make-hash))

(define (handle-bind-event c-evt-ptr)
  (let ((evt (make-webui-evt
              (Webui_event_t-win c-evt-ptr)
              (Webui_event_t-event_type c-evt-ptr)
              (Webui_event_t-element c-evt-ptr)
              (Webui_event_t-event_number c-evt-ptr)
              (Webui_event_t-bind_id c-evt-ptr)
              (Webui_event_t-client_id c-evt-ptr)
              (Webui_event_t-connection_id c-evt-ptr)
              (Webui_event_t-cookies c-evt-ptr)
              #f
              )))
    (let ((count (webui_get_count c-evt-ptr)))
      (when (> count 0)
        (set-webui-evt-data! evt (webui_get_string_at c-evt-ptr 0))))
    (enqueue! bind-event-queue evt)
    ;(semaphore-post bind-event-sem)  ; In atomic mode no synchronization events
    ; must be triggered.
    ; As this is atomic mode, enqueue! will not interfere with dequeue!
    )
  )

(define bind-event-dispatcher
  (thread (λ ()
            (letrec ((dispatch-loop
                      (λ ()
                        ;(semaphore-wait bind-event-sem)
                        (when (> (queue-length bind-event-queue) 0)
                          (displayln (queue->list bind-event-queue))
                          (let* ((evt (dequeue! bind-event-queue))
                                 (data (webui-evt-data evt))
                                 (win (webui-evt-win evt))
                                 (event-number (webui-evt-event-number evt)))
                            (with-handlers ([exn:fail? (λ (e)
                                                         (displayln
                                                          (format "Event dispatching failed for: ~a" data))
                                                         (displayln
                                                          (format "Exception: ~a" e))
                                                         (webui_interface_set_response win event-number "")
                                                         )])
                              (let* ((bind-evt (with-input-from-string data read-json))
                                     (id (hash-ref bind-evt 'id #f))
                                     (sel (hash-ref bind-evt 'selector 'any))
                                     (event (hash-ref bind-evt 'evt #f))
                                     (callback-id (string->symbol (format "sel-~a-~a" sel event)))
                                     (cbs (hash-ref bind-callbacks win #f)))
                                (cond
                                  ([eq? cbs #f]
                                   (error (format "No callbacks registered for window: ~a" win)))
                                  (else
                                   (let ((evt-handler (hash-ref cbs callback-id #f)))
                                     (cond
                                       ([eq? evt-handler #f]
                                        (error (format "No callback registered for: ~a" callback-id)))
                                       (else
                                        (let ((result (evt-handler win id bind-evt)))
                                          (webui_interface_set_response win event-number
                                                                        (if (and result (not (void? result)))
                                                                            (format "~a" result)
                                                                            ""))))))))))))
                        (unless (> (queue-length bind-event-queue) 0)
                          (sleep 0.1))
                        (dispatch-loop))))
              (dispatch-loop))))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Log applier
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define timer-display (λ displ #t))

(define debug-log (make-queue))

(define (log-applier thunk)
  (start-atomic)
  (thunk)
  (end-atomic)
  )

(define (do-log level message data)
  (enqueue! debug-log (list level (timer-display #f)
                            (bytes-copy message))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Serving virtual files...
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define file-handler-queue (make-queue))
(define file-handler-sem   (make-semaphore))
(define file-handler-file-providers (make-hash))

(define (file-handler-callback win filename length-ptr)
  (let ((fn (format "~a" filename)))
    (enqueue! file-handler-queue (list win fn (timer-display #f)))
    ;(semaphore-post file-handler-sem)
    #f ; return NULL and later set the data via async response
    ))

(define (make-reply file)
  (if (file-exists? file)
      (cond ((or (string-suffix? file ".html")
                 (string-suffix? file ".htm")
                 )
             (let* ((size (file-size file))
                    (fin (open-input-file file))
                    (str (read-string size fin)))
               (let ((reply (string->bytes/utf-8
                             (string-append
                             "HTTP/1.1 200 OK\r\n"
                             "Content-Type: text/html\r\n"
                             (format "Content-Length: ~a\r\n\r\n" size)
                             str))))
                 (close-input-port fin)
                 (displayln (format "Returning http response of ~a bytes" (bytes-length reply)))
                 (list #t (bytes-length reply) reply)))
             )
            (else (let* ((size (file-size file))
                         (ext (substring (bytes->string/utf-8
                                          (path-get-extension file)) 1))
                         (fin (open-input-file file))
                         (bytes (read-bytes size fin)))
                    (let* ((hdr (string-append
                                  "HTTP/1.1 200 OK\r\n"
                                  (format "Content-Type: ~a\r\n" (ext->mimetype ext))
                                  (format "Content-Length: ~a\r\n\r\n" size)
                                  ))
                           (reply (bytes-append (string->bytes/utf-8 hdr) bytes))
                           )
                      (close-input-port fin)
                      (displayln (format "Returning http response of ~a bytes" (bytes-length reply)))
                      (list #t (bytes-length reply) reply)))
                  )
            )
      (begin
        (displayln (format "File ~a does not exist" file))
        (list #f 0 ""))
      )
  )

(define file-handler-dispatcher
  (thread
   (λ ()
     (letrec ((dispatch-loop
               (λ ()
                 ;(semaphore-wait file-handler-sem)
                 (when (> (queue-length file-handler-queue) 0)
                   (timer-display)
                   (displayln (queue->list file-handler-queue))
                   (let* ((req (dequeue! file-handler-queue))
                          (win (car req))
                          (req-filename (cadr req))
                          (filename ((hash-ref file-handler-file-providers win) req-filename))
                          (time (caddr req))
                          (reply (make-reply filename)))
                     (displayln (format "http-req: ~a at ~a" filename time))
                     (let ((valid-reply (car reply))
                           (length (cadr reply))
                           (content (caddr reply)))
                       (if valid-reply
                           (webui_interface_set_response_file_handler win content length)
                           (webui_interface_set_response_file_handler win #f 0))
                       )
                     ))
                 (unless (> (queue-length file-handler-queue) 0)
                   (sleep 0.1))
                 (dispatch-loop))
               ))
       (dispatch-loop))
     )
   )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FFI functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define _int-pointer (_ptr i _int))

(define _Webui_Bind_Callback
  (_fun #:keep callback-store #:async-apply enqueue-callback
        _Webui_event_t-pointer -> _void))

(define _Webui_FileHandler_Callback
  (_fun #:keep callback-store #:async-apply enqueue-callback
        _string/utf-8 _int-pointer -> _pointer))

(define _Webui_FileHandlerWin_Callback
  (_fun #:keep callback-store #:async-apply enqueue-callback
        _size_t _string/utf-8 _int-pointer -> _pointer))

;WEBUI_EXPORT bool webui_wait_async(void);
(define-webui webui_wait_async (_fun -> _int))

;WEBUI_EXPORT size_t webui_new_window(void);
(define-webui webui_new_window (_fun -> _size_t))

;WEBUI_EXPORT size_t webui_bind(size_t window, const char* element, void (*func)(webui_event_t* e));
(define-webui webui_bind (_fun _size_t _string/utf-8 _Webui_Bind_Callback -> _size_t))

;WEBUI_EXPORT bool webui_show(size_t window, const char* content);
(define-webui webui_show (_fun _size_t _string/utf-8 -> _int))

;WEBUI_EXPORT bool webui_show_browser(size_t window, const char* content, size_t browser);
(define-webui webui_show_browser (_fun _size_t _string/utf-8 _size_t -> _int))

;WEBUI_EXPORT bool webui_show_wv(size_t window, const char* content);
(define-webui webui_show_wv (_fun _size_t _string/utf-8 -> _int))

;WEBUI_EXPORT void webui_exit(void);
(define-webui webui_exit (_fun -> _void))

;WEBUI_EXPORT void webui_destroy(size_t window);
(define-webui webui_destroy (_fun _size_t -> _void))

;WEBUI_EXPORT void webui_close(size_t window);
(define-webui webui_close (_fun _size_t -> _void))

;WEBUI_EXPORT bool webui_set_root_folder(size_t window, const char* path);
(define-webui webui_set_root_folder (_fun _size_t _string/utf-8 -> _int))

;WEBUI_EXPORT void webui_run(size_t window, const char* script);
(define-webui webui_run (_fun _size_t _string/utf-8 -> _void))

;WEBUI_EXPORT size_t webui_get_count(webui_event_t* e);
(define-webui webui_get_count (_fun _Webui_event_t-pointer -> _size_t))

;WEBUI_EXPORT long long int webui_get_int_at(webui_event_t* e, size_t index);
(define-webui webui_get_int_at (_fun _Webui_event_t-pointer _size_t -> _int64))

;WEBUI_EXPORT double webui_get_float_at(webui_event_t* e, size_t index);
(define-webui webui_get_float_at (_fun _Webui_event_t-pointer _size_t -> _double))

;WEBUI_EXPORT const char* webui_get_string_at(webui_event_t* e, size_t index);
(define-webui webui_get_string_at (_fun _Webui_event_t-pointer _size_t -> _string/utf-8))

;WEBUI_EXPORT void webui_set_file_handler(size_t window, const void* (*handler)(const char* filename, int* length));
(define-webui webui_set_file_handler
  (_fun _size_t _Webui_FileHandler_Callback -> _void))

;WEBUI_EXPORT void webui_set_file_handler_window(size_t window, const void* (*handler)(size_t window, const char* filename, int* length));
(define-webui webui_set_file_handler_window
  (_fun _size_t _Webui_FileHandlerWin_Callback -> _void))

;WEBUI_EXPORT void webui_interface_set_response_file_handler(size_t window, const void* response, int length);
(define-webui webui_interface_set_response_file_handler
  (_fun _size_t _bytes _int -> _void))

;WEBUI_EXPORT void webui_interface_set_response(size_t window, size_t event_number, const char* response);
(define-webui webui_interface_set_response
  (_fun _size _size _string/utf-8 -> _void))

;WEBUI_EXPORT void webui_set_config(webui_config option, bool status);
(define-webui webui_set_config
  (_fun _webui_config_t _int -> _void))

;WEBUI_EXPORT void webui_set_logger(void (*func)(size_t level, const char* log, void* user_data), void *user_data);
(define-webui webui_set_logger
  (_fun
   (_fun #:keep callback-store #:async-apply enqueue-callback
         _size_t _bytes/nul-terminated _pointer -> _void)
   _pointer -> _void))

;WEBUI_EXPORT const char* webui_start_server(size_t window, const char* content);
(define-webui webui_start_server
  (_fun _size_t _string/utf-8 -> _string/utf-8))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Configure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(webui_set_config 'asynchronous-response 1)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Async Wait loop as co-routine
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define run-async-thread #f)
(define log-fh (open-output-file "test.log" #:exists 'replace))

(define (add-to-log)
  (if (> (queue-length debug-log) 0)
      (begin
        (display (dequeue! debug-log) log-fh)
        (add-to-log))
      (flush-output log-fh)))

(define (logger)
  (thread (λ ()
            (letrec ((f (λ ()
                          (add-to-log)
                          (sleep 0.1)
                          (f))))
              (f)
              )))
  )

(define log-thread (logger))

(define (finish-log)
  (kill-thread log-thread)
  (add-to-log)
  (close-output-port log-fh))
      

(define (run-async-wait)
  (when (or (eq? run-async-thread #f)
            (not (thread-running? run-async-thread)))
    (set! run-async-thread 
          (thread (λ ()
                    (letrec ((wait-loop
                              (λ ()
                                (let ((r (webui_wait_async)))   ; Returns true if windows are open
                                  (when (eq? r #t)
                                    (sleep 0.1)
                                    (wait-loop))))))
                      (wait-loop)))
                  #:pool #f
                  )
          )
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (webui-new-window)
  (let ((win (webui_new_window)))
    ;(webui_bind win "" queue-webui-event)
    (webui_bind win "web_ui_wire_handle_event" handle-bind-event)
    win))

(define (webui-show win html)
  (webui_show win html)
  (run-async-wait)
  )

(define (webui-show-browser win html)
  (webui_show_browser win html 1)
  (run-async-wait)
  )

(define (webui-show-wv win html)
  (webui_show_wv win html)
  (run-async-wait)
  )


(define (webui-run win js)
  (webui_run win js))

(define (webui-set-config option status)
  (webui_set_config option status))

(define (webui-bind win selector event callback)
  (let ((sel (if (symbol? selector)
                 (format "#~a" selector)
                 selector))
        (evt (if (symbol? event)
                   (format "~a" event)
                   event))
        )
    (webui-run win
               (string-append "window._web_wire_bind_evt_ids("
                              (format "~a" win)
                              ", '"
                              sel
                              "', '"
                              evt
                              "');"
                              ))
    (let ((cbs (hash-ref bind-callbacks win (make-hash))))
      (hash-set! cbs (string->symbol (format "sel-~a-~a" sel event)) callback)
      (hash-set! bind-callbacks win cbs))
    )
  )

(define (webui-set-file-handler-window win callback)
  (hash-set! file-handler-file-providers win callback)
  (webui_set_file_handler_window win file-handler-callback))

(define (webui-register-move-callback win callback)
    (let ((cbs (hash-ref bind-callbacks win (make-hash))))
      (hash-set! cbs (string->symbol "sel-global-window-move") callback)
      (hash-set! bind-callbacks win cbs))
  )

(define (webui-register-resize-callback win callback)
    (let ((cbs (hash-ref bind-callbacks win (make-hash))))
      (hash-set! cbs (string->symbol "sel-global-window-resize") callback)
      (hash-set! bind-callbacks win cbs))
  )

(define (webui-register-onload-callback win callback)
    (let ((cbs (hash-ref bind-callbacks win (make-hash))))
      (hash-set! cbs (string->symbol "sel-global-html-loaded") callback)
      (hash-set! bind-callbacks win cbs))
  )

(define (webui-wait-async)
  (webui_wait_async))

(define (webui-close win)
  (webui_close win))

(define (webui-destroy win)
  (webui_destroy win)
  (hash-remove! bind-callbacks win)
  )

(define (webui-start-server win url)
  (webui_start_server win url))

(define (webui-exit)
  (webui_exit))

(define (webui-set-root-folder win path)
  (let ((p (if (path? path) (path->string path) path)))
    (webui_set_root_folder win p)))
  
(define (timer)
  (let ((ms (current-milliseconds)))
    (λ displ
      (let* ((dms (- (current-milliseconds) ms))
             (s (exact->inexact (/ dms 1000))))
        (when (null? displ)
          (displayln (format "~a" s)))
        s))))

;(webui_set_logger do-log #f)

(define win #f)
(define (test)
  (let ((tm (timer)))
    (set! timer-display tm)
    (tm)
    (set! win (webui-new-window))
    (tm)
    (webui-set-root-folder win "c:/devel/racket/racket-webui")
    (tm)
    (webui-set-file-handler-window win
                                   (λ (req-file)
                                     (let ((file 
                                            (format "c:/devel/racket/racket-webui~a" req-file)))
                                     (displayln (format "file: ~a" file))
                                       file)))
    (tm)
    (webui-register-onload-callback
     win
     (λ (win id data)
       (webui-bind win "button" 'click
                   (λ (win id data)
                     (displayln (format "~a: ~a" id data)))
                   )
       )
     )
    (tm)
    (webui-register-move-callback win (λ (win id data)
                                        (displayln data)))
    (webui-register-resize-callback win (λ (win id data)
                                          (displayln data)))
    (tm)
    ;(displayln (webui-start-server win "test.html"))
    (tm)
    (webui-show-browser win "test.html")
    ;(webui-show-wv win "test.html")
    (tm)
    )
  )


(define (test-close)
  (webui-close win)
  ;(webui-destroy win)    ;;; Hmm. Crashes in debug mode
  )