Compiles again.
This commit is contained in:
parent
1b78d1cefd
commit
9f4500481f
7 changed files with 163 additions and 154 deletions
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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 -> []
|
||||
|
|
|
|||
|
|
@ -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 "" ]
|
||||
]
|
||||
]
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
20
src/Utils.purs
Normal file
20
src/Utils.purs
Normal file
|
|
@ -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 -> []
|
||||
Loading…
Add table
Reference in a new issue