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 :: forall id a.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
Name -> Action id -> Attributes a -> Attributes a
event Name
eventName Action id
a = Name -> Name -> Attributes a -> Attributes a
forall h.
Attributable h =>
Name -> Name -> Attributes h -> Attributes h
att (Name
"data-on" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
eventName) (Encoded -> Name
encodedToText (Encoded -> Name) -> Encoded -> Name
forall a b. (a -> b) -> a -> b
$ Action id -> Encoded
forall a. ViewAction a => a -> Encoded
toAction Action id
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)

@
viewTaskLoad :: 'View' LazyData ()
viewTaskLoad = do
  -- 100ms after rendering, get the details
  'el' @ onLoad Details 100 ~ bg GrayLight . textAlign AlignCenter $ do
    text \"...\"
@
-}
onLoad :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Action id -> DelayMs -> Attributes a -> Attributes a
onLoad :: forall id a.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
Action id -> DelayMs -> Attributes a -> Attributes a
onLoad Action id
a DelayMs
delay = do
  Name -> Action id -> Attributes a -> Attributes a
forall id a.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
Name -> Action id -> Attributes a -> Attributes a
event Name
"load" Action id
a (Attributes a -> Attributes a)
-> (Attributes a -> Attributes a) -> Attributes a -> Attributes a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name -> Attributes a -> Attributes a
forall h.
Attributable h =>
Name -> Name -> Attributes h -> Attributes h
att Name
"data-delay" (String -> Name
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ DelayMs -> String
forall a. Show a => a -> String
show DelayMs
delay)


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


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


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


onMouseLeave :: (ViewAction (Action id), ViewContext a ~ id, Attributable a) => Action id -> Attributes a -> Attributes a
onMouseLeave :: forall id a.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
Action id -> Attributes a -> Attributes a
onMouseLeave = Name -> Action id -> Attributes a -> Attributes a
forall id a.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
Name -> Action id -> Attributes a -> Attributes a
event Name
"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 :: forall id a.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
(Name -> Action id) -> DelayMs -> Attributes a -> Attributes a
onInput Name -> Action id
a DelayMs
delay = do
  Name -> Name -> Attributes a -> Attributes a
forall h.
Attributable h =>
Name -> Name -> Attributes h -> Attributes h
att Name
"data-oninput" (Encoded -> Name
encodedToText (Encoded -> Name) -> Encoded -> Name
forall a b. (a -> b) -> a -> b
$ (Name -> Action id) -> Encoded
forall a val. ViewAction a => (val -> a) -> Encoded
toActionInput Name -> Action id
a) (Attributes a -> Attributes a)
-> (Attributes a -> Attributes a) -> Attributes a -> Attributes a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name -> Attributes a -> Attributes a
forall h.
Attributable h =>
Name -> Name -> Attributes h -> Attributes h
att Name
"data-delay" (String -> Name
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ DelayMs -> String
forall a. Show a => a -> String
show DelayMs
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 :: forall id a value.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
(value -> Action id) -> Attributes a -> Attributes a
onChange value -> Action id
a = do
  Name -> Name -> Attributes a -> Attributes a
forall h.
Attributable h =>
Name -> Name -> Attributes h -> Attributes h
att Name
"data-onchange" (Encoded -> Name
encodedToText (Encoded -> Name) -> Encoded -> Name
forall a b. (a -> b) -> a -> b
$ (value -> Action id) -> Encoded
forall a val. ViewAction a => (val -> a) -> Encoded
toActionInput value -> Action id
a)


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


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


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


keyDataAttribute :: Key -> Text
keyDataAttribute :: Key -> Name
keyDataAttribute = String -> Name
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Name) -> (Key -> String) -> Key -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
kebab (String -> String) -> (Key -> String) -> Key -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> String
showKey
 where
  showKey :: Key -> String
showKey (OtherKey Name
t) = Name -> String
forall a b. ConvertibleStrings a b => a -> b
cs Name
t
  showKey Key
k = Key -> String
forall a. Show a => a -> String
show Key
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 (DelayMs -> Key -> String -> String
[Key] -> String -> String
Key -> String
(DelayMs -> Key -> String -> String)
-> (Key -> String) -> ([Key] -> String -> String) -> Show Key
forall a.
(DelayMs -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: DelayMs -> Key -> String -> String
showsPrec :: DelayMs -> Key -> String -> String
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> String -> String
showList :: [Key] -> String -> String
Show, ReadPrec [Key]
ReadPrec Key
DelayMs -> ReadS Key
ReadS [Key]
(DelayMs -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key
forall a.
(DelayMs -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: DelayMs -> ReadS Key
readsPrec :: DelayMs -> ReadS Key
$creadList :: ReadS [Key]
readList :: ReadS [Key]
$creadPrec :: ReadPrec Key
readPrec :: ReadPrec Key
$creadListPrec :: ReadPrec [Key]
readListPrec :: ReadPrec [Key]
Read)


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


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


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

@
targetView :: 'View' Controls ()
targetView = do
  target Message $ do
    'button' (SetMessage \"Targeted!\") ~ btn $ \"Target SetMessage\"
@
-}
target :: forall id ctx. (HyperViewHandled id ctx, ViewId id) => id -> View id () -> View ctx ()
target :: forall id ctx.
(HyperViewHandled id ctx, ViewId id) =>
id -> View id () -> View ctx ()
target id
newId View id ()
view = do
  id -> View id () -> View ctx ()
forall ctx c. ctx -> View ctx () -> View c ()
addContext id
newId (View id () -> View ctx ()) -> View id () -> View ctx ()
forall a b. (a -> b) -> a -> b
$ do
    View id ()
view View id ()
-> (Attributes (View id ()) -> Attributes (View id ()))
-> View id ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ id -> Attributes (View id ()) -> Attributes (View id ())
forall id a.
(ViewId id, ViewContext a ~ id, Attributable a) =>
id -> Attributes a -> Attributes a
dataTarget id
newId