Labeled button.

2024-02-17 06:53:20 +01:00 · 2024-02-17 06:53:20 +01:00 · c9bbe81d09
parent 58eee12511
commit c9bbe81d09
4 changed files with 49 additions and 38 deletions
--- a/spago.dhall
+++ b/spago.dhall
@ -37,7 +37,6 @@
  , "web-html"
  , "web-socket"
  , "web-storage"
-  , "web-uievents"
  ]
 , packages = ./packages.dhall
 , sources = [ "src/**/*.purs", "test/**/*.purs" ]
--- a/src/App/AuthenticationDaemonAdminInterface.purs
+++ b/src/App/AuthenticationDaemonAdminInterface.purs
@ -21,6 +21,8 @@ import Halogen.HTML.Properties as HP
 import Web.Event.Event (Event)
 import Web.Event.Event as Event

+import CSSClasses as C
+
 import Web.HTML (window) as HTML
 import Web.HTML.Window (sessionStorage) as Window
 import Web.Storage.Storage as Storage
@ -112,9 +114,10 @@ render :: forall m. State -> H.ComponentHTML Action () m
 render { addUserForm, searchUserForm, page, wsUp }
    = case page of
        Home   -> Bulma.modal "Hello lol" [Bulma.h3 "This is the body lol"] [routing_search_button, routing_add_button]
-        Search -> HH.div_ [ Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "Search users", render_searchuser_form ] ]
-                                           , Bulma.column_ [ Bulma.h3 "Result", Bulma.subtitle "TODO" ] ]
-        Add    -> HH.div_ [ Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "Add a new user", render_adduser_form ] ] ]
+        Search -> Bulma.columns_ [ Bulma.column (C.is_size 3) [ Bulma.h3 "Search users", render_searchuser_form ]
+                                 , Bulma.column_ [ Bulma.h3 "Result", Bulma.subtitle "TODO" ]
+                                 ]
+        Add    -> Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "Add a new user", render_adduser_form ] ]
    where

      active = (if wsUp then (HP.enabled true) else (HP.disabled true))
@ -123,7 +126,7 @@ render { addUserForm, searchUserForm, page, wsUp }
        HH.form
          [ HE.onSubmit PreventSubmit ]
          [ Bulma.box_input "login" "User login" "login" (up ADDUSER_INP_login) addUserForm.login active
-          , Bulma.btn (show addUserForm.admin) (HandleAddUserInput ADDUSER_toggle_admin)
+          , Bulma.btn_labeled "adminbtn" "Admin" (show addUserForm.admin) (HandleAddUserInput ADDUSER_toggle_admin)
          , Bulma.box_input "email" "User email" "email" (up ADDUSER_INP_email) addUserForm.email active
          , Bulma.box_password "password" "User password" "password" (up ADDUSER_INP_pass) addUserForm.pass active
          , Bulma.btn "Send" AddUserAttempt
@ -134,9 +137,9 @@ render { addUserForm, searchUserForm, page, wsUp }
      render_searchuser_form =  Bulma.box [
        HH.form
          [ HE.onSubmit PreventSubmit ]
-          [ Bulma.box_input "login" "User login" "login" (up SEARCHUSER_INP_login) searchUserForm.login active
-          , Bulma.btn (show searchUserForm.admin) (HandleAddUserInput SEARCHUSER_toggle_admin)
-          , Bulma.box_input "email" "User email" "email" (up SEARCHUSER_INP_email) searchUserForm.email active
+          [ Bulma.box_input "login" "Login" "login" (up SEARCHUSER_INP_login) searchUserForm.login active
+          , Bulma.btn_labeled "adminbtn" "Admin" (show searchUserForm.admin) (HandleAddUserInput SEARCHUSER_toggle_admin)
+          , Bulma.box_input "email" "Email" "email" (up SEARCHUSER_INP_email) searchUserForm.email active
          --, Bulma.box_input "domain" "Domain owned" "blah.netlib.re."
          --    (up SEARCHUSER_INP_domain) searchUserForm.email active
          , Bulma.btn "Send" SearchUserAttempt
--- a/src/Bulma.purs
+++ b/src/Bulma.purs
@ -12,7 +12,7 @@ import CSSClasses as C

 import Halogen.HTML.Core (AttrName(..))
 -- import Web.Event.Event (type_, Event, EventType(..))
-import Web.UIEvent.MouseEvent (MouseEvent)
+-- import Web.UIEvent.MouseEvent (MouseEvent) -- package web-uievents

 columns :: forall (w :: Type) (i :: Type).
  Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
@ -57,10 +57,6 @@ input_classes = C.input <> C.is_small <> C.is_info
 table :: forall w i. HH.Node DHI.HTMLtable w i
 table prop xs = HH.table ([ HP.classes $ C.table ] <> prop) xs

-btn_classes :: Boolean -> Array HH.ClassName
-btn_classes true  = C.button <> C.is_small <> C.is_info
-btn_classes false = C.button <> C.is_small <> C.is_danger
-
 simple_table_header :: forall w i. HH.HTML w i
 simple_table_header
  = HH.thead_ [ HH.tr_ [ HH.th  [ HP.style "width: 50px;" ] [ HH.text "Type"  ]
@ -178,25 +174,44 @@ render_input password id placeholder action value cond
        false -> []
        true -> [ HP.type_ HP.InputPassword ]

+div_field = HH.div [HP.classes (C.field <> C.is_horizontal)]
+
+div_field_label id title = HH.div [HP.classes (C.field_label <> C.normal)]
+                                  [HH.label [ HP.classes C.label, HP.for id ] [ HH.text title ]]
+
+div_field_content content
+  = HH.div [ HP.classes C.field_body ]
+           [ HH.div [HP.classes C.field ] [ HH.div [HP.classes C.control ] [ content ] ] ]
+
 field_inner :: forall w i.
  Boolean -> String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
 field_inner ispassword id title placeholder action value cond
  = div_field
-      [ div_field_label
+      [ div_field_label id title
      , div_field_content $ render_input ispassword id placeholder action value cond
      ]
-  where
-    div_field = HH.div [ HP.classes (C.field <> C.is_horizontal) ]
-    div_field_label
-      = HH.div [ HP.classes (C.field_label <> C.normal) ]
-               [HH.label [ HP.classes C.label, HP.for id ] [ HH.text title ]]
-    div_field_content content
-      = HH.div [ HP.classes C.field_body ]
-          [ HH.div [HP.classes C.field ]
-              [ HH.div [HP.classes C.control ] [ content ]
-              ]
+
+div_field_ :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+div_field_ classes = HH.div [ HP.classes (C.field <> classes) ]
+
+btn_labeled :: forall w i. String -> String -> String -> i -> HH.HTML w i
+btn_labeled id title button_text action
+  = div_field
+      [ div_field_label id title
+      , div_field_content $ HH.button
+          [ HE.onClick \_ -> action
+          , HP.classes $ C.button <> C.is_small <> C.is_info
+          , HP.id id
+          ] [ HH.text button_text ]
      ]

+--box_button action value validity cond
+--  = HH.label [ ]
+--      [ HH.label [HP.classes C.label ] [ HH.text title ]
+--      , HH.div [HP.classes C.control ]
+--          [ render_input ispassword placeholder action value validity cond ]
+--      ]
+
 box_input :: forall w i.
  String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
 box_input = field_inner false
@ -211,19 +226,16 @@ section_small = HH.section [ HP.classes (C.section <> C.is_small) ]
 section_medium :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
 section_medium = HH.section [ HP.classes (C.section <> C.medium) ]

-field :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
-field classes = HH.div [ HP.classes (C.field <> classes) ]
-
 new_domain_field :: forall w i.
  (String -> i) -> String -> Array (HP.IProp DHI.HTMLselect i) -> Array String -> HH.HTML w i
-new_domain_field inputaction text selectaction accepted_domains
-  = field C.has_addons
+new_domain_field inputaction text_ selectaction accepted_domains
+  = div_field_ C.has_addons
      [ HH.p
          [ HP.classes C.control ]
          [ HH.input $
              [ HE.onValueInput inputaction
              , HP.placeholder "www"
-              , HP.value text
+              , HP.value text_
              , HP.type_ HP.InputText
              , HP.classes (C.is_primary <> C.input)
              ]
@ -241,13 +253,6 @@ new_domain_field inputaction text selectaction accepted_domains
          ]
      ]

--box_button action value validity cond
--  = HH.label [ ]
--      [ HH.label [HP.classes C.label ] [ HH.text title ]
--      , HH.div [HP.classes C.control ]
--          [ render_input ispassword placeholder action value validity cond ]
--      ]
-
 code :: forall w i. String -> HH.HTML w i
 code str = HH.code_ [ HH.text str ]

--- a/src/CSSClasses.purs
+++ b/src/CSSClasses.purs
@ -1,5 +1,7 @@
 module CSSClasses where

+import Prelude (show, ($), (<>))
+
 import Halogen.HTML as HH

 is_ancestor :: Array HH.ClassName
@ -76,6 +78,8 @@ is_centered :: Array HH.ClassName
 is_centered = [HH.ClassName "is-centered"]
 is_danger :: Array HH.ClassName
 is_danger = [HH.ClassName "is-danger"]
+is_size :: Int -> Array HH.ClassName
+is_size size = [HH.ClassName $ "is-" <> show size]
 is_horizontal :: Array HH.ClassName
 is_horizontal = [HH.ClassName "is-horizontal"]
 is_hoverable :: Array HH.ClassName