Event.hs

module Web.Hyperbole.HyperView.Event where

import Data.String.Conversions (cs)
import Data.Text (Text)
import Text.Casing (kebab)
import Web.Atomic.Types
import Web.Hyperbole.Data.Encoded
import Web.Hyperbole.HyperView.Handled
import Web.Hyperbole.HyperView.Types
import Web.Hyperbole.HyperView.ViewAction
import Web.Hyperbole.HyperView.ViewId
import Web.Hyperbole.View
import Web.Hyperbole.View.Types (ViewContext)


type DelayMs = Int


event :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Name -> Action id -> Attributes a -> Attributes a
event eventName a = att ("data-on" <> eventName) (encodedToText $ toAction a)


{- | Send the action after N milliseconds. Can be used to implement lazy loading or polling. See [Example.Page.Concurrent](https://docs.hyperbole.live/concurrent)

@
#EMBED Example/Page/Concurrency.hs viewTaskLoad
@
-}
onLoad :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Action id -> DelayMs -> Attributes a -> Attributes a
onLoad a delay = do
  event "load" a . att "data-delay" (cs $ show delay)


onClick :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Action id -> Attributes a -> Attributes a
onClick = event "click"


onDblClick :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Action id -> Attributes a -> Attributes a
onDblClick = event "dblclick"


onMouseEnter :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Action id -> Attributes a -> Attributes a
onMouseEnter = event "mouseenter"


onMouseLeave :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Action id -> Attributes a -> Attributes a
onMouseLeave = event "mouseleave"


{- | Run an action when the user types into an 'input' or 'textarea'.

WARNING: a short delay can result in poor performance. It is not recommended to set the 'value' of the input

> input (onInput OnSearch) 250 id
-}
onInput :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => (Text -> Action id) -> DelayMs -> Attributes a -> Attributes a
onInput a delay = do
  att "data-oninput" (encodedToText $ toActionInput a) . att "data-delay" (cs $ show delay)


-- WARNING: no way to do this generically right now, because toActionInput is specialized to Text
--   the change event DOES assume that the target has a string value
--   but, that doesn't let us implement dropdown
onChange :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => (value -> Action id) -> Attributes a -> Attributes a
onChange a = do
  att "data-onchange" (encodedToText $ toActionInput a)


onSubmit :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Action id -> Attributes a -> Attributes a
onSubmit = event "submit"


onKeyDown :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Key -> Action id -> Attributes a -> Attributes a
onKeyDown key act = do
  att ("data-on-keydown-" <> keyDataAttribute key) (encodedToText $ toAction act)


onKeyUp :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Key -> Action id -> Attributes a -> Attributes a
onKeyUp key act = do
  att ("data-on-keyup-" <> keyDataAttribute key) (encodedToText $ toAction act)


keyDataAttribute :: Key -> Text
keyDataAttribute = cs . kebab . showKey
 where
  showKey (OtherKey t) = cs t
  showKey k = show k


-- https://developer.mozilla.org/en-US/docs/Web/API/UI_Events/Keyboard_event_key_values
data Key
  = ArrowDown
  | ArrowUp
  | ArrowLeft
  | ArrowRight
  | Enter
  | Space
  | Escape
  | Alt
  | CapsLock
  | Control
  | Fn
  | Meta
  | Shift
  | OtherKey Text
  deriving (Show, Read)


-- | Serialize a constructor that expects a single input, like `data MyAction = GoSearch Text`
toActionInput :: (ViewAction a) => (val -> a) -> Encoded
toActionInput act =
  -- laziness should let us drop the last item?
  -- maybe... I bet it evaluates it strictly
  let Encoded con vals = toAction (act undefined)
   in if null vals
        then Encoded con vals
        else Encoded con (init vals)


-- | Internal
dataTarget :: (ViewId id, ViewContext a ~ id, Attributable a) => id -> Attributes a -> Attributes a
dataTarget = att "data-target" . encodedToText . toViewId


{- | Allow inputs to trigger actions for a different view

@
#EMBED Example/Page/Advanced.hs targetView
@
-}
target :: forall id ctx. (HyperViewHandled id ctx, ViewId id) => id -> View id () -> View ctx ()
target newId view = do
  addContext newId $ do
    view @ dataTarget newId