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

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

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

btn_modify :: forall w i. i -> HH.HTML w i
btn_modify action
  = HH.button
      [ HE.onClick \_ -> action
      , HP.classes $ btn_classes true
      ] [ HH.text "modify" ]

btn_save :: forall w i. i -> HH.HTML w i
btn_save action
  = HH.button
      [ HE.onClick \_ -> action
      , HP.classes $ btn_classes true
      ] [ HH.text "save" ]

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 -> Boolean -> HH.HTML w i
btn_add action validity
  = HH.button
      [ HE.onClick \_ -> action
      , 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 -> HH.HTML w action
btn title action
  = HH.button
      [ HE.onClick \_ -> action
      , HP.classes $ btn_classes true
      ] [ HH.text title ]

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 ]

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
      , div_field_content $ render_input ispassword id placeholder action value 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 -> (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) ]

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