{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Miso.Event
(
on
, onWithOptions
, onMounted
, onMountedWith
, onBeforeMounted
, onUnmounted
, onUnmountedWith
, onBeforeUnmounted
, onCreated
, onBeforeCreated
, onDestroyed
, onBeforeDestroyed
, module Miso.Event.Decoder
, module Miso.Event.Types
) where
import Control.Monad (when, forM_)
import qualified Data.Map.Strict as M
import Data.Aeson.Types (parseEither)
import Language.Javascript.JSaddle
import Miso.Event.Decoder
import Miso.Event.Types
import qualified Miso.FFI.Internal as FFI
import Miso.Types ( Attribute (Event), LogLevel(..) )
import Miso.String (MisoString, unpack)
on :: MisoString
-> Decoder r
-> (r -> JSVal -> action)
-> Attribute action
on :: forall r action.
MisoString
-> Decoder r -> (r -> JSVal -> action) -> Attribute action
on = Options
-> MisoString
-> Decoder r
-> (r -> JSVal -> action)
-> Attribute action
forall r action.
Options
-> MisoString
-> Decoder r
-> (r -> JSVal -> action)
-> Attribute action
onWithOptions Options
defaultOptions
onWithOptions
:: Options
-> MisoString
-> Decoder r
-> (r -> JSVal -> action)
-> Attribute action
onWithOptions :: forall r action.
Options
-> MisoString
-> Decoder r
-> (r -> JSVal -> action)
-> Attribute action
onWithOptions Options
options MisoString
eventName Decoder{DecodeTarget
Value -> Parser r
decoder :: Value -> Parser r
decodeAt :: DecodeTarget
decodeAt :: forall a. Decoder a -> DecodeTarget
decoder :: forall a. Decoder a -> Value -> Parser a
..} r -> JSVal -> action
toAction =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
n LogLevel
logLevel Events
events ->
case MisoString -> Events -> Maybe Capture
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MisoString
eventName Events
events of
Maybe Capture
Nothing ->
Capture -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Capture -> f () -> f ()
when (LogLevel
logLevel LogLevel -> [LogLevel] -> Capture
forall a. Eq a => a -> [a] -> Capture
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Capture
`elem` [ LogLevel
DebugAll, LogLevel
DebugEvents ]) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$
MisoString -> JSM ()
FFI.consoleError (MisoString -> JSM ()) -> MisoString -> JSM ()
forall a b. (a -> b) -> a -> b
$ [MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat
[ MisoString
"Event \""
, MisoString
eventName
, MisoString
"\" is not being listened on. To use this event, "
, MisoString
"add to the 'events' Map in 'App'"
]
Just Capture
_ -> do
eventObj <- JSString -> Object -> JSM JSVal
getProp JSString
"events" Object
n
eventHandlerObject@(Object eo) <- create
jsOptions <- toJSVal options
decodeAtVal <- toJSVal decodeAt
cb <- FFI.asyncCallback2 $ \JSVal
e JSVal
domRef -> do
Just v <- JSVal -> JSM (Maybe Value)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal (JSVal -> JSM (Maybe Value)) -> JSM JSVal -> JSM (Maybe Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> JSVal -> JSM JSVal
FFI.eventJSON JSVal
decodeAtVal JSVal
e
case parseEither decoder v of
Left [Char]
s -> [Char] -> JSM ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> JSM ()) -> [Char] -> JSM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Parse error on " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> MisoString -> [Char]
unpack MisoString
eventName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
": " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
s
Right r
r -> Sink action
sink (r -> JSVal -> action
toAction r
r JSVal
domRef)
FFI.set "runEvent" cb eventHandlerObject
FFI.set "options" jsOptions eventHandlerObject
FFI.set eventName eo (Object eventObj)
onMounted :: action -> Attribute action
onMounted :: forall action. action -> Attribute action
onMounted action
action =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
object LogLevel
_ Events
_ -> do
callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
FFI.set "onMounted" callback object
onMountedWith :: (MisoString -> action) -> Attribute action
onMountedWith :: forall action. (MisoString -> action) -> Attribute action
onMountedWith MisoString -> action
action =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
object LogLevel
_ Events
_ -> do
callback <- (JSVal -> JSM ()) -> JSM Function
FFI.syncCallback1 ((JSVal -> JSM ()) -> JSM Function)
-> (JSVal -> JSM ()) -> JSM Function
forall a b. (a -> b) -> a -> b
$ \JSVal
jval -> do
maybeName <- JSVal -> JSM (Maybe MisoString)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal JSVal
jval
forM_ maybeName (sink . action)
FFI.set "onMounted" callback object
onBeforeMounted :: action -> Attribute action
onBeforeMounted :: forall action. action -> Attribute action
onBeforeMounted action
action =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
object LogLevel
_ Events
_ -> do
callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
FFI.set "onBeforeMounted" callback object
onCreated :: action -> Attribute action
onCreated :: forall action. action -> Attribute action
onCreated action
action =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
object LogLevel
_ Events
_ -> do
callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
FFI.set "onCreated" callback object
onDestroyed :: action -> Attribute action
onDestroyed :: forall action. action -> Attribute action
onDestroyed action
action =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
object LogLevel
_ Events
_ -> do
callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
FFI.set "onDestroyed" callback object
onUnmounted :: action -> Attribute action
onUnmounted :: forall action. action -> Attribute action
onUnmounted action
action =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
object LogLevel
_ Events
_ -> do
callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
FFI.set "onUnmounted" callback object
onUnmountedWith :: (MisoString -> action) -> Attribute action
onUnmountedWith :: forall action. (MisoString -> action) -> Attribute action
onUnmountedWith MisoString -> action
action =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
object LogLevel
_ Events
_ -> do
callback <- (JSVal -> JSM ()) -> JSM Function
FFI.syncCallback1 ((JSVal -> JSM ()) -> JSM Function)
-> (JSVal -> JSM ()) -> JSM Function
forall a b. (a -> b) -> a -> b
$ \JSVal
jval -> do
maybeName <- JSVal -> JSM (Maybe MisoString)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal JSVal
jval
forM_ maybeName (sink . action)
FFI.set "onUnmounted" callback object
onBeforeUnmounted :: action -> Attribute action
onBeforeUnmounted :: forall action. action -> Attribute action
onBeforeUnmounted action
action =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
object LogLevel
_ Events
_ -> do
callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
FFI.set "onBeforeUnmounted" callback object
onBeforeDestroyed :: action -> Attribute action
onBeforeDestroyed :: forall action. action -> Attribute action
onBeforeDestroyed action
action =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
object LogLevel
_ Events
_ -> do
callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
FFI.set "onBeforeDestroyed" callback object
onBeforeCreated :: action -> Attribute action
onBeforeCreated :: forall action. action -> Attribute action
onBeforeCreated action
action =
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
Event ((Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action)
-> (Sink action -> Object -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink Object
object LogLevel
_ Events
_ -> do
callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
FFI.set "onBeforeCreated" callback object