Type simplification.

beta
Philippe Pittoli 2023-07-02 22:12:39 +02:00
parent e9808e70f1
commit ad6a64d78a
1 changed files with 21 additions and 15 deletions

View File

@ -148,6 +148,7 @@ type Input = Tuple String String
data NewDomainFormAction
= INP_newdomain String
| UpdateSelectedDomain String
data Action
= Initialize
@ -156,7 +157,6 @@ data Action
| UpdateAcceptedDomains (Array String)
| UpdateMyDomains (Array String)
| UpdateSelectedDomain String
| AuthenticateToDNSManager
@ -166,8 +166,10 @@ data Action
-- | Finalize
| HandleWebSocket (WebSocketEvent WebSocketMessageType)
-- TODO: TLD
type NewDomainFormState = { new_domain :: String }
type NewDomainFormState
= { new_domain :: String
, selected_domain :: String
}
type State =
{ messages :: Array String
@ -177,7 +179,6 @@ type State =
, newDomainForm :: NewDomainFormState
, accepted_domains :: Array String
, selected_domain :: String
, my_domains :: Array String
-- TODO: put network stuff in a record.
@ -207,10 +208,11 @@ initialState (Tuple url token) =
, messageHistoryLength: 10
, token: token
, newDomainForm: { new_domain: "" }
, newDomainForm: { new_domain: ""
, selected_domain: default_domain
}
, accepted_domains: [ default_domain ]
, selected_domain: default_domain
, my_domains: [ ]
-- TODO: put network stuff in a record.
@ -254,8 +256,7 @@ render {
newDomainForm.new_domain -- value
true -- validity (TODO)
should_be_disabled -- condition
-- TODO: list of options for TLD
, Bulma.select [ HHE.onSelectedIndexChange (\i -> UpdateSelectedDomain $ maybe "netlib.re" (\x -> x) $ accepted_domains A.!! i) ] $ map Bulma.option accepted_domains
, domain_selection
, HH.div_
[ HH.button
[ HP.style "padding: 0.5rem 1.25rem;"
@ -266,6 +267,12 @@ render {
]
]
domain_selection = Bulma.select [ HHE.onSelectedIndexChange domain_choice ] $ map Bulma.option accepted_domains
domain_choice :: Int -> Action
domain_choice i
= HandleNewDomainInput <<< UpdateSelectedDomain $ maybe "netlib.re" (\x -> x) $ accepted_domains A.!! i
render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages
renderFootnote :: String -> H.ComponentHTML Action () m
@ -317,9 +324,6 @@ handleAction = case _ of
UpdateMyDomains domains -> do
H.modify_ _ { my_domains = domains }
UpdateSelectedDomain domain -> do
H.modify_ _ { selected_domain = domain }
AuthenticateToDNSManager -> do
{ wsConnection, token } <- H.get
appendMessage $ "[🤖] Trying to authenticate..."
@ -332,12 +336,14 @@ handleAction = case _ of
HandleNewDomainInput adduserinp -> do
case adduserinp of
INP_newdomain v -> H.modify_ _ { newDomainForm { new_domain = v } }
UpdateSelectedDomain domain -> do
H.modify_ _ { newDomainForm { selected_domain = domain } }
NewDomainAttempt ev -> do
H.liftEffect $ Event.preventDefault ev
{ wsConnection, newDomainForm, selected_domain } <- H.get
let new_domain = newDomainForm.new_domain
{ wsConnection, newDomainForm } <- H.get
let new_domain = newDomainForm.new_domain <> newDomainForm.selected_domain
case wsConnection, new_domain of
Nothing, _ ->
@ -362,7 +368,7 @@ handleAction = case _ of
Open -> do
H.liftEffect $ do
ab <- DNSManager.serialize $ DNSManager.MkNewDomain { domain: (new_domain <> "." <> selected_domain) }
ab <- DNSManager.serialize $ DNSManager.MkNewDomain { domain: new_domain }
sendArrayBuffer webSocket ab
appendMessageReset "[😇] Trying to add a new domain"