-----------------------------------------------------------------------------
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Lynx.Element.Text.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.Text.Event
  ( -- *** Events
    onLayout
  , onSelectionChange
    -- *** Types
  , LayoutEvent          (..)
  , LineInfo             (..)
  , Size                 (..)
  , SelectionChangeEvent (..)
  , Direction            (..)
    -- *** Decoders
  , layoutDecoder
  , selectionChangeDecoder
    -- *** Event Map
  , textEvents
  ) where
-----------------------------------------------------------------------------
import           Data.Aeson
import           Data.Aeson.Types
import           Miso.Event
-----------------------------------------------------------------------------
import qualified Data.Map.Strict as M
import           Miso.Types (Attribute)
----------------------------------------------------------------------------
textEvents :: Events
textEvents :: Events
textEvents
  = [(MisoString, Capture)] -> Events
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (MisoString
"layout", Capture
False)
  , (MisoString
"selectionchange", Capture
False)
  ]
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/text.html#layout
--
-- The layout event returns the result information after text layout,
-- including the number of lines of the current text, and the start and
-- end positions of the text in each line relative to the entire text.
--
-- @
--
-- data Action = HandleLayout LayoutEvent
--
-- view :: Model -> View Action
-- view model = text_ [ onLayout HandleLayout ] [ text "hi" ]
--
-- update :: Action -> Effect Model Action
-- update (HandleLayout LayoutEvent {..}) = io_ (consoleLog "layout event received")
--
-- @
--
onLayout :: (LayoutEvent -> action) -> Attribute action
onLayout :: forall action. (LayoutEvent -> action) -> Attribute action
onLayout LayoutEvent -> action
action = MisoString
-> Decoder LayoutEvent
-> (LayoutEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"layout" Decoder LayoutEvent
layoutDecoder (\LayoutEvent
e DOMRef
_ -> LayoutEvent -> action
action LayoutEvent
e)
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/text.html#selectionchange
--
-- This event is triggered whenever the selected text range changes.
--
-- @
--
-- data Action = HandleSelectionChange SelectionChangeEvent
--
-- view :: Model -> View Action
-- view model = text_ [ onSelectionChange HandleSelectionChange ] [ text "hi" ]
--
-- update :: Action -> Effect Model Action
-- update (HandleSelectionChange SelectionChangeEvent {..}) =
--   io_ (consoleLog "selection change event received")
--
-- @
--
onSelectionChange :: (SelectionChangeEvent -> action) -> Attribute action
onSelectionChange :: forall action. (SelectionChangeEvent -> action) -> Attribute action
onSelectionChange SelectionChangeEvent -> action
action = MisoString
-> Decoder SelectionChangeEvent
-> (SelectionChangeEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"layout" Decoder SelectionChangeEvent
selectionChangeDecoder (\SelectionChangeEvent
e DOMRef
_ -> SelectionChangeEvent -> action
action SelectionChangeEvent
e)
-----------------------------------------------------------------------------
selectionChangeDecoder :: Decoder SelectionChangeEvent
selectionChangeDecoder :: Decoder SelectionChangeEvent
selectionChangeDecoder = [MisoString
"detail"] [MisoString]
-> (Value -> Parser SelectionChangeEvent)
-> Decoder SelectionChangeEvent
forall a. [MisoString] -> (Value -> Parser a) -> Decoder a
`at` Value -> Parser SelectionChangeEvent
parser
  where
    parser :: Value -> Parser SelectionChangeEvent
    parser :: Value -> Parser SelectionChangeEvent
parser = String
-> (Object -> Parser SelectionChangeEvent)
-> Value
-> Parser SelectionChangeEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SelectionChangeEvent" ((Object -> Parser SelectionChangeEvent)
 -> Value -> Parser SelectionChangeEvent)
-> (Object -> Parser SelectionChangeEvent)
-> Value
-> Parser SelectionChangeEvent
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Double -> Double -> Direction -> SelectionChangeEvent
SelectionChangeEvent
        (Double -> Double -> Direction -> SelectionChangeEvent)
-> Parser Double
-> Parser (Double -> Direction -> SelectionChangeEvent)
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
"start"
        Parser (Double -> Direction -> SelectionChangeEvent)
-> Parser Double -> Parser (Direction -> SelectionChangeEvent)
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
"end"
        Parser (Direction -> SelectionChangeEvent)
-> Parser Direction -> Parser SelectionChangeEvent
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 Direction
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"direction"
-----------------------------------------------------------------------------
data SelectionChangeEvent
  = SelectionChangeEvent
  { SelectionChangeEvent -> Double
start, SelectionChangeEvent -> Double
end :: Double
  , SelectionChangeEvent -> Direction
direction :: Direction
  } deriving (Int -> SelectionChangeEvent -> ShowS
[SelectionChangeEvent] -> ShowS
SelectionChangeEvent -> String
(Int -> SelectionChangeEvent -> ShowS)
-> (SelectionChangeEvent -> String)
-> ([SelectionChangeEvent] -> ShowS)
-> Show SelectionChangeEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectionChangeEvent -> ShowS
showsPrec :: Int -> SelectionChangeEvent -> ShowS
$cshow :: SelectionChangeEvent -> String
show :: SelectionChangeEvent -> String
$cshowList :: [SelectionChangeEvent] -> ShowS
showList :: [SelectionChangeEvent] -> ShowS
Show, SelectionChangeEvent -> SelectionChangeEvent -> Capture
(SelectionChangeEvent -> SelectionChangeEvent -> Capture)
-> (SelectionChangeEvent -> SelectionChangeEvent -> Capture)
-> Eq SelectionChangeEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: SelectionChangeEvent -> SelectionChangeEvent -> Capture
== :: SelectionChangeEvent -> SelectionChangeEvent -> Capture
$c/= :: SelectionChangeEvent -> SelectionChangeEvent -> Capture
/= :: SelectionChangeEvent -> SelectionChangeEvent -> Capture
Eq)
-----------------------------------------------------------------------------
data Direction = Forward | Backward
  deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, Direction -> Direction -> Capture
(Direction -> Direction -> Capture)
-> (Direction -> Direction -> Capture) -> Eq Direction
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: Direction -> Direction -> Capture
== :: Direction -> Direction -> Capture
$c/= :: Direction -> Direction -> Capture
/= :: Direction -> Direction -> Capture
Eq)
-----------------------------------------------------------------------------
instance FromJSON Direction where
  parseJSON :: Value -> Parser Direction
parseJSON = String -> (Text -> Parser Direction) -> Value -> Parser Direction
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Direction" ((Text -> Parser Direction) -> Value -> Parser Direction)
-> (Text -> Parser Direction) -> Value -> Parser Direction
forall a b. (a -> b) -> a -> b
$ \case
    Text
"forward" -> Direction -> Parser Direction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
Forward
    Text
"backward" -> Direction -> Parser Direction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
Backward
    Text
x -> String -> Value -> Parser Direction
forall a. String -> Value -> Parser a
typeMismatch String
"Direction" (Text -> Value
String Text
x)
-----------------------------------------------------------------------------
data LayoutEvent
  = LayoutEvent
  { LayoutEvent -> Double
lineInfoLineCount     :: Double
  , LayoutEvent -> [LineInfo]
lineInfoLines         :: [LineInfo]
  , LayoutEvent -> Size
lineInfoSize          :: Size
  } deriving (Int -> LayoutEvent -> ShowS
[LayoutEvent] -> ShowS
LayoutEvent -> String
(Int -> LayoutEvent -> ShowS)
-> (LayoutEvent -> String)
-> ([LayoutEvent] -> ShowS)
-> Show LayoutEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayoutEvent -> ShowS
showsPrec :: Int -> LayoutEvent -> ShowS
$cshow :: LayoutEvent -> String
show :: LayoutEvent -> String
$cshowList :: [LayoutEvent] -> ShowS
showList :: [LayoutEvent] -> ShowS
Show, LayoutEvent -> LayoutEvent -> Capture
(LayoutEvent -> LayoutEvent -> Capture)
-> (LayoutEvent -> LayoutEvent -> Capture) -> Eq LayoutEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: LayoutEvent -> LayoutEvent -> Capture
== :: LayoutEvent -> LayoutEvent -> Capture
$c/= :: LayoutEvent -> LayoutEvent -> Capture
/= :: LayoutEvent -> LayoutEvent -> Capture
Eq)
-----------------------------------------------------------------------------
layoutDecoder :: Decoder LayoutEvent
layoutDecoder :: Decoder LayoutEvent
layoutDecoder = [] [MisoString]
-> (Value -> Parser LayoutEvent) -> Decoder LayoutEvent
forall a. [MisoString] -> (Value -> Parser a) -> Decoder a
`at` do
  String
-> (Object -> Parser LayoutEvent) -> Value -> Parser LayoutEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LayoutEvent" ((Object -> Parser LayoutEvent) -> Value -> Parser LayoutEvent)
-> (Object -> Parser LayoutEvent) -> Value -> Parser LayoutEvent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Double -> [LineInfo] -> Size -> LayoutEvent
LayoutEvent
      (Double -> [LineInfo] -> Size -> LayoutEvent)
-> Parser Double -> Parser ([LineInfo] -> Size -> LayoutEvent)
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
"lineCount"
      Parser ([LineInfo] -> Size -> LayoutEvent)
-> Parser [LineInfo] -> Parser (Size -> LayoutEvent)
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 [LineInfo]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lineInfo"
      Parser (Size -> LayoutEvent) -> Parser Size -> Parser LayoutEvent
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> do
        s <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
        Size <$> s .: "width" <*> s .: "height"
-----------------------------------------------------------------------------
instance FromJSON LineInfo where
  parseJSON :: Value -> Parser LineInfo
parseJSON = String -> (Object -> Parser LineInfo) -> Value -> Parser LineInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"lineInfo" ((Object -> Parser LineInfo) -> Value -> Parser LineInfo)
-> (Object -> Parser LineInfo) -> Value -> Parser LineInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Double -> Double -> Double -> LineInfo
LineInfo
      (Double -> Double -> Double -> LineInfo)
-> Parser Double -> Parser (Double -> Double -> LineInfo)
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
"start"
      Parser (Double -> Double -> LineInfo)
-> Parser Double -> Parser (Double -> LineInfo)
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
"end"
      Parser (Double -> LineInfo) -> Parser Double -> Parser LineInfo
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
"ellipsisCount"
-----------------------------------------------------------------------------
data LineInfo
  = LineInfo
  { LineInfo -> Double
lineInfoStart, LineInfo -> Double
lineInfoEnd, LineInfo -> Double
lineInfoEllipsisCount :: Double
  } deriving (Int -> LineInfo -> ShowS
[LineInfo] -> ShowS
LineInfo -> String
(Int -> LineInfo -> ShowS)
-> (LineInfo -> String) -> ([LineInfo] -> ShowS) -> Show LineInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LineInfo -> ShowS
showsPrec :: Int -> LineInfo -> ShowS
$cshow :: LineInfo -> String
show :: LineInfo -> String
$cshowList :: [LineInfo] -> ShowS
showList :: [LineInfo] -> ShowS
Show, LineInfo -> LineInfo -> Capture
(LineInfo -> LineInfo -> Capture)
-> (LineInfo -> LineInfo -> Capture) -> Eq LineInfo
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: LineInfo -> LineInfo -> Capture
== :: LineInfo -> LineInfo -> Capture
$c/= :: LineInfo -> LineInfo -> Capture
/= :: LineInfo -> LineInfo -> Capture
Eq)
-----------------------------------------------------------------------------
data Size
  = Size
  { Size -> Double
sizeWidth, Size -> Double
sizeHeight :: Double
  } deriving (Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> String
show :: Size -> String
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show, Size -> Size -> Capture
(Size -> Size -> Capture) -> (Size -> Size -> Capture) -> Eq Size
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: Size -> Size -> Capture
== :: Size -> Size -> Capture
$c/= :: Size -> Size -> Capture
/= :: Size -> Size -> Capture
Eq)
-----------------------------------------------------------------------------