{-# LANGUAGE LambdaCase #-}

module Web.Hyperbole.View.Event where

import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text qualified as T
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

@
pollMessageView :: Text -> 'View' Message ()
pollMessageView m = do
  onLoad LoadMessage 1000 $ do
    'el' 'bold' "Current Message. Reloading in 1s"
    'el_' ('text' m)
@
-}
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)


-- addDataKey :: Key -> Mod c
-- addDataKey k atts =
--   atts{other = M.alter merge "data-key" atts.other}
--  where
--   merge :: Maybe AttValue -> Maybe AttValue
--   merge Nothing = pure $ toKeyValue k
--   merge (Just keys) = pure $ toKeyValue k <> " " <> keys

-- let keyAtt = "data-" <> keyDataAttribute key

-- | 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 =
  -- remove the ' ""' at the end of the constructor
  DelayMs -> Name -> Name
T.dropEnd DelayMs
3 (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ a -> Name
forall a. ViewAction a => a -> Name
toAction (a -> Name) -> a -> Name
forall a b. (a -> b) -> a -> b
$ Name -> a
con Name
""


{- | Apply a Mod only when a request is in flight

@
myView = do
  el (hide . onRequest flexCol) 'el_' "Loading..."
  el (onRequest hide) "Loaded"
@
-}
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


{- | Trigger actions for another view. They will update the view specified

> otherView :: View OtherView ()
> otherView = do
>   el_ "This is not a message view"
>   button OtherAction id "Do Something"
>
>   target (Message 2) $ do
>     el_ "Now we can trigger a MessageAction which will update our Message HyperView, not this one"
>     button ClearMessage id "Clear Message #2"
-}
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