(define-library
  (sx browser)
  (export
    browser-location-href
    browser-location-pathname
    browser-location-origin
    browser-same-origin?
    url-pathname
    browser-push-state
    browser-replace-state
    browser-reload
    browser-navigate
    local-storage-get
    local-storage-set
    local-storage-remove
    set-timeout
    set-interval
    clear-timeout
    clear-interval
    request-animation-frame
    fetch-request
    new-abort-controller
    controller-signal
    controller-abort
    promise-then
    promise-resolve
    promise-delayed
    browser-confirm
    browser-prompt
    browser-media-matches?
    json-parse
    json-stringify
    log-info
    log-warn
    console-log
    now-ms
    schedule-idle
    set-cookie
    get-cookie)
  (begin
    (define
      browser-location-href
      (fn () (host-get (host-get (dom-window) "location") "href")))
    (define
      browser-location-pathname
      (fn () (host-get (host-get (dom-window) "location") "pathname")))
    (define
      browser-location-origin
      (fn () (host-get (host-get (dom-window) "location") "origin")))
    (define
      browser-same-origin?
      ;; A relative URL (no scheme, not protocol-relative "//host") is same-origin
      ;; by definition; an absolute URL must start with our origin. The old check
      ;; only did the latter, so it wrongly rejected every relative link ("/x").
      (fn (url) (or (starts-with? url (browser-location-origin)) (and (not (string-contains? url "://")) (not (starts-with? url "//"))))))
    (define
      url-pathname
      (fn
        (url)
        (host-get (host-new "URL" url (browser-location-origin)) "pathname")))
    (define
      browser-push-state
      (fn
        (url-or-state title url)
        (if
          (nil? title)
          (host-call
            (host-get (dom-window) "history")
            "pushState"
            nil
            ""
            url-or-state)
          (host-call
            (host-get (dom-window) "history")
            "pushState"
            url-or-state
            title
            url))))
    (define
      browser-replace-state
      (fn
        (url-or-state title url)
        (if
          (nil? title)
          (host-call
            (host-get (dom-window) "history")
            "replaceState"
            nil
            ""
            url-or-state)
          (host-call
            (host-get (dom-window) "history")
            "replaceState"
            url-or-state
            title
            url))))
    (define
      browser-reload
      (fn () (host-call (host-get (dom-window) "location") "reload")))
    (define
      browser-navigate
      (fn (url) (host-set! (host-get (dom-window) "location") "href" url)))
    (define
      local-storage-get
      (fn
        (key)
        (host-call (host-get (dom-window) "localStorage") "getItem" key)))
    (define
      local-storage-set
      (fn
        (key val)
        (host-call (host-get (dom-window) "localStorage") "setItem" key val)))
    (define
      local-storage-remove
      (fn
        (key)
        (host-call (host-get (dom-window) "localStorage") "removeItem" key)))
    (define
      set-timeout
      (fn
        (fn-val ms)
        (host-call (dom-window) "setTimeout" (host-callback fn-val) ms)))
    (define
      set-interval
      (fn
        (fn-val ms)
        (host-call (dom-window) "setInterval" (host-callback fn-val) ms)))
    (define
      clear-timeout
      (fn (id) (host-call (dom-window) "clearTimeout" id)))
    (define
      clear-interval
      (fn (id) (host-call (dom-window) "clearInterval" id)))
    (define
      request-animation-frame
      (fn
        (fn-val)
        (host-call
          (dom-window)
          "requestAnimationFrame"
          (host-callback fn-val))))
    (define
      fetch-request
      (fn (url opts) (host-call (dom-window) "fetch" url opts)))
    (define new-abort-controller (fn () (host-new "AbortController")))
    (define
      controller-signal
      (fn (controller) (host-get controller "signal")))
    (define
      controller-abort
      (fn (controller) (host-call controller "abort")))
    (define
      promise-then
      (fn
        (p on-resolve on-reject)
        (let
          ((cb-resolve (host-callback on-resolve))
            (cb-reject (if on-reject (host-callback on-reject) nil)))
          (if
            cb-reject
            (host-call (host-call p "then" cb-resolve) "catch" cb-reject)
            (host-call p "then" cb-resolve)))))
    (define
      promise-resolve
      (fn (val) (host-call (host-global "Promise") "resolve" val)))
    (define
      promise-delayed
      (fn
        (ms val)
        (host-new
          "Promise"
          (host-callback
            (fn
              (resolve)
              (set-timeout (fn () (host-call resolve "call" nil val)) ms))))))
    (define
      browser-confirm
      (fn (msg) (host-call (dom-window) "confirm" msg)))
    (define
      browser-prompt
      (fn (msg default) (host-call (dom-window) "prompt" msg default)))
    (define
      browser-media-matches?
      (fn
        (query)
        (host-get (host-call (dom-window) "matchMedia" query) "matches")))
    (define json-parse (fn (s) (host-call (host-global "JSON") "parse" s)))
    (define
      log-info
      (fn
        (msg)
        (host-call (host-global "console") "log" (str "[sx] " msg))))
    (define
      log-warn
      (fn
        (msg)
        (host-call (host-global "console") "warn" (str "[sx] " msg))))
    (define
      console-log
      (fn
        (msg)
        (host-call (host-global "console") "log" (str "[sx] " msg))))
    (define now-ms (fn () (host-call (host-global "Date") "now")))
    (define
      schedule-idle
      (fn
        (f)
        (let
          ((cb (host-callback (fn (_deadline) (f)))))
          (if
            (host-get (dom-window) "requestIdleCallback")
            (host-call (dom-window) "requestIdleCallback" cb)
            (set-timeout cb 0)))))
    (define
      set-cookie
      (fn
        (name value days)
        (let
          ((d (or days 365))
            (expires
              (host-call
                (host-new
                  "Date"
                  (+ (host-call (host-global "Date") "now") (* d 86400000)))
                "toUTCString")))
          (host-set!
            (dom-document)
            "cookie"
            (str
              name
              "="
              (host-call nil "encodeURIComponent" value)
              ";expires="
              expires
              ";path=/;SameSite=Lax")))))
    (define
      get-cookie
      (fn
        (name)
        (let
          ((cookies (host-get (dom-document) "cookie"))
            (match
              (host-call
                cookies
                "match"
                (host-new "RegExp" (str "(?:^|;\\s*)" name "=([^;]*)")))))
          (if
            match
            (host-call nil "decodeURIComponent" (host-get match 1))
            nil))))))

;; Re-export to global env
(define
  json-stringify
  (fn (v) (host-call (host-global "JSON") "stringify" v)))

(import (sx browser))
