{-# 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
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)
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
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)
toActionInput :: (ViewAction a) => (Text -> a) -> Text
toActionInput :: forall a. ViewAction a => (Name -> a) -> Name
toActionInput Name -> a
con =
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
""
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
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
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