From 9f4500481f55421ec8232e1b85669b16faa92281 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sat, 3 May 2025 16:36:52 +0200 Subject: [PATCH] Compiles again. --- src/App/Page/DomainList.purs | 5 +- src/App/Page/Zone.purs | 89 +++----------- src/{Style => App/Templates}/Table.purs | 151 ++++++++++++++---------- src/Bulma.purs | 13 -- src/Style.purs | 16 ++- src/Style/Button.purs | 23 +++- src/Utils.purs | 20 ++++ 7 files changed, 163 insertions(+), 154 deletions(-) rename src/{Style => App/Templates}/Table.purs (83%) create mode 100644 src/Utils.purs diff --git a/src/App/Page/DomainList.purs b/src/App/Page/DomainList.purs index 729b4d5..1668921 100644 --- a/src/App/Page/DomainList.purs +++ b/src/App/Page/DomainList.purs @@ -28,6 +28,7 @@ import Halogen.HTML.Events as HHE import Web.Event.Event as Event import Web.Event.Event (Event) import Style as Style +import App.Templates.Table (owned_domains, shared_domains) as Table import App.DisplayErrors (error_to_paragraph_label) @@ -199,7 +200,7 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, del render_my_domains = [ Style.h3 "My domains" , Style.simple_quote "You are the exclusive owner of the following domains." - , Style.owned_domains_table domains_i_exclusively_own EnterDomain TransferDomain ShareDomain DeleteDomainModal + , Table.owned_domains domains_i_exclusively_own EnterDomain TransferDomain ShareDomain DeleteDomainModal ] render_my_shared_domains = [ Style.h3 "Shared domains" @@ -207,7 +208,7 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, del The following domains are shared with other users. In case you are the last owner, you can "unshare" it and gain exclusive ownership. """ - , Style.shared_domains_table domains_i_share EnterDomain UnShareDomain DeleteDomainModal + , Table.shared_domains domains_i_share EnterDomain UnShareDomain DeleteDomainModal ] render_new_domain = [ Style.h3 "New domain" diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index 32c53cc..fa1d1f0 100644 --- a/src/App/Page/Zone.purs +++ b/src/App/Page/Zone.purs @@ -12,10 +12,7 @@ -- | TODO: move all serialization code to a single module. module App.Page.Zone where -import Prelude (Unit, unit, void - , bind, pure - , not, comparing, discard, map, show, class Show - , (+), (&&), ($), (/=), (<<<), (<>), (==), (>), (#), (=<<), (-)) +import Prelude (class Show, Unit, bind, comparing, discard, map, pure, show, unit, void, (#), ($), (-), (/=), (<<<), (<>), (=<<), (==), (>)) import Data.Generic.Rep (class Generic) import Data.Show.Generic (genericShow) @@ -24,18 +21,19 @@ import Web.HTML (window) as HTML import Web.HTML.Window (sessionStorage) as Window import Web.Storage.Storage as Storage +import Utils (attach_id, remove_id) + import App.Validation.Email as Email import App.Type.CAA as CAA import Data.Eq (class Eq) import Data.Array as A import Data.Int (fromString) -import Data.Tuple (Tuple(..)) +import Data.Tuple (Tuple) import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Array.NonEmpty as NonEmpty import Data.Either (Either(..)) import Data.String (toLower) -import Data.String.CodePoints as CP -- import Data.Foldable as Foldable import Data.Maybe (Maybe(..), fromMaybe, maybe) import Effect.Aff.Class (class MonadAff) @@ -43,18 +41,16 @@ import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Properties as HP +import App.Templates.Table as Table import Style as Style import CSSClasses as C import App.Text.Explanations as Explanations import App.Type.AcceptedRRTypes (AcceptedRRTypes(..)) -import App.Type.ResourceRecord (ResourceRecord, emptyRR - , show_qualifier, show_qualifier_char - , show_mechanism_type, show_mechanism, to_mechanism - , show_modifier_type, show_modifier, to_modifier - , qualifiers - , mechanism_types, qualifier_types, modifier_types) +import App.Type.ResourceRecord (ResourceRecord + , emptyRR, mechanism_types, modifier_types, qualifier_types + , qualifiers, show_qualifier, to_mechanism, to_modifier) import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..), SRVProtocol(..) , srv_protocols, srv_protocols_txt) as RR import App.Type.DKIM as DKIM @@ -358,7 +354,7 @@ render state , Style.h1 state._domain ] [] , Style.hr - , render_resource_records (sorted state._resources) CreateUpdateRRModal DeleteRRModal + , Table.resource_records (sorted state._resources) CreateUpdateRRModal DeleteRRModal NewToken , Style.hr , render_new_records state , render_zonefile state._zonefile @@ -529,7 +525,7 @@ render state , Style.hr , Style.box_with_tag [C.has_background_info_light] tag_mechanisms [ Style.div_content [] [Style.explanation [Style.p "Mechanisms specify which mail servers are allowed to send mail for the domain and how to evaluate the sending mail server’s IP address."] ] - , maybe (Style.p "You don't have any mechanism.") display_mechanisms state._currentRR.mechanisms + , maybe (Style.p "You don't have any mechanism.") (Table.display_mechanisms SPF_remove_mechanism) state._currentRR.mechanisms , Style.hr , Style.h4 "New mechanism" , Style.selection_field "idMechanismQ" "Policy" SPF_Mechanism_q qualifier_types state.spf_mechanism_q @@ -542,7 +538,7 @@ render state , Style.hr , Style.box_with_tag [C.has_background_success_light] tag_modifiers [ Style.div_content [] [Style.explanation [Style.p "Modifiers provide additional instructions, such as explanations for SPF failures or redirecting SPF checks to another domain."] ] - , maybe (Style.p "You don't have any modifier.") display_modifiers state._currentRR.modifiers + , maybe (Style.p "You don't have any modifier.") (Table.display_modifiers SPF_remove_modifier) state._currentRR.modifiers , Style.hr , Style.h4 "New modifier" , Style.selection_field "idModifierT" "Modifier" SPF_Modifier_t modifier_types state.spf_modifier_t @@ -559,11 +555,11 @@ render state ] ] - tag_mechanisms = tags [tag "Mechanisms"] - tag_modifiers = tags [tag "Modifiers"] + tag_mechanisms = Style.tags [Style.tag "Mechanisms"] + tag_modifiers = Style.tags [Style.tag "Modifiers"] - tag_aggregated_reports = tags [tag "Addresses to contact for aggregated reports"] - tag_detailed_reports = tags [tag "Addresses to contact for detailed reports"] + tag_aggregated_reports = Style.tags [Style.tag "Addresses to contact for aggregated reports"] + tag_detailed_reports = Style.tags [Style.tag "Addresses to contact for detailed reports"] modal_content_dkim :: Array (HH.HTML w Action) modal_content_dkim = @@ -635,12 +631,12 @@ render state , Style.div_content [] [Style.explanation Explanations.dmarc_contact] , Style.box_with_tag [C.has_background_info_light] tag_aggregated_reports [ maybe (Style.p "There is no address to send aggregated reports to.") - (display_dmarc_mail_addresses DMARC_remove_rua) + (Table.display_dmarc_mail_addresses DMARC_remove_rua) state.dmarc.rua ] , Style.box_with_tag [C.has_background_success_light] tag_detailed_reports [ maybe (Style.p "There is no address to send detailed reports to.") - (display_dmarc_mail_addresses DMARC_remove_ruf) + (Table.display_dmarc_mail_addresses DMARC_remove_ruf) state.dmarc.ruf ] @@ -1055,43 +1051,6 @@ handleQuery = case _ of -- Rendering - -display_mechanisms :: forall w. Array RR.Mechanism -> HH.HTML w Action -display_mechanisms [] = Style.p "You don't have any mechanism." -display_mechanisms ms = - Style.table [] [ Style.mechanism_table_header, HH.tbody_ $ map render_mechanism_row $ attach_id 0 ms] - where - render_mechanism_row :: (Tuple Int RR.Mechanism) -> HH.HTML w Action - render_mechanism_row (Tuple i m) = HH.tr_ - [ Style.txt_name $ maybe "" show_qualifier m.q - , HH.td_ [ Style.p $ show_mechanism_type m.t ] - , HH.td_ [ Style.p m.v ] - , HH.td_ [ Style.alert_btn "x" (SPF_remove_mechanism i) ] - ] - -display_modifiers :: forall w. Array RR.Modifier -> HH.HTML w Action -display_modifiers [] = Style.p "You don't have any modifier." -display_modifiers ms = - Style.table [] [ Style.modifier_table_header, HH.tbody_ $ map render_modifier_row $ attach_id 0 ms] - where - render_modifier_row :: (Tuple Int RR.Modifier) -> HH.HTML w Action - render_modifier_row (Tuple i m) = HH.tr_ - [ HH.td_ [ Style.p $ show_modifier_type m.t ] - , HH.td_ [ Style.p m.v ] - , HH.td_ [ Style.alert_btn "x" (SPF_remove_modifier i) ] - ] - -display_dmarc_mail_addresses :: forall w. (Int -> Action) -> Array DMARC.DMARCURI -> HH.HTML w Action -display_dmarc_mail_addresses f ms = - Style.table [] [ Style.dmarc_dmarcuri_table_header, HH.tbody_ $ map render_dmarcuri_row $ attach_id 0 ms] - where - render_dmarcuri_row :: (Tuple Int DMARC.DMARCURI) -> HH.HTML w Action - render_dmarcuri_row (Tuple i m) = HH.tr_ - [ HH.td_ [ Style.p m.mail ] - , HH.td_ [ Style.p $ maybe "(no size limit)" show m.limit ] - , HH.td_ [ Style.alert_btn "x" (f i) ] - ] - -- Component definition and initial state render_new_records :: forall (w :: Type). State -> HH.HTML w Action @@ -1162,17 +1121,3 @@ update_field rr updated_field = case updated_field of Field_CAA_value val -> let new_caa = (fromMaybe default_caa rr.caa) { value = val } in rr { caa = Just new_caa } - -attach_id :: forall a. Int -> Array a -> Array (Tuple Int a) -attach_id _ [] = [] -attach_id i arr = case A.head arr of - Just x -> [Tuple i x] <> attach_id (i + 1) (fromMaybe [] $ A.tail arr) - Nothing -> [] - -remove_id :: forall a. Int -> Array (Tuple Int a) -> Array a -remove_id _ [] = [] -remove_id i arr = case A.head arr of - Just (Tuple n x) -> if i == n - then remove_id i (fromMaybe [] $ A.tail arr) - else [x] <> remove_id i (fromMaybe [] $ A.tail arr) - Nothing -> [] diff --git a/src/Style/Table.purs b/src/App/Templates/Table.purs similarity index 83% rename from src/Style/Table.purs rename to src/App/Templates/Table.purs index 187befd..10086df 100644 --- a/src/Style/Table.purs +++ b/src/App/Templates/Table.purs @@ -1,10 +1,10 @@ -module Style.Table - ( dmarc_dmarcuri_table_header - , mechanism_table_header - , modifier_table_header - , owned_domains_table - , shared_domains_table - , render_resource_records +module App.Templates.Table + ( owned_domains + , shared_domains + , resource_records + , display_dmarc_mail_addresses + , display_modifiers + , display_mechanisms ) where import Prelude @@ -15,11 +15,16 @@ import Data.Array.NonEmpty as NonEmpty import Data.Array as A import Data.Maybe (Maybe(..), fromMaybe, maybe) +import Data.Tuple + +import Style as Style import Style.Button as Button import Bulma as Bulma import Halogen.HTML as HH import Halogen.HTML.Properties as HP import Data.String.CodePoints as CP +import Utils (attach_id, remove_id) +import App.Type.DMARC as DMARC import App.Type.ResourceRecord (ResourceRecord, emptyRR , show_qualifier, show_qualifier_char @@ -42,8 +47,8 @@ txt_name t rr_name_style = HP.style "width: 80px;" rr_name_text = HH.text t -owned_domains_table :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i -owned_domains_table domains_i_exclusively_own action_enter_domain action_transfer_domain action_share_domain action_delete_domain +owned_domains :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i +owned_domains domains_i_exclusively_own action_enter_domain action_transfer_domain action_share_domain action_delete_domain = if A.length domains_i_exclusively_own > 0 then Bulma.table [] [ owned_domains_table_header , HH.tbody_ $ map owned_domain_row domains_i_exclusively_own @@ -59,7 +64,7 @@ owned_domains_table domains_i_exclusively_own action_enter_domain action_transfe ] ] owned_domain_row domain = HH.tr_ - [ HH.td_ [ Bulma.btn domain.name (action_enter_domain domain.name) ] + [ HH.td_ [ Button.btn domain.name (action_enter_domain domain.name) ] , case domain.transfer_key of Just key -> HH.td_ [ Bulma.p "Token key:", Bulma.p key ] Nothing -> HH.td_ [ Button.btn_abbr "Generate a token to transfer the ownership of a domain." "Transfer" (action_transfer_domain domain.name) ] @@ -67,8 +72,8 @@ owned_domains_table domains_i_exclusively_own action_enter_domain action_transfe , HH.td_ [ Button.alert_btn_abbr "Delete the domain. This will remove all zone data and the domain won't be served anymore." "Delete" (action_delete_domain domain.name) ] ] -shared_domains_table :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i -shared_domains_table domains_i_share action_enter_domain action_unshare_domain action_delete_domain +shared_domains :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i +shared_domains domains_i_share action_enter_domain action_unshare_domain action_delete_domain = if A.length domains_i_share > 0 then Bulma.table [] [ shared_domains_table_header , HH.tbody_ $ map shared_domain_row domains_i_share @@ -84,7 +89,7 @@ shared_domains_table domains_i_share action_enter_domain action_unshare_domain a ] ] shared_domain_row domain = HH.tr_ - [ HH.td_ [ Bulma.btn domain.name (action_enter_domain domain.name) ] + [ HH.td_ [ Button.btn domain.name (action_enter_domain domain.name) ] , HH.td_ [ HH.text $ fromMaybe "" domain.share_key ] , if A.length domain.owners == 1 then HH.td_ [ Button.alert_btn_abbr "Unshare the domain by removing the \"share\" token." "Unshare" (action_unshare_domain domain.name) ] @@ -92,13 +97,10 @@ shared_domains_table domains_i_share action_enter_domain action_unshare_domain a , HH.td_ [ Button.alert_btn_abbr "Delete the domain from your list of owned domains. In case you are the only owner, this will also remove all zone data and the domain won't be served anymore." "Delete" (action_delete_domain domain.name) ] ] -tags :: forall w i. Array (HH.HTML w i) -> HH.HTML w i -tags xs = HH.span [HP.classes [C.tags, C.no_margin_bottom, C.no_padding_bottom]] xs - -- | Render all Resource Records. -render_resource_records :: forall w i. Array ResourceRecord -> (Int -> i) -> (Int -> i) -> (Int -> i) -> HH.HTML w i -render_resource_records [] _ _ _ = Bulma.box [Bulma.zone_rr_title "Resource records", Bulma.subtitle "No records for now"] -render_resource_records records action_create_or_update_rr action_delete_rr action_new_token +resource_records :: forall w i. Array ResourceRecord -> (Int -> i) -> (Int -> i) -> (Int -> i) -> HH.HTML w i +resource_records [] _ _ _ = Bulma.box [Bulma.zone_rr_title "Resource records", Bulma.subtitle "No records for now"] +resource_records records action_create_or_update_rr action_delete_rr action_new_token = HH.div_ $ (rr_box [bg_color_ro] tag_soa soa_table_header table_content all_soa_rr) <> (rr_box [] tag_basic simple_table_header table_content_w_seps all_basic_rr) @@ -115,12 +117,6 @@ render_resource_records records action_create_or_update_rr action_delete_rr acti baseRecords :: Array String baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ] - tag :: forall w i. String -> HH.HTML w i - tag str = HH.span [HP.classes [C.tag, C.is_dark]] [HH.text str] - - tag_ro :: forall w i. String -> HH.HTML w i - tag_ro str = HH.span [HP.classes [C.tag, C.is_warning]] [HH.text str] - all_basic_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && not rr.readonly) records all_basic_ro_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && rr.readonly) records all_XX_rr str = A.filter (\rr -> rr.rrtype == str) records @@ -132,15 +128,15 @@ render_resource_records records action_create_or_update_rr action_delete_rr acti all_dkim_rr = all_XX_rr "DKIM" all_dmarc_rr = all_XX_rr "DMARC" - tag_soa = tags [tag_ro "SOA", tag_ro "read only"] - tag_basic = tags [tag "Basic Resource Records (A, AAAA, PTR, NS, TXT)"] - tag_mx = tags [tag "MX"] - tag_caa = tags [tag "CAA"] - tag_srv = tags [tag "SRV"] - tag_spf = tags [tag "SPF"] - tag_dkim = tags [tag "DKIM"] - tag_dmarc = tags [tag "DMARC"] - tag_basic_ro = tags [tag_ro "Basic Resource Records", tag_ro "read only"] + tag_soa = Style.tags [Style.tag_ro "SOA", Style.tag_ro "read only"] + tag_basic = Style.tags [Style.tag "Basic Resource Records (A, AAAA, PTR, NS, TXT)"] + tag_mx = Style.tags [Style.tag "MX"] + tag_caa = Style.tags [Style.tag "CAA"] + tag_srv = Style.tags [Style.tag "SRV"] + tag_spf = Style.tags [Style.tag "SPF"] + tag_dkim = Style.tags [Style.tag "DKIM"] + tag_dmarc = Style.tags [Style.tag "DMARC"] + tag_basic_ro = Style.tags [Style.tag_ro "Basic Resource Records", Style.tag_ro "read only"] rr_box :: Array HH.ClassName -- css classes (such as colors) -> HH.HTML w i -- box title (type of data) @@ -277,38 +273,13 @@ render_resource_records records action_create_or_update_rr action_delete_rr acti show_token_or_btn rr = case rr.rrtype of - "A" -> Bulma.btn_ [C.is_small] "πŸβ€‹ Ask for a token" (action_new_token rr.rrid) - "AAAA" -> Bulma.btn_ [C.is_small] "πŸβ€‹ Ask for a token" (action_new_token rr.rrid) + "A" -> Button.btn_ [C.is_small] "πŸβ€‹ Ask for a token" (action_new_token rr.rrid) + "AAAA" -> Button.btn_ [C.is_small] "πŸβ€‹ Ask for a token" (action_new_token rr.rrid) _ -> HH.text "" fancy_qualifier_display :: RR.Qualifier -> String fancy_qualifier_display qualifier = "(" <> show_qualifier_char qualifier <> ") " <> show_qualifier qualifier -mechanism_table_header :: forall w i. HH.HTML w i -mechanism_table_header - = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Policy" ] - , HH.th_ [ HH.text "Type" ] - , HH.th_ [ HH.text "Value" ] - , HH.th_ [ HH.text "" ] - ] - ] - -modifier_table_header :: forall w i. HH.HTML w i -modifier_table_header - = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type" ] - , HH.th_ [ HH.text "Value" ] - , HH.th_ [ HH.text "" ] - ] - ] - -dmarc_dmarcuri_table_header :: forall w i. HH.HTML w i -dmarc_dmarcuri_table_header - = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Email address" ] - , HH.th_ [ HH.text "Report size limit" ] - , HH.th_ [ HH.text "" ] - ] - ] - simple_table_header :: forall w i. HH.HTML w i simple_table_header = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type" ] @@ -542,3 +513,61 @@ port_header :: forall w i. HH.HTML w i port_header = HH.abbr [ HP.title "Related connection port" ] [ HH.text "Port" ] + +display_mechanisms :: forall w i. (Int -> i) -> Array RR.Mechanism -> HH.HTML w i +display_mechanisms _ [] = Style.p "You don't have any mechanism." +display_mechanisms action_remove_mechanism ms = + Style.table [] [ mechanism_table_header, HH.tbody_ $ map render_mechanism_row $ attach_id 0 ms] + where + render_mechanism_row :: (Tuple Int RR.Mechanism) -> HH.HTML w i + render_mechanism_row (Tuple i m) = HH.tr_ + [ txt_name $ maybe "" show_qualifier m.q + , HH.td_ [ Style.p $ show_mechanism_type m.t ] + , HH.td_ [ Style.p m.v ] + , HH.td_ [ Button.alert_btn "x" (action_remove_mechanism i) ] + ] + mechanism_table_header :: forall w i. HH.HTML w i + mechanism_table_header + = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Policy" ] + , HH.th_ [ HH.text "Type" ] + , HH.th_ [ HH.text "Value" ] + , HH.th_ [ HH.text "" ] + ] + ] + +display_modifiers :: forall w i. (Int -> i) -> Array RR.Modifier -> HH.HTML w i +display_modifiers _ [] = Style.p "You don't have any modifier." +display_modifiers action_remove_modifier ms = + Style.table [] [ modifier_table_header, HH.tbody_ $ map render_modifier_row $ attach_id 0 ms] + where + render_modifier_row :: (Tuple Int RR.Modifier) -> HH.HTML w i + render_modifier_row (Tuple i m) = HH.tr_ + [ HH.td_ [ Style.p $ show_modifier_type m.t ] + , HH.td_ [ Style.p m.v ] + , HH.td_ [ Button.alert_btn "x" (action_remove_modifier i) ] + ] + modifier_table_header :: forall w i. HH.HTML w i + modifier_table_header + = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type" ] + , HH.th_ [ HH.text "Value" ] + , HH.th_ [ HH.text "" ] + ] + ] + +display_dmarc_mail_addresses :: forall w i. (Int -> i) -> Array DMARC.DMARCURI -> HH.HTML w i +display_dmarc_mail_addresses f ms = + Style.table [] [ dmarc_dmarcuri_table_header, HH.tbody_ $ map render_dmarcuri_row $ attach_id 0 ms] + where + render_dmarcuri_row :: (Tuple Int DMARC.DMARCURI) -> HH.HTML w i + render_dmarcuri_row (Tuple i m) = HH.tr_ + [ HH.td_ [ Style.p m.mail ] + , HH.td_ [ Style.p $ maybe "(no size limit)" show m.limit ] + , HH.td_ [ Button.alert_btn "x" (f i) ] + ] + dmarc_dmarcuri_table_header :: forall w i. HH.HTML w i + dmarc_dmarcuri_table_header + = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Email address" ] + , HH.th_ [ HH.text "Report size limit" ] + , HH.th_ [ HH.text "" ] + ] + ] diff --git a/src/Bulma.purs b/src/Bulma.purs index 0620fc6..5b2faf6 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -98,19 +98,6 @@ level left right = HH.nav [ HP.classes [C.level] ] ] where itemize = map (\v -> HH.div [ HP.classes [C.level_item] ] [v]) -btn_ :: forall w action. Array HH.ClassName -> String -> action -> HH.HTML w action -btn_ classes title action - = HH.button - [ HE.onClick \_ -> action - , HP.classes $ [C.button] <> classes - ] [ HH.text title ] - -btn :: forall w action. String -> action -> HH.HTML w action -btn title action = btn_ [] title action - -alert_btn :: forall w action. String -> action -> HH.HTML w action -alert_btn title action = btn_ [C.is_danger] title action - -- | Bulma's `field`, which contains an array of `Halogen.HTML` entries. -- | Two entries are expected: a field label (`div_field_label`) and a field content (`div_field_content`). div_field :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i diff --git a/src/Style.purs b/src/Style.purs index 4921503..abf3bd6 100644 --- a/src/Style.purs +++ b/src/Style.purs @@ -2,14 +2,26 @@ module Style ( module Bulma , module Style.Button , module Style.Input - , module Style.Table + , tags + , tag + , tag_ro ) where import Style.Button import Style.Input -import Style.Table import Bulma import Halogen.HTML as HH import Halogen.HTML.Properties as HP + +import CSSClasses as C + +tags :: forall w i. Array (HH.HTML w i) -> HH.HTML w i +tags xs = HH.span [HP.classes [C.tags, C.no_margin_bottom, C.no_padding_bottom]] xs + +tag :: forall w i. String -> HH.HTML w i +tag str = HH.span [HP.classes [C.tag, C.is_dark]] [HH.text str] + +tag_ro :: forall w i. String -> HH.HTML w i +tag_ro str = HH.span [HP.classes [C.tag, C.is_warning]] [HH.text str] diff --git a/src/Style/Button.purs b/src/Style/Button.purs index 4c97e1f..2de89a2 100644 --- a/src/Style/Button.purs +++ b/src/Style/Button.purs @@ -1,5 +1,8 @@ module Style.Button - ( alert_btn_abbr + ( alert_btn + , alert_btn_abbr + , btn + , btn_ , btn_abbr , btn_abbr_ , btn_add @@ -15,7 +18,6 @@ module Style.Button ) where import Prelude (($), (<>)) -import Bulma as Bulma import CSSClasses as C import Halogen.HTML as HH @@ -45,10 +47,10 @@ btn_modify :: forall w i. i -> HH.HTML w i btn_modify action = btn_abbr_ [C.is_small, C.is_info] [C.is_size 4] "Edit" "βš’" action btn_save :: forall w i. i -> HH.HTML w i -btn_save action = Bulma.btn_ [C.is_info] "Save" action +btn_save action = btn_ [C.is_info] "Save" action btn_add :: forall w i. i -> HH.HTML w i -btn_add action = Bulma.btn_ [C.is_info] "Add" action +btn_add action = btn_ [C.is_info] "Add" action btn_delete :: forall w i. i -> HH.HTML w i btn_delete action = btn_abbr_ [C.is_small, C.is_danger] [C.is_size 4] "Delete" "βœ–" action @@ -78,3 +80,16 @@ btn_validation_ str = HH.button btn_validation :: forall w i. HH.HTML w i btn_validation = btn_validation_ "Validate" + +btn_ :: forall w action. Array HH.ClassName -> String -> action -> HH.HTML w action +btn_ classes title action + = HH.button + [ HE.onClick \_ -> action + , HP.classes $ [C.button] <> classes + ] [ HH.text title ] + +btn :: forall w action. String -> action -> HH.HTML w action +btn title action = btn_ [] title action + +alert_btn :: forall w action. String -> action -> HH.HTML w action +alert_btn title action = btn_ [C.is_danger] title action diff --git a/src/Utils.purs b/src/Utils.purs new file mode 100644 index 0000000..20420d6 --- /dev/null +++ b/src/Utils.purs @@ -0,0 +1,20 @@ +module Utils where + +import Prelude (($), (+), (<>), (==)) +import Data.Array as A +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Tuple (Tuple(..)) + +attach_id :: forall a. Int -> Array a -> Array (Tuple Int a) +attach_id _ [] = [] +attach_id i arr = case A.head arr of + Just x -> [Tuple i x] <> attach_id (i + 1) (fromMaybe [] $ A.tail arr) + Nothing -> [] + +remove_id :: forall a. Int -> Array (Tuple Int a) -> Array a +remove_id _ [] = [] +remove_id i arr = case A.head arr of + Just (Tuple n x) -> if i == n + then remove_id i (fromMaybe [] $ A.tail arr) + else [x] <> remove_id i (fromMaybe [] $ A.tail arr) + Nothing -> []