-----------------------------------------------------------------------------
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Subscription.Window
-- 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
----------------------------------------------------------------------------
module Miso.Subscription.Window
  ( -- *** Subscription
    windowSub
  , windowCoordsSub
  , windowPointerMoveSub
  , windowSubWithOptions
  -- *** Types
  , Coord
  ) where
-----------------------------------------------------------------------------
import           Control.Monad
import           Language.Javascript.JSaddle
import           Data.Aeson.Types (parseEither)
-----------------------------------------------------------------------------
import           Miso.Event
import           Miso.Effect
import qualified Miso.FFI.Internal as FFI
import           Miso.String
import           Miso.Subscription.Util
import           Miso.Canvas (Coord)
-----------------------------------------------------------------------------
-- | Captures window coordinates changes as they occur and writes them to
-- an event sink
windowCoordsSub :: (Coord -> action) -> Sub action
windowCoordsSub :: forall action. (Coord -> action) -> Sub action
windowCoordsSub Coord -> action
f = (PointerEvent -> action) -> Sub action
forall action. (PointerEvent -> action) -> Sub action
windowPointerMoveSub (Coord -> action
f (Coord -> action)
-> (PointerEvent -> Coord) -> PointerEvent -> action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PointerEvent -> Coord
client)
-----------------------------------------------------------------------------
-- | @windowSub eventName decoder toAction@ provides a subscription
-- to listen to window level events.
windowSub :: MisoString -> Decoder r -> (r -> action) -> Sub action
windowSub :: forall r action.
MisoString -> Decoder r -> (r -> action) -> Sub action
windowSub = Options -> MisoString -> Decoder r -> (r -> action) -> Sub action
forall result action.
Options
-> MisoString -> Decoder result -> (result -> action) -> Sub action
windowSubWithOptions Options
defaultOptions
-----------------------------------------------------------------------------
-- | @windowSubWithOptions options eventName decoder toAction@ provides a
-- subscription to listen to window level events.
windowSubWithOptions
  :: Options
  -> MisoString
  -> Decoder result
  -> (result -> action)
  -> Sub action
windowSubWithOptions :: forall result action.
Options
-> MisoString -> Decoder result -> (result -> action) -> Sub action
windowSubWithOptions Options{Bool
_preventDefault :: Bool
_stopPropagation :: Bool
_stopPropagation :: Options -> Bool
_preventDefault :: Options -> Bool
..} MisoString
eventName Decoder {DecodeTarget
Value -> Parser result
decoder :: Value -> Parser result
decodeAt :: DecodeTarget
decodeAt :: forall a. Decoder a -> DecodeTarget
decoder :: forall a. Decoder a -> Value -> Parser a
..} result -> action
toAction Sink action
sink =
  JSM Function -> (Function -> JSM ()) -> Sub action
forall a b action. JSM a -> (a -> JSM b) -> Sub action
createSub JSM Function
acquire Function -> JSM ()
release Sink action
sink
    where
      release :: Function -> JSM ()
release =
        MisoString -> Function -> JSM ()
FFI.windowRemoveEventListener MisoString
eventName
      acquire :: JSM Function
acquire =
        MisoString -> (JSVal -> JSM ()) -> JSM Function
FFI.windowAddEventListener MisoString
eventName ((JSVal -> JSM ()) -> JSM Function)
-> (JSVal -> JSM ()) -> JSM Function
forall a b. (a -> b) -> a -> b
$ \JSVal
e -> do
          decodeAtVal <- DecodeTarget -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal DecodeTarget
decodeAt
          v <- fromJSValUnchecked =<< FFI.eventJSON decodeAtVal e
          case parseEither decoder v of
            Left String
s ->
              MisoString -> JSM ()
FFI.consoleError (MisoString
"windowSubWithOptions: Parse error on " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
eventName MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
": " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms String
s)              
            Right result
r -> do
              Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_stopPropagation (JSVal -> JSM ()
FFI.eventStopPropagation JSVal
e)
              Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_preventDefault (JSVal -> JSM ()
FFI.eventPreventDefault JSVal
e)
              Sink action
sink (result -> action
toAction result
r)
-----------------------------------------------------------------------------
-- | @window.addEventListener ("pointermove", (event) => handle(event))@
-- A 'Sub' to handle @PointerEvent@s on window
windowPointerMoveSub :: (PointerEvent -> action) -> Sub action
windowPointerMoveSub :: forall action. (PointerEvent -> action) -> Sub action
windowPointerMoveSub = MisoString
-> Decoder PointerEvent -> (PointerEvent -> action) -> Sub action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Sub action
windowSub MisoString
"pointermove" Decoder PointerEvent
pointerDecoder
-----------------------------------------------------------------------------