-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Lynx.Element.Image.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.Image.Event
  ( -- *** Events
    onLoad
  , onError
  -- *** Decoder
  , imageLoadDecoder
  , imageErrorDecoder
  -- *** Types
  , ImageErrorEvent (..)
  , ImageLoadEvent (..)
  -- *** Event Map
  , imageEvents
  ) where
-----------------------------------------------------------------------------
import           Data.Aeson
import qualified Data.Map as M
-----------------------------------------------------------------------------
import           Miso.Event
import           Miso.String (MisoString)
import           Miso.Types (Attribute)
-----------------------------------------------------------------------------
imageEvents :: Events
imageEvents :: Events
imageEvents
  = [(MisoString, Capture)] -> Events
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (MisoString
"load", Capture
False)
  , (MisoString
"error", Capture
False)
  ]
----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/image.html#bindload
--
-- Triggered when the image request succeeds, outputting the image's width and height.
--
-- @
--
-- data Action = HandleImageLoad ImageLoadEvent
--
-- view :: Model -> View Action
-- view model = image_ "url" [ onLoad HandleImageLoad ]
--
-- update :: Action -> Effect Model Action
-- update (HandleImageLoad ImageLoadEvent {..}) = do
--   io_ (consoleLog "image load event received")
--
-- @
--
onLoad :: (ImageLoadEvent -> action) -> Attribute action
onLoad :: forall action. (ImageLoadEvent -> action) -> Attribute action
onLoad ImageLoadEvent -> action
action = MisoString
-> Decoder ImageLoadEvent
-> (ImageLoadEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"bindload" Decoder ImageLoadEvent
imageLoadDecoder (\ImageLoadEvent
e DOMRef
_ -> ImageLoadEvent -> action
action ImageLoadEvent
e)
-----------------------------------------------------------------------------
-- | https://lynxjs.org/api/elements/built-in/image.html#binderror
--
-- Triggered when the image request fails, outputting the error message and code.
--
-- @
--
-- data Action = HandleImageError ImageErrorEvent
--
-- view :: Model -> View Action
-- view model = image_ "url" [ onError HandleImageError ]
--
-- update :: Action -> Effect Model Action
-- update (HandleImageError ImageErrorEvent {..}) = do
--   io_ (consoleLog "image error event received")
--
-- @
--
onError :: (ImageErrorEvent -> action) -> Attribute action
onError :: forall action. (ImageErrorEvent -> action) -> Attribute action
onError ImageErrorEvent -> action
action = MisoString
-> Decoder ImageErrorEvent
-> (ImageErrorEvent -> DOMRef -> action)
-> Attribute action
forall r action.
MisoString
-> Decoder r -> (r -> DOMRef -> action) -> Attribute action
on MisoString
"binderror" Decoder ImageErrorEvent
imageErrorDecoder (\ImageErrorEvent
e DOMRef
_ -> ImageErrorEvent -> action
action ImageErrorEvent
e)
-----------------------------------------------------------------------------
-- | Callback when an 'image_' fails to load
data ImageErrorEvent
  = ImageErrorEvent
  { ImageErrorEvent -> MisoString
errorMessage :: MisoString
    -- ^ error message
  , ImageErrorEvent -> Int
errorCode :: Int
    -- ^ error code
  , ImageErrorEvent -> Int
lynxCategorizedCode :: Int
    -- ^ lynx specific error code
  } deriving (Int -> ImageErrorEvent -> ShowS
[ImageErrorEvent] -> ShowS
ImageErrorEvent -> String
(Int -> ImageErrorEvent -> ShowS)
-> (ImageErrorEvent -> String)
-> ([ImageErrorEvent] -> ShowS)
-> Show ImageErrorEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageErrorEvent -> ShowS
showsPrec :: Int -> ImageErrorEvent -> ShowS
$cshow :: ImageErrorEvent -> String
show :: ImageErrorEvent -> String
$cshowList :: [ImageErrorEvent] -> ShowS
showList :: [ImageErrorEvent] -> ShowS
Show, ImageErrorEvent -> ImageErrorEvent -> Capture
(ImageErrorEvent -> ImageErrorEvent -> Capture)
-> (ImageErrorEvent -> ImageErrorEvent -> Capture)
-> Eq ImageErrorEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: ImageErrorEvent -> ImageErrorEvent -> Capture
== :: ImageErrorEvent -> ImageErrorEvent -> Capture
$c/= :: ImageErrorEvent -> ImageErrorEvent -> Capture
/= :: ImageErrorEvent -> ImageErrorEvent -> Capture
Eq)
-----------------------------------------------------------------------------
-- | Callback when an 'image_' succeeds in loading
data ImageLoadEvent
  = ImageLoadEvent
  { ImageLoadEvent -> Int
imageWidth :: Int
    -- ^ 'image_' width
  , ImageLoadEvent -> Int
imageHeight :: Int
    -- ^ 'image_' height
  } deriving (Int -> ImageLoadEvent -> ShowS
[ImageLoadEvent] -> ShowS
ImageLoadEvent -> String
(Int -> ImageLoadEvent -> ShowS)
-> (ImageLoadEvent -> String)
-> ([ImageLoadEvent] -> ShowS)
-> Show ImageLoadEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageLoadEvent -> ShowS
showsPrec :: Int -> ImageLoadEvent -> ShowS
$cshow :: ImageLoadEvent -> String
show :: ImageLoadEvent -> String
$cshowList :: [ImageLoadEvent] -> ShowS
showList :: [ImageLoadEvent] -> ShowS
Show, ImageLoadEvent -> ImageLoadEvent -> Capture
(ImageLoadEvent -> ImageLoadEvent -> Capture)
-> (ImageLoadEvent -> ImageLoadEvent -> Capture)
-> Eq ImageLoadEvent
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: ImageLoadEvent -> ImageLoadEvent -> Capture
== :: ImageLoadEvent -> ImageLoadEvent -> Capture
$c/= :: ImageLoadEvent -> ImageLoadEvent -> Capture
/= :: ImageLoadEvent -> ImageLoadEvent -> Capture
Eq)
-----------------------------------------------------------------------------
imageLoadDecoder :: Decoder ImageLoadEvent
imageLoadDecoder :: Decoder ImageLoadEvent
imageLoadDecoder = [MisoString
"detail"] [MisoString]
-> (Value -> Parser ImageLoadEvent) -> Decoder ImageLoadEvent
forall a. [MisoString] -> (Value -> Parser a) -> Decoder a
`at` Value -> Parser ImageLoadEvent
details
  where
    details :: Value -> Parser ImageLoadEvent
details = String
-> (Object -> Parser ImageLoadEvent)
-> Value
-> Parser ImageLoadEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"detail" ((Object -> Parser ImageLoadEvent)
 -> Value -> Parser ImageLoadEvent)
-> (Object -> Parser ImageLoadEvent)
-> Value
-> Parser ImageLoadEvent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Int -> Int -> ImageLoadEvent
ImageLoadEvent
        (Int -> Int -> ImageLoadEvent)
-> Parser Int -> Parser (Int -> ImageLoadEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width"
        Parser (Int -> ImageLoadEvent)
-> Parser Int -> Parser ImageLoadEvent
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 Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
-----------------------------------------------------------------------------
imageErrorDecoder :: Decoder ImageErrorEvent
imageErrorDecoder :: Decoder ImageErrorEvent
imageErrorDecoder = [MisoString
"detail"] [MisoString]
-> (Value -> Parser ImageErrorEvent) -> Decoder ImageErrorEvent
forall a. [MisoString] -> (Value -> Parser a) -> Decoder a
`at` Value -> Parser ImageErrorEvent
details
  where
    details :: Value -> Parser ImageErrorEvent
details = String
-> (Object -> Parser ImageErrorEvent)
-> Value
-> Parser ImageErrorEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"detail" ((Object -> Parser ImageErrorEvent)
 -> Value -> Parser ImageErrorEvent)
-> (Object -> Parser ImageErrorEvent)
-> Value
-> Parser ImageErrorEvent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      MisoString -> Int -> Int -> ImageErrorEvent
ImageErrorEvent
        (MisoString -> Int -> Int -> ImageErrorEvent)
-> Parser MisoString -> Parser (Int -> Int -> ImageErrorEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser MisoString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"errMsg"
        Parser (Int -> Int -> ImageErrorEvent)
-> Parser Int -> Parser (Int -> ImageErrorEvent)
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 Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error_code"
        Parser (Int -> ImageErrorEvent)
-> Parser Int -> Parser ImageErrorEvent
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 Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lynx_categorized_code"
-----------------------------------------------------------------------------