{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Miso.Subscription.Window
(
windowSub
, windowCoordsSub
, windowPointerMoveSub
, windowSubWithOptions
, 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)
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 :: 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
-> 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)
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