module Web.Hyperbole.HyperView.Input where

import Data.String.Conversions (cs)
import Data.Text (Text)
import Web.Atomic.Types
import Web.Hyperbole.Data.Param (ParamValue (..), ToParam (..))
import Web.Hyperbole.HyperView.Event (DelayMs, onChange, onClick, onInput)
import Web.Hyperbole.HyperView.Types (HyperView (..))
import Web.Hyperbole.HyperView.ViewAction (ViewAction (..))
import Web.Hyperbole.Route (Route (..), routeUri)
import Web.Hyperbole.View


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

@
messageView :: Text -> 'View' Message ()
messageView msg = do
  'button' (Louder msg) ~ border 1 $ text msg
@
-}
button :: (ViewAction (Action id)) => Action id -> View id () -> View id ()
button :: forall id.
ViewAction (Action id) =>
Action id -> View id () -> View id ()
button Action id
action View id ()
cnt = do
  Text -> View id () -> View id ()
forall c. Text -> View c () -> View c ()
tag Text
"button" View id ()
cnt View id ()
-> (Attributes (View id ()) -> Attributes (View id ()))
-> View id ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Action id -> Attributes (View id ()) -> Attributes (View id ())
forall id a.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
Action id -> Attributes a -> Attributes a
onClick Action id
action


-- tag "button" @ att "whatber" "asdf" $ cnt

-- {- | \<input type="checkbox"\> which toggles automatically
--
-- > toggle True SetIsSelected id
-- -}
-- toggle :: (ViewAction (Action id)) => Bool -> (Bool -> Action id) -> Mod id -> View id ()
-- toggle isSelected clickAction f = do
--   tag "input" (att "type" "checkbox" . checked isSelected . onClick (clickAction (not isSelected)) . f) none

{- | Type-safe dropdown. Sends (opt -> Action id) when selected. The default will be selected.

▶️ [Filter](https://hyperbole.live/data/filter)

@
familyDropdown :: Filters -> 'View' Languages ()
familyDropdown filters =
  dropdown SetFamily filters.family ~ border 1 . pad 10 $ do
    option Nothing \"Any\"
    option (Just ObjectOriented) \"Object Oriented\"
    option (Just Functional) \"Functional\"
@
-}
dropdown
  :: (ViewAction (Action id))
  => (opt -> Action id)
  -> opt -- default option
  -> View (Option opt id) ()
  -> View id ()
dropdown :: forall id opt.
ViewAction (Action id) =>
(opt -> Action id) -> opt -> View (Option opt id) () -> View id ()
dropdown opt -> Action id
act opt
defOpt View (Option opt id) ()
options = do
  Text -> View id () -> View id ()
forall c. Text -> View c () -> View c ()
tag Text
"select" (View id () -> View id ())
-> (Attributes (View id () -> View id ())
    -> Attributes (View id () -> View id ()))
-> View id ()
-> View id ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ (opt -> Action id)
-> Attributes (View id () -> View id ())
-> Attributes (View id () -> View id ())
forall id a value.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
(value -> Action id) -> Attributes a -> Attributes a
onChange opt -> Action id
act (View id () -> View id ()) -> View id () -> View id ()
forall a b. (a -> b) -> a -> b
$ do
    Option opt id -> View (Option opt id) () -> View id ()
forall ctx c. ctx -> View ctx () -> View c ()
addContext (opt -> Option opt id
forall {k} opt (id :: k). opt -> Option opt id
Option opt
defOpt) View (Option opt id) ()
options


-- | An option for a 'dropdown' or 'select'
option
  :: (ViewAction (Action id), Eq opt, ToParam opt)
  => opt
  -> Text
  -> View (Option opt id) ()
option :: forall id opt.
(ViewAction (Action id), Eq opt, ToParam opt) =>
opt -> Text -> View (Option opt id) ()
option opt
opt Text
cnt = do
  Option opt id
os <- View (Option opt id) (Option opt id)
forall c. View c c
context
  Text -> View (Option opt id) () -> View (Option opt id) ()
forall c. Text -> View c () -> View c ()
tag Text
"option" (View (Option opt id) () -> View (Option opt id) ())
-> (Attributes (View (Option opt id) () -> View (Option opt id) ())
    -> Attributes (View (Option opt id) () -> View (Option opt id) ()))
-> View (Option opt id) ()
-> View (Option opt id) ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Text
-> Text
-> Attributes (View (Option opt id) () -> View (Option opt id) ())
-> Attributes (View (Option opt id) () -> View (Option opt id) ())
forall h.
Attributable h =>
Text -> Text -> Attributes h -> Attributes h
att Text
"value" (opt -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam opt
opt).value (View (Option opt id) () -> View (Option opt id) ())
-> (Attributes (View (Option opt id) () -> View (Option opt id) ())
    -> Attributes (View (Option opt id) () -> View (Option opt id) ()))
-> View (Option opt id) ()
-> View (Option opt id) ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Bool
-> Attributes (View (Option opt id) () -> View (Option opt id) ())
-> Attributes (View (Option opt id) () -> View (Option opt id) ())
forall h. Attributable h => Bool -> Attributes h -> Attributes h
selected (Option opt id
os.defaultOption opt -> opt -> Bool
forall a. Eq a => a -> a -> Bool
== opt
opt) (View (Option opt id) () -> View (Option opt id) ())
-> View (Option opt id) () -> View (Option opt id) ()
forall a b. (a -> b) -> a -> b
$ Text -> View (Option opt id) ()
forall c. Text -> View c ()
text Text
cnt


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


-- | The view context for an 'option'
data Option opt id = Option
  { forall {k} opt (id :: k). Option opt id -> opt
defaultOption :: opt
  }


{- | A live search field. Set a DelayMs to avoid hitting the server on every keystroke

@
viewSearchUsers :: 'View' Users ()
viewSearchUsers = do
  'el' \"Search for a user by id\"
  search SearchUser 250 ~ border 1 . pad 10 @ placeholder \"2\"
@
-}
search :: (ViewAction (Action id)) => (Text -> Action id) -> DelayMs -> View id ()
search :: forall id.
ViewAction (Action id) =>
(Text -> Action id) -> DelayMs -> View id ()
search Text -> Action id
go DelayMs
delay = do
  Text -> View id () -> View id ()
forall c. Text -> View c () -> View c ()
tag Text
"input" View id ()
forall c. View c ()
none View id ()
-> (Attributes (View id ()) -> Attributes (View id ()))
-> View id ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ (Text -> Action id)
-> DelayMs -> Attributes (View id ()) -> Attributes (View id ())
forall id a.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
(Text -> Action id) -> DelayMs -> Attributes a -> Attributes a
onInput Text -> Action id
go DelayMs
delay


-- | Set checkbox = checked via the client (VDOM doesn't work)
checked :: (Attributable a) => Bool -> Attributes a -> Attributes a
checked :: forall h. Attributable h => Bool -> Attributes h -> Attributes h
checked Bool
c =
  Text -> Text -> Attributes a -> Attributes a
forall h.
Attributable h =>
Text -> Text -> Attributes h -> Attributes h
att Text
"data-checked" (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
c)
    (Attributes a -> Attributes a)
-> (Attributes a -> Attributes a) -> Attributes a -> Attributes a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. if Bool
c then Text -> Text -> Attributes a -> Attributes a
forall h.
Attributable h =>
Text -> Text -> Attributes h -> Attributes h
att Text
"checked" Text
"" else Attributes a -> Attributes a
forall a. a -> a
id


{- | A hyperlink to another route

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