-----------------------------------------------------------------------------
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Lynx.Element.List.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.List.Event
  ( -- *** Event
    onScroll
  , onScrollToUpper
  , onScrollToLower
  , onScrollStateChange
  , onLayoutComplete
  , onSnap
  -- *** Types
  , ScrollEvent (..)
  , SnapEvent (..)
  , LayoutCompleteEvent (..)
  , DiffResult (..)
  , ListEventSource (..)
  , Cell (..)
  , ScrollStateChange (..)
  -- *** Decoder
  , scrollDecoder
  , snapDecoder
  , layoutCompleteDecoder
  -- *** Event Map
  , listEvents
  ) where
-----------------------------------------------------------------------------
import qualified Data.Map as M
import           Data.Aeson
import           Data.Aeson.Types
-----------------------------------------------------------------------------
import           Miso.Types (Attribute)
import           Miso.Event
import           Miso.String (MisoString)
-----------------------------------------------------------------------------
listEvents :: Events
listEvents :: Events
listEvents
  = [(MisoString, Capture)] -> Events
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (MisoString
"scroll", Capture
False)
  , (MisoString
"scrolltoupper", Capture
False)
  , (MisoString
"scrolltolower", Capture
False)
  , (MisoString
"scrollend", Capture
False)
  , (MisoString
"contentsizechanged", Capture
False)
  ]
-----------------------------------------------------------------------------
scrollDecoder :: Decoder ScrollEvent
scrollDecoder :: Decoder ScrollEvent
scrollDecoder = [MisoString
"detail"] [MisoString]
-> (Value -> Parser ScrollEvent) -> Decoder ScrollEvent
forall a. [MisoString] -> (Value -> Parser a) -> Decoder a
`at` Value -> Parser ScrollEvent
forall a. FromJSON a => Value -> Parser a
parseJSON
-----------------------------------------------------------------------------
instance FromJSON ScrollEvent where
  parseJSON :: Value -> Parser ScrollEvent
parseJSON = String
-> (Object -> Parser ScrollEvent) -> Value -> Parser ScrollEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ScrollEvent" ((Object -> Parser ScrollEvent) -> Value -> Parser ScrollEvent)
-> (Object -> Parser ScrollEvent) -> Value -> Parser ScrollEvent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> ListEventSource
-> [Cell]
-> ScrollEvent
ScrollEvent
      (Double
 -> Double
 -> Double
 -> Double
 -> Double
 -> Double
 -> Double
 -> Double
 -> ListEventSource
 -> [Cell]
 -> ScrollEvent)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> ListEventSource
      -> [Cell]
      -> ScrollEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deltaX" Parser (Maybe Double) -> Double -> Parser Double
forall a. Parser (Maybe a) -> a -> Parser a
.!= Double
0
      Parser
  (Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> ListEventSource
   -> [Cell]
   -> ScrollEvent)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> ListEventSource
      -> [Cell]
      -> ScrollEvent)
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 (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deltaY" Parser (Maybe Double) -> Double -> Parser Double
forall a. Parser (Maybe a) -> a -> Parser a
.!= Double
0
      Parser
  (Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> ListEventSource
   -> [Cell]
   -> ScrollEvent)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> ListEventSource
      -> [Cell]
      -> ScrollEvent)
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 (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scrollLeft" Parser (Maybe Double) -> Double -> Parser Double
forall a. Parser (Maybe a) -> a -> Parser a
.!= Double
0
      Parser
  (Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> ListEventSource
   -> [Cell]
   -> ScrollEvent)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Double
      -> Double
      -> ListEventSource
      -> [Cell]
      -> ScrollEvent)
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 (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scrollTop" Parser (Maybe Double) -> Double -> Parser Double
forall a. Parser (Maybe a) -> a -> Parser a
.!= Double
0
      Parser
  (Double
   -> Double
   -> Double
   -> Double
   -> ListEventSource
   -> [Cell]
   -> ScrollEvent)
-> Parser Double
-> Parser
     (Double
      -> Double -> Double -> ListEventSource -> [Cell] -> ScrollEvent)
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 (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scrollWidth" Parser (Maybe Double) -> Double -> Parser Double
forall a. Parser (Maybe a) -> a -> Parser a
.!= Double
0
      Parser
  (Double
   -> Double -> Double -> ListEventSource -> [Cell] -> ScrollEvent)
-> Parser Double
-> Parser
     (Double -> Double -> ListEventSource -> [Cell] -> ScrollEvent)
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 (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scrollHeight" Parser (Maybe Double) -> Double -> Parser Double
forall a. Parser (Maybe a) -> a -> Parser a
.!= Double
0
      Parser
  (Double -> Double -> ListEventSource -> [Cell] -> ScrollEvent)
-> Parser Double
-> Parser (Double -> ListEventSource -> [Cell] -> ScrollEvent)
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 (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"listWidth" Parser (Maybe Double) -> Double -> Parser Double
forall a. Parser (Maybe a) -> a -> Parser a
.!= Double
0
      Parser (Double -> ListEventSource -> [Cell] -> ScrollEvent)
-> Parser Double
-> Parser (ListEventSource -> [Cell] -> ScrollEvent)
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 (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"listHeight" Parser (Maybe Double) -> Double -> Parser Double
forall a. Parser (Maybe a) -> a -> Parser a
.!= Double
0
      Parser (ListEventSource -> [Cell] -> ScrollEvent)
-> Parser ListEventSource -> Parser ([Cell] -> ScrollEvent)
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 ListEventSource
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"listEventSource"
      Parser ([Cell] -> ScrollEvent)
-> Parser [Cell] -> Parser ScrollEvent
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 [Cell]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"attachedCells"
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/list.html#scroll
data ScrollEvent
  = ScrollEvent
  { ScrollEvent -> Double
deltaX, ScrollEvent -> Double
deltaY :: Double
  -- ^ Horizontal / vertical scroll offset since the last scroll, in px
  , ScrollEvent -> Double
scrollLeft, ScrollEvent -> Double
scrollTop :: Double
  -- ^ Current horizontal / vertical scroll offset, in px
  , ScrollEvent -> Double
scrollWidth, ScrollEvent -> Double
scrollHeight :: Double
  -- ^ Current content area height / width, in px
  , ScrollEvent -> Double
listWidth, ScrollEvent -> Double
listHeight :: Double
  -- ^ List width / height in px
  , ScrollEvent -> ListEventSource
listEventSource :: ListEventSource
  -- ^ Scroll event source
  , ScrollEvent -> [Cell]
attachedCells :: [Cell]
  -- ^ Attached cells
  } deriving (Int -> ScrollEvent -> ShowS
[ScrollEvent] -> ShowS
ScrollEvent -> String
(Int -> ScrollEvent -> ShowS)
-> (ScrollEvent -> String)
-> ([ScrollEvent] -> ShowS)
-> Show ScrollEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScrollEvent -> ShowS
showsPrec :: Int -> ScrollEvent -> ShowS
$cshow :: ScrollEvent -> String
show :: ScrollEvent -> String
$cshowList :: [ScrollEvent] -> ShowS
showList :: [ScrollEvent] -> ShowS
Show, ScrollEvent -> ScrollEvent -> Capture
(ScrollEvent -> ScrollEvent -> Capture)
-> (ScrollEvent -> ScrollEvent -> Capture) -> Eq ScrollEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: ScrollEvent -> ScrollEvent -> Capture
== :: ScrollEvent -> ScrollEvent -> Capture
$c/= :: ScrollEvent -> ScrollEvent -> Capture
/= :: ScrollEvent -> ScrollEvent -> Capture
Eq)
-----------------------------------------------------------------------------
data Cell
  = Cell
  { Cell -> Double
cellId :: Double
  -- ^ Node id
  , Cell -> MisoString
cellItemKey :: MisoString
  -- ^ Node item-key
  , Cell -> Double
cellIndex, Cell -> Double
cellLeft, Cell -> Double
cellTop, Cell -> Double
cellRight, Cell -> Double
cellBottom :: Double
  -- ^ Node left/top/right/bottom boundary position relative to list, in px
  } deriving (Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Int -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cell -> ShowS
showsPrec :: Int -> Cell -> ShowS
$cshow :: Cell -> String
show :: Cell -> String
$cshowList :: [Cell] -> ShowS
showList :: [Cell] -> ShowS
Show, Cell -> Cell -> Capture
(Cell -> Cell -> Capture) -> (Cell -> Cell -> Capture) -> Eq Cell
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: Cell -> Cell -> Capture
== :: Cell -> Cell -> Capture
$c/= :: Cell -> Cell -> Capture
/= :: Cell -> Cell -> Capture
Eq)
-----------------------------------------------------------------------------
instance FromJSON Cell where
  parseJSON :: Value -> Parser Cell
parseJSON = String -> (Object -> Parser Cell) -> Value -> Parser Cell
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Cell" ((Object -> Parser Cell) -> Value -> Parser Cell)
-> (Object -> Parser Cell) -> Value -> Parser Cell
forall a b. (a -> b) -> a -> b
$ \Object
cell -> Double
-> MisoString
-> Double
-> Double
-> Double
-> Double
-> Double
-> Cell
Cell
    (Double
 -> MisoString
 -> Double
 -> Double
 -> Double
 -> Double
 -> Double
 -> Cell)
-> Parser Double
-> Parser
     (MisoString
      -> Double -> Double -> Double -> Double -> Double -> Cell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
cell Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser
  (MisoString
   -> Double -> Double -> Double -> Double -> Double -> Cell)
-> Parser MisoString
-> Parser (Double -> Double -> Double -> Double -> Double -> Cell)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
cell Object -> Key -> Parser MisoString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"itemKey"
    Parser (Double -> Double -> Double -> Double -> Double -> Cell)
-> Parser Double
-> Parser (Double -> Double -> Double -> Double -> Cell)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
cell Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
    Parser (Double -> Double -> Double -> Double -> Cell)
-> Parser Double -> Parser (Double -> Double -> Double -> Cell)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
cell Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"left"
    Parser (Double -> Double -> Double -> Cell)
-> Parser Double -> Parser (Double -> Double -> Cell)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
cell Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"top"
    Parser (Double -> Double -> Cell)
-> Parser Double -> Parser (Double -> Cell)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
cell Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"right"
    Parser (Double -> Cell) -> Parser Double -> Parser Cell
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
cell Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bottom"
-----------------------------------------------------------------------------
data ListEventSource
  = DIFF
  | LAYOUT
  | SCROLL
  deriving (Int -> ListEventSource -> ShowS
[ListEventSource] -> ShowS
ListEventSource -> String
(Int -> ListEventSource -> ShowS)
-> (ListEventSource -> String)
-> ([ListEventSource] -> ShowS)
-> Show ListEventSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListEventSource -> ShowS
showsPrec :: Int -> ListEventSource -> ShowS
$cshow :: ListEventSource -> String
show :: ListEventSource -> String
$cshowList :: [ListEventSource] -> ShowS
showList :: [ListEventSource] -> ShowS
Show, ListEventSource -> ListEventSource -> Capture
(ListEventSource -> ListEventSource -> Capture)
-> (ListEventSource -> ListEventSource -> Capture)
-> Eq ListEventSource
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: ListEventSource -> ListEventSource -> Capture
== :: ListEventSource -> ListEventSource -> Capture
$c/= :: ListEventSource -> ListEventSource -> Capture
/= :: ListEventSource -> ListEventSource -> Capture
Eq, Int -> ListEventSource
ListEventSource -> Int
ListEventSource -> [ListEventSource]
ListEventSource -> ListEventSource
ListEventSource -> ListEventSource -> [ListEventSource]
ListEventSource
-> ListEventSource -> ListEventSource -> [ListEventSource]
(ListEventSource -> ListEventSource)
-> (ListEventSource -> ListEventSource)
-> (Int -> ListEventSource)
-> (ListEventSource -> Int)
-> (ListEventSource -> [ListEventSource])
-> (ListEventSource -> ListEventSource -> [ListEventSource])
-> (ListEventSource -> ListEventSource -> [ListEventSource])
-> (ListEventSource
    -> ListEventSource -> ListEventSource -> [ListEventSource])
-> Enum ListEventSource
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ListEventSource -> ListEventSource
succ :: ListEventSource -> ListEventSource
$cpred :: ListEventSource -> ListEventSource
pred :: ListEventSource -> ListEventSource
$ctoEnum :: Int -> ListEventSource
toEnum :: Int -> ListEventSource
$cfromEnum :: ListEventSource -> Int
fromEnum :: ListEventSource -> Int
$cenumFrom :: ListEventSource -> [ListEventSource]
enumFrom :: ListEventSource -> [ListEventSource]
$cenumFromThen :: ListEventSource -> ListEventSource -> [ListEventSource]
enumFromThen :: ListEventSource -> ListEventSource -> [ListEventSource]
$cenumFromTo :: ListEventSource -> ListEventSource -> [ListEventSource]
enumFromTo :: ListEventSource -> ListEventSource -> [ListEventSource]
$cenumFromThenTo :: ListEventSource
-> ListEventSource -> ListEventSource -> [ListEventSource]
enumFromThenTo :: ListEventSource
-> ListEventSource -> ListEventSource -> [ListEventSource]
Enum)
-----------------------------------------------------------------------------
instance FromJSON ListEventSource where
  parseJSON :: Value -> Parser ListEventSource
parseJSON = String
-> (Scientific -> Parser ListEventSource)
-> Value
-> Parser ListEventSource
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"ListEventSource" ((Scientific -> Parser ListEventSource)
 -> Value -> Parser ListEventSource)
-> (Scientific -> Parser ListEventSource)
-> Value
-> Parser ListEventSource
forall a b. (a -> b) -> a -> b
$ \case
    Scientific
0 -> ListEventSource -> Parser ListEventSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListEventSource
DIFF
    Scientific
1 -> ListEventSource -> Parser ListEventSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListEventSource
LAYOUT
    Scientific
2 -> ListEventSource -> Parser ListEventSource
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListEventSource
SCROLL
    Scientific
x -> String -> Value -> Parser ListEventSource
forall a. String -> Value -> Parser a
typeMismatch String
"ListEventSource" (Scientific -> Value
Number Scientific
x)
-----------------------------------------------------------------------------
data ScrollStateChange
  = Stationary
  | Dragging
  | InertialScrolling
  | SmoothAnimationScrolling
  deriving (Int -> ScrollStateChange -> ShowS
[ScrollStateChange] -> ShowS
ScrollStateChange -> String
(Int -> ScrollStateChange -> ShowS)
-> (ScrollStateChange -> String)
-> ([ScrollStateChange] -> ShowS)
-> Show ScrollStateChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScrollStateChange -> ShowS
showsPrec :: Int -> ScrollStateChange -> ShowS
$cshow :: ScrollStateChange -> String
show :: ScrollStateChange -> String
$cshowList :: [ScrollStateChange] -> ShowS
showList :: [ScrollStateChange] -> ShowS
Show, ScrollStateChange -> ScrollStateChange -> Capture
(ScrollStateChange -> ScrollStateChange -> Capture)
-> (ScrollStateChange -> ScrollStateChange -> Capture)
-> Eq ScrollStateChange
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: ScrollStateChange -> ScrollStateChange -> Capture
== :: ScrollStateChange -> ScrollStateChange -> Capture
$c/= :: ScrollStateChange -> ScrollStateChange -> Capture
/= :: ScrollStateChange -> ScrollStateChange -> Capture
Eq, Int -> ScrollStateChange
ScrollStateChange -> Int
ScrollStateChange -> [ScrollStateChange]
ScrollStateChange -> ScrollStateChange
ScrollStateChange -> ScrollStateChange -> [ScrollStateChange]
ScrollStateChange
-> ScrollStateChange -> ScrollStateChange -> [ScrollStateChange]
(ScrollStateChange -> ScrollStateChange)
-> (ScrollStateChange -> ScrollStateChange)
-> (Int -> ScrollStateChange)
-> (ScrollStateChange -> Int)
-> (ScrollStateChange -> [ScrollStateChange])
-> (ScrollStateChange -> ScrollStateChange -> [ScrollStateChange])
-> (ScrollStateChange -> ScrollStateChange -> [ScrollStateChange])
-> (ScrollStateChange
    -> ScrollStateChange -> ScrollStateChange -> [ScrollStateChange])
-> Enum ScrollStateChange
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ScrollStateChange -> ScrollStateChange
succ :: ScrollStateChange -> ScrollStateChange
$cpred :: ScrollStateChange -> ScrollStateChange
pred :: ScrollStateChange -> ScrollStateChange
$ctoEnum :: Int -> ScrollStateChange
toEnum :: Int -> ScrollStateChange
$cfromEnum :: ScrollStateChange -> Int
fromEnum :: ScrollStateChange -> Int
$cenumFrom :: ScrollStateChange -> [ScrollStateChange]
enumFrom :: ScrollStateChange -> [ScrollStateChange]
$cenumFromThen :: ScrollStateChange -> ScrollStateChange -> [ScrollStateChange]
enumFromThen :: ScrollStateChange -> ScrollStateChange -> [ScrollStateChange]
$cenumFromTo :: ScrollStateChange -> ScrollStateChange -> [ScrollStateChange]
enumFromTo :: ScrollStateChange -> ScrollStateChange -> [ScrollStateChange]
$cenumFromThenTo :: ScrollStateChange
-> ScrollStateChange -> ScrollStateChange -> [ScrollStateChange]
enumFromThenTo :: ScrollStateChange
-> ScrollStateChange -> ScrollStateChange -> [ScrollStateChange]
Enum)
-----------------------------------------------------------------------------
instance FromJSON ScrollStateChange where
  parseJSON :: Value -> Parser ScrollStateChange
parseJSON = String
-> (Scientific -> Parser ScrollStateChange)
-> Value
-> Parser ScrollStateChange
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"ScrollStateChange" ((Scientific -> Parser ScrollStateChange)
 -> Value -> Parser ScrollStateChange)
-> (Scientific -> Parser ScrollStateChange)
-> Value
-> Parser ScrollStateChange
forall a b. (a -> b) -> a -> b
$ \case
    Scientific
1 -> ScrollStateChange -> Parser ScrollStateChange
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScrollStateChange
Stationary
    Scientific
2 -> ScrollStateChange -> Parser ScrollStateChange
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScrollStateChange
Dragging
    Scientific
3 -> ScrollStateChange -> Parser ScrollStateChange
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScrollStateChange
InertialScrolling
    Scientific
4 -> ScrollStateChange -> Parser ScrollStateChange
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScrollStateChange
SmoothAnimationScrolling
    Scientific
x -> String -> Value -> Parser ScrollStateChange
forall a. String -> Value -> Parser a
typeMismatch String
"ScrollStateChange" (Scientific -> Value
Number Scientific
x)
-----------------------------------------------------------------------------
scrollStateDecoder :: Decoder ScrollStateChange
scrollStateDecoder :: Decoder ScrollStateChange
scrollStateDecoder = [MisoString
"detail"] [MisoString]
-> (Value -> Parser ScrollStateChange) -> Decoder ScrollStateChange
forall a. [MisoString] -> (Value -> Parser a) -> Decoder a
`at` String
-> (Object -> Parser ScrollStateChange)
-> Value
-> Parser ScrollStateChange
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ScrollStateChange" (Object -> Key -> Parser ScrollStateChange
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state")
-----------------------------------------------------------------------------
data SnapEvent
  = SnapEvent
  { SnapEvent -> Double
position :: Double
  -- ^ The index of the node that will be paginated to
  , SnapEvent -> Double
currentScrollLeft :: Double
  -- ^ Current horizontal scroll offset, in px
  , SnapEvent -> Double
currentScrollTop :: Double
  -- ^ Current vertical scroll offset, in px
  , SnapEvent -> Double
targetScrollLeft :: Double
  -- ^ Target horizontal scroll offset for pagination, in px
  , SnapEvent -> Double
targetScrollTop :: Double
  -- ^ Target vertical scroll offset for pagination, in px
  } deriving (Int -> SnapEvent -> ShowS
[SnapEvent] -> ShowS
SnapEvent -> String
(Int -> SnapEvent -> ShowS)
-> (SnapEvent -> String)
-> ([SnapEvent] -> ShowS)
-> Show SnapEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapEvent -> ShowS
showsPrec :: Int -> SnapEvent -> ShowS
$cshow :: SnapEvent -> String
show :: SnapEvent -> String
$cshowList :: [SnapEvent] -> ShowS
showList :: [SnapEvent] -> ShowS
Show, SnapEvent -> SnapEvent -> Capture
(SnapEvent -> SnapEvent -> Capture)
-> (SnapEvent -> SnapEvent -> Capture) -> Eq SnapEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: SnapEvent -> SnapEvent -> Capture
== :: SnapEvent -> SnapEvent -> Capture
$c/= :: SnapEvent -> SnapEvent -> Capture
/= :: SnapEvent -> SnapEvent -> Capture
Eq)
-----------------------------------------------------------------------------
snapDecoder :: Decoder SnapEvent
snapDecoder :: Decoder SnapEvent
snapDecoder = [MisoString
"detail"] [MisoString] -> (Value -> Parser SnapEvent) -> Decoder SnapEvent
forall a. [MisoString] -> (Value -> Parser a) -> Decoder a
`at` do
  String -> (Object -> Parser SnapEvent) -> Value -> Parser SnapEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SnapEvent" ((Object -> Parser SnapEvent) -> Value -> Parser SnapEvent)
-> (Object -> Parser SnapEvent) -> Value -> Parser SnapEvent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Double -> Double -> Double -> Double -> Double -> SnapEvent
SnapEvent
      (Double -> Double -> Double -> Double -> Double -> SnapEvent)
-> Parser Double
-> Parser (Double -> Double -> Double -> Double -> SnapEvent)
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
"position"
      Parser (Double -> Double -> Double -> Double -> SnapEvent)
-> Parser Double
-> Parser (Double -> Double -> Double -> SnapEvent)
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 Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"currentScrollLeft"
      Parser (Double -> Double -> Double -> SnapEvent)
-> Parser Double -> Parser (Double -> Double -> SnapEvent)
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 Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"currentScrollTop"
      Parser (Double -> Double -> SnapEvent)
-> Parser Double -> Parser (Double -> SnapEvent)
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 Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"targetScrollLeft"
      Parser (Double -> SnapEvent) -> Parser Double -> Parser SnapEvent
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 Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"targetScrollTop"
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/list.html#layoutcomplete
--
-- Enable 'needLayoutCompleteInfo' to use.
--
data LayoutCompleteEvent
  = LayoutCompleteEvent
  { LayoutCompleteEvent -> Double
layoutId :: Double
  , LayoutCompleteEvent -> ScrollEvent
scrollInfo :: ScrollEvent
  -- ^ Current horizontal scroll offset, in px
  , LayoutCompleteEvent -> Maybe DiffResult
diffResult :: Maybe DiffResult
  -- ^ Current vertical scroll offset, in px
  , LayoutCompleteEvent -> [ListItemInfo]
visibleCellsAfterUpdate :: [ListItemInfo]
  -- ^ Target horizontal scroll offset for pagination, in px
  , LayoutCompleteEvent -> [ListItemInfo]
visibleCellsBeforeUpdate :: [ListItemInfo]
  -- ^ Target vertical scroll offset for pagination, in px
  } deriving (Int -> LayoutCompleteEvent -> ShowS
[LayoutCompleteEvent] -> ShowS
LayoutCompleteEvent -> String
(Int -> LayoutCompleteEvent -> ShowS)
-> (LayoutCompleteEvent -> String)
-> ([LayoutCompleteEvent] -> ShowS)
-> Show LayoutCompleteEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayoutCompleteEvent -> ShowS
showsPrec :: Int -> LayoutCompleteEvent -> ShowS
$cshow :: LayoutCompleteEvent -> String
show :: LayoutCompleteEvent -> String
$cshowList :: [LayoutCompleteEvent] -> ShowS
showList :: [LayoutCompleteEvent] -> ShowS
Show, LayoutCompleteEvent -> LayoutCompleteEvent -> Capture
(LayoutCompleteEvent -> LayoutCompleteEvent -> Capture)
-> (LayoutCompleteEvent -> LayoutCompleteEvent -> Capture)
-> Eq LayoutCompleteEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: LayoutCompleteEvent -> LayoutCompleteEvent -> Capture
== :: LayoutCompleteEvent -> LayoutCompleteEvent -> Capture
$c/= :: LayoutCompleteEvent -> LayoutCompleteEvent -> Capture
/= :: LayoutCompleteEvent -> LayoutCompleteEvent -> Capture
Eq)
-----------------------------------------------------------------------------
data DiffResult
  = DiffResult
  { DiffResult -> [Double]
insertions :: [Double]
  , DiffResult -> [Double]
moveFrom :: [Double]
  , DiffResult -> [Double]
moveTo :: [Double]
  , DiffResult -> [Double]
removals :: [Double]
  , DiffResult -> [Double]
updateFrom :: [Double]
  , DiffResult -> [Double]
updateTo :: [Double]
  } deriving (Int -> DiffResult -> ShowS
[DiffResult] -> ShowS
DiffResult -> String
(Int -> DiffResult -> ShowS)
-> (DiffResult -> String)
-> ([DiffResult] -> ShowS)
-> Show DiffResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiffResult -> ShowS
showsPrec :: Int -> DiffResult -> ShowS
$cshow :: DiffResult -> String
show :: DiffResult -> String
$cshowList :: [DiffResult] -> ShowS
showList :: [DiffResult] -> ShowS
Show, DiffResult -> DiffResult -> Capture
(DiffResult -> DiffResult -> Capture)
-> (DiffResult -> DiffResult -> Capture) -> Eq DiffResult
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: DiffResult -> DiffResult -> Capture
== :: DiffResult -> DiffResult -> Capture
$c/= :: DiffResult -> DiffResult -> Capture
/= :: DiffResult -> DiffResult -> Capture
Eq)
-----------------------------------------------------------------------------
instance FromJSON DiffResult where
  parseJSON :: Value -> Parser DiffResult
parseJSON = String
-> (Object -> Parser DiffResult) -> Value -> Parser DiffResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DiffResult" ((Object -> Parser DiffResult) -> Value -> Parser DiffResult)
-> (Object -> Parser DiffResult) -> Value -> Parser DiffResult
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Double]
-> [Double]
-> [Double]
-> [Double]
-> [Double]
-> [Double]
-> DiffResult
DiffResult
      ([Double]
 -> [Double]
 -> [Double]
 -> [Double]
 -> [Double]
 -> [Double]
 -> DiffResult)
-> Parser [Double]
-> Parser
     ([Double]
      -> [Double] -> [Double] -> [Double] -> [Double] -> DiffResult)
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
"insertions"
      Parser
  ([Double]
   -> [Double] -> [Double] -> [Double] -> [Double] -> DiffResult)
-> Parser [Double]
-> Parser
     ([Double] -> [Double] -> [Double] -> [Double] -> DiffResult)
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 [Double]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"move_from"
      Parser ([Double] -> [Double] -> [Double] -> [Double] -> DiffResult)
-> Parser [Double]
-> Parser ([Double] -> [Double] -> [Double] -> DiffResult)
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 [Double]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"move_to"
      Parser ([Double] -> [Double] -> [Double] -> DiffResult)
-> Parser [Double] -> Parser ([Double] -> [Double] -> DiffResult)
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 [Double]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"removals"
      Parser ([Double] -> [Double] -> DiffResult)
-> Parser [Double] -> Parser ([Double] -> DiffResult)
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 [Double]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"update_from"
      Parser ([Double] -> DiffResult)
-> Parser [Double] -> Parser DiffResult
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 [Double]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"update_to"
-----------------------------------------------------------------------------
data ListItemInfo
  = ListItemInfo
  { ListItemInfo -> Double
listItemInfoHeight :: Double
    -- ^ Child node height
  , ListItemInfo -> Double
listItemInfoWidth :: Double
    -- ^ Child node width
  , ListItemInfo -> MisoString
listItemInfoItemKey :: MisoString
    -- ^ Child node ItemKey
  , ListItemInfo -> Capture
listItemInfoIsBinding :: Bool
    -- ^ Whether the child node is in rendering state
  , ListItemInfo -> Double
listItemInfoOriginX :: Double
    -- ^ X coordinate position of the child node relative to the entire scroll area
  , ListItemInfo -> Double
listItemInfoOriginY :: Double
    -- ^ Y coordinate position of the child node relative to the entire scroll area
  , ListItemInfo -> Capture
listItemInfoUpdated :: Bool
    -- ^ Whether the child node has been updated
  } deriving (Int -> ListItemInfo -> ShowS
[ListItemInfo] -> ShowS
ListItemInfo -> String
(Int -> ListItemInfo -> ShowS)
-> (ListItemInfo -> String)
-> ([ListItemInfo] -> ShowS)
-> Show ListItemInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListItemInfo -> ShowS
showsPrec :: Int -> ListItemInfo -> ShowS
$cshow :: ListItemInfo -> String
show :: ListItemInfo -> String
$cshowList :: [ListItemInfo] -> ShowS
showList :: [ListItemInfo] -> ShowS
Show, ListItemInfo -> ListItemInfo -> Capture
(ListItemInfo -> ListItemInfo -> Capture)
-> (ListItemInfo -> ListItemInfo -> Capture) -> Eq ListItemInfo
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: ListItemInfo -> ListItemInfo -> Capture
== :: ListItemInfo -> ListItemInfo -> Capture
$c/= :: ListItemInfo -> ListItemInfo -> Capture
/= :: ListItemInfo -> ListItemInfo -> Capture
Eq)
-----------------------------------------------------------------------------
instance FromJSON ListItemInfo where
  parseJSON :: Value -> Parser ListItemInfo
parseJSON = String
-> (Object -> Parser ListItemInfo) -> Value -> Parser ListItemInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ListItemInfo" ((Object -> Parser ListItemInfo) -> Value -> Parser ListItemInfo)
-> (Object -> Parser ListItemInfo) -> Value -> Parser ListItemInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Double
-> Double
-> MisoString
-> Capture
-> Double
-> Double
-> Capture
-> ListItemInfo
ListItemInfo
      (Double
 -> Double
 -> MisoString
 -> Capture
 -> Double
 -> Double
 -> Capture
 -> ListItemInfo)
-> Parser Double
-> Parser
     (Double
      -> MisoString
      -> Capture
      -> Double
      -> Double
      -> Capture
      -> ListItemInfo)
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
"height"
      Parser
  (Double
   -> MisoString
   -> Capture
   -> Double
   -> Double
   -> Capture
   -> ListItemInfo)
-> Parser Double
-> Parser
     (MisoString
      -> Capture -> Double -> Double -> Capture -> ListItemInfo)
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 Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width"
      Parser
  (MisoString
   -> Capture -> Double -> Double -> Capture -> ListItemInfo)
-> Parser MisoString
-> Parser (Capture -> Double -> Double -> Capture -> ListItemInfo)
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
"itemKey"
      Parser (Capture -> Double -> Double -> Capture -> ListItemInfo)
-> Parser Capture
-> Parser (Double -> Double -> Capture -> ListItemInfo)
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
"isBinding"
      Parser (Double -> Double -> Capture -> ListItemInfo)
-> Parser Double -> Parser (Double -> Capture -> ListItemInfo)
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 Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"originX"
      Parser (Double -> Capture -> ListItemInfo)
-> Parser Double -> Parser (Capture -> ListItemInfo)
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 Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"originY"
      Parser (Capture -> ListItemInfo)
-> Parser Capture -> Parser ListItemInfo
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
"updated"
-----------------------------------------------------------------------------
layoutCompleteDecoder :: Decoder LayoutCompleteEvent
layoutCompleteDecoder :: Decoder LayoutCompleteEvent
layoutCompleteDecoder = [MisoString
"detail"] [MisoString]
-> (Value -> Parser LayoutCompleteEvent)
-> Decoder LayoutCompleteEvent
forall a. [MisoString] -> (Value -> Parser a) -> Decoder a
`at` do
  String
-> (Object -> Parser LayoutCompleteEvent)
-> Value
-> Parser LayoutCompleteEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LayoutCompleteEvent" ((Object -> Parser LayoutCompleteEvent)
 -> Value -> Parser LayoutCompleteEvent)
-> (Object -> Parser LayoutCompleteEvent)
-> Value
-> Parser LayoutCompleteEvent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Double
-> ScrollEvent
-> Maybe DiffResult
-> [ListItemInfo]
-> [ListItemInfo]
-> LayoutCompleteEvent
LayoutCompleteEvent
      (Double
 -> ScrollEvent
 -> Maybe DiffResult
 -> [ListItemInfo]
 -> [ListItemInfo]
 -> LayoutCompleteEvent)
-> Parser Double
-> Parser
     (ScrollEvent
      -> Maybe DiffResult
      -> [ListItemInfo]
      -> [ListItemInfo]
      -> LayoutCompleteEvent)
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
"layout-id"
      Parser
  (ScrollEvent
   -> Maybe DiffResult
   -> [ListItemInfo]
   -> [ListItemInfo]
   -> LayoutCompleteEvent)
-> Parser ScrollEvent
-> Parser
     (Maybe DiffResult
      -> [ListItemInfo] -> [ListItemInfo] -> LayoutCompleteEvent)
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 ScrollEvent
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scrollInfo"
      Parser
  (Maybe DiffResult
   -> [ListItemInfo] -> [ListItemInfo] -> LayoutCompleteEvent)
-> Parser (Maybe DiffResult)
-> Parser ([ListItemInfo] -> [ListItemInfo] -> LayoutCompleteEvent)
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 (Maybe DiffResult)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"diffResult"
      Parser ([ListItemInfo] -> [ListItemInfo] -> LayoutCompleteEvent)
-> Parser [ListItemInfo]
-> Parser ([ListItemInfo] -> LayoutCompleteEvent)
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 [ListItemInfo]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"visibleCellsAfterUpdate"
      Parser ([ListItemInfo] -> LayoutCompleteEvent)
-> Parser [ListItemInfo] -> Parser LayoutCompleteEvent
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 [ListItemInfo]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"visibleCellsBeforeUpdate"
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/list.html#scroll
--
-- \<list\> scroll event.
--
-- @
--
-- data Action = HandleScroll ScrollEvent
--
-- view :: Model -> View Action
-- view model = list_ defaultListOptions [ onScroll HandleScroll ] [ ]
--
-- update :: Action -> Effect Model Action
-- update (HandleScroll ScrollEvent {..}) =
--   io_ (consoleLog "handled scroll event")
--
-- @
--
onScroll :: (ScrollEvent -> action) -> Attribute action
onScroll :: forall action. (ScrollEvent -> action) -> Attribute action
onScroll ScrollEvent -> action
action = MisoString
-> Decoder ScrollEvent
-> (ScrollEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"scroll" Decoder ScrollEvent
scrollDecoder (\ScrollEvent
x DOMRef
_ -> ScrollEvent -> action
action ScrollEvent
x)
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/list.html#scrolltoupper
--
-- Callback triggered when scrolling to the top of \<list\>. The trigger
-- position of this callback can be controlled by 'upperThresholdItemCount'.
--
-- @
--
-- data Action = HandleScroll ScrollEvent
--
-- view :: Model -> View Action
-- view model = list_ defaultListOptions [ onScrollToUpper HandleScroll ] [ ]
--
-- update :: Action -> Effect Model Action
-- update (HandleScroll ScrollEvent {..}) =
--   io_ (consoleLog "handled scroll event")
--
-- @
--
onScrollToUpper :: (ScrollEvent -> action) -> Attribute action
onScrollToUpper :: forall action. (ScrollEvent -> action) -> Attribute action
onScrollToUpper ScrollEvent -> action
action = MisoString
-> Decoder ScrollEvent
-> (ScrollEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"scrolltoupper" Decoder ScrollEvent
scrollDecoder (\ScrollEvent
x DOMRef
_ -> ScrollEvent -> action
action ScrollEvent
x)
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/list.html#scrolltolower
--
-- Callback triggered when scrolling to the bottom of \<list\>. The trigger
-- position of this callback can be controlled by 'lowerThresholdItemCount_'
--
-- @
--
-- data Action = HandleScroll ScrollEvent
--
-- view :: Model -> View Action
-- view model = list_ defaultListOptions [ onScrollToLower HandleScroll ] [ ]
--
-- update :: Action -> Effect Model Action
-- update (HandleScroll ScrollEvent {..}) =
--   io_ (consoleLog "handled scroll event")
--
-- @
--
onScrollToLower :: (ScrollEvent -> action) -> Attribute action
onScrollToLower :: forall action. (ScrollEvent -> action) -> Attribute action
onScrollToLower ScrollEvent -> action
action = MisoString
-> Decoder ScrollEvent
-> (ScrollEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"scrolltolower" Decoder ScrollEvent
scrollDecoder (\ScrollEvent
x DOMRef
_ -> ScrollEvent -> action
action ScrollEvent
x)
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/list.html#scrollstatechange
--
-- Callback triggered when the scroll state of \<list\> changes. The state
-- field in the event parameter's detail indicates the scroll state:
-- * 1 for stationary
-- * 2 for dragging
-- * 3 for inertial scrolling
-- * 4 for smooth animation scrolling.
--
-- @
--
-- data Action = HandleScrollState ScrollStateChange
--
-- view :: Model -> View Action
-- view model = list_ defaultListOptions [ onScrollStateChange HandleScrollState ] [ ]
--
-- update :: Action -> Effect Model Action
-- update (HandleScroll Stationary) =
--   io_ (consoleLog "Received Stationary scroll state change")
-- update _ = pure ()
--
-- @
--
onScrollStateChange :: (ScrollStateChange -> action) -> Attribute action
onScrollStateChange :: forall action. (ScrollStateChange -> action) -> Attribute action
onScrollStateChange ScrollStateChange -> action
action = MisoString
-> Decoder ScrollStateChange
-> (ScrollStateChange -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"scrollstatechange" Decoder ScrollStateChange
scrollStateDecoder (\ScrollStateChange
x DOMRef
_ -> ScrollStateChange -> action
action ScrollStateChange
x)
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/list.html#layoutcomplete
--
-- Callback triggered after \<list\> layout is complete.
--
-- @
--
-- data Action = HandleLayout LayoutCompleteEvent
--
-- view :: Model -> View Action
-- view model = list_ defaultListOptions [ onLayoutComplete HandleLayout ] [ ]
--
-- update :: Action -> Effect Model Action
-- update (HandleLayout LayoutCompleteEvent {..}) =
--   io_ (consoleLog "Received LayoutCompleteEvent")
--
-- @
--
onLayoutComplete :: (LayoutCompleteEvent -> action) -> Attribute action
onLayoutComplete :: forall action. (LayoutCompleteEvent -> action) -> Attribute action
onLayoutComplete LayoutCompleteEvent -> action
action = MisoString
-> Decoder LayoutCompleteEvent
-> (LayoutCompleteEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"layoutcomplete" Decoder LayoutCompleteEvent
layoutCompleteDecoder (\LayoutCompleteEvent
x DOMRef
_ -> LayoutCompleteEvent -> action
action LayoutCompleteEvent
x)
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/list.html#snap
--
-- Callback when pagination scrolling is about to occur.
--
-- @
--
-- data Action = HandleSnap SnapEvent
--
-- view :: Model -> View Action
-- view model = list_ defaultListOptions [ onSnap HandleSnap ] [ ]
--
-- update :: Action -> Effect Model Action
-- update (HandleSnap SnapEvent {..}) =
--   io_ (consoleLog "Received SnapEvent")
--
-- @
--
onSnap :: (SnapEvent -> action) -> Attribute action
onSnap :: forall action. (SnapEvent -> action) -> Attribute action
onSnap SnapEvent -> action
action = MisoString
-> Decoder SnapEvent
-> (SnapEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"snap" Decoder SnapEvent
snapDecoder (\SnapEvent
x DOMRef
_ -> SnapEvent -> action
action SnapEvent
x)
-----------------------------------------------------------------------------