miso-1.13.0.0: src/Miso/FFI/Internal.hs
-----------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module : Miso.FFI.Internal
-- Copyright : (C) 2016-2026 David M. Johnson
-- License : BSD3-style (see the file LICENSE)
-- Maintainer : David M. Johnson <code@dmj.io>
-- Stability : experimental
-- Portability : non-portable
--
-- = Overview
--
-- "Miso.FFI.Internal" contains the low-level browser bindings that back the
-- miso runtime. It is exposed for advanced use-cases and custom renderer
-- authors; most application code should import "Miso.FFI" instead, which
-- re-exports a curated subset of this module.
--
-- = Drawing context abstraction
--
-- Miso routes all DOM mutations through a /drawing context/ object stored at
-- @globalThis.miso.drawingContext@. This indirection lets the same Haskell
-- runtime target different rendering backends (browser DOM, native mobile via
-- <https://github.com/haskell-miso/miso-lynx miso-lynx>, etc.) without
-- changing application code. Use 'setDrawingContext' to switch renderers at
-- startup:
--
-- @
-- setDrawingContext \"lynx\" -- switch to the Lynx native renderer
-- @
--
-- = Inline JavaScript
--
-- 'inline' provides a safe, scoped alternative to 'Miso.DSL.eval'. It
-- wraps a JS snippet in a function, passes the supplied 'Miso.DSL.Object'
-- fields as named parameters, and returns the result:
--
-- @
-- {-\# LANGUAGE DeriveGeneric, DeriveAnyClass \#-}
--
-- data Person = Person { name :: MisoString, age :: Int }
-- deriving (Generic, ToJSVal, ToObject)
--
-- logNameGetAge :: Person -> IO Int
-- logNameGetAge person = inline
-- \"console.log(name); return age;\"
-- person
-- @
--
-- Prefer 'inline' (or the @[js| … |]@ quasi-quoter from "Miso.FFI.QQ")
-- over 'Miso.DSL.eval' — 'inline' is isolated and not subject to the
-- security concerns or optimisation barriers of @eval@.
--
-- = API groups
--
-- * __Callbacks__: 'syncCallback', 'asyncCallback' (and 1\/2-arg variants)
-- * __Events__: 'addEventListener', 'removeEventListener',
-- 'eventPreventDefault', 'eventStopPropagation',
-- 'delegator', 'dispatchEvent', 'newEvent', 'newCustomEvent'
-- * __Window__: 'windowAddEventListener', 'windowRemoveEventListener',
-- 'windowInnerHeight', 'windowInnerWidth'
-- * __DOM__: 'getBody', 'getDocument', 'getElementById', 'getHead',
-- 'removeChild', 'nextSibling', 'previousSibling', 'diff', 'hydrate'
-- * __Console__: 'consoleLog', 'consoleWarn', 'consoleError', 'consoleLog''
-- * __Performance__: 'now'
-- * __Element actions__: 'focus', 'blur', 'select', 'setSelectionRange',
-- 'scrollIntoView', 'requestFullscreen', 'click', 'files', 'setValue'
-- * __CSS \/ JS injection__: 'addStyle', 'addStyleSheet', 'addScript',
-- 'addSrc', 'addScriptImportMap'
-- * __Network__: 'fetch' \/ t'Response' \/ 'CONTENT_TYPE',
-- 'websocketConnect', 'websocketSend', 'websocketClose',
-- 'eventSourceConnect', 'eventSourceClose'
-- * __Navigator__: 'getUserMedia', 'copyClipboard', 'geolocation', 'isOnLine'
-- * __Types__: t'Image', t'Date', t'Blob', t'File', t'FormData',
-- t'ArrayBuffer', t'Uint8Array', t'FileReader', t'URLSearchParams', t'Event'
-- * __Randomness__: 'splitmix32', 'mathRandom', 'getRandomValue'
--
-- = See also
--
-- * "Miso.FFI" — public re-export surface for application code
-- * "Miso.FFI.QQ" — @[js| … |]@ quasi-quoter for inline JavaScript
-- * "Miso.DSL" — 'Miso.DSL.JSVal', 'Miso.DSL.ToJSVal', 'Miso.DSL.FromJSVal'
-----------------------------------------------------------------------------
module Miso.FFI.Internal
( -- * Callbacks
syncCallback
, syncCallback1
, syncCallback2
, asyncCallback
, asyncCallback1
, asyncCallback2
-- * Events
, addEventListener
, removeEventListener
, eventPreventDefault
, eventStopPropagation
-- * Window
, windowAddEventListener
, windowRemoveEventListener
, windowInnerHeight
, windowInnerWidth
-- * Performance
, now
-- * Console
, consoleWarn
, consoleLog
, consoleError
, consoleLog'
-- * JSON
, eventJSON
-- * Object
, set
, setValue
-- * DOM
, getBody
, getDocument
, getDrawingContext
, getHydrationContext
, getEventContext
, getElementById
, removeChild
, getHead
, diff
, nextSibling
, previousSibling
, getProperty
, callFunction
, castJSVal
-- * Events
, delegator
, dispatchEvent
, newEvent
, newCustomEvent
-- * Isomorphic
, hydrate
-- * Misc.
, focus
, blur
, select
, setSelectionRange
, scrollIntoView
, requestFullscreen
, alert
, locationReload
-- * CSS
, addStyle
, addStyleSheet
-- * JS
, addSrc
, addScript
, addScriptImportMap
-- * XHR
, fetch
, CONTENT_TYPE(..)
-- * Drawing
, setDrawingContext
, flush
-- * Image
, Image (..)
, newImage
-- * Date
, Date (..)
, newDate
, toLocaleString
-- * Utils
, getMilliseconds
, getSeconds
-- * Element
, files
, click
-- * WebSocket
, websocketConnect
, websocketClose
, websocketSend
-- * SSE
, eventSourceConnect
, eventSourceClose
-- * Blob
, Blob (..)
-- * FormData
, FormData (..)
-- * URLSearchParams
, URLSearchParams (..)
-- * File
, File (..)
-- * Uint8Array
, Uint8Array (..)
-- * ArrayBuffer
, ArrayBuffer (..)
-- * Navigator
, geolocation
, copyClipboard
, getUserMedia
, isOnLine
, onBTS
, onMTS
, getThreads
-- * Cookie Store
, cookieGet
, cookieGetAll
, cookieSet
, cookieDelete
, cookieDeleteWith
, cookieStoreAddEventListener
, cookieStoreRemoveEventListener
-- * FileReader
, FileReader (..)
, newFileReader
-- * Fetch API
, Response (..)
-- * Event
, Event (..)
-- * Class
, populateClass
, updateRef
-- * Inline JS
, inline
-- * Randomness
, splitmix32
-- * Math
, mathRandom
-- * Crypto
, getRandomValue
) where
-----------------------------------------------------------------------------
import Control.Monad (void, forM_, (<=<), when, unless)
import Data.Map.Strict (Map)
import Data.Maybe
import Prelude hiding ((!!))
-----------------------------------------------------------------------------
import Miso.DSL
import Miso.String
-----------------------------------------------------------------------------
-- | Set property on object
set
:: ToJSVal v
=> MisoString
-- ^ Property name to set
-> v
-- ^ Value to assign
-> Object
-- ^ JavaScript object to mutate
-> IO ()
{-# INLINABLE set #-}
set k v o = do
v' <- toJSVal v
setProp (fromMisoString k) v' o
-----------------------------------------------------------------------------
-- | Get a property of a 'JSVal'
--
-- Example usage:
--
-- > Just (value :: String) <- fromJSVal =<< getProperty domRef "value"
getProperty
:: JSVal
-- ^ JavaScript object to read from
-> MisoString
-- ^ Property name to retrieve
-> IO JSVal
{-# INLINABLE getProperty #-}
getProperty = (!)
-----------------------------------------------------------------------------
-- | Calls a function on a 'JSVal'
--
-- Example usage:
--
-- > callFunction domRef "focus" ()
-- > callFunction domRef "setSelectionRange" (0, 3, "none")
callFunction :: (ToArgs args) => JSVal -> MisoString -> args -> IO JSVal
{-# INLINABLE callFunction #-}
callFunction = (#)
-----------------------------------------------------------------------------
-- | Marshalling of 'JSVal', useful for 'getProperty'
castJSVal :: (FromJSVal a) => JSVal -> IO (Maybe a)
{-# INLINABLE castJSVal #-}
castJSVal = fromJSVal
-----------------------------------------------------------------------------
-- | Register an event listener on given target.
addEventListener
:: JSVal
-- ^ Event target on which we want to register event listener
-> MisoString
-- ^ Type of event to listen to (e.g. "click")
-> (JSVal -> IO ())
-- ^ Callback which will be called when the event occurs,
-- the event will be passed to it as a parameter.
-> IO Function
{-# INLINABLE addEventListener #-}
addEventListener self name cb = do
#ifdef GHCJS_BOTH
cb_ <- Function <$> syncCallback1 cb
#else
cb_ <- Function <$> asyncCallback1 cb
#endif
void $ self # "addEventListener" $ (name, cb_)
pure cb_
-----------------------------------------------------------------------------
-- | Removes an event listener from given target.
removeEventListener
:: JSVal
-- ^ Event target from which we want to remove event listener
-> MisoString
-- ^ Type of event to listen to (e.g. "click")
-> Function
-- ^ Callback which will be called when the event occurs,
-- the event will be passed to it as a parameter.
-> IO ()
{-# INLINABLE removeEventListener #-}
removeEventListener self name cb =
void $ self # "removeEventListener" $ (name, cb)
-----------------------------------------------------------------------------
-- | Removes an event listener from window
windowRemoveEventListener
:: MisoString
-- ^ Type of event to listen to (e.g. "click")
-> Function
-- ^ Callback which will be called when the event occurs,
-- the event will be passed to it as a parameter.
-> IO ()
{-# INLINABLE windowRemoveEventListener #-}
windowRemoveEventListener name cb = do
win <- jsg "window"
removeEventListener win name cb
-----------------------------------------------------------------------------
-- | Registers an event listener on window
windowAddEventListener
:: MisoString
-- ^ Type of event to listen to (e.g. "click")
-> (JSVal -> IO ())
-- ^ Callback which will be called when the event occurs,
-- the event will be passed to it as a parameter.
-> IO Function
{-# INLINABLE windowAddEventListener #-}
windowAddEventListener name cb = do
win <- jsg "window"
addEventListener win name cb
-----------------------------------------------------------------------------
-- | Stop propagation of events
eventStopPropagation :: JSVal -> IO ()
{-# INLINABLE eventStopPropagation #-}
eventStopPropagation e = do
_ <- e # "stopPropagation" $ ()
pure ()
-----------------------------------------------------------------------------
-- | Prevent default event behavior
eventPreventDefault :: JSVal -> IO ()
{-# INLINABLE eventPreventDefault #-}
eventPreventDefault e = do
_ <- e # "preventDefault" $ ()
pure ()
-----------------------------------------------------------------------------
-- | Retrieves the height (in pixels) of the browser window viewport including,
-- if rendered, the horizontal scrollbar.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/Window/innerHeight>
windowInnerHeight :: IO Int
{-# INLINABLE windowInnerHeight #-}
windowInnerHeight = fromJSValUnchecked =<< jsg "window" ! "innerHeight"
-----------------------------------------------------------------------------
-- | Retrieves the width (in pixels) of the browser window viewport including
-- if rendered, the vertical scrollbar.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/Window/innerWidth>
windowInnerWidth :: IO Int
{-# INLINABLE windowInnerWidth #-}
windowInnerWidth =
fromJSValUnchecked =<< jsg "window" ! "innerWidth"
-----------------------------------------------------------------------------
-- | Retrieve high resolution time stamp
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/Performance/now>
-- Lynx's *background* thread realm has no @performance@ global at all - only
-- the main thread does - so the obvious @performance.now()@ throws
-- @cannot read property 'now' of undefined@ there. Everything that timestamps
-- from the BTS goes through here, including gesture handling like
-- double-tap detection, so that throw took real features down rather than
-- merely losing precision. Falls back to @Date.now()@, which every realm has.
now :: IO Double
{-# INLINABLE now #-}
now = now_ffi
-----------------------------------------------------------------------------
-- | Outputs a message to the web console
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/Console/log>
--
-- Console logging of JavaScript strings.
consoleLog :: MisoString -> IO ()
{-# INLINABLE consoleLog #-}
consoleLog v = do
_ <- jsg "console" # "log" $ [ms v]
pure ()
-----------------------------------------------------------------------------
-- | Outputs a warning message to the web console
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/Console/warn>
--
-- Console logging of JavaScript strings.
consoleWarn :: MisoString -> IO ()
{-# INLINABLE consoleWarn #-}
consoleWarn v = do
_ <- jsg "console" # "warn" $ [ms v]
pure ()
-----------------------------------------------------------------------------
-- | Outputs an error message to the web console
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/Console/error>
--
-- Console logging of JavaScript strings.
consoleError :: MisoString -> IO ()
{-# INLINABLE consoleError #-}
consoleError v = do
_ <- jsg "console" # "error" $ [ms v]
pure ()
-----------------------------------------------------------------------------
-- | Console-logging of JSVal
consoleLog' :: ToArgs a => a -> IO ()
{-# INLINABLE consoleLog' #-}
consoleLog' args' = do
args <- toArgs args'
_ <- jsg "console" # "log" $ args
pure ()
-----------------------------------------------------------------------------
-- | Convert a JavaScript object to JSON
-- JSONified representation of events
eventJSON
:: JSVal -- ^ decodeAt :: [JSString]
-> JSVal -- ^ object with impure references to the DOM
-> IO JSVal
{-# INLINABLE eventJSON #-}
eventJSON x y = do
moduleMiso <- jsg "miso"
moduleMiso # "eventJSON" $ [x,y]
-----------------------------------------------------------------------------
-- | Used to update the JavaScript reference post-diff.
updateRef
:: ToJSVal val
=> val
-> val
-> IO ()
{-# INLINABLE updateRef #-}
updateRef jsval1 jsval2 = do
moduleMiso <- jsg "miso"
freeJSVal =<< (moduleMiso # "updateRef" $ (jsval1, jsval2))
freeJSVal moduleMiso
-----------------------------------------------------------------------------
-- | Convenience function to write inline javascript.
--
-- Prefer this function over the use of `eval`.
--
-- This function takes as arguments a JavaScript object and makes the
-- keys available in the function body.
--
-- @
--
-- data Person = Person { name :: MisoString, age :: Int }
-- deriving stock (Generic)
-- deriving anyclass (ToJSVal, ToObject)
--
-- logNameGetAge :: Person -> IO Int
-- logNameGetAge = inline
-- """
-- console.log(@name@, name);
-- return age;
-- """
--
-- @
--
inline
:: (FromJSVal return, ToObject object)
=> MisoString
-> object
-> IO return
{-# INLINABLE inline #-}
inline code o = do
moduleMiso <- jsg "miso"
Object obj <- toObject o
fromJSValUnchecked =<< do
moduleMiso # "inline" $ (code, obj)
-----------------------------------------------------------------------------
-- | Populate the 'Miso.Html.Property.classList' Set on the virtual DOM.
populateClass
:: JSVal
-- ^ Node
-> [MisoString]
-- ^ classes
-> IO ()
{-# INLINABLE populateClass #-}
populateClass domRef classes = do
moduleMiso <- jsg "miso"
freeJSVal =<< (moduleMiso # "populateClass" $ (domRef, classes))
freeJSVal moduleMiso
-----------------------------------------------------------------------------
-- | Retrieves a reference to document body.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/Document/body>
getBody :: IO JSVal
{-# INLINABLE getBody #-}
getBody = do
ctx <- getDrawingContext
ctx # "getRoot" $ ()
-----------------------------------------------------------------------------
-- | Retrieves a reference to the document.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/Document>
getDocument :: IO JSVal
{-# INLINABLE getDocument #-}
getDocument = jsg "document"
-----------------------------------------------------------------------------
-- | Retrieves a reference to the drawing context.
--
-- This is a miso specific construct used to provide an identical interface
-- for both native (iOS / Android, etc.) and browser environments.
--
getDrawingContext :: IO JSVal
{-# INLINABLE getDrawingContext #-}
getDrawingContext = do
moduleMiso <- jsg "miso"
context <- moduleMiso ! "drawingContext"
freeJSVal moduleMiso
pure context
-----------------------------------------------------------------------------
-- | Retrieves a reference to the event context.
--
-- This is a miso specific construct used to provide an identical interface
-- for both native (iOS / Android, etc.) and browser environments.
--
getEventContext :: IO JSVal
{-# INLINABLE getEventContext #-}
getEventContext = jsg "miso" ! "eventContext"
-----------------------------------------------------------------------------
-- | Retrieves a reference to the hydration context.
--
-- This is a miso specific construct used to provide an identical interface
-- for both native (iOS / Android, etc.) and browser environments.
--
getHydrationContext :: IO JSVal
{-# INLINABLE getHydrationContext #-}
getHydrationContext = jsg "miso" ! "hydrationContext"
-----------------------------------------------------------------------------
-- | Returns an Element object representing the element whose id property matches
-- the specified string.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/Document/getElementById>
getElementById :: MisoString -> IO JSVal
{-# INLINABLE getElementById #-}
getElementById e = getDocument # "getElementById" $ [e]
-----------------------------------------------------------------------------
-- | Retrieves a reference to the renderer's "head" mount.
--
-- Calls @miso.drawingContext.getHead()@.
--
-- Note: custom renderers should implement this method.
--
-- @since 1.9.0.0
getHead :: IO JSVal
{-# INLINABLE getHead #-}
getHead = do
context <- getDrawingContext
context # "getHead" $ ()
-----------------------------------------------------------------------------
-- | Removes a child node from a parent node.
--
-- Calls @miso.drawingContext.removeChild(parent, child)@.
--
-- @since 1.9.0.0
removeChild :: JSVal -> JSVal -> IO ()
{-# INLINABLE removeChild #-}
removeChild parent child = do
context <- getDrawingContext
void $ context # "removeChild" $ (parent, child)
-----------------------------------------------------------------------------
-- | Diff two virtual DOMs
diff
:: Object
-- ^ current object
-> Object
-- ^ new object
-> JSVal
-- ^ parent node
-> IO ()
{-# INLINABLE diff #-}
diff (Object a) (Object b) c = do
moduleMiso <- jsg "miso"
context <- getDrawingContext
freeJSVal =<< (moduleMiso # "diff" $ [a,b,c,context])
freeJSVal moduleMiso
freeJSVal context
-----------------------------------------------------------------------------
-- | Initialize event delegation from a mount point.
delegator :: JSVal -> JSVal -> Bool -> IO JSVal -> IO ()
{-# INLINABLE delegator #-}
delegator mountPoint events debug getVTree = do
ctx <- getEventContext
#ifdef WASM
cb <- asyncCallback1 $ \continuation -> void (call continuation global =<< getVTree)
#else
cb <- syncCallback1 $ \continuation -> void (call continuation global =<< getVTree)
#endif
d <- toJSVal debug
eventContext <- getEventContext
void $ eventContext # "delegator" $ [mountPoint,events,cb,d,ctx]
-----------------------------------------------------------------------------
-- | Copies DOM pointers into virtual dom entry point into isomorphic javascript
--
-- See [hydration](https://en.wikipedia.org/wiki/Hydration_(web_development))
--
hydrate :: Bool -> JSVal -> JSVal -> IO JSVal
{-# INLINABLE hydrate #-}
hydrate logLevel mountPoint vtree = do
ll <- toJSVal logLevel
drawingContext <- getDrawingContext
hydrationContext <- getHydrationContext
moduleMiso <- jsg "miso"
moduleMiso # "hydrate" $ (ll, mountPoint, vtree, hydrationContext, drawingContext)
-----------------------------------------------------------------------------
-- | Fails silently if the element is not found.
--
-- Analogous to @document.getElementById(id).focus()@.
focus :: MisoString -> IO ()
{-# INLINABLE focus #-}
focus x = void $ jsg "miso" # "callFocus" $ (x, 50 :: Int)
-----------------------------------------------------------------------------
-- | Fails silently if the element is not found.
--
-- Analogous to @document.getElementById(id).blur()@
blur :: MisoString -> IO ()
{-# INLINABLE blur #-}
blur x = void $ jsg "miso" # "callBlur" $ (x, 50 :: Int)
-----------------------------------------------------------------------------
-- | Fails silently if the element is not found.
--
-- Analogous to @document.querySelector('#' + id).select()@.
select :: MisoString -> IO ()
{-# INLINABLE select #-}
select x = void $ jsg "miso" # "callSelect" $ (x, 50 :: Int)
-----------------------------------------------------------------------------
-- | Fails silently if the element is not found.
--
-- Analogous to @document.querySelector('#' + id).setSelectionRange(start, end, \'none\')@.
setSelectionRange
:: MisoString
-- ^ DOM element @id@ (without the @#@ prefix) to call @setSelectionRange@ on
-> Int
-- ^ Selection start index (inclusive)
-> Int
-- ^ Selection end index (exclusive)
-> IO ()
{-# INLINABLE setSelectionRange #-}
setSelectionRange x start end = void $ jsg "miso" # "callSetSelectionRange" $ (x, start, end, 50 :: Int)
-----------------------------------------------------------------------------
-- | Calls @document.getElementById(id).scrollIntoView()@
scrollIntoView :: MisoString -> IO ()
{-# INLINABLE scrollIntoView #-}
scrollIntoView elId = do
el <- jsg "document" # "getElementById" $ [elId]
_ <- el # "scrollIntoView" $ ()
pure ()
-----------------------------------------------------------------------------
-- | Calls @document.documentElement.requestFullscreen()@, falling back to
-- @webkitRequestFullscreen@ for Safari.
requestFullscreen :: IO ()
{-# INLINABLE requestFullscreen #-}
requestFullscreen = do
doc <- jsg "document"
docEl <- doc ! "documentElement"
rfs <- docEl ! "requestFullscreen"
undef <- isUndefined rfs
if undef
then do
wrfs <- docEl ! "webkitRequestFullscreen"
wundef <- isUndefined wrfs
unless wundef $ void $ docEl # "webkitRequestFullscreen" $ ()
else void $ docEl # "requestFullscreen" $ ()
-----------------------------------------------------------------------------
-- | Calls the @alert()@ function.
alert :: MisoString -> IO ()
{-# INLINABLE alert #-}
alert a = () <$ jsg1 "alert" a
-----------------------------------------------------------------------------
-- | Calls the @location.reload()@ function.
locationReload :: IO ()
{-# INLINABLE locationReload #-}
locationReload = void $ jsg "location" # "reload" $ ([] :: [MisoString])
-----------------------------------------------------------------------------
-- | Appends a 'Miso.Html.Element.style_' element containing CSS to 'Miso.Html.Element.head_'
--
-- > addStyle "body { background-color: green; }"
--
-- > <head><style>body { background-color: green; }</style></head>
--
addStyle :: MisoString -> IO JSVal
{-# INLINABLE addStyle #-}
addStyle css = do
context <- getDrawingContext
head_ <- getHead
style <- context # "createElement" $ ["style" :: MisoString]
setField style "innerHTML" css
void $ context # "appendChild" $ (head_, style)
pure style
-----------------------------------------------------------------------------
-- | Appends a 'Miso.Html.Element.script_' element containing JS to 'Miso.Html.Element.head_'
--
-- > addScript False "function () { alert('hi'); }"
--
addScript :: Bool -> MisoString -> IO JSVal
{-# INLINABLE addScript #-}
addScript useModule js_ = do
context <- getDrawingContext
head_ <- getHead
script <- context # "createElement" $ ["script" :: MisoString]
when useModule $ setField script "type" ("module" :: MisoString)
setField script "innerHTML" js_
void $ context # "appendChild" $ (head_, script)
pure script
-----------------------------------------------------------------------------
-- | Sets the @.value@ property on a @DOMRef@.
--
-- Useful for resetting the @value@ property on an input element.
--
-- @
-- setValue domRef ("" :: MisoString)
-- @
--
setValue :: JSVal -> MisoString -> IO ()
{-# INLINABLE setValue #-}
setValue domRef value = setField domRef "value" value
-----------------------------------------------------------------------------
-- | Appends a 'Miso.Html.Element.script_' element containing a JS import map.
--
-- > addScript "{ \"import\" : { \"three\" : \"url\" } }"
--
addScriptImportMap :: MisoString -> IO JSVal
{-# INLINABLE addScriptImportMap #-}
addScriptImportMap impMap = do
context <- getDrawingContext
head_ <- getHead
script <- context # "createElement" $ ["script" :: MisoString]
setField script "type" ("importmap" :: MisoString)
setField script "innerHTML" impMap
void $ context # "appendChild" $ (head_, script)
pure script
-----------------------------------------------------------------------------
-- | Appends a \<script\> element to 'Miso.Html.Element.head_'
--
-- > addSrc "https://example.com/script.js"
--
addSrc :: MisoString -> Bool -> IO JSVal
{-# INLINABLE addSrc #-}
addSrc url cacheBust = do
context <- getDrawingContext
head_ <- getHead
link <- context # "createElement" $ ["script" :: MisoString]
url_ <- appendTimestamp url cacheBust
_ <- link # "setAttribute" $ ["src", url_ ]
void $ context # "appendChild" $ (head_, link)
pure link
-----------------------------------------------------------------------------
-- | Appends a StyleSheet 'Miso.Html.Element.link_' element to 'Miso.Html.Element.head_'
-- The 'Miso.Html.Element.link_' tag will contain a URL to a CSS file.
--
-- > addStyleSheet "https://cdn.jsdelivr.net/npm/todomvc-common@1.0.5/base.min.css"
--
-- > <head><link href="https://cdn.jsdelivr.net/npm/todomvc-common@1.0.5/base.min.css" ref="stylesheet"></head>
--
addStyleSheet :: MisoString -> Bool -> IO JSVal
{-# INLINABLE addStyleSheet #-}
addStyleSheet url cacheBust = do
context <- getDrawingContext
head_ <- getHead
link <- context # "createElement" $ ["link" :: MisoString]
_ <- link # "setAttribute" $ ["rel","stylesheet" :: MisoString]
url_ <- appendTimestamp url cacheBust
_ <- link # "setAttribute" $ ["href", url_ ]
void $ context # "appendChild" $ (head_, link)
pure link
-----------------------------------------------------------------------------
-- | Helper for cache busting
appendTimestamp
:: MisoString
-- ^ Base URL to optionally append a timestamp query parameter to
-> Bool
-- ^ When 'True', appends @?v=\<timestamp\>@ to force cache invalidation
-> IO MisoString
{-# INLINABLE appendTimestamp #-}
appendTimestamp url = \case
True -> do
ts <- fromJSValUnchecked =<< do jsg "Date" # "now" $ ()
pure (url <> "?v=" <> ms (ts :: Double))
False ->
pure url
-----------------------------------------------------------------------------
-- | Retrieve JSON via Fetch API
--
-- Basic GET of JSON using Fetch API, will be expanded upon.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API>
--
fetch
:: (FromJSVal success, FromJSVal error)
=> MisoString
-- ^ url
-> MisoString
-- ^ method
-> Maybe JSVal
-- ^ body
-> [(MisoString, MisoString)]
-- ^ headers
-> (Response success -> IO ())
-- ^ successful callback
-> (Response error -> IO ())
-- ^ errorful callback
-> CONTENT_TYPE
-- ^ content type
-> IO ()
{-# INLINABLE fetch #-}
fetch url method maybeBody requestHeaders successful errorful type_ = do
successful_ <- toJSVal =<< asyncCallback1 (successful <=< fromJSValUnchecked)
errorful_ <- toJSVal =<< asyncCallback1 (errorful <=< fromJSValUnchecked)
moduleMiso <- jsg "miso"
url_ <- toJSVal url
method_ <- toJSVal method
body_ <- toJSVal maybeBody
Object headers_ <- do
o <- create
forM_ requestHeaders $ \(k,v) -> set k v o
pure o
typ <- toJSVal type_
void $ moduleMiso # "fetchCore" $
[ url_
, method_
, body_
, headers_
, successful_
, errorful_
, typ
]
-----------------------------------------------------------------------------
-- | List of possible content types that are available for use with the fetch API
data CONTENT_TYPE
= JSON
| ARRAY_BUFFER
| TEXT
| BLOB
| BYTES
| FORM_DATA
| NONE
deriving (Show, Eq)
-----------------------------------------------------------------------------
instance ToJSVal CONTENT_TYPE where
toJSVal = \case
JSON ->
toJSVal ("json" :: MisoString)
ARRAY_BUFFER ->
toJSVal ("arrayBuffer" :: MisoString)
TEXT ->
toJSVal ("text" :: MisoString)
BLOB ->
toJSVal ("blob" :: MisoString)
BYTES ->
toJSVal ("bytes" :: MisoString)
FORM_DATA ->
toJSVal ("formData" :: MisoString)
NONE ->
toJSVal ("none" :: MisoString)
{-# INLINE toJSVal #-}
-----------------------------------------------------------------------------
-- | Flush is used to force a draw of the render tree. This is currently
-- only used when targeting platforms other than the browser (like mobile).
flush :: IO ()
{-# INLINABLE flush #-}
flush = do
context <- getDrawingContext
freeJSVal =<< (context # "flush" $ ([] :: [JSVal]))
freeJSVal context
-----------------------------------------------------------------------------
-- | Type that holds an [Image](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/img).
newtype Image = Image JSVal
deriving (ToJSVal, ToObject)
-----------------------------------------------------------------------------
instance FromJSVal Image where
fromJSVal = pure . pure . Image
{-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
-- | Smart constructor for building a t'Image' w/ 'Miso.Html.Property.src_' 'Miso.Types.Attribute'.
newImage :: MisoString -> IO Image
{-# INLINABLE newImage #-}
newImage url = do
img <- new (jsg "Image") ([] :: [MisoString])
setField img "src" url
pure (Image img)
-----------------------------------------------------------------------------
-- | Used to select a drawing context. Users can override the default DOM renderer
-- by implementing their own Context, and exporting it to the global scope. This
-- opens the door to different rendering engines, ala [miso-lynx](https://github.com/haskell-miso/miso-lynx).
setDrawingContext :: MisoString -> IO ()
{-# INLINABLE setDrawingContext #-}
setDrawingContext rendererName =
void $ jsg "miso" # "setDrawingContext" $ [rendererName]
-----------------------------------------------------------------------------
-- | The [Date](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date) type
newtype Date = Date JSVal
deriving (ToJSVal, ToObject, Eq)
-----------------------------------------------------------------------------
-- | Smart constructor for a t'Date'
newDate :: IO Date
{-# INLINABLE newDate #-}
newDate = Date <$> new (jsg "Date") ([] :: [MisoString])
-----------------------------------------------------------------------------
-- | Date conversion function to produce a locale
toLocaleString :: Date -> IO MisoString
{-# INLINABLE toLocaleString #-}
toLocaleString date = fromJSValUnchecked =<< do
date # "toLocaleString" $ ()
-----------------------------------------------------------------------------
-- | Retrieves current milliseconds from t'Date'
getMilliseconds :: Date -> IO Double
{-# INLINABLE getMilliseconds #-}
getMilliseconds date =
fromJSValUnchecked =<< do
date # "getMilliseconds" $ ([] :: [MisoString])
-----------------------------------------------------------------------------
-- | Retrieves current seconds from t'Date'
getSeconds :: Date -> IO Double
{-# INLINABLE getSeconds #-}
getSeconds date =
fromJSValUnchecked =<< do
date # "getSeconds" $ ([] :: [MisoString])
-----------------------------------------------------------------------------
-- | Fetch next sibling DOM node
--
-- @since 1.9.0.0
nextSibling :: JSVal -> IO JSVal
{-# INLINABLE nextSibling #-}
nextSibling domRef = domRef ! "nextSibling"
-----------------------------------------------------------------------------
-- | Fetch previous sibling DOM node
--
-- @since 1.9.0.0
previousSibling :: JSVal -> IO JSVal
{-# INLINABLE previousSibling #-}
previousSibling domRef = domRef ! "previousSibling"
-----------------------------------------------------------------------------
-- | When working with @\<input type="file"\>@, this is useful for
-- extracting out the selected files.
--
-- @
-- update (InputClicked inputElement) = withSink $ \\sink -> do
-- files_ <- files inputElement
-- forM_ files_ $ \\file -> sink (Upload file)
-- update (Upload file) = do
-- fetch \"https://localhost:8080\/upload\" \"POST\" (Just file) []
-- Successful Errorful
-- @
--
-- @since 1.9.0.0
files :: JSVal -> IO [JSVal]
{-# INLINABLE files #-}
files domRef = fromJSValUnchecked =<< domRef ! "files"
-----------------------------------------------------------------------------
-- | Simulates a click event
--
-- > button & click ()
--
-- @since 1.9.0.0
click :: () -> JSVal -> IO ()
{-# INLINABLE click #-}
click () domRef = void $ domRef # "click" $ ([] :: [MisoString])
-----------------------------------------------------------------------------
-- | Get Camera on user's device
--
-- <https://developer.mozilla.org/en-US/docs/Web/API/MediaDevices/getUserMedia>
--
getUserMedia
:: Bool
-- ^ video
-> Bool
-- ^ audio
-> (JSVal -> IO ())
-- ^ successful
-> (JSVal -> IO ())
-- ^ errorful
-> IO ()
{-# INLINABLE getUserMedia #-}
getUserMedia video audio successful errorful = do
params <- create
set "video" video params
set "audio" audio params
devices <- jsg "navigator" ! "mediaDevices"
promise <- devices # "getUserMedia" $ [params]
successfulCallback <- asyncCallback1 successful
void $ promise # "then" $ [successfulCallback]
errorfulCallback <- asyncCallback1 errorful
void $ promise # "catch" $ [errorfulCallback]
-----------------------------------------------------------------------------
-- | Copy clipboard
--
-- <https://developer.mozilla.org/en-US/docs/Web/API/MediaDevices/getUserMedia>
--
copyClipboard
:: MisoString
-- ^ Text to copy
-> IO ()
-- ^ successful
-> (JSVal -> IO ())
-- ^ errorful
-> IO ()
{-# INLINABLE copyClipboard #-}
copyClipboard txt successful errorful = do
clipboard <- jsg "navigator" ! "clipboard"
promise <- clipboard # "writeText" $ [txt]
successfulCallback <- asyncCallback successful
void $ promise # "then" $ [successfulCallback]
errorfulCallback <- asyncCallback1 errorful
void $ promise # "catch" $ [errorfulCallback]
-----------------------------------------------------------------------------
-- | Establishes a @WebSocket@ connection
websocketConnect
:: MisoString
-> IO ()
-> (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
{-# INLINABLE websocketConnect #-}
websocketConnect
url onOpen onClose
onMessageText onMessageJSON
onMessageBLOB onMessageArrayBuffer
onError textOnly = do
url_ <- toJSVal url
onOpen_ <- toJSVal =<< asyncCallback onOpen
onClose_ <- toJSVal =<< asyncCallback1 onClose
onMessageText_ <- withMaybe onMessageText
onMessageJSON_ <- withMaybe onMessageJSON
onMessageBLOB_ <- withMaybe onMessageBLOB
onMessageArrayBuffer_ <- withMaybe onMessageArrayBuffer
onError_ <- toJSVal =<< asyncCallback1 onError
textOnly_ <- toJSVal textOnly
jsg "miso" # "websocketConnect" $
[ url_
, onOpen_
, onClose_
, onMessageText_
, onMessageJSON_
, onMessageBLOB_
, onMessageArrayBuffer_
, onError_
, textOnly_
]
where
withMaybe Nothing = pure jsNull
withMaybe (Just f) = asyncCallback1 f
-----------------------------------------------------------------------------
-- | Closes an open WebSocket.
--
-- @since 1.13.0.0
websocketClose :: JSVal -> IO ()
{-# INLINABLE websocketClose #-}
websocketClose websocket = void $ do
jsg "miso" # "websocketClose" $ [websocket]
-----------------------------------------------------------------------------
-- | Sends a payload over an open WebSocket.
--
-- @since 1.13.0.0
websocketSend :: JSVal -> JSVal -> IO ()
{-# INLINABLE websocketSend #-}
websocketSend websocket message = void $ do
jsg "miso" # "websocketSend" $ [websocket, message]
-----------------------------------------------------------------------------
-- | Opens a @Server-Sent Events@ connection and wires up its callbacks.
--
-- @since 1.13.0.0
eventSourceConnect
:: MisoString
-> IO ()
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
{-# INLINABLE eventSourceConnect #-}
eventSourceConnect url onOpen onMessageText onMessageJSON onError textOnly = do
onOpen_ <- asyncCallback onOpen
onMessageText_ <- withMaybe onMessageText
onMessageJSON_ <- withMaybe onMessageJSON
onError_ <- asyncCallback1 onError
textOnly_ <- toJSVal textOnly
jsg "miso" # "eventSourceConnect" $
(url, onOpen_, onMessageText_, onMessageJSON_, onError_, textOnly_)
where
withMaybe Nothing = pure jsNull
withMaybe (Just f) = toJSVal =<< asyncCallback1 f
-----------------------------------------------------------------------------
-- | Closes an open @Server-Sent Events@ connection.
--
-- @since 1.13.0.0
eventSourceClose :: JSVal -> IO ()
{-# INLINABLE eventSourceClose #-}
eventSourceClose eventSource = void $ do
jsg "miso" # "eventSourceClose" $ [eventSource]
-----------------------------------------------------------------------------
-- | Navigator function to query the current online status of the user's computer
--
-- See [navigator.onLine](https://developer.mozilla.org/en-US/docs/Web/API/Navigator/onLine)
--
isOnLine :: IO Bool
{-# INLINABLE isOnLine #-}
isOnLine = fromJSValUnchecked =<< jsg "navigator" ! "onLine"
-----------------------------------------------------------------------------
-- | Returns 'True' when executing on the Lynx background thread (BTS),
-- @False@ on the main thread or in a web build.
--
-- Backed by @miso.onBTS()@, which uses the @__BACKGROUND__@ compile-time
-- define injected by rspeedy. In web builds where @__BACKGROUND__@ is
-- undefined the function safely returns @false@.
--
-- @since 1.13.0.0
onBTS :: IO Bool
{-# INLINABLE onBTS #-}
onBTS = fromJSValUnchecked =<< do jsg "miso" # "onBTS" $ ()
-----------------------------------------------------------------------------
-- | Returns 'True' when executing on the Lynx main thread (MTS),
-- @False@ on the background thread and in web builds.
--
-- @since 1.13.0.0
onMTS :: IO Bool
{-# INLINABLE onMTS #-}
onMTS = fromJSValUnchecked =<< do jsg "miso" # "onMTS" $ ()
-----------------------------------------------------------------------------
-- | Returns @(mts, bts, web)@: whether the current execution context is the
-- Lynx main thread, Lynx background thread, or a plain web build.
--
-- @since 1.13.0.0
getThreads :: IO (Bool, Bool, Bool)
getThreads = do
mts <- onMTS
bts <- onBTS
pure (mts, bts, not mts && not bts)
-----------------------------------------------------------------------------
-- | [Blob](https://developer.mozilla.org/en-US/docs/Web/API/FormData)
newtype Blob = Blob JSVal
deriving (ToJSVal, Eq)
-----------------------------------------------------------------------------
instance FromJSVal Blob where
fromJSVal = pure . pure . Blob
{-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
-- | [FormData](https://developer.mozilla.org/en-US/docs/Web/API/FormData)
newtype FormData = FormData JSVal
deriving (ToJSVal, Eq)
-----------------------------------------------------------------------------
instance FromJSVal FormData where
fromJSVal = pure . pure . FormData
{-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
instance FromJSVal ArrayBuffer where
fromJSVal = pure . pure . ArrayBuffer
{-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
-- | [ArrayBuffer](https://developer.mozilla.org/en-US/docs/Web/API/ArrayBuffer)
newtype ArrayBuffer = ArrayBuffer JSVal
deriving (Eq, ToJSVal)
-----------------------------------------------------------------------------
-- | Reads the device position via @navigator.geolocation.getCurrentPosition@.
--
-- @since 1.13.0.0
geolocation :: (JSVal -> IO ()) -> (JSVal -> IO ()) -> IO ()
{-# INLINABLE geolocation #-}
geolocation successful errorful = do
geo <- jsg "navigator" ! "geolocation"
cb1 <- asyncCallback1 successful
cb2 <- asyncCallback1 errorful
void $ geo # "getCurrentPosition" $ (cb1, cb2)
-----------------------------------------------------------------------------
-- | [File](https://developer.mozilla.org/en-US/docs/Web/API/File)
newtype File = File JSVal
deriving (ToJSVal, ToObject, Eq)
-----------------------------------------------------------------------------
instance FromJSVal File where
fromJSVal = pure . pure . File
{-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
-- | [Uint8Array](https://developer.mozilla.org/en-US/docs/Web/API/Uint8Array)
newtype Uint8Array = Uint8Array JSVal
deriving ToJSVal
-----------------------------------------------------------------------------
instance FromJSVal Uint8Array where
fromJSVal = pure . pure . Uint8Array
{-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
-- | [FileReader](https://developer.mozilla.org/en-US/docs/Web/API/FileReader)
newtype FileReader = FileReader JSVal
deriving (ToJSVal, ToObject, Eq)
-----------------------------------------------------------------------------
instance FromJSVal FileReader where
fromJSVal = pure . pure . FileReader
{-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
-- | [URLSearchParams](https://developer.mozilla.org/en-US/docs/Web/API/URLSearchParams)
newtype URLSearchParams = URLSearchParams JSVal
deriving (ToJSVal, ToObject, Eq)
-----------------------------------------------------------------------------
instance FromJSVal URLSearchParams where
fromJSVal = pure . pure . URLSearchParams
{-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
-- | Smart constructor for building a t'FileReader'
newFileReader :: IO FileReader
{-# INLINABLE newFileReader #-}
newFileReader = do
reader <- new (jsg "FileReader") ([] :: [MisoString])
pure (FileReader reader)
-----------------------------------------------------------------------------
-- | Type returned from a 'fetch' request
data Response body
= Response
{ status :: Maybe Int
-- ^ HTTP status code
, headers :: Map MisoString MisoString
-- ^ Response headers
, errorMessage :: Maybe MisoString
-- ^ Optional error message
, body :: body
-- ^ Response body
}
-----------------------------------------------------------------------------
instance Functor Response where
fmap f response@Response { body } = response { body = f body }
{-# INLINE fmap #-}
-----------------------------------------------------------------------------
instance FromJSVal body => FromJSVal (Response body) where
fromJSVal o = do
status_ <- fromJSVal =<< getProp "status" (Object o)
headers_ <- fromJSVal =<< getProp "headers" (Object o)
errorMessage_ <- fromJSVal =<< getProp "error" (Object o)
body_ <- fromJSVal =<< getProp "body" (Object o)
pure (Response <$> status_ <*> headers_ <*> errorMessage_ <*> body_)
{-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
-- | [Event](https://developer.mozilla.org/en-US/docs/Web/API/Event/Event)
newtype Event = Event JSVal
deriving (ToJSVal, Eq)
-----------------------------------------------------------------------------
instance FromJSVal Event where
fromJSVal = pure . Just . Event
{-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
-- | Invokes [document.dispatchEvent](https://developer.mozilla.org/en-US/docs/Web/API/EventTarget/dispatchEvent)
--
-- @
-- update ChangeTheme = io_ $ do
-- themeEvent <- newEvent "basecoat:theme"
-- dispatchEvent themeEvent
-- @
--
dispatchEvent :: Event -> IO ()
{-# INLINABLE dispatchEvent #-}
dispatchEvent event = do
doc <- getDocument
_ <- doc # "dispatchEvent" $ [event]
pure ()
-----------------------------------------------------------------------------
-- | Creates a new [Event](https://developer.mozilla.org/en-US/docs/Web/API/Event/Event)
--
-- @
-- update ChangeTheme = io_ $ do
-- themeEvent <- newEvent "basecoat:theme"
-- dispatchEvent themeEvent
-- @
--
newEvent :: ToArgs args => args -> IO Event
{-# INLINABLE newEvent #-}
newEvent args = Event <$> new (jsg "Event") args
-----------------------------------------------------------------------------
-- | Creates a new [Event](https://developer.mozilla.org/en-US/docs/Web/API/Event/CustomEvent)
--
-- @
-- update ToggleSidebar = io_ $ do
-- themeEvent <- newCustomEvent "basecoat:sidebar"
-- dispatchEvent themeEvent
-- @
--
newCustomEvent :: ToArgs args => args -> IO Event
{-# INLINABLE newCustomEvent #-}
newCustomEvent args = Event <$> new (jsg "CustomEvent") args
-----------------------------------------------------------------------------
-- | Uses the @splitmix@ function to generate a PRNG.
--
splitmix32 :: Double -> IO JSVal
{-# INLINABLE splitmix32 #-}
splitmix32 x = jsg "miso" # "splitmix32" $ [x]
-----------------------------------------------------------------------------
-- | Uses the 'Math.random()' function.
--
mathRandom :: IO Double
{-# INLINABLE mathRandom #-}
mathRandom = fromJSValUnchecked =<< do
jsg "miso" # "mathRandom" $ ()
-----------------------------------------------------------------------------
-- | Uses the first element of 'crypto.getRandomValues()'.
--
getRandomValue :: IO Double
{-# INLINABLE getRandomValue #-}
getRandomValue = fromJSValUnchecked =<< do
jsg "miso" # "getRandomValues" $ ()
-----------------------------------------------------------------------------
-- | Retrieve a single cookie by name from the
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore CookieStore API>.
--
-- The successful callback receives a @null@ 'JSVal' when no cookie with
-- that name exists. The errorful callback receives the error message string.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/get>
--
-- @since 1.13.0.0
cookieGet
:: MisoString
-- ^ Cookie name
-> (JSVal -> IO ())
-- ^ Successful callback
-> (MisoString -> IO ())
-- ^ Errorful callback
-> IO ()
{-# INLINABLE cookieGet #-}
cookieGet name successful errorful = do
s_ <- toJSVal =<< asyncCallback1 successful
e_ <- toJSVal =<< asyncCallback1 (errorful <=< fromJSValUnchecked)
n_ <- toJSVal name
void $ jsg "miso" # "cookieGet" $ [n_, e_, s_]
-----------------------------------------------------------------------------
-- | Retrieve all cookies from the
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore CookieStore API>.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/getAll>
--
-- @since 1.13.0.0
cookieGetAll
:: (JSVal -> IO ())
-- ^ Successful callback (receives a JS array of cookie objects)
-> (MisoString -> IO ())
-- ^ Errorful callback
-> IO ()
{-# INLINABLE cookieGetAll #-}
cookieGetAll successful errorful = do
s_ <- toJSVal =<< asyncCallback1 successful
e_ <- toJSVal =<< asyncCallback1 (errorful <=< fromJSValUnchecked)
void $ jsg "miso" # "cookieGetAll" $ [e_, s_]
-----------------------------------------------------------------------------
-- | Set a cookie via the
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore CookieStore API>.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/set>
--
-- @since 1.13.0.0
cookieSet
:: JSVal
-- ^ Cookie options object (serialised 'Miso.Cookie.Cookie')
-> IO ()
-- ^ Successful callback
-> (MisoString -> IO ())
-- ^ Errorful callback
-> IO ()
{-# INLINABLE cookieSet #-}
cookieSet cookie successful errorful = do
s_ <- toJSVal =<< asyncCallback successful
e_ <- toJSVal =<< asyncCallback1 (errorful <=< fromJSValUnchecked)
void $ jsg "miso" # "cookieSet" $ [cookie, e_, s_]
-----------------------------------------------------------------------------
-- | Delete a cookie by name via the
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore CookieStore API>.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/delete>
--
-- @since 1.13.0.0
cookieDelete
:: MisoString
-- ^ Cookie name
-> IO ()
-- ^ Successful callback
-> (MisoString -> IO ())
-- ^ Errorful callback
-> IO ()
{-# INLINABLE cookieDelete #-}
cookieDelete name successful errorful = do
s_ <- toJSVal =<< asyncCallback successful
e_ <- toJSVal =<< asyncCallback1 (errorful <=< fromJSValUnchecked)
n_ <- toJSVal name
void $ jsg "miso" # "cookieDelete" $ [n_, e_, s_]
-----------------------------------------------------------------------------
-- | Delete a cookie by options object via the
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore CookieStore API>.
--
-- See <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/delete>
--
-- @since 1.13.0.0
cookieDeleteWith
:: JSVal
-- ^ Cookie options object (name, path, domain, partitioned)
-> IO ()
-- ^ Successful callback
-> (MisoString -> IO ())
-- ^ Errorful callback
-> IO ()
{-# INLINABLE cookieDeleteWith #-}
cookieDeleteWith opts successful errorful = do
s_ <- toJSVal =<< asyncCallback successful
e_ <- toJSVal =<< asyncCallback1 (errorful <=< fromJSValUnchecked)
void $ jsg "miso" # "cookieDeleteWith" $ [opts, e_, s_]
-----------------------------------------------------------------------------
-- | Register a listener for
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/change_event cookieStore change>
-- events. Returns the t'Function' handle needed to remove the listener later.
--
-- When the CookieStore API is unavailable (e.g. Firefox, insecure contexts)
-- no listener is registered and an inert t'Function' handle is returned.
cookieStoreAddEventListener :: (JSVal -> IO ()) -> IO Function
{-# INLINABLE cookieStoreAddEventListener #-}
cookieStoreAddEventListener cb = do
cs <- jsg "cookieStore"
undef <- isUndefined cs
if undef
then pure (Function cs)
else addEventListener cs "change" cb
-----------------------------------------------------------------------------
-- | Remove a previously registered
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/change_event cookieStore change>
-- listener.
--
-- When the CookieStore API is unavailable this is a no-op.
cookieStoreRemoveEventListener :: Function -> IO ()
{-# INLINABLE cookieStoreRemoveEventListener #-}
cookieStoreRemoveEventListener cb = do
cs <- jsg "cookieStore"
undef <- isUndefined cs
unless undef $
removeEventListener cs "change" cb
-----------------------------------------------------------------------------