dnsmanager-webclient/src/Bulma.purs

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

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

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

simple_table_header :: forall w i. HH.HTML w i
simple_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type" ]
                       , HH.th_ [ HH.text "Name" ]
                       , HH.th_ [ HH.text "TTL" ]
                       , HH.th_ [ HH.text "Target" ]
                       , HH.th_ [ HH.text "" ]
                       , HH.th_ [ HH.text "Token" ]
                       ]
              ]

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_ [ HH.text "Name"  ]
                       , HH.th_ [ HH.text "TTL"   ]
                       , HH.th_ [ HH.text "Target" ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

mx_table_header :: forall w i. HH.HTML w i
mx_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name"  ]
                       , HH.th_ [ HH.text "TTL"   ]
                       , HH.th_ [ HH.text "Priority" ]
                       , HH.th_ [ HH.text "Target" ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

srv_table_header :: forall w i. HH.HTML w i
srv_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name"  ]
                       , HH.th_ [ HH.text "Protocol" ]
                       , HH.th_ [ HH.text "Target" ]
                       , HH.th_ [ HH.text "Port" ]
                       , HH.th_ [ HH.text "TTL"   ]
                       , HH.th_ [ HH.text "Priority" ]
                       , HH.th_ [ HH.text "Weight" ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

spf_table_header :: forall w i. HH.HTML w i
spf_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name"  ]
                       , HH.th_ [ HH.text "TTL"   ]
                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed.
                       , HH.th_ [ HH.text "Mechanisms" ]
                       , HH.th_ [ HH.text "Modifiers" ]
                       , HH.th_ [ HH.text "Default Policy" ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

dkim_table_header :: forall w i. HH.HTML w i
dkim_table_header
  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name"  ]
                       , HH.th_ [ HH.text "TTL"   ]
                       -- , 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_ [ HH.text "Notes" ]
                       , HH.th_ [ HH.text "" ]
                       ]
              ]

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_ [ HH.text "name"]
                      , HH.th_ [ HH.text "ttl"]
                      , HH.th_ [ HH.text "target"]
                      , HH.th_ [ HH.text "mname"]
                      , HH.th_ [ HH.text "rname"]
                      , HH.th_ [ HH.text "serial"]
                      , HH.th_ [ HH.text "refresh"]
                      , HH.th_ [ HH.text "retry"]
                      , HH.th_ [ HH.text "expire"]
                      , HH.th_ [ HH.text "minttl"]
                      ]
              ]

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 ]

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

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

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

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 id title
      , div_field_content $ 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
  = 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 ]
      ]

labeled_field :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
labeled_field id title content
  = div_field
      [ div_field_label id title
      , div_field_content content
      ]

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

box_password :: forall w i.
  String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
box_password = field_inner 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 :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
modal_card = HH.div [HP.classes C.modal_card]
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

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.has_addons <> 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.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 [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
  = div_field
      [ div_field_label id title
      , div_field_content $ selection action values selected
      ]

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.HTML w i) -> HH.HTML w i
div_content content = HH.div [HP.classes (C.content)] content

explanation :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
explanation content = HH.blockquote [HP.classes [HH.ClassName "justified"]] 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 deleteaction = notification C.is_primary value deleteaction

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

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

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"