From ad6a64d78a218152f4dd3b4f1b970e0a537125a7 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Sun, 2 Jul 2023 22:12:39 +0200
Subject: [PATCH] Type simplification.

---
 src/App/DNSManagerDomainsInterface.purs | 36 ++++++++++++++-----------
 1 file changed, 21 insertions(+), 15 deletions(-)

diff --git a/src/App/DNSManagerDomainsInterface.purs b/src/App/DNSManagerDomainsInterface.purs
index e7bd7f0..2efd396 100644
--- a/src/App/DNSManagerDomainsInterface.purs
+++ b/src/App/DNSManagerDomainsInterface.purs
@@ -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..."
@@ -331,13 +335,15 @@ handleAction = case _ of
 
   HandleNewDomainInput adduserinp -> do
     case adduserinp of
-      INP_newdomain  v -> H.modify_ _ { newDomainForm { new_domain = v } }
+      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"