#lang racket/base

(require ffi/unsafe
         ffi/unsafe/define
         ffi/unsafe/atomic
         racket/runtime-path
         racket/port
         data/queue
         json
         racket/string
         )

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

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

(define lib-type 'debug)

(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 event-queue (make-queue))
(define webui-event-queue (make-queue))

;typedef struct webui_event_t {
;    size_t window;          // The window object number
;    size_t event_type;      // Event type
;    char* element;          // HTML element ID
;    size_t event_number;    // Internal WebUI
;    size_t bind_id;         // Bind ID
;    size_t client_id;       // Client's unique ID
;    size_t connection_id;   // Client's connection ID
;    char* cookies;          // Client's full cookies
;} webui_event_t;

(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
  )

(define (queue-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! event-queue evt)
    )
  )

(define dispatcher-sem (make-semaphore))

(define (enqueue-applyer queue-event-closure)
  (start-atomic)
  (queue-event-closure)
  (end-atomic)
  (semaphore-post dispatcher-sem)
  )

(define callbacks (make-hash))

(define (event-dispatcher)
  (thread
   (λ ()
     (letrec ((dispatcher
               (λ ()
                 (semaphore-wait dispatcher-sem)
                 (let* ((evt (dequeue! event-queue))
                        (data (webui-evt-data evt)))
                   (with-handlers ([exn:fail?
                                    (λ (e)
                                      (displayln (format
                                                  "Event dispatching failed for: ~a" data)))])
                     (let ((e (with-input-from-string
                                  data
                                (λ () (read-json)))))
                       (let ((id (hash-ref e 'id #f))
                             (sel (hash-ref e 'selector 'any))
                             (event (hash-ref e 'evt #f))
                             (win (webui-evt-win evt)))
                         (let ((cb-id (string->symbol (format "sel-~a-~a" sel event))))
                           (let ((cbs (hash-ref callbacks win #f)))
                             (if (eq? cbs #f)
                                 (displayln (format "No callbacks registered for window: ~a" win))
                                 (let ((evt-handler (hash-ref cbs cb-id #f)))
                                   (if (eq? evt-handler #f)
                                       (displayln (format "No callback registered for ~a" cb-id))
                                       (evt-handler win id e)
                                       )
                                   )
                                 )
                             )
                           )
                         )
                       )
                     )
                   )
                 (dispatcher)
                 )
               ))
       (dispatcher))
     )
   )
  )

(event-dispatcher)

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

(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) message)))

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

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

(define request-sem (make-semaphore))

(define (filehandler-applier thunk)
  (start-atomic)
  (thunk)
  (end-atomic)
  (semaphore-post request-sem)
  )

(define requested-files (make-queue))

(define (fh-callback win filename length-ptr)
  (enqueue! requested-files (list win filename (timer-display #f)))
  #f)

(define (make-reply file)
  (if (file-exists? file)
      (if (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-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)
              (list #t (string-length reply) reply)))
          (list #f 0 ""))
      (list #f 0 "")
      )
  )

(define (http-req-dispatcher)
  (thread
   (λ ()
     (letrec ((dispatcher
               (λ ()
                 (semaphore-wait request-sem)
                 (timer-display)
                 (let* ((req (dequeue! requested-files))
                        (win (car req))
                        (filename (cadr req))
                        (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))
                     )
                   )
                 (dispatcher))
               ))
       (dispatcher))
     )
   )
  )

(http-req-dispatcher)

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

(define _Webui_Bind_Callback (_fun #:async-apply enqueue-applyer
                                   _Webui_event_t-pointer -> _void))

(define _int-pointer (_ptr i _int))

(define _Webui_FileHandler_Callback
  (_fun #:async-apply filehandler-applier _string/utf-8 _int-pointer -> _pointer))

(define _Webui_FileHandlerWin_Callback
  (_fun #:async-apply filehandler-applier _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 _pointer _int -> _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 #:async-apply log-applier
         _size_t _bytes _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 (λ ()
            (add-to-log)
            (sleep 0.1)
            )))

(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" queue-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 callbacks win (make-hash))))
      (hash-set! cbs (string->symbol (format "sel-~a-~a" sel event)) callback)
      (hash-set! callbacks win cbs))
    )
  )

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

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

(define (webui-register-onload-callback win callback)
    (let ((cbs (hash-ref callbacks win (make-hash))))
      (hash-set! cbs (string->symbol "sel-global-html-loaded") callback)
      (hash-set! 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! 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 fh-callback)
    (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
  )