-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Lynx.Element.View.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
----------------------------------------------------------------------------
module Miso.Lynx.Element.View.Event
  ( -- *** Events
    onTouchStart
  , onTouchMove
  , onTouchEnd
  , onTouchCancel
  , onTap
  , onLongPress
  , onLayoutChange
  , onAppear
  , onDisappear
  , onAnimationStart
  , onAnimationEnd
  , onAnimationCancel
  , onAnimationIteration
  , onTransitionStart
  , onTransitionEnd
  , onTransitionCancel
    -- *** Types
  , TouchEvent (..)
  , AnimationEvent (..)
  , LayoutChangeDetailEvent (..)
  , UIAppearanceDetailEvent (..)
    -- *** Decoders
  , touchDecoder
  , animationDecoder
  , layoutChangeDetailDecoder
  , uiAppearanceDetailDecoder
    -- *** Event Map
  , viewEvents
  ) where
----------------------------------------------------------------------------
import           Data.Aeson (FromJSON (..), (.:), withObject, withText)
import           Data.Aeson.Types (typeMismatch, Value(String), Object)
import qualified Data.Map.Strict as M
-----------------------------------------------------------------------------
import           Miso.Types (Attribute)
import           Miso.String (MisoString)
import           Miso.Event (on, Decoder(..), DecodeTarget(..), Events, emptyDecoder)
----------------------------------------------------------------------------
viewEvents :: Events
viewEvents :: Events
viewEvents
  = [(MisoString, Capture)] -> Events
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (MisoString
"touchstart", Capture
False)
  , (MisoString
"touchmove", Capture
False)
  , (MisoString
"touchend", Capture
False)
  , (MisoString
"touchcancel", Capture
False)
  , (MisoString
"tap", Capture
False)
  , (MisoString
"longpress", Capture
False)
  , (MisoString
"layoutchange", Capture
False)
  , (MisoString
"uiappear", Capture
False)
  , (MisoString
"uidisappear", Capture
False)
  , (MisoString
"animationstart", Capture
False)
  , (MisoString
"animationend", Capture
False)
  , (MisoString
"animationcancel", Capture
False)
  , (MisoString
"animationiteration", Capture
False)
  , (MisoString
"transitionstart", Capture
False)
  , (MisoString
"transitionend", Capture
False)
  , (MisoString
"transitioncancel", Capture
False)
  ]
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/lynx-api/event/touch-event.html
data TouchEvent
  = TouchEvent
  { TouchEvent -> Double
identifier :: Double
    -- ^ Unique identifier of the touch point, which remains
    -- unchanged during the same touch process
  , TouchEvent -> (Double, Double)
xy :: (Double, Double)
    -- ^ The horizontal / vertical position of the touch point in the
    -- coordinate system of the element actually touched
  , TouchEvent -> (Double, Double)
page :: (Double, Double)
    -- ^ The horizontal / vertical position of the touch point in the
    -- current LynxView coordinate system
  , TouchEvent -> (Double, Double)
client :: (Double, Double)
    -- ^ The horizontal / vertical position of the touch point in the
    -- current window coordinate system
  } deriving (Int -> TouchEvent -> ShowS
[TouchEvent] -> ShowS
TouchEvent -> String
(Int -> TouchEvent -> ShowS)
-> (TouchEvent -> String)
-> ([TouchEvent] -> ShowS)
-> Show TouchEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TouchEvent -> ShowS
showsPrec :: Int -> TouchEvent -> ShowS
$cshow :: TouchEvent -> String
show :: TouchEvent -> String
$cshowList :: [TouchEvent] -> ShowS
showList :: [TouchEvent] -> ShowS
Show, TouchEvent -> TouchEvent -> Capture
(TouchEvent -> TouchEvent -> Capture)
-> (TouchEvent -> TouchEvent -> Capture) -> Eq TouchEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: TouchEvent -> TouchEvent -> Capture
== :: TouchEvent -> TouchEvent -> Capture
$c/= :: TouchEvent -> TouchEvent -> Capture
/= :: TouchEvent -> TouchEvent -> Capture
Eq)
----------------------------------------------------------------------------
-- | Touch decoder for use with events like 'onTap'
touchDecoder :: Decoder TouchEvent
touchDecoder :: Decoder TouchEvent
touchDecoder = Decoder {DecodeTarget
Value -> Parser TouchEvent
decodeAt :: DecodeTarget
decoder :: Value -> Parser TouchEvent
decodeAt :: DecodeTarget
decoder :: Value -> Parser TouchEvent
..}
  where
    pair :: Object -> Key -> Key -> Parser (a, b)
pair Object
o Key
x Key
y = (a -> b -> (a, b)) -> Parser a -> Parser b -> Parser (a, b)
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
x) (Object
o Object -> Key -> Parser b
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
y)
    decodeAt :: DecodeTarget
decodeAt = [MisoString] -> DecodeTarget
DecodeTarget [MisoString]
forall a. Monoid a => a
mempty
    decoder :: Value -> Parser TouchEvent
decoder = String
-> (Object -> Parser TouchEvent) -> Value -> Parser TouchEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"touchDecoder" ((Object -> Parser TouchEvent) -> Value -> Parser TouchEvent)
-> (Object -> Parser TouchEvent) -> Value -> Parser TouchEvent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
       Double
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> TouchEvent
TouchEvent
        (Double
 -> (Double, Double)
 -> (Double, Double)
 -> (Double, Double)
 -> TouchEvent)
-> Parser Double
-> Parser
     ((Double, Double)
      -> (Double, Double) -> (Double, Double) -> TouchEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifier"
        Parser
  ((Double, Double)
   -> (Double, Double) -> (Double, Double) -> TouchEvent)
-> Parser (Double, Double)
-> Parser ((Double, Double) -> (Double, Double) -> TouchEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Key -> Parser (Double, Double)
forall {a} {b}.
(FromJSON a, FromJSON b) =>
Object -> Key -> Key -> Parser (a, b)
pair Object
o Key
"x" Key
"y"
        Parser ((Double, Double) -> (Double, Double) -> TouchEvent)
-> Parser (Double, Double)
-> Parser ((Double, Double) -> TouchEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Key -> Parser (Double, Double)
forall {a} {b}.
(FromJSON a, FromJSON b) =>
Object -> Key -> Key -> Parser (a, b)
pair Object
o Key
"pageX" Key
"pageY"
        Parser ((Double, Double) -> TouchEvent)
-> Parser (Double, Double) -> Parser TouchEvent
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Key -> Parser (Double, Double)
forall {a} {b}.
(FromJSON a, FromJSON b) =>
Object -> Key -> Key -> Parser (a, b)
pair Object
o Key
"clientX" Key
"clientY"
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/lynx-api/event/animation-event.html
data AnimationEvent
  = AnimationEvent
  { AnimationEvent -> AnimationType
animationType :: AnimationType
    -- ^ The type of the animation. If it is a keyframe animation,
    -- this value is `keyframe-animation`; if it is a transition animation,
    -- this value is `transition-animation`.
  , AnimationEvent -> MisoString
animationName :: MisoString
    -- ^ The name of the animation. If it is a keyframe animation, it
    -- is the name of `@keyframes` in CSS; if it is a transition animation,
    -- it is the name of `transition-property` in CSS.
  , AnimationEvent -> Capture
newAnimator :: Bool
    -- ^ Default value 'True'
  } deriving (Int -> AnimationEvent -> ShowS
[AnimationEvent] -> ShowS
AnimationEvent -> String
(Int -> AnimationEvent -> ShowS)
-> (AnimationEvent -> String)
-> ([AnimationEvent] -> ShowS)
-> Show AnimationEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnimationEvent -> ShowS
showsPrec :: Int -> AnimationEvent -> ShowS
$cshow :: AnimationEvent -> String
show :: AnimationEvent -> String
$cshowList :: [AnimationEvent] -> ShowS
showList :: [AnimationEvent] -> ShowS
Show, AnimationEvent -> AnimationEvent -> Capture
(AnimationEvent -> AnimationEvent -> Capture)
-> (AnimationEvent -> AnimationEvent -> Capture)
-> Eq AnimationEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: AnimationEvent -> AnimationEvent -> Capture
== :: AnimationEvent -> AnimationEvent -> Capture
$c/= :: AnimationEvent -> AnimationEvent -> Capture
/= :: AnimationEvent -> AnimationEvent -> Capture
Eq)
----------------------------------------------------------------------------
data AnimationType
  = KeyFrameAnimation
  | TransitionAnimation
  deriving (Int -> AnimationType -> ShowS
[AnimationType] -> ShowS
AnimationType -> String
(Int -> AnimationType -> ShowS)
-> (AnimationType -> String)
-> ([AnimationType] -> ShowS)
-> Show AnimationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnimationType -> ShowS
showsPrec :: Int -> AnimationType -> ShowS
$cshow :: AnimationType -> String
show :: AnimationType -> String
$cshowList :: [AnimationType] -> ShowS
showList :: [AnimationType] -> ShowS
Show, AnimationType -> AnimationType -> Capture
(AnimationType -> AnimationType -> Capture)
-> (AnimationType -> AnimationType -> Capture) -> Eq AnimationType
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: AnimationType -> AnimationType -> Capture
== :: AnimationType -> AnimationType -> Capture
$c/= :: AnimationType -> AnimationType -> Capture
/= :: AnimationType -> AnimationType -> Capture
Eq)
----------------------------------------------------------------------------
instance FromJSON AnimationType where
  parseJSON :: Value -> Parser AnimationType
parseJSON = String
-> (Text -> Parser AnimationType) -> Value -> Parser AnimationType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"animation-type" ((Text -> Parser AnimationType) -> Value -> Parser AnimationType)
-> (Text -> Parser AnimationType) -> Value -> Parser AnimationType
forall a b. (a -> b) -> a -> b
$ \case
    Text
"keyframe-animation" -> AnimationType -> Parser AnimationType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnimationType
KeyFrameAnimation
    Text
"transition-animation" -> AnimationType -> Parser AnimationType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnimationType
TransitionAnimation
    Text
x -> String -> Value -> Parser AnimationType
forall a. String -> Value -> Parser a
typeMismatch String
"animation-type" (Text -> Value
String Text
x)
----------------------------------------------------------------------------
-- | Animation decoder for use with events like 'onAnimationStart'
animationDecoder :: Decoder AnimationEvent
animationDecoder :: Decoder AnimationEvent
animationDecoder = Decoder {DecodeTarget
Value -> Parser AnimationEvent
decodeAt :: DecodeTarget
decoder :: Value -> Parser AnimationEvent
decodeAt :: DecodeTarget
decoder :: Value -> Parser AnimationEvent
..}
  where
    decodeAt :: DecodeTarget
decodeAt = [MisoString] -> DecodeTarget
DecodeTarget [MisoString]
forall a. Monoid a => a
mempty
    decoder :: Value -> Parser AnimationEvent
decoder = String
-> (Object -> Parser AnimationEvent)
-> Value
-> Parser AnimationEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"animationDecoder" ((Object -> Parser AnimationEvent)
 -> Value -> Parser AnimationEvent)
-> (Object -> Parser AnimationEvent)
-> Value
-> Parser AnimationEvent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      AnimationType -> MisoString -> Capture -> AnimationEvent
AnimationEvent
        (AnimationType -> MisoString -> Capture -> AnimationEvent)
-> Parser AnimationType
-> Parser (MisoString -> Capture -> AnimationEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser AnimationType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"animation_type"
        Parser (MisoString -> Capture -> AnimationEvent)
-> Parser MisoString -> Parser (Capture -> AnimationEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser MisoString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"animation_name"
        Parser (Capture -> AnimationEvent)
-> Parser Capture -> Parser AnimationEvent
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Capture
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"new_animator"
-----------------------------------------------------------------------------
data LayoutChangeDetailEvent
  = LayoutChangeDetailEvent
  { LayoutChangeDetailEvent -> MisoString
layoutChangeDetailEventId :: MisoString
    -- ^ The id selector of the target.
  , LayoutChangeDetailEvent -> Double
layoutChangeDetailEventWidth :: Double
    -- ^ The width of the target.
  , LayoutChangeDetailEvent -> Double
layoutChangeDetailEventHeight :: Double
    -- ^ The height of the target.
  , LayoutChangeDetailEvent -> Double
layoutChangeDetailEventTop :: Double
    -- ^ The top of the target.
  , LayoutChangeDetailEvent -> Double
layoutChangeDetailEventRight :: Double
    -- ^ The right of the target.
  , LayoutChangeDetailEvent -> Double
layoutChangeDetailEventBottom :: Double
    -- ^ The bottom of the target.
  , LayoutChangeDetailEvent -> Double
layoutChangeDetailEventLeft :: Double
    -- ^ The left of the target.
  , LayoutChangeDetailEvent -> Object
layoutChangeDetailEventDataset :: Object
    -- ^ The dataset of the target.
  } deriving (Int -> LayoutChangeDetailEvent -> ShowS
[LayoutChangeDetailEvent] -> ShowS
LayoutChangeDetailEvent -> String
(Int -> LayoutChangeDetailEvent -> ShowS)
-> (LayoutChangeDetailEvent -> String)
-> ([LayoutChangeDetailEvent] -> ShowS)
-> Show LayoutChangeDetailEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayoutChangeDetailEvent -> ShowS
showsPrec :: Int -> LayoutChangeDetailEvent -> ShowS
$cshow :: LayoutChangeDetailEvent -> String
show :: LayoutChangeDetailEvent -> String
$cshowList :: [LayoutChangeDetailEvent] -> ShowS
showList :: [LayoutChangeDetailEvent] -> ShowS
Show, LayoutChangeDetailEvent -> LayoutChangeDetailEvent -> Capture
(LayoutChangeDetailEvent -> LayoutChangeDetailEvent -> Capture)
-> (LayoutChangeDetailEvent -> LayoutChangeDetailEvent -> Capture)
-> Eq LayoutChangeDetailEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: LayoutChangeDetailEvent -> LayoutChangeDetailEvent -> Capture
== :: LayoutChangeDetailEvent -> LayoutChangeDetailEvent -> Capture
$c/= :: LayoutChangeDetailEvent -> LayoutChangeDetailEvent -> Capture
/= :: LayoutChangeDetailEvent -> LayoutChangeDetailEvent -> Capture
Eq)
-----------------------------------------------------------------------------
layoutChangeDetailDecoder :: Decoder LayoutChangeDetailEvent
layoutChangeDetailDecoder :: Decoder LayoutChangeDetailEvent
layoutChangeDetailDecoder = Decoder {DecodeTarget
Value -> Parser LayoutChangeDetailEvent
decodeAt :: DecodeTarget
decoder :: Value -> Parser LayoutChangeDetailEvent
decodeAt :: DecodeTarget
decoder :: Value -> Parser LayoutChangeDetailEvent
..}
  where
    decodeAt :: DecodeTarget
decodeAt = [MisoString] -> DecodeTarget
DecodeTarget [MisoString]
forall a. Monoid a => a
mempty
    decoder :: Value -> Parser LayoutChangeDetailEvent
decoder = String
-> (Object -> Parser LayoutChangeDetailEvent)
-> Value
-> Parser LayoutChangeDetailEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LayoutChangeDetailEvent" ((Object -> Parser LayoutChangeDetailEvent)
 -> Value -> Parser LayoutChangeDetailEvent)
-> (Object -> Parser LayoutChangeDetailEvent)
-> Value
-> Parser LayoutChangeDetailEvent
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      d <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"detail"
      LayoutChangeDetailEvent
        <$> d .: "id"
        <*> d .: "width"
        <*> d .: "height"
        <*> d .: "top"
        <*> d .: "right"
        <*> d .: "bottom"
        <*> d .: "left"
        <*> d .: "dataset"
-----------------------------------------------------------------------------
data UIAppearanceDetailEventType
  = UIAppear
  | UIDisappear
  deriving (Int -> UIAppearanceDetailEventType -> ShowS
[UIAppearanceDetailEventType] -> ShowS
UIAppearanceDetailEventType -> String
(Int -> UIAppearanceDetailEventType -> ShowS)
-> (UIAppearanceDetailEventType -> String)
-> ([UIAppearanceDetailEventType] -> ShowS)
-> Show UIAppearanceDetailEventType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UIAppearanceDetailEventType -> ShowS
showsPrec :: Int -> UIAppearanceDetailEventType -> ShowS
$cshow :: UIAppearanceDetailEventType -> String
show :: UIAppearanceDetailEventType -> String
$cshowList :: [UIAppearanceDetailEventType] -> ShowS
showList :: [UIAppearanceDetailEventType] -> ShowS
Show, UIAppearanceDetailEventType
-> UIAppearanceDetailEventType -> Capture
(UIAppearanceDetailEventType
 -> UIAppearanceDetailEventType -> Capture)
-> (UIAppearanceDetailEventType
    -> UIAppearanceDetailEventType -> Capture)
-> Eq UIAppearanceDetailEventType
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: UIAppearanceDetailEventType
-> UIAppearanceDetailEventType -> Capture
== :: UIAppearanceDetailEventType
-> UIAppearanceDetailEventType -> Capture
$c/= :: UIAppearanceDetailEventType
-> UIAppearanceDetailEventType -> Capture
/= :: UIAppearanceDetailEventType
-> UIAppearanceDetailEventType -> Capture
Eq)
----------------------------------------------------------------------------
instance FromJSON UIAppearanceDetailEventType where
  parseJSON :: Value -> Parser UIAppearanceDetailEventType
parseJSON = String
-> (Text -> Parser UIAppearanceDetailEventType)
-> Value
-> Parser UIAppearanceDetailEventType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"UIAppearanceDetailEventType" ((Text -> Parser UIAppearanceDetailEventType)
 -> Value -> Parser UIAppearanceDetailEventType)
-> (Text -> Parser UIAppearanceDetailEventType)
-> Value
-> Parser UIAppearanceDetailEventType
forall a b. (a -> b) -> a -> b
$ \case
    Text
"uiappear" -> UIAppearanceDetailEventType -> Parser UIAppearanceDetailEventType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UIAppearanceDetailEventType
UIAppear
    Text
"uidisppear" -> UIAppearanceDetailEventType -> Parser UIAppearanceDetailEventType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UIAppearanceDetailEventType
UIDisappear
    Text
x -> String -> Value -> Parser UIAppearanceDetailEventType
forall a. String -> Value -> Parser a
typeMismatch String
"UIAppearanceDetailEventType" (Text -> Value
String Text
x)
-----------------------------------------------------------------------------
data UIAppearanceDetailEvent
  = UIAppearanceDetailEvent
  { UIAppearanceDetailEvent -> UIAppearanceDetailEventType
uiAppearanceDetailEventType :: UIAppearanceDetailEventType
  , UIAppearanceDetailEvent -> MisoString
uiAppearanceDetailEventExposureId :: MisoString
  , UIAppearanceDetailEvent -> MisoString
uiAppearanceDetailEventExposureScene :: MisoString
  , UIAppearanceDetailEvent -> MisoString
uiAppearanceDetailEventUniqueId :: MisoString
  , UIAppearanceDetailEvent -> Object
uiAppearanceDetailEventDataset :: Object
  } deriving (Int -> UIAppearanceDetailEvent -> ShowS
[UIAppearanceDetailEvent] -> ShowS
UIAppearanceDetailEvent -> String
(Int -> UIAppearanceDetailEvent -> ShowS)
-> (UIAppearanceDetailEvent -> String)
-> ([UIAppearanceDetailEvent] -> ShowS)
-> Show UIAppearanceDetailEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UIAppearanceDetailEvent -> ShowS
showsPrec :: Int -> UIAppearanceDetailEvent -> ShowS
$cshow :: UIAppearanceDetailEvent -> String
show :: UIAppearanceDetailEvent -> String
$cshowList :: [UIAppearanceDetailEvent] -> ShowS
showList :: [UIAppearanceDetailEvent] -> ShowS
Show, UIAppearanceDetailEvent -> UIAppearanceDetailEvent -> Capture
(UIAppearanceDetailEvent -> UIAppearanceDetailEvent -> Capture)
-> (UIAppearanceDetailEvent -> UIAppearanceDetailEvent -> Capture)
-> Eq UIAppearanceDetailEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: UIAppearanceDetailEvent -> UIAppearanceDetailEvent -> Capture
== :: UIAppearanceDetailEvent -> UIAppearanceDetailEvent -> Capture
$c/= :: UIAppearanceDetailEvent -> UIAppearanceDetailEvent -> Capture
/= :: UIAppearanceDetailEvent -> UIAppearanceDetailEvent -> Capture
Eq)
-----------------------------------------------------------------------------
uiAppearanceDetailDecoder :: Decoder UIAppearanceDetailEvent
uiAppearanceDetailDecoder :: Decoder UIAppearanceDetailEvent
uiAppearanceDetailDecoder = Decoder {DecodeTarget
Value -> Parser UIAppearanceDetailEvent
decodeAt :: DecodeTarget
decoder :: Value -> Parser UIAppearanceDetailEvent
decodeAt :: DecodeTarget
decoder :: Value -> Parser UIAppearanceDetailEvent
..}
  where
    decodeAt :: DecodeTarget
decodeAt = [MisoString] -> DecodeTarget
DecodeTarget [MisoString]
forall a. Monoid a => a
mempty
    decoder :: Value -> Parser UIAppearanceDetailEvent
decoder = String
-> (Object -> Parser UIAppearanceDetailEvent)
-> Value
-> Parser UIAppearanceDetailEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UIAppearanceDetailEvent" ((Object -> Parser UIAppearanceDetailEvent)
 -> Value -> Parser UIAppearanceDetailEvent)
-> (Object -> Parser UIAppearanceDetailEvent)
-> Value
-> Parser UIAppearanceDetailEvent
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      d <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"detail"
      UIAppearanceDetailEvent
        <$> o .: "type"
        <*> d .: "exposure-id"
        <*> d .: "exposure-scene"
        <*> d .: "unique-id"
        <*> d .: "dataset"
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#touchstart
--
-- It belongs to [touch event](https://lynxjs.org/api/lynx-api/event/touch-event.html),
-- which is triggered when the finger starts to touch the touch surface.
--
-- @
-- data Action = HandleTouch TouchEvent
--
-- view model = view_ [ onTouchStart HandleTouch ]
--
-- update :: Action -> Effect Model Action
-- update (HandleTouch TouchEvent {..}) = do
--   io_ (consoleLog "touch event received")
--
onTouchStart :: (TouchEvent -> action) -> Attribute action
onTouchStart :: forall action. (TouchEvent -> action) -> Attribute action
onTouchStart TouchEvent -> action
action = MisoString
-> Decoder TouchEvent
-> (TouchEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"touchstart" Decoder TouchEvent
touchDecoder (\TouchEvent
x DOMRef
_ -> TouchEvent -> action
action TouchEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#touchmove
--
-- It belongs to [touch event](https://lynxjs.org/api/lynx-api/event/touch-event.html),
-- which is triggered when the finger moves on the touch surface.
--
-- @
-- data Action = HandleTouch TouchEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onTouchMove HandleTouch ]
--
-- update :: Action -> Effect Model Action
-- update (HandleTouch TouchEvent {..}) = do
--   io_ (consoleLog "touch event received")
--
-- @
--
onTouchMove :: (TouchEvent -> action) -> Attribute action
onTouchMove :: forall action. (TouchEvent -> action) -> Attribute action
onTouchMove TouchEvent -> action
action = MisoString
-> Decoder TouchEvent
-> (TouchEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"touchmove" Decoder TouchEvent
touchDecoder (\TouchEvent
x DOMRef
_ -> TouchEvent -> action
action TouchEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#touchend
--
-- It belongs to [touch event](https://lynxjs.org/api/lynx-api/event/touch-event.html),
-- which is triggered when the finger leaves the touch surface.
--
-- @
-- data Action = HandleTouch TouchEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onTouchEnd HandleTouch ]
--
-- update :: Action -> Effect Model Action
-- update (HandleTouch TouchEvent {..}) = do
--   io_ (consoleLog "touch event received")
--
-- @
--
onTouchEnd :: (TouchEvent -> action) -> Attribute action
onTouchEnd :: forall action. (TouchEvent -> action) -> Attribute action
onTouchEnd TouchEvent -> action
action = MisoString
-> Decoder TouchEvent
-> (TouchEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"touchend" Decoder TouchEvent
touchDecoder (\TouchEvent
x DOMRef
_ -> TouchEvent -> action
action TouchEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#touchcancel
--
-- It belongs to [touch event](https://lynxjs.org/api/lynx-api/event/touch-event.html),
-- which is triggered when the [touch event](https://lynxjs.org/api/lynx-api/event/touch-event.html),
-- is interrupted by the system or Lynx external gesture.
--
-- @
-- data Action = HandleTouch TouchEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onTouchCancel HandleTouch ]
--
-- update :: Action -> Effect Model Action
-- update (HandleTouch TouchEvent {..}) = do
--   io_ (consoleLog "touch event received")
--
-- @
--
onTouchCancel :: (TouchEvent -> action) -> Attribute action
onTouchCancel :: forall action. (TouchEvent -> action) -> Attribute action
onTouchCancel TouchEvent -> action
action = MisoString
-> Decoder TouchEvent
-> (TouchEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"touchcancel" Decoder TouchEvent
touchDecoder (\TouchEvent
x DOMRef
_ -> TouchEvent -> action
action TouchEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#tap
--
-- It belongs to [touch event](https://lynxjs.org/api/lynx-api/event/touch-event.html),
-- which is triggered when the finger clicks on the touch surface.
--
-- @
-- data Action = HandleTap
--
-- view :: Model -> View Action
-- view model = view_ [ onTap HandleTap ]
--
-- update :: Action -> Effect Model Action
-- update HandleTap = do
--   io_ (consoleLog "touch event received")
--
-- @
--
onTap :: action -> Attribute action
onTap :: forall action. action -> Attribute action
onTap action
action = MisoString
-> Decoder () -> (() -> DOMRef -> action) -> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"tap" Decoder ()
emptyDecoder (\() DOMRef
_ -> action
action)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#longpress
--
-- It belongs to the touch event, which is triggered when the finger is long
-- pressed on the touch surface, and the interval between long press triggers is `500 ms`.
--
-- @
-- data Action = HandleTouch TouchEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onLongPress HandleTouch ]
--
-- update :: Action -> Effect Model Action
-- update (HandleTouch TouchEvent {..}) = do
--   io_ (consoleLog "touch event received")
--
-- @
--
onLongPress :: (TouchEvent -> action) -> Attribute action
onLongPress :: forall action. (TouchEvent -> action) -> Attribute action
onLongPress TouchEvent -> action
action = MisoString
-> Decoder TouchEvent
-> (TouchEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"longpress" Decoder TouchEvent
touchDecoder (\TouchEvent
x DOMRef
_ -> TouchEvent -> action
action TouchEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#layoutchange
--
-- It belongs to a [custom event](https://lynxjs.org/api/lynx-api/event/custom-event.html), which is triggered when the target node layout
-- is completed, and returns the position information of the target node relative
-- to the LynxView viewport coordinate system.
--
-- @
-- data Action = HandleLayout LayoutChangeDetailEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onLayoutChange HandleLayout ]
--
-- update :: Action -> Effect Model Action
-- update (HandleLayout LayoutChangeDetailEvent {..}) = do
--   io_ (consoleLog "layout changed")
-- @
--
onLayoutChange :: (LayoutChangeDetailEvent -> action) -> Attribute action
onLayoutChange :: forall action.
(LayoutChangeDetailEvent -> action) -> Attribute action
onLayoutChange LayoutChangeDetailEvent -> action
action = MisoString
-> Decoder LayoutChangeDetailEvent
-> (LayoutChangeDetailEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"layoutchange" Decoder LayoutChangeDetailEvent
layoutChangeDetailDecoder (\LayoutChangeDetailEvent
x DOMRef
_ -> LayoutChangeDetailEvent -> action
action LayoutChangeDetailEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#uiappear
--
-- It belongs to custom event, which is triggered when the target node appears on the screen.
--
-- @
-- data Action = HandleUI UIAppearanceDetailEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onAppear HandleUI ]
--
-- update :: Action -> Effect Model Action
-- update (HandleUI UIAppearanceDetailEvent {..}) = do
--   io_ (consoleLog "appearance detail event received")
-- @
--
onAppear :: (UIAppearanceDetailEvent -> action) -> Attribute action
onAppear :: forall action.
(UIAppearanceDetailEvent -> action) -> Attribute action
onAppear UIAppearanceDetailEvent -> action
action = MisoString
-> Decoder UIAppearanceDetailEvent
-> (UIAppearanceDetailEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"uiappear" Decoder UIAppearanceDetailEvent
uiAppearanceDetailDecoder (\UIAppearanceDetailEvent
x DOMRef
_ -> UIAppearanceDetailEvent -> action
action UIAppearanceDetailEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#uidisappear
--
-- It belongs to custom event, which is triggered when the target node appears on the screen.
--
-- @
-- data Action = HandleUI UIAppearanceDetailEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onDisappear HandleUI ]
--
-- update :: Action -> Effect Model Action
-- update (HandleUI UIAppearanceDetailEvent {..}) = do
--   io_ (consoleLog "appearance detail event received")
-- @
--
onDisappear :: (UIAppearanceDetailEvent -> action) -> Attribute action
onDisappear :: forall action.
(UIAppearanceDetailEvent -> action) -> Attribute action
onDisappear UIAppearanceDetailEvent -> action
action = MisoString
-> Decoder UIAppearanceDetailEvent
-> (UIAppearanceDetailEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"uidisappear" Decoder UIAppearanceDetailEvent
uiAppearanceDetailDecoder (\UIAppearanceDetailEvent
x DOMRef
_ -> UIAppearanceDetailEvent -> action
action UIAppearanceDetailEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#animationstart
--
-- It belongs to [animation event](https://lynxjs.org/api/lynx-api/event/animation-event.html), which is triggered when the Animation animation starts.
--
-- @
-- data Action = HandleAnimation AnimationEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onAnimationStart HandleAnimation ]
--
-- update :: Action -> Effect Model Action
-- update (HandleAnimation AnimationEvent {..}) = do
--   io_ (consoleLog "animation event received")
-- @
--
onAnimationStart :: (AnimationEvent -> action) -> Attribute action
onAnimationStart :: forall action. (AnimationEvent -> action) -> Attribute action
onAnimationStart AnimationEvent -> action
action = MisoString
-> Decoder AnimationEvent
-> (AnimationEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"animationstart" Decoder AnimationEvent
animationDecoder ((AnimationEvent -> DOMRef -> action) -> Attribute action)
-> (AnimationEvent -> DOMRef -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ (\AnimationEvent
x DOMRef
_ -> AnimationEvent -> action
action AnimationEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#animationend
--
-- It belongs to [animation event](https://lynxjs.org/api/lynx-api/event/animation-event.html), which is triggered when the Animation animation ends.
--
-- @
-- data Action = HandleAnimation AnimationEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onAnimationEnd HandleAnimation ]
--
-- update :: Action -> Effect Model Action
-- update (HandleAnimation AnimationEvent {..}) = do
--   io_ (consoleLog "animation event received")
-- @
--
onAnimationEnd :: (AnimationEvent -> action) -> Attribute action
onAnimationEnd :: forall action. (AnimationEvent -> action) -> Attribute action
onAnimationEnd AnimationEvent -> action
action = MisoString
-> Decoder AnimationEvent
-> (AnimationEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"animationend" Decoder AnimationEvent
animationDecoder (\AnimationEvent
x DOMRef
_ -> AnimationEvent -> action
action AnimationEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#animationcancel
--
-- It belongs to [animation event](https://lynxjs.org/api/lynx-api/event/animation-event.html), which is triggered when the Animation animation cancels.
--
-- @
-- data Action = HandleAnimation AnimationEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onAnimationCancel HandleAnimation ]
--
-- update :: Action -> Effect Model Action
-- update (HandleAnimation AnimationEvent {..}) = do
--   io_ (consoleLog "animation event received")
-- @
--
onAnimationCancel :: (AnimationEvent -> action) -> Attribute action
onAnimationCancel :: forall action. (AnimationEvent -> action) -> Attribute action
onAnimationCancel AnimationEvent -> action
action = MisoString
-> Decoder AnimationEvent
-> (AnimationEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"animationcancel" Decoder AnimationEvent
animationDecoder (\AnimationEvent
x DOMRef
_ -> AnimationEvent -> action
action AnimationEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#animationiteration
--
-- It belongs to [animation event](https://lynxjs.org/api/lynx-api/event/animation-event.html), which is triggered when the Animation animation iterates.
--
-- @
-- data Action = HandleAnimation AnimationEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onAnimationIteration HandleAnimation ]
--
-- update :: Action -> Effect Model Action
-- update (HandleAnimation AnimationEvent {..}) = do
--   io_ (consoleLog "animation event received")
-- @
--
onAnimationIteration :: (AnimationEvent -> action) -> Attribute action
onAnimationIteration :: forall action. (AnimationEvent -> action) -> Attribute action
onAnimationIteration AnimationEvent -> action
action = MisoString
-> Decoder AnimationEvent
-> (AnimationEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"animationiteration" Decoder AnimationEvent
animationDecoder (\AnimationEvent
x DOMRef
_ -> AnimationEvent -> action
action AnimationEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#transitionstart
--
-- It belongs to [animation event](https://lynxjs.org/api/lynx-api/event/animation-event.html), which is triggered when the Transition animation starts.
--
-- @
-- data Action = HandleTransition AnimationEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onTransitionStart HandleTransition ]
--
-- update :: Action -> Effect Model Action
-- update (HandleTransition TransitionEvent {..}) = do
--   io_ (consoleLog "transition event received")
-- @
--
onTransitionStart :: (AnimationEvent -> action) -> Attribute action
onTransitionStart :: forall action. (AnimationEvent -> action) -> Attribute action
onTransitionStart AnimationEvent -> action
action = MisoString
-> Decoder AnimationEvent
-> (AnimationEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"transitionstart" Decoder AnimationEvent
animationDecoder (\AnimationEvent
x DOMRef
_ -> AnimationEvent -> action
action AnimationEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#transitionend
--
-- It belongs to [animation event](https://lynxjs.org/api/lynx-api/event/animation-event.html), which is triggered when the Transition animation ends.
--
-- @
-- data Action = HandleTransition AnimationEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onTransitionEnd HandleTransition ]
--
-- update :: Action -> Effect Model Action
-- update (HandleTransition TransitionEvent {..}) = do
--   io_ (consoleLog "transition event received")
-- @
--
onTransitionEnd :: (AnimationEvent -> action) -> Attribute action
onTransitionEnd :: forall action. (AnimationEvent -> action) -> Attribute action
onTransitionEnd AnimationEvent -> action
action = MisoString
-> Decoder AnimationEvent
-> (AnimationEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"transitionend" Decoder AnimationEvent
animationDecoder (\AnimationEvent
x DOMRef
_ -> AnimationEvent -> action
action AnimationEvent
x)
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#transitioncancel
--
-- It belongs to [animation event](https://lynxjs.org/api/lynx-api/event/animation-event.html), which is triggered when the Transition animation cancels.
--
-- @
-- data Action = HandleTransition AnimationEvent
--
-- view :: Model -> View Action
-- view model = view_ [ onTransitionCancel HandleTransition ]
--
-- update :: Action -> Effect Model Action
-- update (HandleTransition TransitionEvent {..}) = do
--   io_ (consoleLog "transition event received")
-- @
--
onTransitionCancel :: (AnimationEvent -> action) -> Attribute action
onTransitionCancel :: forall action. (AnimationEvent -> action) -> Attribute action
onTransitionCancel AnimationEvent -> action
action = MisoString
-> Decoder AnimationEvent
-> (AnimationEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"transitioncancel" Decoder AnimationEvent
animationDecoder (\AnimationEvent
x DOMRef
_ -> AnimationEvent -> action
action AnimationEvent
x)
----------------------------------------------------------------------------