{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Miso.Subscription.Window
(
windowSub
, windowCoordsSub
, windowPointerMoveSub
, windowSubWithOptions
) where
import Control.Monad
import Language.Javascript.JSaddle
import Data.Aeson.Types (parseEither)
import Miso.Event
import Miso.Effect
import Miso.FFI
import Miso.String
windowCoordsSub :: ((Int, Int) -> action) -> Sub action
windowCoordsSub f = \sink -> do
sink . f =<< (,) <$> windowInnerHeight <*> windowInnerWidth
windowAddEventListener "resize" $
\windowEvent -> do
target <- getProp "target" (Object windowEvent)
Just w <- fromJSVal =<< getProp "innerWidth" (Object target)
Just h <- fromJSVal =<< getProp "innerHeight" (Object target)
sink $ f (h, w)
windowSub :: MisoString -> Decoder r -> (r -> action) -> Sub action
windowSub = windowSubWithOptions defaultOptions
windowSubWithOptions :: Options -> MisoString -> Decoder r -> (r -> action) -> Sub action
windowSubWithOptions Options{..} eventName Decoder{..} toAction = \sink ->
windowAddEventListener eventName $ \e -> do
decodeAtVal <- toJSVal decodeAt
Just v <- fromJSVal =<< eventJSON decodeAtVal e
case parseEither decoder v of
Left s -> error $ "Parse error on " <> unpack eventName <> ": " <> s
Right r -> do
when stopPropagation (eventStopPropagation e)
when preventDefault (eventPreventDefault e)
sink (toAction r)
windowPointerMoveSub :: (PointerEvent -> action) -> Sub action
windowPointerMoveSub = windowSub "pointermove" pointerDecoder