{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE CPP #-}
module Miso.FFI.Internal
( JSM
, forkJSM
, syncCallback
, syncCallback1
, syncCallback2
, asyncCallback
, asyncCallback1
, asyncCallback2
, ghcjsPure
, syncPoint
, addEventListener
, removeEventListener
, eventPreventDefault
, eventStopPropagation
, windowAddEventListener
, windowRemoveEventListener
, windowInnerHeight
, windowInnerWidth
, now
, consoleWarn
, consoleLog
, consoleError
, consoleLog'
, jsonStringify
, jsonParse
, eventJSON
, set
, getBody
, getDocument
, getContext
, getElementById
, diff
, nextSibling
, previousSibling
, integralToJSString
, realFloatToJSString
, jsStringToDouble
, delegateEvent
, undelegateEvent
, hydrate
, focus
, blur
, scrollIntoView
, alert
, reload
, addStyle
, addStyleSheet
, addSrc
, addScript
, addScriptImportMap
, fetch
, shouldSync
, requestAnimationFrame
, setDrawingContext
, flush
, Image (..)
, newImage
, Date (..)
, newDate
, toLocaleString
, getMilliseconds
, getSeconds
, getParentComponentId
, getComponentId
, files
, click
, websocketConnect
, websocketClose
, websocketSend
, eventSourceConnect
, eventSourceClose
, Blob (..)
, ArrayBuffer (..)
, geolocation
, copyClipboard
, getUserMedia
, isOnLine
) where
import Control.Concurrent (ThreadId, forkIO)
import Control.Monad (void, forM_, (<=<))
import Control.Monad.IO.Class (liftIO)
import Data.Aeson hiding (Object)
import qualified Data.Aeson as A
import qualified Data.JSString as JSS
#ifdef GHCJS_BOTH
import Language.Javascript.JSaddle
#else
import Language.Javascript.JSaddle hiding (Success)
#endif
import Prelude hiding ((!!))
import Miso.String
forkJSM :: JSM () -> JSM ThreadId
forkJSM :: JSM () -> JSM ThreadId
forkJSM JSM ()
a = do
ctx <- JSM JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
liftIO (forkIO (runJSM a ctx))
syncCallback :: JSM () -> JSM Function
syncCallback :: JSM () -> JSM Function
syncCallback JSM ()
a = JSCallAsFunction -> JSM Function
function (\JSVal
_ JSVal
_ [JSVal]
_ -> JSM ()
a)
asyncCallback :: JSM () -> JSM Function
asyncCallback :: JSM () -> JSM Function
asyncCallback JSM ()
a = JSCallAsFunction -> JSM Function
asyncFunction (\JSVal
_ JSVal
_ [JSVal]
_ -> JSM ()
a)
asyncCallback1 :: (JSVal -> JSM ()) -> JSM Function
asyncCallback1 :: (JSVal -> JSM ()) -> JSM Function
asyncCallback1 JSVal -> JSM ()
f = JSCallAsFunction -> JSM Function
asyncFunction JSCallAsFunction
forall {p} {p}. p -> p -> [JSVal] -> JSM ()
handle
where
handle :: p -> p -> [JSVal] -> JSM ()
handle p
_ p
_ [] = String -> JSM ()
forall a. HasCallStack => String -> a
error String
"asyncCallback1: no args, impossible"
handle p
_ p
_ (JSVal
x:[JSVal]
_) = JSVal -> JSM ()
f JSVal
x
asyncCallback2 :: (JSVal -> JSVal -> JSM ()) -> JSM Function
asyncCallback2 :: (JSVal -> JSVal -> JSM ()) -> JSM Function
asyncCallback2 JSVal -> JSVal -> JSM ()
f = JSCallAsFunction -> JSM Function
asyncFunction JSCallAsFunction
forall {p} {p}. p -> p -> [JSVal] -> JSM ()
handle
where
handle :: p -> p -> [JSVal] -> JSM ()
handle p
_ p
_ [] = String -> JSM ()
forall a. HasCallStack => String -> a
error String
"asyncCallback2: no args, impossible"
handle p
_ p
_ [JSVal
_] = String -> JSM ()
forall a. HasCallStack => String -> a
error String
"asyncCallback2: 1 arg, impossible"
handle p
_ p
_ (JSVal
x:JSVal
y:[JSVal]
_) = JSVal -> JSVal -> JSM ()
f JSVal
x JSVal
y
syncCallback1 :: (JSVal -> JSM ()) -> JSM Function
syncCallback1 :: (JSVal -> JSM ()) -> JSM Function
syncCallback1 JSVal -> JSM ()
f = JSCallAsFunction -> JSM Function
function JSCallAsFunction
forall {p} {p}. p -> p -> [JSVal] -> JSM ()
handle
where
handle :: p -> p -> [JSVal] -> JSM ()
handle p
_ p
_ [] = String -> JSM ()
forall a. HasCallStack => String -> a
error String
"syncCallback1: no args, impossible"
handle p
_ p
_ (JSVal
x:[JSVal]
_) = JSVal -> JSM ()
f JSVal
x
syncCallback2 :: (JSVal -> JSVal -> JSM ()) -> JSM Function
syncCallback2 :: (JSVal -> JSVal -> JSM ()) -> JSM Function
syncCallback2 JSVal -> JSVal -> JSM ()
f = JSCallAsFunction -> JSM Function
function JSCallAsFunction
forall {p} {p}. p -> p -> [JSVal] -> JSM ()
handle
where
handle :: p -> p -> [JSVal] -> JSM ()
handle p
_ p
_ [] = String -> JSM ()
forall a. HasCallStack => String -> a
error String
"syncCallback2: no args, impossible"
handle p
_ p
_ [JSVal
_] = String -> JSM ()
forall a. HasCallStack => String -> a
error String
"syncCallback2: 1 arg, impossible"
handle p
_ p
_ (JSVal
x:JSVal
y:[JSVal]
_) = JSVal -> JSVal -> JSM ()
f JSVal
x JSVal
y
set :: ToJSVal v => MisoString -> v -> Object -> JSM ()
set :: forall v. ToJSVal v => MisoString -> v -> Object -> JSM ()
set (MisoString -> String
unpack -> String
"class") v
v Object
o = do
classSet <- ((String -> MisoString
JSS.pack String
"class") MisoString -> [MisoString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem`) ([MisoString] -> Bool) -> JSM [MisoString] -> JSM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> JSM [MisoString]
listProps Object
o
if classSet
then do
classStr <- fromJSValUnchecked =<< getProp (JSS.pack "class") o
vStr <- fromJSValUnchecked =<< toJSVal v
v' <- toJSVal (classStr <> JSS.pack " " <> vStr)
setProp (JSS.pack "class") v' o
else do
v' <- toJSVal v
setProp (JSS.pack "class") v' o
set MisoString
k v
v Object
o = do
v' <- v -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal v
v
setProp (fromMisoString k) v' o
addEventListener
:: JSVal
-> MisoString
-> (JSVal -> JSM ())
-> JSM Function
addEventListener :: JSVal -> MisoString -> (JSVal -> JSM ()) -> JSM Function
addEventListener JSVal
self MisoString
name JSVal -> JSM ()
cb = do
cb_ <- JSCallAsFunction -> JSM Function
asyncFunction JSCallAsFunction
forall {p} {p}. p -> p -> [JSVal] -> JSM ()
handle
void $ self # "addEventListener" $ (name, cb_)
pure cb_
where
handle :: p -> p -> [JSVal] -> JSM ()
handle p
_ p
_ [] = String -> JSM ()
forall a. HasCallStack => String -> a
error String
"addEventListener: no args, impossible"
handle p
_ p
_ (JSVal
x:[JSVal]
_) = JSVal -> JSM ()
cb JSVal
x
removeEventListener
:: JSVal
-> MisoString
-> Function
-> JSM ()
removeEventListener :: JSVal -> MisoString -> Function -> JSM ()
removeEventListener JSVal
self MisoString
name Function
cb =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
self JSVal -> String -> (MisoString, Function) -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"removeEventListener" ((MisoString, Function) -> JSM JSVal)
-> (MisoString, Function) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (MisoString
name, Function
cb)
windowRemoveEventListener
:: MisoString
-> Function
-> JSM ()
windowRemoveEventListener :: MisoString -> Function -> JSM ()
windowRemoveEventListener MisoString
name Function
cb = do
win <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"window"
removeEventListener win name cb
windowAddEventListener
:: MisoString
-> (JSVal -> JSM ())
-> JSM Function
windowAddEventListener :: MisoString -> (JSVal -> JSM ()) -> JSM Function
windowAddEventListener MisoString
name JSVal -> JSM ()
cb = do
win <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"window"
addEventListener win name cb
eventStopPropagation :: JSVal -> JSM ()
eventStopPropagation :: JSVal -> JSM ()
eventStopPropagation JSVal
e = do
_ <- JSVal
e JSVal -> String -> () -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"stopPropagation" (() -> JSM JSVal) -> () -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ()
pure ()
eventPreventDefault :: JSVal -> JSM ()
eventPreventDefault :: JSVal -> JSM ()
eventPreventDefault JSVal
e = do
_ <- JSVal
e JSVal -> String -> () -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"preventDefault" (() -> JSM JSVal) -> () -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ()
pure ()
windowInnerHeight :: JSM Int
windowInnerHeight :: JSM Int
windowInnerHeight =
JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Int) -> JSM JSVal -> JSM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"window" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"innerHeight"
windowInnerWidth :: JSM Int
windowInnerWidth :: JSM Int
windowInnerWidth =
JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Int) -> JSM JSVal -> JSM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"window" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"innerWidth"
now :: JSM Double
now :: JSM Double
now = JSVal -> JSM Double
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Double) -> JSM JSVal -> JSM Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"performance" JSM JSVal -> String -> () -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"now" (() -> JSM JSVal) -> () -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ())
consoleLog :: MisoString -> JSM ()
consoleLog :: MisoString -> JSM ()
consoleLog MisoString
v = do
_ <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"console" JSM JSVal -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"log" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString -> MisoString
forall a. ToJSString a => a -> MisoString
toJSString MisoString
v]
pure ()
consoleWarn :: MisoString -> JSM ()
consoleWarn :: MisoString -> JSM ()
consoleWarn MisoString
v = do
_ <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"console" JSM JSVal -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"warn" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString -> MisoString
forall a. ToJSString a => a -> MisoString
toJSString MisoString
v]
pure ()
consoleError :: MisoString -> JSM ()
consoleError :: MisoString -> JSM ()
consoleError MisoString
v = do
_ <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"console" JSM JSVal -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"error" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString -> MisoString
forall a. ToJSString a => a -> MisoString
toJSString MisoString
v]
pure ()
consoleLog' :: JSVal -> JSM ()
consoleLog' :: JSVal -> JSM ()
consoleLog' JSVal
v = do
_ <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"console" JSM JSVal -> String -> [JSVal] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"log" ([JSVal] -> JSM JSVal) -> [JSVal] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [JSVal
v]
pure ()
jsonStringify :: ToJSON json => json -> JSM JSVal
{-# INLINE jsonStringify #-}
jsonStringify :: forall json. ToJSON json => json -> JSM JSVal
jsonStringify json
j = do
v <- Value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (json -> Value
forall a. ToJSON a => a -> Value
toJSON json
j)
jsg "JSON" # "stringify" $ [v]
jsonParse :: FromJSON json => JSVal -> JSM json
{-# INLINE jsonParse #-}
jsonParse :: forall json. FromJSON json => JSVal -> JSM json
jsonParse JSVal
jval = do
v <- JSVal -> JSM Value
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Value) -> JSM JSVal -> JSM Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"JSON" JSM JSVal -> String -> [JSVal] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"parse" ([JSVal] -> JSM JSVal) -> [JSVal] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [JSVal
jval])
case fromJSON v of
A.Success json
x -> json -> JSM json
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure json
x
A.Error String
y -> String -> JSM json
forall a. HasCallStack => String -> a
error String
y
eventJSON
:: JSVal
-> JSVal
-> JSM JSVal
eventJSON :: JSVal -> JSVal -> JSM JSVal
eventJSON JSVal
x JSVal
y = do
moduleMiso <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso"
moduleMiso # "eventJSON" $ [x,y]
getBody :: JSM JSVal
getBody :: JSM JSVal
getBody = do
ctx <- JSM JSVal
getContext
ctx # "getRoot" $ ()
getDocument :: JSM JSVal
getDocument :: JSM JSVal
getDocument = String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"document"
getContext :: JSM JSVal
getContext :: JSM JSVal
getContext = String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"context"
getElementById :: MisoString -> JSM JSVal
getElementById :: MisoString -> JSM JSVal
getElementById MisoString
e = JSM JSVal
getDocument JSM JSVal -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"getElementById" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
e]
diff
:: Object
-> Object
-> JSVal
-> JSM ()
diff :: Object -> Object -> JSVal -> JSM ()
diff (Object JSVal
a) (Object JSVal
b) JSVal
c = do
moduleMiso <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso"
context <- getContext
void $ moduleMiso # "diff" $ [a,b,c,context]
integralToJSString :: Integral a => a -> MisoString
integralToJSString :: forall a. Integral a => a -> MisoString
integralToJSString = String -> MisoString
pack (String -> MisoString) -> (a -> String) -> a -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> (a -> Integer) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. Integral a => a -> Integer
toInteger
realFloatToJSString :: RealFloat a => a -> MisoString
realFloatToJSString :: forall a. RealFloat a => a -> MisoString
realFloatToJSString a
x = (String -> MisoString
pack (String -> MisoString)
-> (Double -> String) -> Double -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
x :: Double)
jsStringToDouble :: MisoString -> Double
jsStringToDouble :: MisoString -> Double
jsStringToDouble = String -> Double
forall a. Read a => String -> a
read (String -> Double)
-> (MisoString -> String) -> MisoString -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> String
unpack
delegateEvent :: JSVal -> JSVal -> Bool -> JSM JSVal -> JSM ()
delegateEvent :: JSVal -> JSVal -> Bool -> JSM JSVal -> JSM ()
delegateEvent JSVal
mountPoint JSVal
events Bool
debug JSM JSVal
getVTree = do
ctx <- JSM JSVal
getContext
cb <- function handler
delegate mountPoint events debug cb ctx
where
handler :: p -> p -> [f] -> JSM ()
handler p
_ p
_ [] = String -> JSM ()
forall a. HasCallStack => String -> a
error String
"delegate: no args - impossible state"
handler p
_ p
_ (f
continuation : [f]
_) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f -> Object -> JSVal -> JSM JSVal
forall f this args.
(MakeObject f, MakeObject this, MakeArgs args) =>
f -> this -> args -> JSM JSVal
call f
continuation Object
global (JSVal -> JSM JSVal) -> JSM JSVal -> JSM JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM JSVal
getVTree)
undelegateEvent :: JSVal -> JSVal -> Bool -> JSM JSVal -> JSM ()
undelegateEvent :: JSVal -> JSVal -> Bool -> JSM JSVal -> JSM ()
undelegateEvent JSVal
mountPoint JSVal
events Bool
debug JSM JSVal
getVTree = do
ctx <- JSM JSVal
getContext
cb <- function handler
undelegate mountPoint events debug cb ctx
where
handler :: p -> p -> [f] -> JSM ()
handler p
_ p
_ [] = String -> JSM ()
forall a. HasCallStack => String -> a
error String
"undelegate: no args - impossible state"
handler p
_ p
_ (f
continuation : [f]
_) =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f -> Object -> JSVal -> JSM JSVal
forall f this args.
(MakeObject f, MakeObject this, MakeArgs args) =>
f -> this -> args -> JSM JSVal
call f
continuation Object
global (JSVal -> JSM JSVal) -> JSM JSVal -> JSM JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM JSVal
getVTree)
delegate :: JSVal -> JSVal -> Bool -> Function -> JSVal -> JSM ()
delegate :: JSVal -> JSVal -> Bool -> Function -> JSVal -> JSM ()
delegate JSVal
mountPoint JSVal
events Bool
debug Function
callback JSVal
ctx = do
d <- Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
debug
cb <- toJSVal callback
moduleMiso <- jsg "miso"
void $ moduleMiso # "delegate" $ [mountPoint,events,cb,d,ctx]
undelegate :: JSVal -> JSVal -> Bool -> Function -> JSVal -> JSM ()
undelegate :: JSVal -> JSVal -> Bool -> Function -> JSVal -> JSM ()
undelegate JSVal
mountPoint JSVal
events Bool
debug Function
callback JSVal
ctx = do
d <- Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
debug
cb <- toJSVal callback
moduleMiso <- jsg "miso"
void $ moduleMiso # "undelegate" $ [mountPoint,events,cb,d,ctx]
hydrate :: Bool -> JSVal -> JSVal -> JSM ()
hydrate :: Bool -> JSVal -> JSVal -> JSM ()
hydrate Bool
logLevel JSVal
mountPoint JSVal
vtree = JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
ll <- Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
logLevel
context <- getContext
moduleMiso <- jsg "miso"
void $ moduleMiso # "hydrate" $ [ll, mountPoint, vtree, context]
focus :: MisoString -> JSM ()
focus :: MisoString -> JSM ()
focus MisoString
x = do
moduleMiso <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso"
el <- toJSVal x
delay <- toJSVal (50 :: Int)
void $ moduleMiso # "callFocus" $ [el,delay]
blur :: MisoString -> JSM ()
blur :: MisoString -> JSM ()
blur MisoString
x = do
moduleMiso <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso"
el <- toJSVal x
delay <- toJSVal (50 :: Int)
void $ moduleMiso # "callBlur" $ [el,delay]
scrollIntoView :: MisoString -> JSM ()
scrollIntoView :: MisoString -> JSM ()
scrollIntoView MisoString
elId = do
el <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"document" JSM JSVal -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"getElementById" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
elId]
_ <- el # "scrollIntoView" $ ()
pure ()
alert :: MisoString -> JSM ()
alert :: MisoString -> JSM ()
alert MisoString
a = () () -> JSM JSVal -> JSM ()
forall a b. a -> JSM b -> JSM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> MisoString -> JSM JSVal
forall name a0.
(ToJSString name, ToJSVal a0) =>
name -> a0 -> JSM JSVal
jsg1 String
"alert" MisoString
a
reload :: JSM ()
reload :: JSM ()
reload = JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"location" JSM JSVal -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"reload" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
addStyle :: MisoString -> JSM JSVal
addStyle :: MisoString -> JSM JSVal
addStyle MisoString
css = do
style <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"document" JSM JSVal -> String -> [String] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"createElement" ([String] -> JSM JSVal) -> [String] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [String
"style"]
(style <# "innerHTML") css
jsg "document" ! "head" # "appendChild" $ [style]
addScript :: MisoString -> JSM JSVal
addScript :: MisoString -> JSM JSVal
addScript MisoString
js_ = do
script <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"document" JSM JSVal -> String -> [String] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"createElement" ([String] -> JSM JSVal) -> [String] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [String
"script"]
(script <# "innerHTML") js_
jsg "document" ! "head" # "appendChild" $ [script]
addScriptImportMap :: MisoString -> JSM JSVal
addScriptImportMap :: MisoString -> JSM JSVal
addScriptImportMap MisoString
impMap = do
script <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"document" JSM JSVal -> String -> [String] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"createElement" ([String] -> JSM JSVal) -> [String] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [String
"script"]
(script <# "type") "importmap"
(script <# "innerHTML") impMap
jsg "document" ! "head" # "appendChild" $ [script]
addSrc :: MisoString -> JSM JSVal
addSrc :: MisoString -> JSM JSVal
addSrc MisoString
url = do
link <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"document" JSM JSVal -> String -> [String] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"createElement" ([String] -> JSM JSVal) -> [String] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [String
"script"]
_ <- link # "setAttribute" $ ["src", fromMisoString url]
jsg "document" ! "head" # "appendChild" $ [link]
addStyleSheet :: MisoString -> JSM JSVal
addStyleSheet :: MisoString -> JSM JSVal
addStyleSheet MisoString
url = do
link <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"document" JSM JSVal -> String -> [String] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"createElement" ([String] -> JSM JSVal) -> [String] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [String
"link"]
_ <- link # "setAttribute" $ ["rel","stylesheet"]
_ <- link # "setAttribute" $ ["href", fromMisoString url]
jsg "document" ! "head" # "appendChild" $ [link]
fetch
:: MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (JSVal -> JSM ())
-> (MisoString -> JSM ())
-> MisoString
-> JSM ()
fetch :: MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (JSVal -> JSM ())
-> (MisoString -> JSM ())
-> MisoString
-> JSM ()
fetch MisoString
url MisoString
method Maybe JSVal
maybeBody [(MisoString, MisoString)]
headers JSVal -> JSM ()
successful MisoString -> JSM ()
errorful MisoString
type_ = do
successful_ <- Function -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (Function -> JSM JSVal) -> JSM Function -> JSM JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JSVal -> JSM ()) -> JSM Function
asyncCallback1 JSVal -> JSM ()
successful
errorful_ <- toJSVal =<< asyncCallback1 (errorful <=< fromJSValUnchecked)
moduleMiso <- jsg "miso"
url_ <- toJSVal url
method_ <- toJSVal method
body_ <- toJSVal maybeBody
Object headers_ <- do
o <- create
forM_ headers $ \(MisoString
k,MisoString
v) -> MisoString -> MisoString -> Object -> JSM ()
forall v. ToJSVal v => MisoString -> v -> Object -> JSM ()
set MisoString
k MisoString
v Object
o
pure o
typ <- toJSVal type_
void $ moduleMiso # "fetchCore" $
[ url_
, method_
, body_
, headers_
, successful_
, errorful_
, typ
]
shouldSync :: JSVal -> JSM Bool
shouldSync :: JSVal -> JSM Bool
shouldSync JSVal
vnode = do
returnValue <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso" JSM JSVal -> String -> [JSVal] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"shouldSync" ([JSVal] -> JSM JSVal) -> [JSVal] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [JSVal
vnode]
fromJSValUnchecked returnValue
flush :: JSM ()
flush :: JSM ()
flush = do
context <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"context"
void $ context # "flush" $ ([] :: [JSVal])
requestAnimationFrame :: JSM () -> JSM ()
requestAnimationFrame :: JSM () -> JSM ()
requestAnimationFrame JSM ()
f = do
context <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"context"
cb <- syncCallback f
void $ context # "requestAnimationFrame" $ [cb]
newtype Image = Image JSVal
deriving ([Image] -> JSM JSVal
Image -> JSM JSVal
(Image -> JSM JSVal) -> ([Image] -> JSM JSVal) -> ToJSVal Image
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
$ctoJSVal :: Image -> JSM JSVal
toJSVal :: Image -> JSM JSVal
$ctoJSValListOf :: [Image] -> JSM JSVal
toJSValListOf :: [Image] -> JSM JSVal
ToJSVal, Image -> JSM Object
(Image -> JSM Object) -> MakeObject Image
forall this. (this -> JSM Object) -> MakeObject this
$cmakeObject :: Image -> JSM Object
makeObject :: Image -> JSM Object
MakeObject)
instance FromJSVal Image where
fromJSVal :: JSVal -> JSM (Maybe Image)
fromJSVal = Maybe Image -> JSM (Maybe Image)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Image -> JSM (Maybe Image))
-> (JSVal -> Maybe Image) -> JSVal -> JSM (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 -> JSM Image
newImage :: MisoString -> JSM Image
newImage MisoString
url = do
img <- JSM JSVal -> [MisoString] -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new (String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"Image") ([] :: [MisoString])
img <# "src" $ url
pure (Image img)
setDrawingContext :: MisoString -> JSM ()
setDrawingContext :: MisoString -> JSM ()
setDrawingContext MisoString
rendererName =
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso" JSM JSVal -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"setDrawingContext" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
rendererName]
newtype Date = Date JSVal
deriving ([Date] -> JSM JSVal
Date -> JSM JSVal
(Date -> JSM JSVal) -> ([Date] -> JSM JSVal) -> ToJSVal Date
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
$ctoJSVal :: Date -> JSM JSVal
toJSVal :: Date -> JSM JSVal
$ctoJSValListOf :: [Date] -> JSM JSVal
toJSValListOf :: [Date] -> JSM JSVal
ToJSVal, Date -> JSM Object
(Date -> JSM Object) -> MakeObject Date
forall this. (this -> JSM Object) -> MakeObject this
$cmakeObject :: Date -> JSM Object
makeObject :: Date -> JSM Object
MakeObject)
newDate :: JSM Date
newDate :: JSM Date
newDate = JSVal -> Date
Date (JSVal -> Date) -> JSM JSVal -> JSM Date
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSVal -> [MisoString] -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new (String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"Date") ([] :: [MisoString])
toLocaleString :: Date -> JSM MisoString
toLocaleString :: Date -> JSM MisoString
toLocaleString Date
date = JSVal -> JSM MisoString
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM MisoString) -> JSM JSVal -> JSM MisoString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Date
date Date -> String -> () -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"toLocaleString" (() -> JSM JSVal) -> () -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ()
getMilliseconds :: Date -> JSM Double
getMilliseconds :: Date -> JSM Double
getMilliseconds Date
date =
JSVal -> JSM Double
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Double) -> JSM JSVal -> JSM Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Date
date Date -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"getMilliseconds" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
getSeconds :: Date -> JSM Double
getSeconds :: Date -> JSM Double
getSeconds Date
date =
JSVal -> JSM Double
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Double) -> JSM JSVal -> JSM Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Date
date Date -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"getSeconds" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
getParentComponentId :: JSVal -> JSM (Maybe Int)
getParentComponentId :: JSVal -> JSM (Maybe Int)
getParentComponentId JSVal
domRef =
JSVal -> JSM (Maybe Int)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal (JSVal -> JSM (Maybe Int)) -> JSM JSVal -> JSM (Maybe Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso" JSM JSVal -> String -> [JSVal] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"getParentComponentId" ([JSVal] -> JSM JSVal) -> [JSVal] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [JSVal
domRef]
getComponentId :: JSVal -> JSM Int
getComponentId :: JSVal -> JSM Int
getComponentId JSVal
vtree = JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Int) -> JSM JSVal -> JSM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
vtree JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"componentId"
nextSibling :: JSVal -> JSM JSVal
nextSibling :: JSVal -> JSM JSVal
nextSibling JSVal
domRef = JSVal
domRef JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"nextSibling"
previousSibling :: JSVal -> JSM JSVal
previousSibling :: JSVal -> JSM JSVal
previousSibling JSVal
domRef = JSVal
domRef JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"previousSibling"
files :: JSVal -> JSM [JSVal]
files :: JSVal -> JSM [JSVal]
files JSVal
domRef = JSVal -> JSM [JSVal]
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM [JSVal]) -> JSM JSVal -> JSM [JSVal]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
domRef JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"files"
click :: () -> JSVal -> JSM ()
click :: () -> JSVal -> JSM ()
click () JSVal
domRef = JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
domRef JSVal -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"click" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [MisoString])
getUserMedia
:: Bool
-> Bool
-> (JSVal -> JSM ())
-> (JSVal -> JSM ())
-> JSM ()
getUserMedia :: Bool -> Bool -> (JSVal -> JSM ()) -> (JSVal -> JSM ()) -> JSM ()
getUserMedia Bool
video Bool
audio JSVal -> JSM ()
successful JSVal -> JSM ()
errorful = do
params <- JSM Object
create
set (ms "video") video params
set (ms "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
-> JSM ()
-> (JSVal -> JSM ())
-> JSM ()
copyClipboard :: MisoString -> JSM () -> (JSVal -> JSM ()) -> JSM ()
copyClipboard MisoString
txt JSM ()
successful JSVal -> JSM ()
errorful = do
clipboard <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"navigator" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"clipboard"
promise <- clipboard # "writeText" $ [txt]
successfulCallback <- asyncCallback successful
void $ promise # "then" $ [successfulCallback]
errorfulCallback <- asyncCallback1 errorful
void $ promise # "catch" $ [errorfulCallback]
websocketConnect
:: MisoString
-> JSM ()
-> (JSVal -> JSM ())
-> Maybe (JSVal -> JSM ())
-> Maybe (JSVal -> JSM ())
-> Maybe (JSVal -> JSM ())
-> Maybe (JSVal -> JSM ())
-> (JSVal -> JSM ())
-> Bool
-> JSM JSVal
websocketConnect :: MisoString
-> JSM ()
-> (JSVal -> JSM ())
-> Maybe (JSVal -> JSM ())
-> Maybe (JSVal -> JSM ())
-> Maybe (JSVal -> JSM ())
-> Maybe (JSVal -> JSM ())
-> (JSVal -> JSM ())
-> Bool
-> JSM JSVal
websocketConnect
MisoString
url JSM ()
onOpen JSVal -> JSM ()
onClose
Maybe (JSVal -> JSM ())
onMessageText Maybe (JSVal -> JSM ())
onMessageJSON
Maybe (JSVal -> JSM ())
onMessageBLOB Maybe (JSVal -> JSM ())
onMessageArrayBuffer
JSVal -> JSM ()
onError Bool
textOnly = do
url_ <- MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM 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 -> JSM ()) -> JSM JSVal
withMaybe Maybe (JSVal -> JSM ())
Nothing = JSVal -> JSM JSVal
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
jsNull
withMaybe (Just JSVal -> JSM ()
f) = Function -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (Function -> JSM JSVal) -> JSM Function -> JSM JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JSVal -> JSM ()) -> JSM Function
asyncCallback1 JSVal -> JSM ()
f
websocketClose :: JSVal -> JSM ()
websocketClose :: JSVal -> JSM ()
websocketClose JSVal
websocket = JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso" JSM JSVal -> String -> [JSVal] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"websocketClose" ([JSVal] -> JSM JSVal) -> [JSVal] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [JSVal
websocket]
websocketSend :: JSVal -> JSVal -> JSM ()
websocketSend :: JSVal -> JSVal -> JSM ()
websocketSend JSVal
websocket JSVal
message = JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso" JSM JSVal -> String -> [JSVal] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"websocketSend" ([JSVal] -> JSM JSVal) -> [JSVal] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [JSVal
websocket, JSVal
message]
eventSourceConnect
:: MisoString
-> JSM ()
-> Maybe (JSVal -> JSM ())
-> Maybe (JSVal -> JSM ())
-> (JSVal -> JSM ())
-> Bool
-> JSM JSVal
eventSourceConnect :: MisoString
-> JSM ()
-> Maybe (JSVal -> JSM ())
-> Maybe (JSVal -> JSM ())
-> (JSVal -> JSM ())
-> Bool
-> JSM JSVal
eventSourceConnect MisoString
url JSM ()
onOpen Maybe (JSVal -> JSM ())
onMessageText Maybe (JSVal -> JSM ())
onMessageJSON JSVal -> JSM ()
onError Bool
textOnly = do
onOpen_ <- JSM () -> JSM Function
asyncCallback JSM ()
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 -> JSM ()) -> JSM JSVal
withMaybe Maybe (JSVal -> JSM ())
Nothing = JSVal -> JSM JSVal
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
jsNull
withMaybe (Just JSVal -> JSM ()
f) = Function -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (Function -> JSM JSVal) -> JSM Function -> JSM JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JSVal -> JSM ()) -> JSM Function
asyncCallback1 JSVal -> JSM ()
f
eventSourceClose :: JSVal -> JSM ()
eventSourceClose :: JSVal -> JSM ()
eventSourceClose JSVal
eventSource = JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"miso" JSM JSVal -> String -> [JSVal] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"eventSourceClose" ([JSVal] -> JSM JSVal) -> [JSVal] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [JSVal
eventSource]
isOnLine :: JSM Bool
isOnLine :: JSM Bool
isOnLine = JSVal -> JSM Bool
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Bool) -> JSM JSVal -> JSM Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"navigator" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"onLine"
newtype Blob = Blob JSVal
deriving [Blob] -> JSM JSVal
Blob -> JSM JSVal
(Blob -> JSM JSVal) -> ([Blob] -> JSM JSVal) -> ToJSVal Blob
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
$ctoJSVal :: Blob -> JSM JSVal
toJSVal :: Blob -> JSM JSVal
$ctoJSValListOf :: [Blob] -> JSM JSVal
toJSValListOf :: [Blob] -> JSM JSVal
ToJSVal
instance FromJSVal Blob where
fromJSVal :: JSVal -> JSM (Maybe Blob)
fromJSVal = Maybe Blob -> JSM (Maybe Blob)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Blob -> JSM (Maybe Blob))
-> (JSVal -> Maybe Blob) -> JSVal -> JSM (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
instance FromJSVal ArrayBuffer where
fromJSVal :: JSVal -> JSM (Maybe ArrayBuffer)
fromJSVal = Maybe ArrayBuffer -> JSM (Maybe ArrayBuffer)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ArrayBuffer -> JSM (Maybe ArrayBuffer))
-> (JSVal -> Maybe ArrayBuffer) -> JSVal -> JSM (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] -> JSM JSVal
ArrayBuffer -> JSM JSVal
(ArrayBuffer -> JSM JSVal)
-> ([ArrayBuffer] -> JSM JSVal) -> ToJSVal ArrayBuffer
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
$ctoJSVal :: ArrayBuffer -> JSM JSVal
toJSVal :: ArrayBuffer -> JSM JSVal
$ctoJSValListOf :: [ArrayBuffer] -> JSM JSVal
toJSValListOf :: [ArrayBuffer] -> JSM JSVal
ToJSVal
geolocation :: (JSVal -> JSM ()) -> (JSVal -> JSM ()) -> JSM ()
geolocation :: (JSVal -> JSM ()) -> (JSVal -> JSM ()) -> JSM ()
geolocation JSVal -> JSM ()
successful JSVal -> JSM ()
errorful = do
geo <- String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"navigator" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"geolocation"
cb1 <- asyncCallback1 successful
cb2 <- asyncCallback1 errorful
void $ geo # "getCurrentPosition" $ (cb1, cb2)