{-# LANGUAGE DeriveFunctor #-}

module Text.Blaze.Front.Event
    ( -- * Event handling
      mapActions

      -- ** Keyboard events
    , onKeyDown
    , onKeyUp
    , onKeyPress
    , onEnter

      -- ** Focus events
    , onFocus
    , onBlur

      -- ** Form events
    , onValueChange
    , onCheckedChange
    , onSelectedChange
    , onSubmit

      -- ** Mouse events
    , onClick
    , onDoubleClick
    , onMouseDown
    , onMouseUp
    , onMouseMove
    , onMouseEnter
    , onMouseLeave
    , onMouseOver
    , onMouseOut

      -- ** UI Events
    , onScroll

      -- ** Wheel Events
    , onWheel

    ) where

import           Prelude
import           Text.Blaze.Front.Internal (Attribute (..), Markup,
                                            MarkupM (..))

import           Bridge

-- | Modify all event handlers attached to a 'Markup' tree so that the given
-- function is applied to the return values of their callbacks.
mapActions :: (act -> act') -> Markup act -> Markup act'
mapActions :: (act -> act') -> Markup act -> Markup act'
mapActions = (act -> act') -> Markup act -> Markup act'
forall act a act'. (act' -> act) -> MarkupM act' a -> MarkupM act a
MapActions

-- Keyboard events
-------------------------------------------------------------------------------

-- | The user has pressed a physical key while the target element was focused.
onKeyDown :: act -> Attribute act
onKeyDown :: act -> Attribute act
onKeyDown = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnKeyDown

-- | The user has released a phyiscal key while the target element was focused.
onKeyUp :: act -> Attribute act
onKeyUp :: act -> Attribute act
onKeyUp = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnKeyUp

-- | The user has input some ASCII character while the target element was focused.
onKeyPress :: act -> Attribute act
onKeyPress :: act -> Attribute act
onKeyPress = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnKeyPress

-- | The user has pressed <Enter> while the target element was focused.
onEnter :: act -> Attribute act
onEnter :: act -> Attribute act
onEnter = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnEnter

-- Focus events
-------------------------------------------------------------------------------

-- | The focus has moved to the target element.
onFocus :: act -> Attribute act
onFocus :: act -> Attribute act
onFocus = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnFocus

-- | The focus has left the target element.
onBlur :: act -> Attribute act
onBlur :: act -> Attribute act
onBlur = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnBlur

-- Form events
-------------------------------------------------------------------------------

-- | The 'value' property of the target element has changed. The new value is
-- passed as a parameter to the callback. This handler is supported for
-- <input>, <textarea>, and <select> elements.
onValueChange :: act -> Attribute act
onValueChange :: act -> Attribute act
onValueChange = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnValueChange

-- | The 'checked' property of the target element has changed. This handler is
-- supported for <input> elements of type 'checkbox' or 'radio'.
onCheckedChange :: act -> Attribute act
onCheckedChange :: act -> Attribute act
onCheckedChange = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnCheckedChange

-- | The 'selected' property of the the target element has changed. This
-- handler is supported for <option> elements.
onSelectedChange :: act -> Attribute act
onSelectedChange :: act -> Attribute act
onSelectedChange = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnSelectedChange

-- | The user has submitted the target form. This handler is supported for
-- <form> elements.
onSubmit :: act -> Attribute act
onSubmit :: act -> Attribute act
onSubmit = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnSubmit

-- Mouse events
-------------------------------------------------------------------------------

-- | A simplified version of 'onClick' which watches for the 'LeftButton' only
-- and ignores the cursor position.
onClick :: act -> Attribute act
onClick :: act -> Attribute act
onClick = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnClick

-- | A simplified version of 'onDoubleClick' which watches for the 'LeftButton'
-- only and ignores the cursor position.
onDoubleClick :: act -> Attribute act
onDoubleClick :: act -> Attribute act
onDoubleClick = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnDoubleClick

-- | A simplified version of 'onMouseDown' which watches for the 'LeftButton'
-- only and ignores the cursor position.
onMouseDown :: act -> Attribute act
onMouseDown :: act -> Attribute act
onMouseDown = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnMouseDown

-- | A simplified version of 'onMouseUp' which watches for the 'LeftButton'
-- only and ignores the cursor position.
onMouseUp :: act -> Attribute act
onMouseUp :: act -> Attribute act
onMouseUp = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnMouseUp

-- | The mouse cursor has moved while positioned over the target element. The
-- mouse position at the time the event was fired is passed as a parameter to
-- the callback.
onMouseMove :: act -> Attribute act
onMouseMove :: act -> Attribute act
onMouseMove = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnMouseMove

-- | The mouse cursor has entered the region occupied by the target element.
-- The mouse position at the time the event was fired is passed as a parameter
-- to the callback.
onMouseEnter :: act -> Attribute act
onMouseEnter :: act -> Attribute act
onMouseEnter = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnMouseEnter

-- | The mouse cursor has left the region occupied by the target element. The
-- mouse position at the time the event was fired is passed as a parameter to
-- the callback.
onMouseLeave :: act -> Attribute act
onMouseLeave :: act -> Attribute act
onMouseLeave = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnMouseLeave

-- | Like MouseEnter, but handles bubbling differently.
onMouseOver :: act -> Attribute act
onMouseOver :: act -> Attribute act
onMouseOver = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnMouseOver

-- | Like MouseLeave, but handles bubbling differently.
onMouseOut :: act -> Attribute act
onMouseOut :: act -> Attribute act
onMouseOut = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnMouseOut

-- UI events
-------------------------------------------------------------------------------

-- | The the scroll-position of the page has changed. The amount by which it
-- has changed (in lines) is passed as a parameter to the callback.
onScroll :: act -> Attribute act
onScroll :: act -> Attribute act
onScroll = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnScroll

-- Wheel events
-------------------------------------------------------------------------------

-- | The user has moved the scroll-wheel. The amount by which the scroll
-- position of an infinitely large page is affected is passed as a parameter to
-- the callback.
onWheel :: act -> Attribute act
onWheel :: act -> Attribute act
onWheel = EventHandler act -> Attribute act
forall act. EventHandler act -> Attribute act
onEvent (EventHandler act -> Attribute act)
-> (act -> EventHandler act) -> act -> Attribute act
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> EventHandler act
forall a. a -> EventHandler a
OnWheel


-------------------------------------------------------------------------------
-- Internal
-------------------------------------------------------------------------------

-- | Register an event handler.
onEvent :: EventHandler act -> Attribute act
onEvent :: EventHandler act -> Attribute act
onEvent eh :: EventHandler act
eh = (forall a. MarkupM act a -> MarkupM act a) -> Attribute act
forall ev. (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
Attribute (EventHandler act -> MarkupM act a -> MarkupM act a
forall act a. EventHandler act -> MarkupM act a -> MarkupM act a
OnEvent EventHandler act
eh)
{-# INLINE onEvent #-}