-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Lynx.Element.View.Method
-- 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.Method
  ( -- *** Methods
    boundingClientRect
  , takeScreenshot
  , requestAccessibilityFocus
  -- *** Types
  , Rect (..)
  , BoundingClientRect (..)
  , TakeScreenshot (..)
  -- *** Smart constructors
  , defaultBoundingClientRect
  , defaultTakeScreenshot
  ) where
-----------------------------------------------------------------------------
import Language.Javascript.JSaddle
-----------------------------------------------------------------------------
import Miso
import Miso.Lynx.FFI
-----------------------------------------------------------------------------
-- | Result of calling `getClientBoundingRect`
data Rect
  = Rect
  { Rect -> Double
x,Rect -> Double
y :: Double
  , Rect -> Double
width, Rect -> Double
height :: Double
  , Rect -> Double
top, Rect -> Double
bottom :: Double
  , Rect -> Double
right, Rect -> Double
left :: Double
  } deriving (Int -> Rect -> ShowS
[Rect] -> ShowS
Rect -> String
(Int -> Rect -> ShowS)
-> (Rect -> String) -> ([Rect] -> ShowS) -> Show Rect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rect -> ShowS
showsPrec :: Int -> Rect -> ShowS
$cshow :: Rect -> String
show :: Rect -> String
$cshowList :: [Rect] -> ShowS
showList :: [Rect] -> ShowS
Show, Rect -> Rect -> Bool
(Rect -> Rect -> Bool) -> (Rect -> Rect -> Bool) -> Eq Rect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rect -> Rect -> Bool
== :: Rect -> Rect -> Bool
$c/= :: Rect -> Rect -> Bool
/= :: Rect -> Rect -> Bool
Eq)
-----------------------------------------------------------------------------
instance FromJSVal Rect where
  fromJSVal :: JSVal -> JSM (Maybe Rect)
fromJSVal = \JSVal
rect -> do
    let readProp :: MisoString -> JSM Double
readProp = \MisoString
name ->
          JSVal -> JSM Double
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Double) -> JSM JSVal -> JSM Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
            JSVal
rect JSVal -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (MisoString
name :: MisoString)
    x      <- MisoString -> JSM Double
readProp MisoString
"x"
    y      <- readProp "y"
    height <- readProp "height"
    width  <- readProp "width"
    top    <- readProp "top"
    right  <- readProp "right"
    left   <- readProp "left"
    bottom <- readProp "bottom"
    pure $ Just Rect {..}
-----------------------------------------------------------------------------
data BoundingClientRect
  = BoundingClientRect
  { BoundingClientRect -> Bool
androidEnableTransformProps :: Bool
  -- ^ Specifies whether to consider the transform attribute
  -- when calculating the position on Android. The default value is 'False'
  , BoundingClientRect -> Maybe JSVal
relativeTo :: Maybe JSVal
  -- ^ Specify the reference node, relative to LynxView by default.
  }
-----------------------------------------------------------------------------
instance ToJSVal BoundingClientRect where
  toJSVal :: BoundingClientRect -> JSM JSVal
toJSVal BoundingClientRect {Bool
Maybe JSVal
androidEnableTransformProps :: BoundingClientRect -> Bool
relativeTo :: BoundingClientRect -> Maybe JSVal
androidEnableTransformProps :: Bool
relativeTo :: Maybe JSVal
..} = do
    o <- JSM Object
create
    set "androidEnableTransformProps" androidEnableTransformProps o
    set "relativeTo" relativeTo o
    toJSVal o
-----------------------------------------------------------------------------
-- | Smart constructor for constructing 'boundingClientRect'
defaultBoundingClientRect :: BoundingClientRect
defaultBoundingClientRect :: BoundingClientRect
defaultBoundingClientRect
  = BoundingClientRect
  { androidEnableTransformProps :: Bool
androidEnableTransformProps = Bool
True
  , relativeTo :: Maybe JSVal
relativeTo = Maybe JSVal
forall a. Maybe a
Nothing
  }
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#boundingclientrect
--
-- The front end can execute 'boundingClientRect' through the SelectorQuery API.
--
-- @
--
-- data Action
--   = Success Rect
--   | Failure MisoString
--   | GetRect
--
-- update :: Action -> Effect model Action
-- update GetRect =
--   boundingClientRect defaultBoundingClientRect "#box" Success Failure
-- update (Succes Rect {..}) =
--   consoleLog "Successfuly got Rect"
-- update (Failure errorMsg) =
--   consoleLog ("Failed to call getClientBoundingRect: " <> errorMsg)
--
-- @
--
boundingClientRect
  :: MisoString
  -> BoundingClientRect
  -> (Rect -> action)
  -> (MisoString -> action)
  -> Effect parent model action
boundingClientRect :: forall action parent model.
MisoString
-> BoundingClientRect
-> (Rect -> action)
-> (MisoString -> action)
-> Effect parent model action
boundingClientRect = MisoString
-> MisoString
-> BoundingClientRect
-> (Rect -> action)
-> (MisoString -> action)
-> Effect parent model action
forall params argument action parent model.
(ToJSVal params, FromJSVal argument) =>
MisoString
-> MisoString
-> params
-> (argument -> action)
-> (MisoString -> action)
-> Effect parent model action
invokeExec MisoString
"boundingClientRect"
-----------------------------------------------------------------------------
data TakeScreenshot
  = TakeScreenshot
  { TakeScreenshot -> MisoString
format :: MisoString
  -- ^ e.g. Specify the image format, supports jpeg and png, the default is jpeg
  , TakeScreenshot -> Double
scale :: Double
  -- ^ e.g. Specify the image quality, 0 < scale <= 1, the default is 1,
  -- the smaller the value, the blurrier and smaller the size.
  }
-----------------------------------------------------------------------------
instance ToJSVal TakeScreenshot where
  toJSVal :: TakeScreenshot -> JSM JSVal
toJSVal TakeScreenshot {Double
MisoString
format :: TakeScreenshot -> MisoString
scale :: TakeScreenshot -> Double
format :: MisoString
scale :: Double
..} = do
    o <- JSM Object
create
    set "format" format o
    set "scale" scale o
    toJSVal o
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#takescreenshot
--
-- The front end can execute 'takeScreenshot' through the SelectorQuery API.
--
-- @
--
-- data Action
--   = Success Image
--   | Failure MisoString
--   | GetScreenshot
--
-- update :: Action -> Effect model Action
-- update GetScreenshot = takeScreenshot
--   defaultTakeScreenshot "#my-view" Success Failure
-- update (Succes image) =
--   consoleLog "Successfuly got image"
--   consoleLog' image
-- update (Failure errorMsg) =
--   consoleLog ("Failed to call takeScreenshot: " <> errorMsg)
--
-- @
--
takeScreenshot
  :: MisoString
  -> TakeScreenshot
  -> (JSVal -> action)
  -> (MisoString -> action)
  -> Effect parent model action
takeScreenshot :: forall action parent model.
MisoString
-> TakeScreenshot
-> (JSVal -> action)
-> (MisoString -> action)
-> Effect parent model action
takeScreenshot = MisoString
-> MisoString
-> TakeScreenshot
-> (JSVal -> action)
-> (MisoString -> action)
-> Effect parent model action
forall params argument action parent model.
(ToJSVal params, FromJSVal argument) =>
MisoString
-> MisoString
-> params
-> (argument -> action)
-> (MisoString -> action)
-> Effect parent model action
invokeExec MisoString
"takeScreenshot"
-----------------------------------------------------------------------------
-- | Smart constructor for calling 'TakeScreenshot'
defaultTakeScreenshot :: TakeScreenshot
defaultTakeScreenshot :: TakeScreenshot
defaultTakeScreenshot
  = TakeScreenshot
  { scale :: Double
scale = Double
0.5
  , format :: MisoString
format = MisoString
".png"
  }
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/view.html#requestaccessibilityfocus
--
-- The front end can execute 'requestAccessiblityFocus' through the SelectorQuery API.
--
-- @
--
-- data Action
--   = Success
--   | Failure MisoString
--   | GetFocus
--
-- update :: Action -> Effect model Action
-- update GetFocus = requestAccessibilityFocus "#my-view" Success Failure
-- update Success = consoleLog "Successfuly got focus"
-- update (Failure errorMsg) =
--   consoleLog ("Failed to call requestAccessibilityFocus: " <> errorMsg)
--
-- @
--
requestAccessibilityFocus
  :: MisoString
  -> (JSVal -> action)
  -> (MisoString -> action)
  -> Effect parent model action
requestAccessibilityFocus :: forall action parent model.
MisoString
-> (JSVal -> action)
-> (MisoString -> action)
-> Effect parent model action
requestAccessibilityFocus MisoString
selector =
  MisoString
-> MisoString
-> ()
-> (JSVal -> action)
-> (MisoString -> action)
-> Effect parent model action
forall params argument action parent model.
(ToJSVal params, FromJSVal argument) =>
MisoString
-> MisoString
-> params
-> (argument -> action)
-> (MisoString -> action)
-> Effect parent model action
invokeExec MisoString
"requestAccessibilityFocus" MisoString
selector ()
-----------------------------------------------------------------------------