-----------------------------------------------------------------------------
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Delegate
-- Copyright   :  (C) 2016-2026 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Types and functions related to [event delegation](https://developer.mozilla.org/en-US/docs/Learn_web_development/Core/Scripting/Event_bubbling#event_delegation)
--
----------------------------------------------------------------------------
module Miso.Delegate
  ( delegator
  ) where
-----------------------------------------------------------------------------
import           Control.Monad.IO.Class (liftIO)
import           Data.IORef (IORef, readIORef)
import qualified Data.Map.Strict as M
-----------------------------------------------------------------------------
import           Miso.DSL (create, JSVal, Object(..), ToJSVal(toJSVal))
import           Miso.Types (VTree(..), Events, Phase)
import           Miso.String (MisoString)
import qualified Miso.FFI.Internal as FFI
-----------------------------------------------------------------------------
-- | Local Event type, used to create field names for a delegated event
data Event
  = Event
  { Event -> MisoString
name :: MisoString
  -- ^ Event name
  , Event -> Phase
capture :: Phase
  -- ^ Capture settings for event
  } deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show, 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 used to initialize event delegation
instance ToJSVal Event where
  toJSVal :: Event -> IO JSVal
toJSVal Event {MisoString
Phase
name :: Event -> MisoString
capture :: Event -> Phase
name :: MisoString
capture :: Phase
..} = do
    Object
o <- IO Object
create
    (JSVal -> Object -> IO ()) -> Object -> JSVal -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"name") Object
o (JSVal -> IO ()) -> IO JSVal -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal MisoString
name
    (JSVal -> Object -> IO ()) -> Object -> JSVal -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"capture") Object
o (JSVal -> IO ()) -> IO JSVal -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Phase -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Phase
capture
    Object -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Object
o
-----------------------------------------------------------------------------
-- | Entry point for event delegation
delegator
  :: JSVal
  -> IORef VTree
  -> Events
  -> Bool
  -> IO ()
delegator :: JSVal -> IORef VTree -> Events -> Bool -> IO ()
delegator JSVal
mountPointElement IORef VTree
vtreeRef Events
es Bool
debug = do
  JSVal
evts <- [Event] -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal ((MisoString -> Phase -> Event) -> (MisoString, Phase) -> Event
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MisoString -> Phase -> Event
Event ((MisoString, Phase) -> Event) -> [(MisoString, Phase)] -> [Event]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Events -> [(MisoString, Phase)]
forall k a. Map k a -> [(k, a)]
M.toList Events
es)
  JSVal -> JSVal -> Bool -> IO JSVal -> IO ()
FFI.delegator JSVal
mountPointElement JSVal
evts Bool
debug (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    VTree (Object JSVal
vtree) <- IO VTree -> IO VTree
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef VTree -> IO VTree
forall a. IORef a -> IO a
readIORef IORef VTree
vtreeRef)
    JSVal -> IO JSVal
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
vtree
-----------------------------------------------------------------------------