halogen-websocket-ipc-playzone/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)

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 :: Boolean -> Array HH.ClassName
input_classes true  = C.input <> C.is_small <> C.is_info
input_classes false = C.input <> C.is_small <> C.is_danger

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

btn_classes :: Boolean -> Array HH.ClassName
btn_classes true  = C.button <> C.is_small <> C.is_info
btn_classes false = C.button <> C.is_small <> C.is_danger

simple_table_header :: forall w i. HH.HTML w i
simple_table_header
  = HH.thead_ [ HH.tr_ [ HH.th  [ HP.style "width: 50px;" ] [ HH.text "Type"  ]
                       , HH.th_ [ HH.text "Name"  ]
                       , HH.th_ [ HH.text "TTL"   ]
                       , HH.th_ [ HH.text "Target" ]
                       ]
              ]

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

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 "TTL"   ]
                       , HH.th_ [ HH.text "Priority" ]
                       , HH.th_ [ HH.text "Protocol" ]
                       , HH.th_ [ HH.text "Weight" ]
                       , HH.th_ [ HH.text "Port" ]
                       , HH.th_ [ HH.text "Target" ]
                       ]
              ]

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

input_email :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
input_email action "" validity
  = HH.input [ HE.onValueInput action
             , HP.placeholder "email"
             , HP.classes $ input_classes validity
             ]
input_email action email validity
  = HH.input
      [ HE.onValueInput action
      , HP.value email
      , HP.placeholder "email"
      , HP.classes $ input_classes validity
      ]

box_input_email :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
box_input_email action email validity = HH.label [ ]
  [ HH.label [HP.classes C.label ] [ HH.text "Email" ]
  , HH.div [HP.classes C.control ] [ input_email action email validity ]
  ]

input_password :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
input_password action "" validity
  = HH.input [ HE.onValueInput action
             , HP.placeholder "password"
             , HP.classes $ input_classes validity
             ]
input_password action password validity
  = HH.input
      [ HE.onValueInput action
      , HP.value password
      , HP.placeholder "password"
      , HP.classes $ input_classes validity
      ]

box_input_password :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
box_input_password action password validity = HH.label [ ]
  [ HH.label [HP.classes C.label ] [ HH.text "Password" ]
  , HH.div [HP.classes C.control ] [ input_password action password validity ]
  ]

input_domain :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
input_domain action domain validity
  = HH.input
      [ HE.onValueInput action
      , HP.value domain
      , HP.placeholder "domain"
      , HP.classes $ input_classes validity
      ]

box_input_domain :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
box_input_domain action domain validity = HH.label [ ]
  [ HH.label [HP.classes C.label ] [ HH.text "Domain" ]
  , HH.div [HP.classes C.control ] [ input_domain action domain validity ]
  ]

input_ttl :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
input_ttl action ttl validity
  = HH.input
      [ HE.onValueInput action
      , HP.value ttl
      , MissingProperties.size 6
      , HP.placeholder "ttl"
      , HP.classes $ input_classes validity
      ]

box_input_ttl :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
box_input_ttl action value validity = HH.label [ ]
  [ HH.label [HP.classes C.label ] [ HH.text "TTL" ]
  , HH.div [HP.classes C.control ] [ input_ttl action value validity ]
  ]

input_priority :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
input_priority action priority validity
  = HH.input
      [ HE.onValueInput action
      , HP.value priority
      , MissingProperties.size 6
      , HP.placeholder "priority"
      , HP.classes $ input_classes validity
      ]

box_input_priority :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
box_input_priority action value validity = HH.label [ ]
  [ HH.label [HP.classes C.label ] [ HH.text "Priority" ]
  , HH.div [HP.classes C.control ] [ input_priority action value validity ]
  ]

input_protocol :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
input_protocol action protocol validity
  = HH.input
      [ HE.onValueInput action
      , HP.value protocol
      , MissingProperties.size 6
      , HP.placeholder "_tcp"
      , HP.classes $ input_classes validity
      ]

box_input_protocol :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
box_input_protocol action value validity = HH.label [ ]
  [ HH.label [HP.classes C.label ] [ HH.text "Protocol" ]
  , HH.div [HP.classes C.control ] [ input_protocol action value validity ]
  ]

-- | For textareas I don't use Bulma's "textarea" class since it doesn't allow to expand
-- | textareas horizontaly, which makes edition of TXT records painful.
textarea_classes :: Boolean -> Array HH.ClassName
textarea_classes true  = C.input <> C.is_small <> C.is_info
textarea_classes false = C.input <> C.is_small <> C.is_danger

textarea :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
textarea action value validity
  = HH.textarea
      [ HE.onValueInput action
      , HP.value value
      , HP.placeholder "target"
      , HP.classes $ textarea_classes validity
      ]

input_target :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
input_target action value validity
  = HH.input
      [ HE.onValueInput action
      , HP.value value
      , HP.placeholder "target"
      , HP.classes $ input_classes validity
      ]

box_input_target :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
box_input_target action value validity = HH.label [ ]
  [ HH.label [HP.classes C.label ] [ HH.text "Target" ]
  , HH.div [HP.classes C.control ] [ input_target action value validity ]
  ]


input_weight :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
input_weight action weight validity
  = HH.input
      [ HE.onValueInput action
      , HP.value weight
      , MissingProperties.size 6
      , HP.placeholder "weight"
      , HP.classes $ input_classes validity
      ]

box_input_weight :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
box_input_weight action weight validity = HH.label [ ]
  [ HH.label [HP.classes C.label ] [ HH.text "Weight" ]
  , HH.div [HP.classes C.control ] [ input_weight action weight validity ]
  ]


input_port :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
input_port action port validity
  = HH.input
      [ HE.onValueInput action
      , HP.value port
      , MissingProperties.size 6
      , HP.placeholder "port"
      , HP.classes $ input_classes validity
      ]

box_input_port :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
box_input_port action port validity = HH.label [ ]
  [ HH.label [HP.classes C.label ] [ HH.text "Port" ]
  , HH.div [HP.classes C.control ] [ input_port action port validity ]
  ]


btn_change :: forall w i. i -> i -> Boolean -> Boolean -> HH.HTML w i
btn_change action1 action2 modified validity
  = HH.button
      [ HP.disabled (not modified)
      , btn_change_action validity
      , HP.classes $ btn_classes validity
      ] [ HH.text "save" ]
  where
    btn_change_action = case _ of
      true -> HE.onClick \_ -> action1
      _    -> HE.onClick \_ -> action2

btn_delete :: forall w i. (MouseEvent -> i) -> HH.HTML w i
btn_delete action
  = HH.button
      [ HE.onClick action
      , HP.classes [ HH.ClassName "button is-small is-danger" ]
      ] [ HH.text "remove" ]

btn_add :: forall w i. i -> i -> Boolean -> HH.HTML w i
btn_add action1 action2 validity
  = HH.button
      [ if validity then (HE.onClick \_ -> action1) else (HE.onClick \_ -> action2)
      , HP.classes $ btn_classes validity
      ] [ HH.text "Add" ]

-- | 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_add_new_rr :: forall w i. i -> String -> HH.HTML w i
btn_add_new_rr action title
  = HH.button
      [ HE.onClick \_ -> action
      , HP.classes $ C.button <> C.is_small <> C.is_info
      ] [ HH.text title ]

btn :: forall w action. String -> action -> action -> Boolean -> HH.HTML w action
btn title action1 action2 validity
  = HH.button
      [ if validity then (HE.onClick \_ -> action1) else (HE.onClick \_ -> action2)
      , HP.classes $ btn_classes validity
      ] [ HH.text title ]

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

field_inner :: forall w i.
  Boolean -> String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
field_inner ispassword id title placeholder action value validity cond
  = div_field
      [ div_field_label
      , div_field_content $ render_input ispassword id placeholder action value validity cond
      ]
  where
    div_field = HH.div [ HP.classes (C.field <> C.is_horizontal) ]
    div_field_label
      = HH.div [ HP.classes (C.field_label <> C.normal) ]
               [HH.label [ HP.classes C.label, HP.for id ] [ HH.text title ]]
    div_field_content content
      = HH.div [ HP.classes C.field_body ]
          [ HH.div [HP.classes C.field ]
              [ HH.div [HP.classes C.control ] [ content ]
              ]
          ]

box_input :: forall w i.
  String -> String -> String -> (String -> i) -> String -> Boolean -> (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 -> Boolean -> (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) ]

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

new_domain_field :: forall w i.
  (String -> i) -> String -> Array (HP.IProp DHI.HTMLselect i) -> Array String -> HH.HTML w i
new_domain_field inputaction text selectaction accepted_domains
  = field C.has_addons
      [ 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 ]
      , HH.p
          [ HP.classes C.control ]
          [ HH.button
              [ HP.type_ HP.ButtonSubmit
              , HP.classes C.button
              ]
              [ HH.text "add a new domain!" ]
          ]
      ]

--box_button action value validity cond
--  = HH.label [ ]
--      [ HH.label [HP.classes C.label ] [ HH.text title ]
--      , HH.div [HP.classes C.control ]
--          [ render_input ispassword placeholder action value validity cond ]
--      ]

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

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]

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

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]

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

modal_domain_delete :: forall w i. String -> HH.HTML w i
modal_domain_delete domain =
  modal
    [ modal_background
    , modal_card [modal_header "Deleting a domain", modal_body]
    , modal_foot [modal_delete_button, modal_cancel_button]
    ]
    where
      -- modal_header = HH.header [HP.classes C.modal_card_head]
      --   [ HH.p [HP.classes C.modal_card_title] [HH.text "Deleting a domain"]
      --   --, HH.button [HP.classes C.delete, ARIA.label "close"] []
      --   ]
      modal_body = HH.section [HP.classes C.modal_card_body] [ warning_message ]
      -- modal_foot = HH.div [HP.classes C.modal_card_foot]
      modal_delete_button = HH.button [HP.classes (C.button <> C.is_success)] [HH.text "Delete the domain."]
      modal_cancel_button = HH.button [HP.classes C.button]                       [HH.text "Cancel"]
      warning_message
        = HH.p [] [ HH.text $ "You are about to delete your domain '"
                              <> domain
                              <> "'. Are you sure you want to do this? This is "
                  , HH.strong_ [ HH.text "irreversible" ]
                  , HH.text "."
                  ]

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