Better forms.

This commit is contained in:
Philippe Pittoli 2023-07-15 03:23:21 +02:00
parent 4767bd186c
commit e60664b522
6 changed files with 53 additions and 30 deletions

View File

@ -98,7 +98,7 @@ render { addUserForm, wsUp }
render_adduser_form = HH.form render_adduser_form = HH.form
[ HE.onSubmit PreventSubmit ] [ HE.onSubmit PreventSubmit ]
[ Bulma.box_input "User login" "login" -- title, placeholder [ Bulma.box_input "login" "User login" "login" -- title, placeholder
(HandleAddUserInput <<< ADDUSER_INP_login) -- action (HandleAddUserInput <<< ADDUSER_INP_login) -- action
addUserForm.login -- value addUserForm.login -- value
true -- validity (TODO) true -- validity (TODO)
@ -108,12 +108,12 @@ render { addUserForm, wsUp }
(HandleAddUserInput ADDUSER_toggle_admin) -- action1 (HandleAddUserInput ADDUSER_toggle_admin) -- action1
(HandleAddUserInput ADDUSER_toggle_admin) -- action2 (HandleAddUserInput ADDUSER_toggle_admin) -- action2
true -- validity true -- validity
, Bulma.box_input "User email" "email" -- title, placeholder , Bulma.box_input "email" "User email" "email" -- title, placeholder
(HandleAddUserInput <<< ADDUSER_INP_email) -- action (HandleAddUserInput <<< ADDUSER_INP_email) -- action
addUserForm.email -- value addUserForm.email -- value
true -- validity (TODO) true -- validity (TODO)
should_be_disabled -- condition should_be_disabled -- condition
, Bulma.box_password "User password" "password" -- title, placeholder , Bulma.box_password "password" "User password" "password" -- title, placeholder
(HandleAddUserInput <<< ADDUSER_INP_pass) -- action (HandleAddUserInput <<< ADDUSER_INP_pass) -- action
addUserForm.pass -- value addUserForm.pass -- value
true -- validity (TODO) true -- validity (TODO)

View File

@ -111,12 +111,12 @@ render { wsUp, authenticationForm, registrationForm }
render_auth_form = HH.form render_auth_form = HH.form
[ HE.onSubmit AuthenticationAttempt ] [ HE.onSubmit AuthenticationAttempt ]
[ Bulma.box_input "Login" "login" -- title, placeholder [ Bulma.box_input "loginLOGIN" "Login" "login" -- title, placeholder
(HandleAuthenticationInput <<< AUTH_INP_login) -- action (HandleAuthenticationInput <<< AUTH_INP_login) -- action
authenticationForm.login -- value authenticationForm.login -- value
true -- validity (TODO) true -- validity (TODO)
should_be_disabled -- condition should_be_disabled -- condition
, Bulma.box_password "Password" "password" -- title, placeholder , Bulma.box_password "passwordLOGIN" "Password" "password" -- title, placeholder
(HandleAuthenticationInput <<< AUTH_INP_pass) -- action (HandleAuthenticationInput <<< AUTH_INP_pass) -- action
authenticationForm.pass -- value authenticationForm.pass -- value
true -- validity (TODO) true -- validity (TODO)
@ -131,17 +131,17 @@ render { wsUp, authenticationForm, registrationForm }
render_register_form = HH.form render_register_form = HH.form
[ HE.onSubmit RegisterAttempt ] [ HE.onSubmit RegisterAttempt ]
[ Bulma.box_input "Login" "login" -- title, placeholder [ Bulma.box_input "loginREGISTER" "Login" "login" -- title, placeholder
(HandleRegisterInput <<< REG_INP_login) -- action (HandleRegisterInput <<< REG_INP_login) -- action
registrationForm.login -- value registrationForm.login -- value
true -- validity (TODO) true -- validity (TODO)
should_be_disabled -- condition should_be_disabled -- condition
, Bulma.box_input "Email" "email@example.com" -- title, placeholder , Bulma.box_input "emailREGISTER" "Email" "email@example.com" -- title, placeholder
(HandleRegisterInput <<< REG_INP_email) -- action (HandleRegisterInput <<< REG_INP_email) -- action
registrationForm.email -- value registrationForm.email -- value
true -- validity (TODO) true -- validity (TODO)
should_be_disabled -- condition should_be_disabled -- condition
, Bulma.box_password "Password" "password" -- title, placeholder , Bulma.box_password "passwordREGISTER" "Password" "password" -- title, placeholder
(HandleRegisterInput <<< REG_INP_pass) -- action (HandleRegisterInput <<< REG_INP_pass) -- action
registrationForm.pass -- value registrationForm.pass -- value
true -- validity (TODO) true -- validity (TODO)

View File

@ -75,7 +75,7 @@ protocol_max_len = 10
name_format :: String name_format :: String
name_format = "[a-zA-Z]+" name_format = "[a-zA-Z]+"
hostname_format :: String hostname_format :: String
hostname_format = "^(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9-]*[a-zA-Z0-9]).)*([A-Za-z0-9]|[A-Za-z0-9][A-Za-z0-9-]*[A-Za-z0-9])$" hostname_format = "^(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9-]*[a-zA-Z0-9]).)*([A-Za-z0-9]|[A-Za-z0-9][A-Za-z0-9-]*[A-Za-z0-9])[.]?$"
protocol_format :: String protocol_format :: String
protocol_format = "^(tcp|udp|sctp)$" protocol_format = "^(tcp|udp|sctp)$"
--name_format = "[a-zA-Z][a-zA-Z0-9_-]*" --name_format = "[a-zA-Z][a-zA-Z0-9_-]*"

View File

@ -24,6 +24,7 @@ import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Foldable as Foldable import Data.Foldable as Foldable
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.String as S
import Data.String.Regex as Regex import Data.String.Regex as Regex
import Data.String.Regex.Flags as RegexFlags import Data.String.Regex.Flags as RegexFlags
import Data.String.Regex.Unsafe as RegexUnsafe import Data.String.Regex.Unsafe as RegexUnsafe
@ -463,11 +464,11 @@ handleAction = case _ of
Left validation_errors -> do Left validation_errors -> do
let new_error_hash = Hash.insert local_rr.rrid validation_errors state._errors let new_error_hash = Hash.insert local_rr.rrid validation_errors state._errors
H.modify_ _ { _errors = new_error_hash } H.modify_ _ { _errors = new_error_hash }
H.raise $ Log $ SimpleLog $ "Errors in " H.raise $ Log $ SimpleLog $ "[😈] Errors in "
<> t <> t
<> " RR! Please fix them before update." <> " RR! Please fix them before update."
Right rr -> do Right rr -> do
H.raise $ Log $ SimpleLog $ "Save " <> t <> " RR" -- H.raise $ Log $ SimpleLog $ "Save " <> t <> " RR"
let new_error_hash = Hash.delete local_rr.rrid state._errors let new_error_hash = Hash.delete local_rr.rrid state._errors
H.modify_ _ { _errors = new_error_hash } H.modify_ _ { _errors = new_error_hash }
message <- H.liftEffect message <- H.liftEffect
@ -698,7 +699,7 @@ from_error_array_to_td :: Validation.Errors -> Validation.Attribute -> _
from_error_array_to_td [] _ = [] from_error_array_to_td [] _ = []
from_error_array_to_td errors attribute = case A.uncons errors of from_error_array_to_td errors attribute = case A.uncons errors of
Just { head: (Tuple attr err), tail: xs } -> if attr == attribute Just { head: (Tuple attr err), tail: xs } -> if attr == attribute
then [Bulma.p err] then [Bulma.p_ (C.help <> C.is_danger) err]
else from_error_array_to_td xs attribute else from_error_array_to_td xs attribute
Nothing -> [] Nothing -> []
@ -783,7 +784,7 @@ render_srv_records errors records
] ]
baseRecords :: Array String baseRecords :: Array String
baseRecords = [ "NS", "A", "AAAA", "CNAME", "TXT" ] baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ]
-- Component definition and initial state -- Component definition and initial state
@ -805,20 +806,34 @@ render_new_records state
render_new_record_column_simple :: forall (w :: Type) render_new_record_column_simple :: forall (w :: Type)
. (SimpleRR ()) -> Hash.HashMap RRId Validation.Errors -> HH.HTML w Action . (SimpleRR ()) -> Hash.HashMap RRId Validation.Errors -> HH.HTML w Action
render_new_record_column_simple rr errors render_new_record_column_simple rr errors
= Bulma.column_ $ [ Bulma.box = Bulma.column_ $ [ Bulma.zone_rr_title $ S.joinWith ", " baseRecords
[ Bulma.zone_rr_title "NS, A, AAAA, CNAME, TXT"
, type_selection , type_selection
, Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Domain) rr.name rr.valid , Bulma.hr
, Bulma.box_input_ttl (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_TTL) rr.ttl rr.valid , Bulma.box_input "domainSRR" "Domain" "www" -- id, title, placeholder
, Bulma.box_input_target (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Target) rr.target rr.valid (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Domain) -- action
rr.name -- value
rr.valid -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_input "ttlSRR" "TTL" "3600"
(UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_TTL)
rr.ttl
rr.valid
should_be_disabled
, Bulma.box_input "targetSRR" "Target" "198.51.100.5"
(UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Target)
rr.target
rr.valid
should_be_disabled
, Bulma.btn_add (AddRR Add_SRR) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid , Bulma.btn_add (AddRR Add_SRR) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid
]
] ]
where where
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
-- type_selection :: forall w i. HH.HTML w i -- type_selection :: forall w i. HH.HTML w i
type_selection = HH.select type_selection = HH.div [HP.classes $ C.select <> C.is_normal]
[ HE.onSelectedIndexChange (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Type) ] [ HH.select
$ map type_option baseRecords [ HE.onSelectedIndexChange (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Type) ]
$ map type_option baseRecords
]
type_option n type_option n
= HH.option = HH.option
[ HP.value n [ HP.value n

View File

@ -299,30 +299,31 @@ btn title action1 action2 validity
_ -> HE.onClick \_ -> action2 _ -> HE.onClick \_ -> action2
render_input :: forall w i. render_input :: forall w i.
Boolean -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i Boolean -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
render_input password placeholder action value validity cond render_input password id placeholder action value validity cond
= HH.input $ = HH.input $
[ HE.onValueInput action [ HE.onValueInput action
, HP.value value , HP.value value
, HP.placeholder placeholder , HP.placeholder placeholder
, HP.classes $ input_classes validity , HP.classes $ input_classes validity
, HP.id id
, cond , cond
] <> case password of ] <> case password of
false -> [] false -> []
true -> [ HP.type_ HP.InputPassword ] true -> [ HP.type_ HP.InputPassword ]
field_inner :: forall w i. field_inner :: forall w i.
Boolean -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i Boolean -> String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
field_inner ispassword title placeholder action value validity cond field_inner ispassword id title placeholder action value validity cond
= div_field = div_field
[ div_field_label [ div_field_label
, div_field_content $ render_input ispassword placeholder action value validity cond , div_field_content $ render_input ispassword id placeholder action value validity cond
] ]
where where
div_field = HH.div [ HP.classes (C.field <> C.is_horizontal) ] div_field = HH.div [ HP.classes (C.field <> C.is_horizontal) ]
div_field_label div_field_label
= HH.div [ HP.classes (C.field_label <> C.normal) ] = HH.div [ HP.classes (C.field_label <> C.normal) ]
[HH.label [ HP.classes C.label ] [ HH.text title ]] [HH.label [ HP.classes C.label, HP.for id ] [ HH.text title ]]
div_field_content content div_field_content content
= HH.div [ HP.classes C.field_body ] = HH.div [ HP.classes C.field_body ]
[ HH.div [HP.classes C.field ] [ HH.div [HP.classes C.field ]
@ -331,10 +332,10 @@ field_inner ispassword title placeholder action value validity cond
] ]
box_input :: forall w i. box_input :: forall w i.
String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
box_input = field_inner false box_input = field_inner false
box_password :: forall w i. box_password :: forall w i.
String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
box_password = field_inner true box_password = field_inner true
section_small :: forall w i. Array (HH.HTML w i) -> HH.HTML w i section_small :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
@ -383,6 +384,9 @@ new_domain_field inputaction text selectaction accepted_domains
p :: forall w i. String -> HH.HTML w i p :: forall w i. String -> HH.HTML w i
p str = HH.p_ [ HH.text str ] p str = HH.p_ [ HH.text str ]
p_ :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
p_ classes str = HH.p [HP.classes classes] [ HH.text str ]
box :: forall w i. Array (HH.HTML w i) -> HH.HTML w i box :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
box = HH.div [HP.classes C.box] box = HH.div [HP.classes C.box]

View File

@ -36,6 +36,8 @@ has_succeeds_separator :: Array HH.ClassName
has_succeeds_separator = [HH.ClassName "has-succeeds-separator"] has_succeeds_separator = [HH.ClassName "has-succeeds-separator"]
has_dropdown :: Array HH.ClassName has_dropdown :: Array HH.ClassName
has_dropdown = [HH.ClassName "has-dropdown"] has_dropdown = [HH.ClassName "has-dropdown"]
help :: Array HH.ClassName
help = [HH.ClassName "help"]
hero :: Array HH.ClassName hero :: Array HH.ClassName
hero = [HH.ClassName "hero"] hero = [HH.ClassName "hero"]
hero_body :: Array HH.ClassName hero_body :: Array HH.ClassName
@ -60,6 +62,8 @@ is_info :: Array HH.ClassName
is_info = [HH.ClassName "is-info"] is_info = [HH.ClassName "is-info"]
is_light :: Array HH.ClassName is_light :: Array HH.ClassName
is_light = [HH.ClassName "is-light"] is_light = [HH.ClassName "is-light"]
is_normal :: Array HH.ClassName
is_normal = [HH.ClassName "is-normal"]
is_primary :: Array HH.ClassName is_primary :: Array HH.ClassName
is_primary = [HH.ClassName "is-primary"] is_primary = [HH.ClassName "is-primary"]
is_small :: Array HH.ClassName is_small :: Array HH.ClassName