dnsmanager-webclient/src/Bulma.purs

-- | The `Bulma` module is a wrapper around the BULMA css framework.
module Bulma where
import Prelude

import Data.Maybe (Maybe, fromMaybe)
import Data.Tuple (Tuple, fst, snd)
import Halogen.HTML as HH
import DOM.HTML.Indexed as DHI
import Halogen.HTML.Properties as HP
import Halogen.HTML.Events as HE
-- import MissingHTMLProperties as MissingProperties

import CSSClasses as C

import Halogen.HTML.Core (AttrName(..))
-- import Web.Event.Event (type_, Event, EventType(..))
-- 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
columns classes = HH.div [ HP.classes (C.columns <> classes) ]

columns_ :: forall (w :: Type) (i :: Type). Array (HH.HTML w i) -> HH.HTML w i
columns_ = columns []

column :: forall (w :: Type) (i :: Type).
  Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
column classes = HH.div [ HP.classes (C.column <> classes) ]

column_ :: forall (w :: Type) (i :: Type). Array (HH.HTML w i) -> HH.HTML w i
column_ = column []

h1 :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
h1 title = HH.h1 [ HP.classes (C.title) ] [ HH.text title ]

h3 :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
h3 title = HH.h3 [ HP.classes (C.title <> C.is5) ] [ HH.text title ]

zone_rr_title :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
zone_rr_title title
  = HH.h3 [ HP.classes (C.title <> C.is5 <> C.has_text_light <> C.has_background_dark) ]
          [ HH.text title ]

subtitle :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
subtitle title = HH.h2 [ HP.classes (C.subtitle <> C.is4) ] [ HH.text title ]

hdiv :: forall (w :: Type) (a :: Type). Array (HH.HTML w a) -> HH.HTML w a
hdiv = HH.div [ HP.classes [HH.ClassName "mt-5"] ]

--offcolumn :: forall (w :: Type) (a :: Type).
--  Int -> Int -> Array (HH.HTML w a) -> HH.HTML w a
--offcolumn 0      size = HH.div [ HP.classes [HH.ClassName ("mt-"<>show size)] ]
--offcolumn offset size
--  = column [ HH.ClassName ("is-offset-" <> (show offset) <> " is-" <> (show size)) ]

input_classes :: Array HH.ClassName
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

table_ :: forall w i. Array HH.ClassName -> HH.Node DHI.HTMLtable w i
table_ classes prop xs = HH.table ([ HP.classes $ C.table <> classes] <> prop) xs

table_header_owned_domains :: forall w i. HH.HTML w i
table_header_owned_domains
  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
                       , HH.th_ [ HH.text "" ]
                       , HH.th_ [ HH.text "" ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

table_header_shared_domains :: forall w i. HH.HTML w i
table_header_shared_domains
  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
                       , HH.th_ [ HH.text "Share key" ]
                       , HH.th_ [ HH.text "" ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

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 "" ]
                       ]
              ]

name_header :: forall w i. HH.HTML w i
name_header = HH.abbr
  [ HP.title "Name of the DNS entry, the fully-qualified-domain-name is <name>.<domain>." ]
  [ HH.text "Name" ]

ttl_header :: forall w i. HH.HTML w i
ttl_header = HH.abbr
  [ HP.title "Time-to-Live, nb seconds before being considered invalid" ]
  [ HH.text "TTL" ]

target_header :: forall w i. HH.HTML w i
target_header = HH.abbr
  [ HP.title "In the DNS jargon, the target means the most important value associated with the entry, for an A entry it would be an IPv4 address, for example" ]
  [ HH.text "Target" ]

token_header :: forall w i. HH.HTML w i
token_header = HH.abbr
  [ HP.title "Tokens are used to update the entry, see the tab: \"Tokens? 🤨\"" ]
  [ HH.text "Token" ]

priority_header :: forall w i. HH.HTML w i
priority_header = HH.abbr
  [ HP.title "A numeric value that indicates the preference of the server (lower values indicate higher priority)" ]
  [ HH.text "Priority" ]

weight_header :: forall w i. HH.HTML w i
weight_header = HH.abbr
  [ HP.title "A relative weight used when multiple servers have the same priority, determining how often they should be used" ]
  [ HH.text "Weight" ]

srv_mechanisms_header :: forall w i. HH.HTML w i
srv_mechanisms_header = HH.abbr
  [ HP.title "Mechanisms specify which mail servers are allowed to send mail for the domain and how to evaluate the sending mail server’s IP address" ]
  [ HH.text "Mechanisms" ]

srv_modifiers_header :: forall w i. HH.HTML w i
srv_modifiers_header = HH.abbr
  [ HP.title "Modifiers provide additional instructions, such as explanations for SPF failures or redirecting SPF checks to another domain" ]
  [ HH.text "Modifiers" ]

srv_default_policy_header :: forall w i. HH.HTML w i
srv_default_policy_header = HH.abbr
  [ HP.title "" ]
  [ HH.text "Default Policy" ]

protocol_header :: forall w i. HH.HTML w i
protocol_header = HH.abbr
  [ HP.title "The related communication protocol, either TCP or UDP (want more? Just ask me)" ]
  [ HH.text "Protocol" ]

port_header :: forall w i. HH.HTML w i
port_header = HH.abbr
  [ HP.title "Related connection port" ]
  [ HH.text "Port" ]

dkim_notes_header :: forall w i. HH.HTML w i
dkim_notes_header = HH.abbr
  [ HP.title "Arbitrary string related to this cryptographic material" ]
  [ HH.text "Notes" ]

dmarc_policy_header :: forall w i. HH.HTML w i
dmarc_policy_header = HH.abbr
  [ HP.title "How to handle email when SPF and DKIM aren't valid?" ]
  [ HH.text "Policy" ]

dmarc_subdom_policy_header :: forall w i. HH.HTML w i
dmarc_subdom_policy_header = HH.abbr
  [ HP.title "How to handle email when SPF and DKIM aren't valid?" ]
  [ HH.text "Subdomain Policy" ]

dmarc_dkim_policy_header :: forall w i. HH.HTML w i
dmarc_dkim_policy_header = HH.abbr
  [ HP.title "What should be considered acceptable to do with an email not conforming with DKIM" ]
  [ HH.text "DKIM Policy" ]

dmarc_spf_policy_header :: forall w i. HH.HTML w i
dmarc_spf_policy_header = HH.abbr
  [ HP.title "What should be considered acceptable to do with an email not conforming with SPF" ]
  [ HH.text "SPF Policy" ]

dmarc_sample_rate_header :: forall w i. HH.HTML w i
dmarc_sample_rate_header = HH.abbr
  [ HP.title "Percentage of messages subjected to the requested policy [0-100]" ]
  [ HH.text "Sample Rate" ]

dmarc_report_on_header :: forall w i. HH.HTML w i
dmarc_report_on_header = HH.abbr
  [ HP.title "What error should be reported? DKIM, SPF, Both, Any or None?" ]
  [ HH.text "Report on" ]

dmarc_report_interval_header :: forall w i. HH.HTML w i
dmarc_report_interval_header = HH.abbr
  [ HP.title "Minimal duration between two DMARC reports (in seconds)" ]
  [ HH.text "Report interval" ]

simple_table_header :: forall w i. HH.HTML w i
simple_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type" ]
                       , HH.th_ [ name_header ]
                       , HH.th_ [ ttl_header ]
                       , HH.th_ [ target_header ]
                       , HH.th_ [ HH.text "" ]
                       , HH.th_ [ token_header ]
                       ]
              ]

simple_table_header_ro :: forall w i. HH.HTML w i
simple_table_header_ro
  = HH.thead_ [ HH.tr [ HP.classes C.has_background_warning_light ]
                       [ HH.th  [ HP.style "width: 50px;" ] [ HH.text "Type"  ]
                       , HH.th_ [ name_header ]
                       , HH.th_ [ ttl_header ]
                       , HH.th_ [ target_header ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

mx_table_header :: forall w i. HH.HTML w i
mx_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
                       , HH.th_ [ ttl_header ]
                       , HH.th_ [ priority_header ]
                       , HH.th_ [ target_header ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

caa_table_header :: forall w i. HH.HTML w i
caa_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
                       , HH.th_ [ ttl_header ]
                       , HH.th_ [ HH.text "Flag" ]
                       , HH.th_ [ HH.text "Tag" ]
                       , HH.th_ [ HH.text "Value" ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

srv_table_header :: forall w i. HH.HTML w i
srv_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
                       , HH.th_ [ protocol_header ]
                       , HH.th_ [ target_header ]
                       , HH.th_ [ port_header ]
                       , HH.th_ [ ttl_header ]
                       , HH.th_ [ priority_header ]
                       , HH.th_ [ weight_header ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

spf_table_header :: forall w i. HH.HTML w i
spf_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
                       , HH.th_ [ ttl_header ]
                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed.
                       , HH.th_ [ srv_mechanisms_header ]
                       , HH.th_ [ srv_modifiers_header ]
                       , HH.th_ [ srv_default_policy_header ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

dkim_table_header :: forall w i. HH.HTML w i
dkim_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
                       , HH.th_ [ ttl_header ]
                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed. Assume DKIM1.
                       , HH.th_ [ HH.text "Hash algo" ]
                       , HH.th_ [ HH.text "Signature algo" ]
                       , HH.th_ [ HH.text "Public Key" ]
                       , HH.th_ [ dkim_notes_header ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

dmarc_table_header :: forall w i. HH.HTML w i
dmarc_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
                       , HH.th_ [ ttl_header ]
                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed. Assume DMARC1.
                       , HH.th_ [ dmarc_policy_header ]          -- p
                       , HH.th_ [ dmarc_subdom_policy_header ]   -- sp
                       , HH.th_ [ dmarc_dkim_policy_header ]     -- adkim
                       , HH.th_ [ dmarc_spf_policy_header ]      -- aspf
                       , HH.th_ [ dmarc_sample_rate_header ]     -- pct
                       , HH.th_ [ dmarc_report_on_header ]       -- fo
                       , HH.th_ [ dmarc_report_interval_header ] -- ri
                       -- TODO? rua & ruf
                       -- , HH.th_ [ HH.text "Accepted report formats" ] -- For now, assume AFRF.
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

name_soa_header :: forall w i. HH.HTML w i
name_soa_header = HH.abbr
  [ HP.title "Your actual domain name (technical term: \"fully qualified domain name\")" ]
  [ HH.text "Name" ]

mname_soa_header :: forall w i. HH.HTML w i
mname_soa_header = HH.abbr
  [ HP.title "Domain name of the primary authoritative DNS server for the zone (SOA \"MNAME\" field)" ]
  [ HH.text "Primary NS" ]

rname_soa_header :: forall w i. HH.HTML w i
rname_soa_header = HH.abbr
  [ HP.title "The email address of the person responsible for managing the zone (the \"@\" is replaced by \".\" for some reason, this is the SOA \"RNAME\" field)" ]
  [ HH.text "Contact" ]

serial_soa_header :: forall w i. HH.HTML w i
serial_soa_header = HH.abbr
  [ HP.title "A number that is incremented every time the zone is updated. Secondary DNS servers use this number to check for updates" ]
  [ HH.text "Serial" ]

refresh_soa_header :: forall w i. HH.HTML w i
refresh_soa_header = HH.abbr
  [ HP.title "The interval (in seconds) at which secondary DNS servers should check the primary server for changes to the zone" ]
  [ HH.text "Refresh" ]

retry_soa_header :: forall w i. HH.HTML w i
retry_soa_header = HH.abbr
  [ HP.title "The time in seconds that secondary servers should wait before retrying a failed attempt to contact the primary DNS server" ]
  [ HH.text "Retry" ]

expire_soa_header :: forall w i. HH.HTML w i
expire_soa_header = HH.abbr
  [ HP.title "The time in seconds that secondary DNS servers will keep the zone data before discarding it if they cannot contact the primary server" ]
  [ HH.text "Expire" ]

minttl_soa_header :: forall w i. HH.HTML w i
minttl_soa_header = HH.abbr
  [ HP.title "The minimum time (in seconds) that other DNS servers should cache negative responses (e.g., for non-existent domain names)" ]
  [ HH.text "Minimum TTL" ]

soa_table_header :: forall w i. HH.HTML w i
soa_table_header
  = HH.thead_ [ HH.tr [ HP.classes C.has_background_warning_light ]
                      [ HH.th_ [ name_soa_header ]
                      , HH.th_ [ ttl_header ]
                      , HH.th_ [ mname_soa_header ]
                      , HH.th_ [ rname_soa_header ]
                      , HH.th_ [ serial_soa_header ]
                      , HH.th_ [ refresh_soa_header ]
                      , HH.th_ [ retry_soa_header ]
                      , HH.th_ [ expire_soa_header ]
                      , HH.th_ [ minttl_soa_header ]
                      ]
              ]

txt_name :: forall w i. String -> HH.HTML w i
txt_name t
  = HH.td  [ rr_name_style ] [ rr_name_text ]
  where
    rr_name_style = HP.style "width: 80px;"
    rr_name_text  = HH.text t

textarea_ :: forall w i. Array HH.ClassName -> String -> String -> (String -> i) -> HH.HTML w i
textarea_ classes placeholder value action
  = HH.textarea
      [ HE.onValueInput action
      , HP.value value
      , HP.placeholder placeholder
      , HP.classes $ C.textarea <> classes
      ]

textarea :: forall w i. String ->  String -> (String -> i) -> HH.HTML w i
textarea placeholder value action = textarea_ [] placeholder value action

btn_modify :: forall w i. i -> HH.HTML w i
btn_modify action = btn_ (C.is_small <> C.is_info) "⚒" action

btn_save :: forall w i. i -> HH.HTML w i
btn_save action = btn_ C.is_info "Save" action

btn_add :: forall w i. i -> HH.HTML w i
btn_add action = btn_ C.is_info "Add" action

btn_delete :: forall w i. i -> HH.HTML w i
btn_delete action = btn_ (C.is_small <> C.is_danger) "✖" action

btn_modify_ro :: forall w i. HH.HTML w i
btn_modify_ro = btn_ro (C.is_small <> C.is_warning) "modify"

btn_readonly :: forall w i. HH.HTML w i
btn_readonly = btn_ro (C.is_small <> C.is_warning) "read only"

btn_delete_ro :: forall w i. HH.HTML w i
btn_delete_ro = btn_ro (C.is_small <> C.is_warning) "remove"

btn_ro :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
btn_ro classes title
  = HH.button
      [ HP.classes $ C.button <> classes
      ] [ HH.text title ]

-- | Create a `level`, different components that should appear on the same horizontal line.
-- | First argument, elements that should appear on the left, second on the right.
level :: forall w i. Array (HH.HTML w i) -> Array (HH.HTML w i) -> HH.HTML w i
level left right = HH.nav [ HP.classes C.level ]
                          [ HH.div [ HP.classes C.level_left  ] $ itemize left
                          , HH.div [ HP.classes C.level_right ] $ itemize right
                          ]
   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

render_input :: forall w i.
  Boolean -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
render_input password id placeholder action value cond
  = HH.input $
      [ HE.onValueInput action
      , HP.value value
      , HP.placeholder placeholder
      , HP.classes $ input_classes
      , HP.id id
      , cond
      ] <> case password of
        false -> []
        true -> [ HP.type_ HP.InputPassword ]

-- | 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
div_field classes = HH.div [HP.classes (C.field <> C.is_horizontal <> classes)]

-- | Field label (id and title) for a Bulma `field`.
div_field_label :: forall w i. String -> String -> HH.HTML w i
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 ]]

-- | Any `Halogen.HTML` data in Bulma `field-body > field > control` divs.
div_field_content :: forall w i. HH.HTML w i -> HH.HTML w i
div_field_content content
  = HH.div [ HP.classes C.field_body ]
           [ HH.div [HP.classes C.field ] [ HH.div [HP.classes C.control ] [ content ] ] ]

-- | Basic field entry with a title and a field content.
-- |
-- |```
-- |div [field is-horizontal]
-- |  div [field-label is-normal]
-- |    label [for-id]
-- |      text
-- |  div [field-body]
-- |    div [field]
-- |      div [control]
-- |```
field_entry :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
field_entry id title entry
  = div_field []
      [ div_field_label id title
      , div_field_content entry
      ]

-- | Error field entry with a title and a field content.
error_field_entry :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
error_field_entry id title entry
  = div_field C.has_background_danger_light
      [ div_field_label id title
      , div_field_content entry
      ]

error_box :: forall w i. String -> String -> String -> HH.HTML w i
error_box id title value = error_field_entry id title $ notification_danger' value

field_inner :: forall w i.
  Boolean -> (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
field_inner ispassword cond id title placeholder action value
  = field_entry id title $ render_input ispassword id placeholder action value cond

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
  = field_entry id title $ HH.button
      [ HE.onClick \_ -> action
      , HP.classes $ C.button <> C.is_small <> C.is_info
      , HP.id id
      ] [ HH.text button_text ]

box_input_ :: forall w i.
  (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
box_input_ = field_inner false

box_password_ :: forall w i.
  (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
box_password_ = field_inner true

box_input :: forall w i. String -> String -> String -> (String -> i) -> String -> HH.HTML w i
box_input = box_input_ (HP.enabled true)

box_password :: forall w i. String -> String -> String -> (String -> i) -> String -> HH.HTML w i
box_password = box_password_ (HP.enabled true)

section_small :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
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) ]

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
  = div_field_ C.has_addons
      [ HH.p
          [ HP.classes C.control ]
          [ HH.input $
              [ HE.onValueInput inputaction
              , HP.placeholder "www"
              , HP.value text_
              , HP.type_ HP.InputText
              , HP.classes (C.is_primary <> C.input)
              ]
          ]
      , HH.p
          [ HP.classes C.control ]
          [ select selectaction $ map option accepted_domains ]
      ]

code :: forall w i. String -> HH.HTML w i
code str = HH.code_ [ HH.text str ]

text :: forall w i. String -> HH.HTML w i
text = HH.text

p :: forall w i. String -> HH.HTML w i
p str = HH.p_ [ HH.text str ]

p_ :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
p_ classes str = HH.p [HP.classes classes] [ HH.text str ]

box :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
box = HH.div [HP.classes C.box]

box_ :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
box_ classes = HH.div [HP.classes $ C.box <> classes]

option :: forall w i. String -> HH.HTML w i
option value = HH.option_ [HH.text value]

select :: forall w i. HH.Node DHI.HTMLselect w i
select action options
  = HH.div [ HP.classes (C.select <> C.is_primary) ]
           [ HH.select action options]

hero :: forall w i. String -> String -> HH.HTML w i
hero _title _subtitle
  = HH.section [ HP.classes (C.hero <> C.is_info <> C.is_small) ]
      [ HH.div [ HP.classes C.hero_body ]
          [ HH.p [ HP.classes C.title ] [ HH.text _title ]
          , HH.p [ HP.classes C.subtitle ] [ HH.text _subtitle ]
          ]
      ]

small_hero :: forall w i. String -> String -> HH.HTML w i
small_hero _title _subtitle =
  HH.section [ HP.classes (C.hero <> C.is_info <> C.is_small) ]
    [ HH.div [ HP.classes C.hero_body ]
        [ HH.div [ HP.classes $ C.container <> C.has_text_centered ]
            [ HH.p [ HP.classes C.title ]    [ HH.text _title ]
            , HH.p [ HP.classes C.subtitle ] [ HH.text _subtitle ]
            ]
        ]
    ]

hero_danger :: forall w i. String -> String -> HH.HTML w i
hero_danger _title _subtitle
  = HH.section [ HP.classes (C.hero <> C.is_danger <> C.is_small) ]
      [ HH.div [ HP.classes C.hero_body ]
          [ HH.p [ HP.classes C.title ] [ HH.text _title ]
          , HH.p [ HP.classes C.subtitle ] [ HH.text _subtitle ]
          ]
      ]

header :: forall w i. String -> String -> HH.HTML w i
header = hero

container :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
container = HH.div [HP.classes (C.container <> C.is_info)]

data_target :: forall r i. String -> HP.IProp r i
data_target = HP.attr (AttrName "data-target")

modal_ :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
modal_ = HH.div [HP.classes (C.modal <> C.is_active)]
modal_background :: forall w i. HH.HTML w i
modal_background = HH.div [HP.classes C.modal_background] []
modal_card_large :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
modal_card_large = HH.div [HP.classes $ C.modal_card <> C.is_large]
modal_header :: forall w i. String -> HH.HTML w i
modal_header title = HH.header [HP.classes C.modal_card_head]
  [ HH.p [HP.classes C.modal_card_title] [HH.text title]
  ]
modal_body :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
modal_body = HH.section [HP.classes C.modal_card_body]
modal_foot :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
modal_foot = HH.div [HP.classes C.modal_card_foot]

cancel_button :: forall w i. i -> HH.HTML w i
cancel_button action
  = HH.button [ HP.classes C.button
              , HE.onClick \_ -> action
              ] [HH.text "Cancel"]

strong :: forall w i. String -> HH.HTML w i
strong str = HH.strong_ [ HH.text str ]

hr :: forall w i. HH.HTML w i
hr = HH.hr_

tile :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
tile classes = HH.div [HP.classes (C.tile <> classes)]

tile_ :: forall w i. Array (HH.HTML w i) ->  HH.HTML w i
tile_ = tile []

tile_danger :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
tile_danger classes = tile (C.is_danger <> C.notification <> classes)

tile_warning :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
tile_warning classes = tile (C.is_warning <> C.notification <> classes)

article_ :: forall w i. Array HH.ClassName -> HH.HTML w i -> HH.HTML w i -> HH.HTML w i
article_ classes head body = HH.article [HP.classes (C.message <> classes)]
  [ HH.div [HP.classes C.message_header] [head]
  , HH.div [HP.classes C.message_body  ] [body]
  ]

article :: forall w i. HH.HTML w i -> HH.HTML w i -> HH.HTML w i
article head body = article_ [] head body

error_message :: forall w i. HH.HTML w i -> HH.HTML w i -> HH.HTML w i
error_message head body = article_ C.is_danger head body


-- | Basic input field with a read-only side text.
-- |
-- |```
-- |div [field is-horizontal]
-- |  div [field-label normal]
-- |    label [label for-id]
-- |      text
-- |  div [field-body]
-- |    div [has-addons field]
-- |      p [control]
-- |        input
-- |      p [control]
-- |        a [button is-small is-static]
-- |          text
-- |```
input_with_side_text :: forall w i.
  String -> String -> String -> (String -> i) -> String -> String -> HH.HTML w i
input_with_side_text id title placeholder action value sidetext
  = HH.div [HP.classes $ C.field <> C.is_horizontal]
      [ HH.div [ HP.classes (C.field_label <> C.normal) ]
               [HH.label [ HP.classes C.label, HP.for id ] [ HH.text title ]]
      , HH.div [ HP.classes C.field_body ]
          [ HH.div [ HP.classes $ C.has_addons <> C.field ]
              [ HH.p [HP.classes C.control]
                  [ HH.input $
                    [ HE.onValueInput action
                    , HP.value value
                    , HP.placeholder placeholder
                    , HP.classes $ input_classes
                    , HP.id id
                    ]
                  ]
              , HH.p [HP.classes C.control]
                  [ HH.a [HP.classes $ C.button <> C.is_small <> C.is_static]
                         [HH.text sidetext] ]
              ]
          ]
      ]

-- | `modal`: create a modal by providing a few things:
-- | - a title (a simple String)
-- | - a body (`HTML` content)
-- | - a footer (`HTML` content)
modal :: forall w i. String -> Array (HH.HTML w i) -> Array (HH.HTML w i) -> HH.HTML w i
modal title body foot =
  modal_
    [ modal_background
    , modal_card_large [modal_header title, modal_body body]
    , modal_foot foot
    ]

-- selection: create a "select" input.
-- Get the changes with "onSelectedIndexChange" which provides an index.
selection :: forall w i. (Int -> i) -> Array String -> String -> HH.HTML w i
selection action values selected = HH.div [HP.classes $ C.select <> C.is_normal]
  [ HH.select [ HE.onSelectedIndexChange action ]
    $ map (\n -> HH.option [HP.value n, HP.selected (n == selected)] [HH.text n]) values
  ]

selection_field :: forall w i. String -> String -> (Int -> i) -> Array String -> String -> HH.HTML w i
selection_field id title action values selected
  = field_entry id title $ selection action values selected

selection_field' :: forall w i.
  String -> String -> (Int -> i) -> Array (Tuple String String) -> String -> HH.HTML w i
selection_field' id title action values selected
  = field_entry id title $ selection' action values selected

selection_field'' :: forall w i t. Show t =>
  String -> String -> (Int -> i) -> Array (Tuple String String) -> t -> Maybe t -> HH.HTML w i
selection_field'' id title action values default_value selected
  = field_entry id title $ selection' action values selected_value
  where
  selected_value = (show $ fromMaybe default_value selected)

-- | selection': as `selection` but takes an array of tuple as values.
-- | First value in the tuple is what to display, the second one is what to match on.
selection' :: forall w i. (Int -> i) -> Array (Tuple String String) -> String -> HH.HTML w i
selection' action values selected = HH.div [HP.classes $ C.select <> C.is_normal]
  [ HH.select [ HE.onSelectedIndexChange action ]
    $ map (\n -> HH.option [HP.value (snd n), HP.selected ((snd n) == selected)] [HH.text (fst n)]) values
  ]

tag_light_info :: forall w i. String -> HH.HTML w i
tag_light_info str = HH.span [HP.classes (C.tag <> C.is_info <> C.is_light)] [HH.text str]

div_large_content :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
div_large_content content = HH.div [HP.classes (C.is_large <> C.content)] content

div_content :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
div_content classes content = HH.div [HP.classes (C.content <> classes)] content

explanation :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
explanation content = HH.blockquote [HP.classes [HH.ClassName "justified"]] content

quote :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
quote content = div_content [] [ explanation content ]

simple_quote :: forall w i. String -> HH.HTML w i
simple_quote content = quote [ p content ]

tabs :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
tabs classes tab_list = HH.div [HP.classes $ C.tabs <> classes] [HH.ul_ tab_list]

fancy_tabs :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
fancy_tabs arr = tabs (C.is_medium <> C.is_boxed <> C.is_centered) arr

tab_entry :: forall w i. Boolean -> String -> i -> HH.HTML w i
tab_entry active name action =
  HH.li (if active then [HP.classes C.is_active] else [])
    [ HH.a [HE.onClick \_ -> action] [HH.text name] ]

delete_btn :: forall w i. i -> HH.HTML w i
delete_btn action = HH.button [HE.onClick \_ -> action, HP.classes C.delete] []

notification :: forall w i. Array HH.ClassName -> String -> i -> HH.HTML w i
notification classes value deleteaction =
  HH.div [HP.classes (C.notification <> classes)]
         [ delete_btn deleteaction
         , HH.text value
         ]

notification_primary :: forall w i. String -> i -> HH.HTML w i
notification_primary value action = notification C.is_primary value action

notification_success :: forall w i. String -> i -> HH.HTML w i
notification_success value action = notification C.is_success value action

notification_warning :: forall w i. String -> i -> HH.HTML w i
notification_warning value action = notification C.is_warning value action

notification_danger :: forall w i. String -> i -> HH.HTML w i
notification_danger value action = notification C.is_danger value action

notification_block' :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
notification_block' classes content =
  HH.div [HP.classes (C.notification <> classes)] content

notification' :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
notification' classes value =
  HH.div [HP.classes (C.notification <> classes)]
         [ HH.text value ]

notification_primary' :: forall w i. String -> HH.HTML w i
notification_primary' value = notification' C.is_primary value

notification_warning' :: forall w i. String -> HH.HTML w i
notification_warning' value = notification' C.is_warning value

notification_danger' :: forall w i. String -> HH.HTML w i
notification_danger' value = notification' C.is_danger value

notification_danger_block' :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
notification_danger_block' content = notification_block' C.is_danger content

btn_validation_ :: forall w i. String -> HH.HTML w i
btn_validation_ str = HH.button
  -- [ HP.style "padding: 0.5rem 1.25rem;"
  [ HP.type_ HP.ButtonSubmit
  , HP.classes $ C.button <> C.is_primary
  ]
  [ HH.text str ]

btn_validation :: forall w i. HH.HTML w i
btn_validation = btn_validation_ "Validate"

-- | Box with tags.
box_with_tag :: forall w action.
  Array HH.ClassName            -- css classes (like the color)
  -> HH.HTML w action           -- tag (title for the box)
  -> Array (HH.HTML w action)   -- box content
  -> HH.HTML w action
box_with_tag colors tag xs
  = box_
    (C.no_padding_left <> C.no_padding_top <> colors)
    [tag, HH.div [HP.classes $ C.restore_padding_left <> C.restore_padding_top] xs]