{-# LANGUAGE LambdaCase #-}

module Web.Hyperbole.View.Event where

import Data.String.Conversions (cs)
import Data.Text (Text)
import Text.Casing (kebab)
import Web.Hyperbole.HyperView
import Web.View (Mod, View, addContext, att, parent)
import Web.View.Types (Content (Node), Element (..))
import Web.View.View (viewModContents)


type DelayMs = Int


{- | 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)) => Action id -> DelayMs -> Mod id
onLoad :: forall id. ViewAction (Action id) => Action id -> DelayMs -> Mod id
onLoad Action id
a DelayMs
delay = do
  Name -> Name -> Mod id
forall c. Name -> Name -> Mod c
att Name
"data-on-load" (Action id -> Name
forall a. ViewAction a => a -> Name
toAction Action id
a) Mod id -> Mod id -> Mod id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name -> Mod id
forall c. Name -> Name -> Mod c
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)) => Action id -> Mod id
onClick :: forall id. ViewAction (Action id) => Action id -> Mod id
onClick Action id
a = do
  Name -> Name -> Mod id
forall c. Name -> Name -> Mod c
att Name
"data-on-click" (Action id -> Name
forall a. ViewAction a => a -> Name
toAction Action id
a)


onDblClick :: (ViewAction (Action id)) => Action id -> Mod id
onDblClick :: forall id. ViewAction (Action id) => Action id -> Mod id
onDblClick Action id
a = do
  Name -> Name -> Mod id
forall c. Name -> Name -> Mod c
att Name
"data-on-dblclick" (Action id -> Name
forall a. ViewAction a => a -> Name
toAction Action id
a)


{- | 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)) => (Text -> Action id) -> DelayMs -> Mod id
onInput :: forall id.
ViewAction (Action id) =>
(Name -> Action id) -> DelayMs -> Mod id
onInput Name -> Action id
a DelayMs
delay = do
  Name -> Name -> Mod id
forall c. Name -> Name -> Mod c
att Name
"data-on-input" ((Name -> Action id) -> Name
forall a. ViewAction a => (Name -> a) -> Name
toActionInput Name -> Action id
a) Mod id -> Mod id -> Mod id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name -> Mod id
forall c. Name -> Name -> Mod c
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)


onSubmit :: (ViewAction (Action id)) => Action id -> Mod id
onSubmit :: forall id. ViewAction (Action id) => Action id -> Mod id
onSubmit Action id
act = do
  Name -> Name -> Mod id
forall c. Name -> Name -> Mod c
att Name
"data-on-submit" (Action id -> Name
forall a. ViewAction a => a -> Name
toAction Action id
act)


onKeyDown :: (ViewAction (Action id)) => Key -> Action id -> Mod id
onKeyDown :: forall id. ViewAction (Action id) => Key -> Action id -> Mod id
onKeyDown Key
key Action id
act = do
  Name -> Name -> Mod id
forall c. Name -> Name -> Mod c
att (Name
"data-on-keydown-" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Key -> Name
keyDataAttribute Key
key) (Action id -> Name
forall a. ViewAction a => a -> Name
toAction Action id
act)


onKeyUp :: (ViewAction (Action id)) => Key -> Action id -> Mod id
onKeyUp :: forall id. ViewAction (Action id) => Key -> Action id -> Mod id
onKeyUp Key
key Action id
act = do
  Name -> Name -> Mod id
forall c. Name -> Name -> Mod c
att (Name
"data-on-keyup-" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Key -> Name
keyDataAttribute Key
key) (Action id -> Name
forall a. ViewAction a => a -> Name
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 'Text', like `data MyAction = GoSearch Text`
toActionInput :: (ViewAction a) => (Text -> a) -> Text
toActionInput :: forall a. ViewAction a => (Name -> a) -> Name
toActionInput Name -> a
con =
  let marker :: Name
marker = Name
"%HYP-INP%"
   in a -> Name
forall a. ViewAction a => a -> Name
toAction (a -> Name) -> a -> Name
forall a b. (a -> b) -> a -> b
$ Name -> a
con Name
marker


{- | Apply a Mod only when a request is in flight. See [Example.Page.Contact](https://docs.hyperbole.live/contacts/1)

@
contactEditView :: User -> 'View' Contact ()
contactEditView u = do
  'el' (hide . onRequest flexCol) contactLoading
  'el' (onRequest hide) $ contactEdit 'View' Save u
@
-}
onRequest :: Mod id -> Mod id
onRequest :: forall id. Mod id -> Mod id
onRequest Mod id
f = do
  Name -> Mod id -> Mod id
forall c. Name -> Mod c -> Mod c
parent Name
"hyp-loading" Mod id
f


-- | Internal
dataTarget :: (ViewId a) => a -> Mod x
dataTarget :: forall a x. ViewId a => a -> Mod x
dataTarget = Name -> Name -> Mod x
forall c. Name -> Name -> Mod c
att Name
"data-target" (Name -> Mod x) -> (a -> Name) -> a -> Mod x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Name
forall a. ViewId a => a -> Name
toViewId


-- | Allow inputs to trigger actions for a different view
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 context c. context -> View context () -> View c ()
addContext id
newId (View id () -> View ctx ()) -> View id () -> View ctx ()
forall a b. (a -> b) -> a -> b
$ do
    View id ()
view
    ([Content] -> [Content]) -> View id ()
forall context. ([Content] -> [Content]) -> View context ()
viewModContents ((Content -> Content) -> [Content] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Content -> Content
addDataTarget)
 where
  addDataTarget :: Content -> Content
  addDataTarget :: Content -> Content
addDataTarget = \case
    Node Element
elm ->
      Element -> Content
Node (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$
        let atts :: Attributes ()
atts = Element
elm.attributes
         in Element
elm{attributes = dataTarget newId atts}
    Content
cnt -> Content
cnt