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.View


type DelayMs = Int


event :: (ViewAction (Action id), Attributable a) => Name -> Action id -> Attributes a -> Attributes a
event :: forall id a.
(ViewAction (Action id), Attributable a) =>
Name -> Action id -> Attributes a -> Attributes a
event Name
nm Action id
a = Name -> Name -> Attributes a -> Attributes a
forall h.
Attributable h =>
Name -> Name -> Attributes h -> Attributes h
att (Name -> Name
eventName Name
nm) (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)


eventName :: Text -> Name
eventName :: Name -> Name
eventName Name
t = Name
"data-on" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
t


{- | Send the action after N milliseconds. Can be used to implement lazy loading or polling.

@
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), Attributable a) => Action id -> DelayMs -> Attributes a -> Attributes a
onLoad :: forall id a.
(ViewAction (Action 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), 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), Attributable a) => Action id -> Attributes a -> Attributes a
onClick :: forall id a.
(ViewAction (Action id), Attributable a) =>
Action id -> Attributes a -> Attributes a
onClick = Name -> Action id -> Attributes a -> Attributes a
forall id a.
(ViewAction (Action id), Attributable a) =>
Name -> Action id -> Attributes a -> Attributes a
event Name
"click"


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


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


onMouseLeave :: (ViewAction (Action id), Attributable a) => Action id -> Attributes a -> Attributes a
onMouseLeave :: forall id a.
(ViewAction (Action id), Attributable a) =>
Action id -> Attributes a -> Attributes a
onMouseLeave = Name -> Action id -> Attributes a -> Attributes a
forall id a.
(ViewAction (Action 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), Attributable a) => (Text -> Action id) -> DelayMs -> Attributes a -> Attributes a
onInput :: forall id a.
(ViewAction (Action 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 -> Name
eventName Name
"input") (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), Attributable a) => (value -> Action id) -> Attributes a -> Attributes a
onChange :: forall id a value.
(ViewAction (Action 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 -> Name
eventName Name
"change") (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), Attributable a) => Action id -> Attributes a -> Attributes a
onSubmit :: forall id a.
(ViewAction (Action id), Attributable a) =>
Action id -> Attributes a -> Attributes a
onSubmit = Name -> Action id -> Attributes a -> Attributes a
forall id a.
(ViewAction (Action id), Attributable a) =>
Name -> Action id -> Attributes a -> Attributes a
event Name
"submit"


onKeyDown :: (ViewAction (Action id), Attributable a) => Key -> Action id -> Attributes a -> Attributes a
onKeyDown :: forall id a.
(ViewAction (Action id), Attributable a) =>
Key -> Action id -> Attributes a -> Attributes a
onKeyDown Key
key = do
  Name -> Action id -> Attributes a -> Attributes a
forall id a.
(ViewAction (Action id), Attributable a) =>
Name -> Action id -> Attributes a -> Attributes a
event (Name
"keydown-" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Key -> Name
keyDataAttribute Key
key)


onKeyUp :: (ViewAction (Action id), Attributable a) => Key -> Action id -> Attributes a -> Attributes a
onKeyUp :: forall id a.
(ViewAction (Action id), Attributable a) =>
Key -> Action id -> Attributes a -> Attributes a
onKeyUp Key
key = do
  Name -> Action id -> Attributes a -> Attributes a
forall id a.
(ViewAction (Action id), Attributable a) =>
Name -> Action id -> Attributes a -> Attributes a
event (Name
"keyup-" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Key -> Name
keyDataAttribute Key
key)


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, Attributable a) => id -> Attributes a -> Attributes a
dataTarget :: forall id a.
(ViewId 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 Targeted () $ do
    'button' (SetMessage \"Targeted!\") ~ btn $ \"Target SetMessage\"
@
-}
target :: forall id ctx. (HyperViewHandled id ctx, ViewId id) => id -> ViewState id -> View id () -> View ctx ()
target :: forall id ctx.
(HyperViewHandled id ctx, ViewId id) =>
id -> ViewState id -> View id () -> View ctx ()
target id
newId ViewState id
st View id ()
view = do
  id -> ViewState id -> View id () -> View ctx ()
forall ctx c. ctx -> ViewState ctx -> View ctx () -> View c ()
runViewContext id
newId ViewState id
st (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, Attributable a) =>
id -> Attributes a -> Attributes a
dataTarget id
newId