module Web.Hyperbole.View.Element where

import Data.Text (Text)
import Web.Hyperbole.HyperView (HyperView (..), ViewAction (..))
import Web.Hyperbole.Route (Route (..), routeUrl)
import Web.Hyperbole.View.Event (DelayMs, onClick, onInput)
import Web.View hiding (Query, Segment, button, cssResetEmbed, form, input, label)


{- | \<button\> HTML tag which sends the action when pressed

> button SomeAction (border 1) "Click Me"
-}
button :: (ViewAction (Action id)) => Action id -> Mod id -> View id () -> View id ()
button :: forall id.
ViewAction (Action id) =>
Action id -> Mod id -> View id () -> View id ()
button Action id
action Mod id
f View id ()
cd = do
  Text -> Mod id -> View id () -> View id ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"button" (Action id -> Mod id
forall id. ViewAction (Action id) => Action id -> Mod id
onClick Action id
action Mod id -> Mod id -> Mod id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod id
f) View id ()
cd


{- | Type-safe dropdown. Sends (opt -> Action id) when selected. The selection predicate (opt -> Bool) controls which option is selected. See [Example.Contacts](https://github.com/seanhess/hyperbole/blob/main/example/Example/Contacts.hs)

@
data ContactsAction
  = Reload (Maybe Filter)
  | Delete Int
  deriving (Generic, Param)

allContactsView :: Maybe Filter -> View Contacts ()
allContactsView fil = do
  row (gap 10) $ do
    el (pad 10) "Filter: "
    dropdown Reload (== fil) id $ do
      option Nothing ""
      option (Just Active) "Active!"
      option (Just Inactive) \"Inactive\"
  ...
@
-}
dropdown
  :: (ViewAction (Action id))
  => (opt -> Action id)
  -> (opt -> Bool) -- check if selec
  -> Mod id
  -> View (Option opt id (Action id)) ()
  -> View id ()
dropdown :: forall id opt.
ViewAction (Action id) =>
(opt -> Action id)
-> (opt -> Bool)
-> Mod id
-> View (Option opt id (Action id)) ()
-> View id ()
dropdown opt -> Action id
act opt -> Bool
isSel Mod id
f View (Option opt id (Action id)) ()
options = do
  Text -> Mod id -> View id () -> View id ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"select" (Text -> Text -> Mod id
forall c. Text -> Text -> Mod c
att Text
"data-on-change" Text
"" Mod id -> Mod id -> Mod id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod id
f) (View id () -> View id ()) -> View id () -> View id ()
forall a b. (a -> b) -> a -> b
$ do
    Option opt id (Action id)
-> View (Option opt id (Action id)) () -> View id ()
forall context c. context -> View context () -> View c ()
addContext ((opt -> Action id) -> (opt -> Bool) -> Option opt id (Action id)
forall {k} opt (id :: k) action.
(opt -> action) -> (opt -> Bool) -> Option opt id action
Option opt -> Action id
act opt -> Bool
isSel) View (Option opt id (Action id)) ()
options


-- | An option for a 'dropdown'. First argument is passed to (opt -> Action id) in the 'dropdown', and to the selected predicate
option
  :: (ViewAction (Action id), Eq opt)
  => opt
  -> View (Option opt id (Action id)) ()
  -> View (Option opt id (Action id)) ()
option :: forall id opt.
(ViewAction (Action id), Eq opt) =>
opt
-> View (Option opt id (Action id)) ()
-> View (Option opt id (Action id)) ()
option opt
opt View (Option opt id (Action id)) ()
cnt = do
  Option opt id (Action id)
os <- View (Option opt id (Action id)) (Option opt id (Action id))
forall context. View context context
context
  Text
-> Mod (Option opt id (Action id))
-> View (Option opt id (Action id)) ()
-> View (Option opt id (Action id)) ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"option" (Text -> Text -> Mod (Option opt id (Action id))
forall c. Text -> Text -> Mod c
att Text
"value" (Action id -> Text
forall a. ViewAction a => a -> Text
toAction (Option opt id (Action id)
os.toAction opt
opt)) Mod (Option opt id (Action id))
-> Mod (Option opt id (Action id))
-> Mod (Option opt id (Action id))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Mod (Option opt id (Action id))
forall id. Bool -> Mod id
selected (Option opt id (Action id)
os.selected opt
opt)) View (Option opt id (Action id)) ()
cnt


-- | sets selected = true if the 'dropdown' predicate returns True
selected :: Bool -> Mod id
selected :: forall id. Bool -> Mod id
selected Bool
b = if Bool
b then Text -> Text -> Attributes id -> Attributes id
forall c. Text -> Text -> Mod c
att Text
"selected" Text
"true" else Attributes id -> Attributes id
forall a. a -> a
id


-- | The view context for an 'option'
data Option opt id action = Option
  { forall {k} opt (id :: k) action.
Option opt id action -> opt -> action
toAction :: opt -> action
  , forall {k} opt (id :: k) action.
Option opt id action -> opt -> Bool
selected :: opt -> Bool
  }


-- | A live search field
search :: (ViewAction (Action id)) => (Text -> Action id) -> DelayMs -> Mod id -> View id ()
search :: forall id.
ViewAction (Action id) =>
(Text -> Action id) -> DelayMs -> Mod id -> View id ()
search Text -> Action id
go DelayMs
delay Mod id
f = do
  Text -> Mod id -> View id () -> View id ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"input" ((Text -> Action id) -> DelayMs -> Mod id
forall id.
ViewAction (Action id) =>
(Text -> Action id) -> DelayMs -> Mod id
onInput Text -> Action id
go DelayMs
delay Mod id -> Mod id -> Mod id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod id
f) View id ()
forall c. View c ()
none


{- | A hyperlink to another route

>>> route (User 100) id "View User"
<a href="/user/100">View User</a>
-}
route :: (Route a) => a -> Mod c -> View c () -> View c ()
route :: forall a c. Route a => a -> Mod c -> View c () -> View c ()
route a
r = Url -> Mod c -> View c () -> View c ()
forall c. Url -> Mod c -> View c () -> View c ()
link (a -> Url
forall a. Route a => a -> Url
routeUrl a
r)