-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Event
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Functions for specifying component lifecycle events and event handlers in 'Miso.Types.View'.
--
----------------------------------------------------------------------------
module Miso.Event
   ( -- *** Smart constructors
     on
   , onCapture
   , onWithOptions
   , Phase (..)
   -- *** Lifecycle events
   , onMounted
   , onBeforeMounted
   , onUnmounted
   , onBeforeUnmounted
   , onCreated
   , onCreatedWith
   , onBeforeCreated
   , onDestroyed
   , onBeforeDestroyed
   , onBeforeDestroyedWith
    -- *** Exports
   , module Miso.Event.Decoder
   , module Miso.Event.Types
   ) where
-----------------------------------------------------------------------------
import           Control.Monad (when)
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 (On), LogLevel(..), DOMRef, VTree(..))
import           Miso.String (MisoString, ms)
-----------------------------------------------------------------------------
-- | Convenience wrapper for @onWithOptions defaultOptions@.
--
-- > let clickHandler = on "click" emptyDecoder $ \() -> Action
-- > in button_ [ clickHandler, class_ "add" ] [ text_ "+" ]
--
-- This is used to define events that are triggered during the browser
-- bubble phase.
--
on :: MisoString
   -> Decoder r
   -> (r -> DOMRef -> action)
   -> Attribute action
on :: forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on = Phase
-> Options
-> MisoString
-> Decoder r
-> (r -> DOMRef -> action)
-> Attribute action
forall r action.
Phase
-> Options
-> MisoString
-> Decoder r
-> (r -> DOMRef -> action)
-> Attribute action
onWithOptions Phase
BUBBLE Options
defaultOptions
-----------------------------------------------------------------------------
-- | Convenience wrapper for @onWithOptions (True :: Capture)@.
--
-- > let clickHandler = onCapture "click" emptyDecoder $ \() -> Action
-- > in button_ [ clickHandler, class_ "add" ] [ text_ "+" ]
--
-- This is used to define events that are triggered during the browser
-- capture phase.
--
onCapture 
   :: MisoString
   -> Decoder r
   -> (r -> DOMRef -> action)
   -> Attribute action
onCapture :: forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
onCapture = Phase
-> Options
-> MisoString
-> Decoder r
-> (r -> DOMRef -> action)
-> Attribute action
forall r action.
Phase
-> Options
-> MisoString
-> Decoder r
-> (r -> DOMRef -> action)
-> Attribute action
onWithOptions Phase
CAPTURE Options
defaultOptions
-----------------------------------------------------------------------------
-- | @onWithOptions opts eventName decoder toAction@ is an attribute
-- that will set the event handler of the associated DOM node to a function that
-- decodes its argument using @decoder@, converts it to an action
-- using @toAction@ and then feeds that action back to the @update@ function.
--
-- @opts@ can be used to disable further event propagation.
--
-- > let clickHandler = onWithOptions defaultOptions "click" emptyDecoder $ \() -> Action
-- > in button_ [ clickHandler, class_ "add" ] [ text_ "+" ]
--
onWithOptions
  :: Phase
  -> Options
  -> MisoString
  -> Decoder r
  -> (r -> DOMRef -> action)
  -> Attribute action
onWithOptions :: forall r action.
Phase
-> Options
-> MisoString
-> Decoder r
-> (r -> DOMRef -> action)
-> Attribute action
onWithOptions Phase
phase 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 -> DOMRef -> action
toAction =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
n) LogLevel
logLevel Events
events -> do
    Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogLevel
logLevel LogLevel -> LogLevel -> Bool
forall a. Eq a => a -> a -> Bool
== LogLevel
DebugAll Bool -> Bool -> Bool
|| LogLevel
logLevel LogLevel -> LogLevel -> Bool
forall a. Eq a => a -> a -> Bool
== LogLevel
DebugEvents) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$
      case MisoString -> Events -> Maybe Phase
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MisoString
eventName Events
events of
        Maybe Phase
Nothing ->
            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 Component"
              ]
        Maybe Phase
_ -> () -> JSM ()
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    eventsVal <-
      MisoString -> Object -> JSM DOMRef
getProp MisoString
"events" Object
n
    eventObj <-
      case phase of
        Phase
CAPTURE -> MisoString -> Object -> JSM DOMRef
getProp MisoString
"captures" (DOMRef -> Object
Object DOMRef
eventsVal)
        Phase
BUBBLE -> MisoString -> Object -> JSM DOMRef
getProp MisoString
"bubbles" (DOMRef -> Object
Object DOMRef
eventsVal)
    eventHandlerObject@(Object eo) <- create
    jsOptions <- toJSVal options
    decodeAtVal <- toJSVal decodeAt
    cb <- FFI.syncCallback2 $ \DOMRef
e DOMRef
domRef -> do
        Just v <- DOMRef -> JSM (Maybe Value)
forall a. FromJSVal a => DOMRef -> JSM (Maybe a)
fromJSVal (DOMRef -> JSM (Maybe Value)) -> JSM DOMRef -> JSM (Maybe Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DOMRef -> DOMRef -> JSM DOMRef
FFI.eventJSON DOMRef
decodeAtVal DOMRef
e
        case parseEither decoder v of
          Left String
msg -> MisoString -> JSM ()
FFI.consoleError (MisoString
"[EVENT DECODE ERROR]: " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms String
msg)
          Right r
event -> Sink action
sink (r -> DOMRef -> action
toAction r
event DOMRef
domRef)
    FFI.set "runEvent" cb eventHandlerObject
    FFI.set "options" jsOptions eventHandlerObject
    FFI.set eventName eo (Object eventObj)
-----------------------------------------------------------------------------
-- | @onMounted action@ is an event that gets called after the actual DOM
-- element is created.
--
-- @since 1.9.0.0
--
onMounted :: action -> Attribute action
onMounted :: forall action. action -> Attribute action
onMounted action
action =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
object) LogLevel
_ Events
_ -> do
    callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
    FFI.set "onMounted" callback object
-----------------------------------------------------------------------------
-- | @onBeforeMounted action@ is an event that gets called before the actual DOM
-- element is created.
--
-- @since 1.9.0.0
--
onBeforeMounted :: action -> Attribute action
onBeforeMounted :: forall action. action -> Attribute action
onBeforeMounted action
action =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
object) LogLevel
_ Events
_ -> do
    callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
    FFI.set "onBeforeMounted" callback object
-----------------------------------------------------------------------------
-- | @onCreated action@ is an event that gets called after the actual DOM
-- element is created.
--
-- @since 1.9.0.0
--
onCreated :: action -> Attribute action
onCreated :: forall action. action -> Attribute action
onCreated action
action =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
object) LogLevel
_ Events
_ -> do
    callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
    FFI.set "onCreated" callback object
-----------------------------------------------------------------------------
-- | Like @onCreated action@ but passes along the `DOMRef`
--
-- @since 1.9.0.0
--
onCreatedWith :: (DOMRef -> action) -> Attribute action
onCreatedWith :: forall action. (DOMRef -> action) -> Attribute action
onCreatedWith DOMRef -> action
action =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
object) LogLevel
_ Events
_ -> do
    callback <- (DOMRef -> JSM ()) -> JSM Function
FFI.syncCallback1 (Sink action
sink Sink action -> (DOMRef -> action) -> DOMRef -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DOMRef -> action
action)
    FFI.set "onCreated" callback object
-----------------------------------------------------------------------------
-- | @onDestroyed action@ is an event that gets called after the DOM element
-- is removed from the DOM.
--
-- @since 1.9.0.0
--
onDestroyed :: action -> Attribute action
onDestroyed :: forall action. action -> Attribute action
onDestroyed action
action =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
object) LogLevel
_ Events
_ -> do
    callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
    FFI.set "onDestroyed" callback object
-----------------------------------------------------------------------------
-- | @onUnmounted action@ is an event that gets called after the DOM element
-- is removed from the DOM.
--
-- @since 1.9.0.0
--
onUnmounted :: action -> Attribute action
onUnmounted :: forall action. action -> Attribute action
onUnmounted action
action =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
object) LogLevel
_ Events
_ -> do
    callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
    FFI.set "onUnmounted" callback object
-----------------------------------------------------------------------------
-- | @onBeforeUnmounted action@ is an event that gets called before the DOM element
-- is removed from the DOM.
--
-- @since 1.9.0.0
--
onBeforeUnmounted :: action -> Attribute action
onBeforeUnmounted :: forall action. action -> Attribute action
onBeforeUnmounted action
action =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
object) LogLevel
_ Events
_ -> do
    callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
    FFI.set "onBeforeUnmounted" callback object
-----------------------------------------------------------------------------
-- | @onBeforeDestroyed action@ is an event that gets called before the DOM element
-- is removed from the DOM.
--
-- @since 1.9.0.0
--
onBeforeDestroyed :: action -> Attribute action
onBeforeDestroyed :: forall action. action -> Attribute action
onBeforeDestroyed action
action =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
object) LogLevel
_ Events
_ -> do
    callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
    FFI.set "onBeforeDestroyed" callback object
-----------------------------------------------------------------------------
-- | Like @onBeforeDestroyed@ but passes along the `DOMRef`
--
-- @since 1.9.0.0
--
onBeforeDestroyedWith :: (DOMRef -> action) -> Attribute action
onBeforeDestroyedWith :: forall action. (DOMRef -> action) -> Attribute action
onBeforeDestroyedWith DOMRef -> action
action =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
object) LogLevel
_ Events
_ -> do
    callback <- (DOMRef -> JSM ()) -> JSM Function
FFI.syncCallback1 (Sink action
sink Sink action -> (DOMRef -> action) -> DOMRef -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DOMRef -> action
action)
    FFI.set "onBeforeDestroyed" callback object
-----------------------------------------------------------------------------
-- | @onBeforeCreated action@ is an event that gets called before the DOM element
-- is created on the DOM.
--
-- @since 1.9.0.0
--
onBeforeCreated :: action -> Attribute action
onBeforeCreated :: forall action. action -> Attribute action
onBeforeCreated action
action =
  (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall action.
(Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
On ((Sink action -> VTree -> LogLevel -> Events -> JSM ())
 -> Attribute action)
-> (Sink action -> VTree -> LogLevel -> Events -> JSM ())
-> Attribute action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink (VTree Object
object) LogLevel
_ Events
_ -> do
    callback <- JSM () -> JSM Function
FFI.syncCallback (Sink action
sink action
action)
    FFI.set "onBeforeCreated" callback object
-----------------------------------------------------------------------------