{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Miso.FFI.Internal
(
syncCallback
, syncCallback1
, syncCallback2
, asyncCallback
, asyncCallback1
, asyncCallback2
, addEventListener
, removeEventListener
, eventPreventDefault
, eventStopPropagation
, windowAddEventListener
, windowRemoveEventListener
, windowInnerHeight
, windowInnerWidth
, now
, consoleWarn
, consoleLog
, consoleError
, consoleLog'
, eventJSON
, set
, setValue
, getBody
, getDocument
, getDrawingContext
, getHydrationContext
, getEventContext
, getElementById
, removeChild
, getHead
, diff
, nextSibling
, previousSibling
, getProperty
, callFunction
, castJSVal
, delegateEvent
, dispatchEvent
, newEvent
, newCustomEvent
, hydrate
, focus
, blur
, select
, setSelectionRange
, scrollIntoView
, alert
, locationReload
, addStyle
, addStyleSheet
, addSrc
, addScript
, addScriptImportMap
, fetch
, CONTENT_TYPE(..)
, setDrawingContext
, flush
, Image (..)
, newImage
, Date (..)
, newDate
, toLocaleString
, getMilliseconds
, getSeconds
, files
, click
, websocketConnect
, websocketClose
, websocketSend
, eventSourceConnect
, eventSourceClose
, Blob (..)
, FormData (..)
, URLSearchParams (..)
, File (..)
, Uint8Array (..)
, ArrayBuffer (..)
, geolocation
, copyClipboard
, getUserMedia
, isOnLine
, FileReader (..)
, newFileReader
, Response (..)
, Event (..)
, populateClass
, updateRef
, inline
) where
import Data.Map.Strict (Map)
import Data.Maybe
import Control.Monad (void, forM_, (<=<), when)
import Prelude hiding ((!!))
import Miso.DSL
import Miso.String
import Miso.Effect (DOMRef)
set :: ToJSVal v => MisoString -> v -> Object -> IO ()
set :: forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
set MisoString
k v
v Object
o = do
v' <- v -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal v
v
setProp (fromMisoString k) v' o
getProperty :: JSVal -> MisoString -> IO JSVal
getProperty :: JSVal -> MisoString -> IO JSVal
getProperty = JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
(!)
callFunction :: (ToArgs args) => JSVal -> MisoString -> args -> IO JSVal
callFunction :: forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction = JSVal -> MisoString -> args -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
(#)
castJSVal :: (FromJSVal a) => JSVal -> IO (Maybe a)
castJSVal :: forall a. FromJSVal a => JSVal -> IO (Maybe a)
castJSVal = JSVal -> IO (Maybe a)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal
addEventListener
:: JSVal
-> MisoString
-> (JSVal -> IO ())
-> IO Function
addEventListener :: JSVal -> MisoString -> (JSVal -> IO ()) -> IO Function
addEventListener JSVal
self MisoString
name JSVal -> IO ()
cb = do
#ifdef GHCJS_BOTH
cb_ <- Function <$> syncCallback1 cb
#else
cb_ <- JSVal -> Function
Function (JSVal -> Function) -> IO JSVal -> IO Function
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSVal -> IO ()) -> IO JSVal
asyncCallback1 JSVal -> IO ()
cb
#endif
void $ self # "addEventListener" $ (name, cb_)
pure cb_
removeEventListener
:: JSVal
-> MisoString
-> Function
-> IO ()
removeEventListener :: JSVal -> MisoString -> Function -> IO ()
removeEventListener JSVal
self MisoString
name Function
cb =
IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ JSVal
self JSVal -> MisoString -> (MisoString, Function) -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"removeEventListener" ((MisoString, Function) -> IO JSVal)
-> (MisoString, Function) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ (MisoString
name, Function
cb)
windowRemoveEventListener
:: MisoString
-> Function
-> IO ()
windowRemoveEventListener :: MisoString -> Function -> IO ()
windowRemoveEventListener MisoString
name Function
cb = do
win <- MisoString -> IO JSVal
jsg MisoString
"window"
removeEventListener win name cb
windowAddEventListener
:: MisoString
-> (JSVal -> IO ())
-> IO Function
windowAddEventListener :: MisoString -> (JSVal -> IO ()) -> IO Function
windowAddEventListener MisoString
name JSVal -> IO ()
cb = do
win <- MisoString -> IO JSVal
jsg MisoString
"window"
addEventListener win name cb
eventStopPropagation :: JSVal -> IO ()
eventStopPropagation :: JSVal -> IO ()
eventStopPropagation JSVal
e = do
_ <- JSVal
e JSVal -> MisoString -> () -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"stopPropagation" (() -> IO JSVal) -> () -> IO JSVal
forall a b. (a -> b) -> a -> b
$ ()
pure ()
eventPreventDefault :: JSVal -> IO ()
eventPreventDefault :: JSVal -> IO ()
eventPreventDefault JSVal
e = do
_ <- JSVal
e JSVal -> MisoString -> () -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"preventDefault" (() -> IO JSVal) -> () -> IO JSVal
forall a b. (a -> b) -> a -> b
$ ()
pure ()
windowInnerHeight :: IO Int
windowInnerHeight :: IO Int
windowInnerHeight = JSVal -> IO Int
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO Int) -> IO JSVal -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MisoString -> IO JSVal
jsg MisoString
"window" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"innerHeight"
windowInnerWidth :: IO Int
windowInnerWidth :: IO Int
windowInnerWidth =
JSVal -> IO Int
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO Int) -> IO JSVal -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MisoString -> IO JSVal
jsg MisoString
"window" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"innerWidth"
now :: IO Double
now :: IO Double
now = JSVal -> IO Double
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO Double) -> IO JSVal -> IO Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (MisoString -> IO JSVal
jsg MisoString
"performance" IO JSVal -> MisoString -> () -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"now" (() -> IO JSVal) -> () -> IO JSVal
forall a b. (a -> b) -> a -> b
$ ())
consoleLog :: MisoString -> IO ()
consoleLog :: MisoString -> IO ()
consoleLog MisoString
v = do
_ <- MisoString -> IO JSVal
jsg MisoString
"console" IO JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"log" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
v]
pure ()
consoleWarn :: MisoString -> IO ()
consoleWarn :: MisoString -> IO ()
consoleWarn MisoString
v = do
_ <- MisoString -> IO JSVal
jsg MisoString
"console" IO JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"warn" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
v]
pure ()
consoleError :: MisoString -> IO ()
consoleError :: MisoString -> IO ()
consoleError MisoString
v = do
_ <- MisoString -> IO JSVal
jsg MisoString
"console" IO JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"error" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
v]
pure ()
consoleLog' :: ToArgs a => a -> IO ()
consoleLog' :: forall a. ToArgs a => a -> IO ()
consoleLog' a
args' = do
args <- a -> IO [JSVal]
forall args. ToArgs args => args -> IO [JSVal]
toArgs a
args'
_ <- jsg "console" # "log" $ args
pure ()
eventJSON
:: JSVal
-> JSVal
-> IO JSVal
eventJSON :: JSVal -> JSVal -> IO JSVal
eventJSON JSVal
x JSVal
y = do
moduleMiso <- MisoString -> IO JSVal
jsg MisoString
"miso"
moduleMiso # "eventJSON" $ [x,y]
updateRef
:: ToJSVal val
=> val
-> val
-> IO ()
updateRef :: forall val. ToJSVal val => val -> val -> IO ()
updateRef val
jsval1 val
jsval2 = do
moduleMiso <- MisoString -> IO JSVal
jsg MisoString
"miso"
void $ moduleMiso # "updateRef" $ (jsval1, jsval2)
inline
:: (FromJSVal return, ToObject object)
=> MisoString
-> object
-> IO return
inline :: forall return object.
(FromJSVal return, ToObject object) =>
MisoString -> object -> IO return
inline MisoString
code object
o = do
moduleMiso <- MisoString -> IO JSVal
jsg MisoString
"miso"
Object obj <- toObject o
fromJSValUnchecked =<< do
moduleMiso # "inline" $ (code, obj)
populateClass
:: JSVal
-> [MisoString]
-> IO ()
populateClass :: JSVal -> [MisoString] -> IO ()
populateClass JSVal
domRef [MisoString]
classes = do
moduleMiso <- MisoString -> IO JSVal
jsg MisoString
"miso"
void $ moduleMiso # "populateClass" $ (domRef, classes)
getBody :: IO JSVal
getBody :: IO JSVal
getBody = do
ctx <- IO JSVal
getDrawingContext
ctx # "getRoot" $ ()
getDocument :: IO JSVal
getDocument :: IO JSVal
getDocument = MisoString -> IO JSVal
jsg MisoString
"document"
getDrawingContext :: IO JSVal
getDrawingContext :: IO JSVal
getDrawingContext = MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"drawingContext"
getEventContext :: IO JSVal
getEventContext :: IO JSVal
getEventContext = MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"eventContext"
getHydrationContext :: IO JSVal
getHydrationContext :: IO JSVal
getHydrationContext = MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"hydrationContext"
getElementById :: MisoString -> IO JSVal
getElementById :: MisoString -> IO JSVal
getElementById MisoString
e = IO JSVal
getDocument IO JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"getElementById" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
e]
getHead :: IO DOMRef
getHead :: IO JSVal
getHead = do
context <- IO JSVal
getDrawingContext
context # "getHead" $ ()
removeChild :: DOMRef -> DOMRef -> IO ()
removeChild :: JSVal -> JSVal -> IO ()
removeChild JSVal
parent JSVal
child = do
context <- IO JSVal
getDrawingContext
void $ context # "removeChild" $ (parent, child)
diff
:: Object
-> Object
-> JSVal
-> IO ()
diff :: Object -> Object -> JSVal -> IO ()
diff (Object JSVal
a) (Object JSVal
b) JSVal
c = do
moduleMiso <- MisoString -> IO JSVal
jsg MisoString
"miso"
context <- getDrawingContext
void $ moduleMiso # "diff" $ [a,b,c,context]
delegateEvent :: JSVal -> JSVal -> Bool -> IO JSVal -> IO ()
delegateEvent :: JSVal -> JSVal -> Bool -> IO JSVal -> IO ()
delegateEvent JSVal
mountPoint JSVal
events Bool
debug IO JSVal
getVTree = do
ctx <- IO JSVal
getEventContext
cb <- syncCallback1 $ \JSVal
continuation -> IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal -> JSVal -> JSVal -> IO JSVal
forall obj this args.
(ToObject obj, ToObject this, ToArgs args) =>
obj -> this -> args -> IO JSVal
call JSVal
continuation JSVal
global (JSVal -> IO JSVal) -> IO JSVal -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO JSVal
getVTree)
delegate mountPoint events debug (Function cb) ctx
delegate :: JSVal -> JSVal -> Bool -> Function -> JSVal -> IO ()
delegate :: JSVal -> JSVal -> Bool -> Function -> JSVal -> IO ()
delegate JSVal
mountPoint JSVal
events Bool
debug Function
callback JSVal
ctx = do
d <- Bool -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Bool
debug
cb <- toJSVal callback
moduleMiso <- jsg "miso"
void $ moduleMiso # "delegate" $ [mountPoint,events,cb,d,ctx]
hydrate :: Bool -> JSVal -> JSVal -> IO JSVal
hydrate :: Bool -> JSVal -> JSVal -> IO JSVal
hydrate Bool
logLevel JSVal
mountPoint JSVal
vtree = do
ll <- Bool -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Bool
logLevel
drawingContext <- getDrawingContext
hydrationContext <- getHydrationContext
moduleMiso <- jsg "miso"
moduleMiso # "hydrate" $ (ll, mountPoint, vtree, hydrationContext, drawingContext)
focus :: MisoString -> IO ()
focus :: MisoString -> IO ()
focus MisoString
x = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> (MisoString, Int) -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"callFocus" ((MisoString, Int) -> IO JSVal) -> (MisoString, Int) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ (MisoString
x, Int
50 :: Int)
blur :: MisoString -> IO ()
blur :: MisoString -> IO ()
blur MisoString
x = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> (MisoString, Int) -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"callBlur" ((MisoString, Int) -> IO JSVal) -> (MisoString, Int) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ (MisoString
x, Int
50 :: Int)
select :: MisoString -> IO ()
select :: MisoString -> IO ()
select MisoString
x = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> (MisoString, Int) -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"callSelect" ((MisoString, Int) -> IO JSVal) -> (MisoString, Int) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ (MisoString
x, Int
50 :: Int)
setSelectionRange :: MisoString -> Int -> Int -> IO ()
setSelectionRange :: MisoString -> Int -> Int -> IO ()
setSelectionRange MisoString
x Int
start Int
end = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> (MisoString, Int, Int, Int) -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"callSetSelectionRange" ((MisoString, Int, Int, Int) -> IO JSVal)
-> (MisoString, Int, Int, Int) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ (MisoString
x, Int
start, Int
end, Int
50 :: Int)
scrollIntoView :: MisoString -> IO ()
scrollIntoView :: MisoString -> IO ()
scrollIntoView MisoString
elId = do
el <- MisoString -> IO JSVal
jsg MisoString
"document" IO JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"getElementById" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
elId]
_ <- el # "scrollIntoView" $ ()
pure ()
alert :: MisoString -> IO ()
alert :: MisoString -> IO ()
alert MisoString
a = () () -> IO JSVal -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MisoString -> MisoString -> IO JSVal
forall arg. ToJSVal arg => MisoString -> arg -> IO JSVal
jsg1 MisoString
"alert" MisoString
a
locationReload :: IO ()
locationReload :: IO ()
locationReload = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ MisoString -> IO JSVal
jsg MisoString
"location" IO JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"reload" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
addStyle :: MisoString -> IO JSVal
addStyle :: MisoString -> IO JSVal
addStyle MisoString
css = do
context <- IO JSVal
getDrawingContext
head_ <- getHead
style <- context # "createElement" $ ["style" :: MisoString]
setField style "innerHTML" css
void $ context # "appendChild" $ (head_, style)
pure style
addScript :: Bool -> MisoString -> IO JSVal
addScript :: Bool -> MisoString -> IO JSVal
addScript Bool
useModule MisoString
js_ = do
context <- IO JSVal
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
setValue :: DOMRef -> MisoString -> IO ()
setValue :: JSVal -> MisoString -> IO ()
setValue JSVal
domRef MisoString
value = JSVal -> MisoString -> MisoString -> IO ()
forall o v.
(ToObject o, ToJSVal v) =>
o -> MisoString -> v -> IO ()
setField JSVal
domRef MisoString
"value" MisoString
value
addScriptImportMap :: MisoString -> IO JSVal
addScriptImportMap :: MisoString -> IO JSVal
addScriptImportMap MisoString
impMap = do
context <- IO JSVal
getDrawingContext
head_ <- getHead
script <- context # "createElement" $ ["script" :: MisoString]
setField script "type" ("importmap" :: MisoString)
setField script "innerHTML" impMap
void $ context # "appendChild" $ (head_, script)
pure script
addSrc :: MisoString -> IO JSVal
addSrc :: MisoString -> IO JSVal
addSrc MisoString
url = do
context <- IO JSVal
getDrawingContext
head_ <- getHead
link <- context # "createElement" $ ["script" :: MisoString]
_ <- link # "setAttribute" $ ["src", url]
void $ context # "appendChild" $ (head_, link)
pure link
addStyleSheet :: MisoString -> IO JSVal
addStyleSheet :: MisoString -> IO JSVal
addStyleSheet MisoString
url = do
context <- IO JSVal
getDrawingContext
head_ <- getHead
link <- context # "createElement" $ ["link" :: MisoString]
_ <- link # "setAttribute" $ ["rel","stylesheet" :: MisoString]
_ <- link # "setAttribute" $ ["href", url]
void $ context # "appendChild" $ (head_, link)
pure link
fetch
:: (FromJSVal success, FromJSVal error)
=> MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response success -> IO ())
-> (Response error -> IO ())
-> CONTENT_TYPE
-> IO ()
fetch :: forall success error.
(FromJSVal success, FromJSVal error) =>
MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response success -> IO ())
-> (Response error -> IO ())
-> CONTENT_TYPE
-> IO ()
fetch MisoString
url MisoString
method Maybe JSVal
maybeBody [(MisoString, MisoString)]
requestHeaders Response success -> IO ()
successful Response error -> IO ()
errorful CONTENT_TYPE
type_ = do
successful_ <- JSVal -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (JSVal -> IO JSVal) -> IO JSVal -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JSVal -> IO ()) -> IO JSVal
asyncCallback1 (Response success -> IO ()
successful (Response success -> IO ())
-> (JSVal -> IO (Response success)) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO (Response success)
forall a. FromJSVal a => JSVal -> IO a
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 $ \(MisoString
k,MisoString
v) -> MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
set MisoString
k MisoString
v Object
o
pure o
typ <- toJSVal type_
void $ moduleMiso # "fetchCore" $
[ url_
, method_
, body_
, headers_
, successful_
, errorful_
, typ
]
data CONTENT_TYPE
= JSON
| ARRAY_BUFFER
| TEXT
| BLOB
| BYTES
| FORM_DATA
| NONE
deriving (Int -> CONTENT_TYPE -> ShowS
[CONTENT_TYPE] -> ShowS
CONTENT_TYPE -> String
(Int -> CONTENT_TYPE -> ShowS)
-> (CONTENT_TYPE -> String)
-> ([CONTENT_TYPE] -> ShowS)
-> Show CONTENT_TYPE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CONTENT_TYPE -> ShowS
showsPrec :: Int -> CONTENT_TYPE -> ShowS
$cshow :: CONTENT_TYPE -> String
show :: CONTENT_TYPE -> String
$cshowList :: [CONTENT_TYPE] -> ShowS
showList :: [CONTENT_TYPE] -> ShowS
Show, CONTENT_TYPE -> CONTENT_TYPE -> Bool
(CONTENT_TYPE -> CONTENT_TYPE -> Bool)
-> (CONTENT_TYPE -> CONTENT_TYPE -> Bool) -> Eq CONTENT_TYPE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CONTENT_TYPE -> CONTENT_TYPE -> Bool
== :: CONTENT_TYPE -> CONTENT_TYPE -> Bool
$c/= :: CONTENT_TYPE -> CONTENT_TYPE -> Bool
/= :: CONTENT_TYPE -> CONTENT_TYPE -> Bool
Eq)
instance ToJSVal CONTENT_TYPE where
toJSVal :: CONTENT_TYPE -> IO JSVal
toJSVal = \case
CONTENT_TYPE
JSON ->
MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString
"json" :: MisoString)
CONTENT_TYPE
ARRAY_BUFFER ->
MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString
"arrayBuffer" :: MisoString)
CONTENT_TYPE
TEXT ->
MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString
"text" :: MisoString)
CONTENT_TYPE
BLOB ->
MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString
"blob" :: MisoString)
CONTENT_TYPE
BYTES ->
MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString
"bytes" :: MisoString)
CONTENT_TYPE
FORM_DATA ->
MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString
"formData" :: MisoString)
CONTENT_TYPE
NONE ->
MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString
"none" :: MisoString)
flush :: IO ()
flush :: IO ()
flush = do
context <- IO JSVal
getDrawingContext
void $ context # "flush" $ ([] :: [JSVal])
newtype Image = Image JSVal
deriving (Image -> IO JSVal
(Image -> IO JSVal) -> ToJSVal Image
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: Image -> IO JSVal
toJSVal :: Image -> IO JSVal
ToJSVal, Image -> IO Object
(Image -> IO Object) -> ToObject Image
forall a. (a -> IO Object) -> ToObject a
$ctoObject :: Image -> IO Object
toObject :: Image -> IO Object
ToObject)
instance FromJSVal Image where
fromJSVal :: JSVal -> IO (Maybe Image)
fromJSVal = Maybe Image -> IO (Maybe Image)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Image -> IO (Maybe Image))
-> (JSVal -> Maybe Image) -> JSVal -> IO (Maybe Image)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image -> Maybe Image
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Image -> Maybe Image) -> (JSVal -> Image) -> JSVal -> Maybe Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> Image
Image
newImage :: MisoString -> IO Image
newImage :: MisoString -> IO Image
newImage MisoString
url = do
img <- IO JSVal -> [MisoString] -> IO JSVal
forall constructor args.
(ToObject constructor, ToArgs args) =>
constructor -> args -> IO JSVal
new (MisoString -> IO JSVal
jsg MisoString
"Image") ([] :: [MisoString])
setField img "src" url
pure (Image img)
setDrawingContext :: MisoString -> IO ()
setDrawingContext :: MisoString -> IO ()
setDrawingContext MisoString
rendererName =
IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"setDrawingContext" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
rendererName]
newtype Date = Date JSVal
deriving (Date -> IO JSVal
(Date -> IO JSVal) -> ToJSVal Date
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: Date -> IO JSVal
toJSVal :: Date -> IO JSVal
ToJSVal, Date -> IO Object
(Date -> IO Object) -> ToObject Date
forall a. (a -> IO Object) -> ToObject a
$ctoObject :: Date -> IO Object
toObject :: Date -> IO Object
ToObject, Date -> Date -> Bool
(Date -> Date -> Bool) -> (Date -> Date -> Bool) -> Eq Date
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
/= :: Date -> Date -> Bool
Eq)
newDate :: IO Date
newDate :: IO Date
newDate = JSVal -> Date
Date (JSVal -> Date) -> IO JSVal -> IO Date
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO JSVal -> [MisoString] -> IO JSVal
forall constructor args.
(ToObject constructor, ToArgs args) =>
constructor -> args -> IO JSVal
new (MisoString -> IO JSVal
jsg MisoString
"Date") ([] :: [MisoString])
toLocaleString :: Date -> IO MisoString
toLocaleString :: Date -> IO MisoString
toLocaleString Date
date = JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO MisoString) -> IO JSVal -> IO MisoString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Date
date Date -> MisoString -> () -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"toLocaleString" (() -> IO JSVal) -> () -> IO JSVal
forall a b. (a -> b) -> a -> b
$ ()
getMilliseconds :: Date -> IO Double
getMilliseconds :: Date -> IO Double
getMilliseconds Date
date =
JSVal -> IO Double
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO Double) -> IO JSVal -> IO Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Date
date Date -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"getMilliseconds" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
getSeconds :: Date -> IO Double
getSeconds :: Date -> IO Double
getSeconds Date
date =
JSVal -> IO Double
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO Double) -> IO JSVal -> IO Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Date
date Date -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"getSeconds" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
nextSibling :: JSVal -> IO JSVal
nextSibling :: JSVal -> IO JSVal
nextSibling JSVal
domRef = JSVal
domRef JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"nextSibling"
previousSibling :: JSVal -> IO JSVal
previousSibling :: JSVal -> IO JSVal
previousSibling JSVal
domRef = JSVal
domRef JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"previousSibling"
files :: JSVal -> IO [JSVal]
files :: JSVal -> IO [JSVal]
files JSVal
domRef = JSVal -> IO [JSVal]
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO [JSVal]) -> IO JSVal -> IO [JSVal]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
domRef JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"files"
click :: () -> JSVal -> IO ()
click :: () -> JSVal -> IO ()
click () JSVal
domRef = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ JSVal
domRef JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"click" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
getUserMedia
:: Bool
-> Bool
-> (JSVal -> IO ())
-> (JSVal -> IO ())
-> IO ()
getUserMedia :: Bool -> Bool -> (JSVal -> IO ()) -> (JSVal -> IO ()) -> IO ()
getUserMedia Bool
video Bool
audio JSVal -> IO ()
successful JSVal -> IO ()
errorful = do
params <- IO Object
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]
copyClipboard
:: MisoString
-> IO ()
-> (JSVal -> IO ())
-> IO ()
copyClipboard :: MisoString -> IO () -> (JSVal -> IO ()) -> IO ()
copyClipboard MisoString
txt IO ()
successful JSVal -> IO ()
errorful = do
clipboard <- MisoString -> IO JSVal
jsg MisoString
"navigator" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"clipboard"
promise <- clipboard # "writeText" $ [txt]
successfulCallback <- asyncCallback successful
void $ promise # "then" $ [successfulCallback]
errorfulCallback <- asyncCallback1 errorful
void $ promise # "catch" $ [errorfulCallback]
websocketConnect
:: MisoString
-> IO ()
-> (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
websocketConnect :: MisoString
-> IO ()
-> (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
websocketConnect
MisoString
url IO ()
onOpen JSVal -> IO ()
onClose
Maybe (JSVal -> IO ())
onMessageText Maybe (JSVal -> IO ())
onMessageJSON
Maybe (JSVal -> IO ())
onMessageBLOB Maybe (JSVal -> IO ())
onMessageArrayBuffer
JSVal -> IO ()
onError Bool
textOnly = do
url_ <- MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal MisoString
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 :: Maybe (JSVal -> IO ()) -> IO JSVal
withMaybe Maybe (JSVal -> IO ())
Nothing = JSVal -> IO JSVal
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
jsNull
withMaybe (Just JSVal -> IO ()
f) = (JSVal -> IO ()) -> IO JSVal
asyncCallback1 JSVal -> IO ()
f
websocketClose :: JSVal -> IO ()
websocketClose :: JSVal -> IO ()
websocketClose JSVal
websocket = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ do
MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> [JSVal] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"websocketClose" ([JSVal] -> IO JSVal) -> [JSVal] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [JSVal
websocket]
websocketSend :: JSVal -> JSVal -> IO ()
websocketSend :: JSVal -> JSVal -> IO ()
websocketSend JSVal
websocket JSVal
message = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ do
MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> [JSVal] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"websocketSend" ([JSVal] -> IO JSVal) -> [JSVal] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [JSVal
websocket, JSVal
message]
eventSourceConnect
:: MisoString
-> IO ()
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
eventSourceConnect :: MisoString
-> IO ()
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
eventSourceConnect MisoString
url IO ()
onOpen Maybe (JSVal -> IO ())
onMessageText Maybe (JSVal -> IO ())
onMessageJSON JSVal -> IO ()
onError Bool
textOnly = do
onOpen_ <- IO () -> IO JSVal
asyncCallback IO ()
onOpen
onMessageText_ <- withMaybe onMessageText
onMessageJSON_ <- withMaybe onMessageJSON
onError_ <- asyncCallback1 onError
textOnly_ <- toJSVal textOnly
jsg "miso" # "eventSourceConnect" $
(url, onOpen_, onMessageText_, onMessageJSON_, onError_, textOnly_)
where
withMaybe :: Maybe (JSVal -> IO ()) -> IO JSVal
withMaybe Maybe (JSVal -> IO ())
Nothing = JSVal -> IO JSVal
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
jsNull
withMaybe (Just JSVal -> IO ()
f) = JSVal -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (JSVal -> IO JSVal) -> IO JSVal -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JSVal -> IO ()) -> IO JSVal
asyncCallback1 JSVal -> IO ()
f
eventSourceClose :: JSVal -> IO ()
eventSourceClose :: JSVal -> IO ()
eventSourceClose JSVal
eventSource = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ do
MisoString -> IO JSVal
jsg MisoString
"miso" IO JSVal -> MisoString -> [JSVal] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"eventSourceClose" ([JSVal] -> IO JSVal) -> [JSVal] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [JSVal
eventSource]
isOnLine :: IO Bool
isOnLine :: IO Bool
isOnLine = JSVal -> IO Bool
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO Bool) -> IO JSVal -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MisoString -> IO JSVal
jsg MisoString
"navigator" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"onLine"
newtype Blob = Blob JSVal
deriving (Blob -> IO JSVal
(Blob -> IO JSVal) -> ToJSVal Blob
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: Blob -> IO JSVal
toJSVal :: Blob -> IO JSVal
ToJSVal, Blob -> Blob -> Bool
(Blob -> Blob -> Bool) -> (Blob -> Blob -> Bool) -> Eq Blob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Blob -> Blob -> Bool
== :: Blob -> Blob -> Bool
$c/= :: Blob -> Blob -> Bool
/= :: Blob -> Blob -> Bool
Eq)
instance FromJSVal Blob where
fromJSVal :: JSVal -> IO (Maybe Blob)
fromJSVal = Maybe Blob -> IO (Maybe Blob)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Blob -> IO (Maybe Blob))
-> (JSVal -> Maybe Blob) -> JSVal -> IO (Maybe Blob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blob -> Maybe Blob
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blob -> Maybe Blob) -> (JSVal -> Blob) -> JSVal -> Maybe Blob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> Blob
Blob
newtype FormData = FormData JSVal
deriving (FormData -> IO JSVal
(FormData -> IO JSVal) -> ToJSVal FormData
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: FormData -> IO JSVal
toJSVal :: FormData -> IO JSVal
ToJSVal, FormData -> FormData -> Bool
(FormData -> FormData -> Bool)
-> (FormData -> FormData -> Bool) -> Eq FormData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormData -> FormData -> Bool
== :: FormData -> FormData -> Bool
$c/= :: FormData -> FormData -> Bool
/= :: FormData -> FormData -> Bool
Eq)
instance FromJSVal FormData where
fromJSVal :: JSVal -> IO (Maybe FormData)
fromJSVal = Maybe FormData -> IO (Maybe FormData)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FormData -> IO (Maybe FormData))
-> (JSVal -> Maybe FormData) -> JSVal -> IO (Maybe FormData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormData -> Maybe FormData
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormData -> Maybe FormData)
-> (JSVal -> FormData) -> JSVal -> Maybe FormData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> FormData
FormData
instance FromJSVal ArrayBuffer where
fromJSVal :: JSVal -> IO (Maybe ArrayBuffer)
fromJSVal = Maybe ArrayBuffer -> IO (Maybe ArrayBuffer)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ArrayBuffer -> IO (Maybe ArrayBuffer))
-> (JSVal -> Maybe ArrayBuffer) -> JSVal -> IO (Maybe ArrayBuffer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayBuffer -> Maybe ArrayBuffer
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArrayBuffer -> Maybe ArrayBuffer)
-> (JSVal -> ArrayBuffer) -> JSVal -> Maybe ArrayBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> ArrayBuffer
ArrayBuffer
newtype ArrayBuffer = ArrayBuffer JSVal
deriving (ArrayBuffer -> ArrayBuffer -> Bool
(ArrayBuffer -> ArrayBuffer -> Bool)
-> (ArrayBuffer -> ArrayBuffer -> Bool) -> Eq ArrayBuffer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArrayBuffer -> ArrayBuffer -> Bool
== :: ArrayBuffer -> ArrayBuffer -> Bool
$c/= :: ArrayBuffer -> ArrayBuffer -> Bool
/= :: ArrayBuffer -> ArrayBuffer -> Bool
Eq, ArrayBuffer -> IO JSVal
(ArrayBuffer -> IO JSVal) -> ToJSVal ArrayBuffer
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: ArrayBuffer -> IO JSVal
toJSVal :: ArrayBuffer -> IO JSVal
ToJSVal)
geolocation :: (JSVal -> IO ()) -> (JSVal -> IO ()) -> IO ()
geolocation :: (JSVal -> IO ()) -> (JSVal -> IO ()) -> IO ()
geolocation JSVal -> IO ()
successful JSVal -> IO ()
errorful = do
geo <- MisoString -> IO JSVal
jsg MisoString
"navigator" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"geolocation"
cb1 <- asyncCallback1 successful
cb2 <- asyncCallback1 errorful
void $ geo # "getCurrentPosition" $ (cb1, cb2)
newtype File = File JSVal
deriving (File -> IO JSVal
(File -> IO JSVal) -> ToJSVal File
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: File -> IO JSVal
toJSVal :: File -> IO JSVal
ToJSVal, File -> IO Object
(File -> IO Object) -> ToObject File
forall a. (a -> IO Object) -> ToObject a
$ctoObject :: File -> IO Object
toObject :: File -> IO Object
ToObject, File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: File -> File -> Bool
== :: File -> File -> Bool
$c/= :: File -> File -> Bool
/= :: File -> File -> Bool
Eq)
instance FromJSVal File where
fromJSVal :: JSVal -> IO (Maybe File)
fromJSVal = Maybe File -> IO (Maybe File)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe File -> IO (Maybe File))
-> (JSVal -> Maybe File) -> JSVal -> IO (Maybe File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File -> Maybe File
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (File -> Maybe File) -> (JSVal -> File) -> JSVal -> Maybe File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> File
File
newtype Uint8Array = Uint8Array JSVal
deriving Uint8Array -> IO JSVal
(Uint8Array -> IO JSVal) -> ToJSVal Uint8Array
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: Uint8Array -> IO JSVal
toJSVal :: Uint8Array -> IO JSVal
ToJSVal
instance FromJSVal Uint8Array where
fromJSVal :: JSVal -> IO (Maybe Uint8Array)
fromJSVal = Maybe Uint8Array -> IO (Maybe Uint8Array)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Uint8Array -> IO (Maybe Uint8Array))
-> (JSVal -> Maybe Uint8Array) -> JSVal -> IO (Maybe Uint8Array)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uint8Array -> Maybe Uint8Array
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Uint8Array -> Maybe Uint8Array)
-> (JSVal -> Uint8Array) -> JSVal -> Maybe Uint8Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> Uint8Array
Uint8Array
newtype FileReader = FileReader JSVal
deriving (FileReader -> IO JSVal
(FileReader -> IO JSVal) -> ToJSVal FileReader
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: FileReader -> IO JSVal
toJSVal :: FileReader -> IO JSVal
ToJSVal, FileReader -> IO Object
(FileReader -> IO Object) -> ToObject FileReader
forall a. (a -> IO Object) -> ToObject a
$ctoObject :: FileReader -> IO Object
toObject :: FileReader -> IO Object
ToObject, FileReader -> FileReader -> Bool
(FileReader -> FileReader -> Bool)
-> (FileReader -> FileReader -> Bool) -> Eq FileReader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileReader -> FileReader -> Bool
== :: FileReader -> FileReader -> Bool
$c/= :: FileReader -> FileReader -> Bool
/= :: FileReader -> FileReader -> Bool
Eq)
instance FromJSVal FileReader where
fromJSVal :: JSVal -> IO (Maybe FileReader)
fromJSVal = Maybe FileReader -> IO (Maybe FileReader)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileReader -> IO (Maybe FileReader))
-> (JSVal -> Maybe FileReader) -> JSVal -> IO (Maybe FileReader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileReader -> Maybe FileReader
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileReader -> Maybe FileReader)
-> (JSVal -> FileReader) -> JSVal -> Maybe FileReader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> FileReader
FileReader
newtype URLSearchParams = URLSearchParams JSVal
deriving (URLSearchParams -> IO JSVal
(URLSearchParams -> IO JSVal) -> ToJSVal URLSearchParams
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: URLSearchParams -> IO JSVal
toJSVal :: URLSearchParams -> IO JSVal
ToJSVal, URLSearchParams -> IO Object
(URLSearchParams -> IO Object) -> ToObject URLSearchParams
forall a. (a -> IO Object) -> ToObject a
$ctoObject :: URLSearchParams -> IO Object
toObject :: URLSearchParams -> IO Object
ToObject, URLSearchParams -> URLSearchParams -> Bool
(URLSearchParams -> URLSearchParams -> Bool)
-> (URLSearchParams -> URLSearchParams -> Bool)
-> Eq URLSearchParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URLSearchParams -> URLSearchParams -> Bool
== :: URLSearchParams -> URLSearchParams -> Bool
$c/= :: URLSearchParams -> URLSearchParams -> Bool
/= :: URLSearchParams -> URLSearchParams -> Bool
Eq)
instance FromJSVal URLSearchParams where
fromJSVal :: JSVal -> IO (Maybe URLSearchParams)
fromJSVal = Maybe URLSearchParams -> IO (Maybe URLSearchParams)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe URLSearchParams -> IO (Maybe URLSearchParams))
-> (JSVal -> Maybe URLSearchParams)
-> JSVal
-> IO (Maybe URLSearchParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URLSearchParams -> Maybe URLSearchParams
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URLSearchParams -> Maybe URLSearchParams)
-> (JSVal -> URLSearchParams) -> JSVal -> Maybe URLSearchParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> URLSearchParams
URLSearchParams
newFileReader :: IO FileReader
newFileReader :: IO FileReader
newFileReader = do
reader <- IO JSVal -> [MisoString] -> IO JSVal
forall constructor args.
(ToObject constructor, ToArgs args) =>
constructor -> args -> IO JSVal
new (MisoString -> IO JSVal
jsg MisoString
"FileReader") ([] :: [MisoString])
pure (FileReader reader)
data Response body
= Response
{ forall body. Response body -> Maybe Int
status :: Maybe Int
, :: Map MisoString MisoString
, forall body. Response body -> Maybe MisoString
errorMessage :: Maybe MisoString
, forall body. Response body -> body
body :: body
}
instance Functor Response where
fmap :: forall a b. (a -> b) -> Response a -> Response b
fmap a -> b
f response :: Response a
response@Response { a
body :: forall body. Response body -> body
body :: a
body } = Response a
response { body = f body }
instance FromJSVal body => FromJSVal (Response body) where
fromJSVal :: JSVal -> IO (Maybe (Response body))
fromJSVal JSVal
o = do
status_ <- JSVal -> IO (Maybe (Maybe Int))
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe (Maybe Int)))
-> IO JSVal -> IO (Maybe (Maybe Int))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MisoString -> Object -> IO JSVal
forall o. ToObject o => MisoString -> o -> IO JSVal
getProp MisoString
"status" (JSVal -> Object
Object JSVal
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_)
newtype Event = Event JSVal
deriving (Event -> IO JSVal
(Event -> IO JSVal) -> ToJSVal Event
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: Event -> IO JSVal
toJSVal :: Event -> IO JSVal
ToJSVal, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq)
instance FromJSVal Event where
fromJSVal :: JSVal -> IO (Maybe Event)
fromJSVal = Maybe Event -> IO (Maybe Event)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Event -> IO (Maybe Event))
-> (JSVal -> Maybe Event) -> JSVal -> IO (Maybe Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Maybe Event
forall a. a -> Maybe a
Just (Event -> Maybe Event) -> (JSVal -> Event) -> JSVal -> Maybe Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> Event
Event
dispatchEvent :: Event -> IO ()
dispatchEvent :: Event -> IO ()
dispatchEvent Event
event = do
doc <- IO JSVal
getDocument
_ <- doc # "dispatchEvent" $ [event]
pure ()
newEvent :: ToArgs args => args -> IO Event
newEvent :: forall args. ToArgs args => args -> IO Event
newEvent args
args = JSVal -> Event
Event (JSVal -> Event) -> IO JSVal -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO JSVal -> args -> IO JSVal
forall constructor args.
(ToObject constructor, ToArgs args) =>
constructor -> args -> IO JSVal
new (MisoString -> IO JSVal
jsg MisoString
"Event") args
args
newCustomEvent :: ToArgs args => args -> IO Event
newCustomEvent :: forall args. ToArgs args => args -> IO Event
newCustomEvent args
args = JSVal -> Event
Event (JSVal -> Event) -> IO JSVal -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO JSVal -> args -> IO JSVal
forall constructor args.
(ToObject constructor, ToArgs args) =>
constructor -> args -> IO JSVal
new (MisoString -> IO JSVal
jsg MisoString
"CustomEvent") args
args