halogen-websocket-ipc-playzone/src/Bulma.purs

module Bulma where
{- This file is a wrapper around the BULMA css framework. -}

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

-- HTML PropName used with HP.prop
--import Halogen.HTML.Core (PropName(..))
-- import Web.Event.Event (type_, Event, EventType(..))
--import Web.UIEvent.MouseEvent (MouseEvent)

class_columns  :: Array (HH.ClassName)
class_columns  = [HH.ClassName "columns"  ]
class_column   :: Array (HH.ClassName)
class_column   = [HH.ClassName "column"   ]
class_title    :: Array (HH.ClassName)
class_title    = [HH.ClassName "title"    ]
class_subtitle :: Array (HH.ClassName)
class_subtitle = [HH.ClassName "subtitle" ]
class_is5      :: Array (HH.ClassName)
class_is5      = [HH.ClassName "is-5"     ]
class_is4      :: Array (HH.ClassName)
class_is4      = [HH.ClassName "is-4"     ]
class_box      :: Array (HH.ClassName)
class_box      = [HH.ClassName "box"      ]
class_label    :: Array (HH.ClassName)
class_label    = [HH.ClassName "label"    ]
class_control  :: Array (HH.ClassName)
class_control  = [HH.ClassName "control"  ]
class_select   :: Array (HH.ClassName)
class_select   = [HH.ClassName "select"   ]
class_primary  :: Array (HH.ClassName)
class_primary  = [HH.ClassName "is-primary"   ]


columns :: forall (w :: Type) (i :: Type).
  Array (HH.ClassName) -> Array (HH.HTML w i) -> HH.HTML w i
columns classes = HH.div [ HP.classes (class_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 (class_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 (class_title) ] [ HH.text title ]

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

--subtitle :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
--subtitle title = HH.h2 [ HP.classes (class_subtitle <> class_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 :: forall (r :: Row Type) (i :: Type). Boolean -> HP.IProp ( class :: String | r ) i
input_classes true  = HP.classes [ HH.ClassName "input is-small is-info" ]
input_classes false = HP.classes [ HH.ClassName "input is-small is-danger" ]

btn_classes :: forall (r :: Row Type) (i :: Type)
  . Boolean -> HP.IProp ( class :: String | r ) i
btn_classes true  = HP.classes [ HH.ClassName "button is-small is-info" ]
btn_classes false = HP.classes [ HH.ClassName "button is-small 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 "Domain"  ]
--                       , HH.th_ [ HH.text "TTL"   ]
--                       , HH.th_ [ HH.text "Value" ]
--                       ]
--              ]
--
--mx_table_header :: forall w i. HH.HTML w i
--mx_table_header
--  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Domain"  ]
--                       , HH.th_ [ HH.text "TTL"   ]
--                       , HH.th_ [ HH.text "Priority" ]
--                       , HH.th_ [ HH.text "Value" ]
--                       ]
--              ]
--
--srv_table_header :: forall w i. HH.HTML w i
--srv_table_header
--  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Domain"  ]
--                       , HH.th_ [ HH.text "TTL"   ]
--                       , HH.th_ [ HH.text "Priority" ]
--                       , HH.th_ [ HH.text "Weight" ]
--                       , HH.th_ [ HH.text "Port" ]
--                       , HH.th_ [ HH.text "Value" ]
--                       ]
--              ]
--
--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", input_classes validity ]
input_email action email validity
  = HH.input
      [ HE.onValueInput action
      , HP.value email
      , HP.placeholder "email"
      , 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 class_label ] [ HH.text "Email" ]
  , HH.div [HP.classes class_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", input_classes validity ]
input_password action password validity
  = HH.input
      [ HE.onValueInput action
      , HP.value password
      , HP.placeholder "password"
      , 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 class_label ] [ HH.text "Password" ]
  , HH.div [HP.classes class_control ] [ input_password action password validity ]
  ]


---- TODO: right types
---- input_domain :: forall a w i
----   . (String -> a)
----   -> String
----   -> Boolean
----   -> HH.HTML w i
--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"
--      , 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 class_label ] [ HH.text "Domain" ]
--  , HH.div [HP.classes class_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
--      , HP.prop (PropName "size") 6.0
--      , HP.placeholder "ttl"
--      , 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 class_label ] [ HH.text "TTL" ]
--  , HH.div [HP.classes class_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
--      , HP.prop (PropName "size") 6.0
--      , HP.placeholder "priority"
--      , 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 class_label ] [ HH.text "Priority" ]
--  , HH.div [HP.classes class_control ] [ input_priority action value validity ]
--  ]
--
--
--input_value :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
--input_value action value validity
--  = HH.input
--      [ HE.onValueInput action
--      , HP.value value
--      , HP.placeholder "value"
--      , input_classes validity
--      ]
--
--box_input_value :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
--box_input_value action value validity = HH.label [ ]
--  [ HH.label [HP.classes class_label ] [ HH.text "Value" ]
--  , HH.div [HP.classes class_control ] [ input_value 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
--      , HP.prop (PropName "size") 6.0
--      , HP.placeholder "weight"
--      , 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 class_label ] [ HH.text "Weight" ]
--  , HH.div [HP.classes class_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
--      , HP.prop (PropName "size") 6.0
--      , HP.placeholder "port"
--      , 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 class_label ] [ HH.text "Port" ]
--  , HH.div [HP.classes class_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
--      , btn_classes validity
--      ] [ HH.text "fix" ]
--  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 "X" ]
--
--
--btn_add :: forall w i. i -> i -> Boolean -> HH.HTML w i
--btn_add action1 action2 validity
--  = HH.button
--      [ btn_add_action validity
--      , btn_classes validity
--      ] [ HH.text "Add" ]
--  where
--
--    btn_add_action = case _ of
--      true -> HE.onClick \_ -> action1
--      _    -> HE.onClick \_ -> action2


btn :: forall w action. String -> action -> action -> Boolean -> HH.HTML w action
btn title action1 action2 validity
  = HH.button
      [ btn_add_action validity
      , btn_classes validity
      ] [ HH.text title ]
  where
    btn_add_action = case _ of
      true -> HE.onClick \_ -> action1
      _    -> HE.onClick \_ -> action2


render_input password placeholder action value validity cond
  = HH.input $
      [ HE.onValueInput action
      , HP.value value
      , HP.placeholder placeholder
      , input_classes validity
      , cond
      ] <> case password of
        false -> []
        true -> [ HP.type_ HP.InputPassword ]

class_horizontal  :: Array (HH.ClassName)
class_horizontal  = [HH.ClassName "is-horizontal"   ]
class_normal  :: Array (HH.ClassName)
class_normal  = [HH.ClassName "is-normal"   ]
class_field  :: Array (HH.ClassName)
class_field  = [HH.ClassName "field"   ]
class_field_label  :: Array (HH.ClassName)
class_field_label  = [HH.ClassName "field-label"   ]
class_field_body  :: Array (HH.ClassName)
class_field_body  = [HH.ClassName "field-body"   ]

field_inner ispassword title placeholder action value validity cond
  = div_field
      [ div_field_label title
      , div_field_content $ render_input ispassword placeholder action value validity cond
      ]
  where
    div_field = HH.div [ HP.classes (class_field <> class_horizontal) ]
    div_field_label title
      = HH.div [ HP.classes (class_field_label <> class_normal) ]
               [HH.label [ HP.classes class_label ] [ HH.text title ]]
    div_field_content content
      = HH.div [HP.classes class_field_body]
          [ HH.div [HP.classes class_field ]
              [ HH.div [HP.classes class_control ] [ content ]
              ]
          ]

box_input    = field_inner false
box_password = field_inner true

class_has_addons :: Array (HH.ClassName)
class_has_addons = [HH.ClassName "has-addons"]

field classes = HH.div [ HP.classes (class_field <> classes) ]

class_input  :: Array (HH.ClassName)
class_input  = [HH.ClassName "input"   ]

new_domain_field inputaction text selectaction accepted_domains
  = field class_has_addons
      [ HH.p
          [ HP.classes class_control ]
          [ HH.input $
              [ HE.onValueInput inputaction
              , HP.placeholder "www"
              , HP.value text
              , HP.type_ HP.InputText
              , HP.classes (class_primary <> class_input)
              ]
          ]
      , HH.p
          [ HP.classes class_control ]
          [ select selectaction $ map option accepted_domains ]
      , HH.p
          [ HP.classes class_control ]
          [ HH.button
              [ HP.type_ HP.ButtonSubmit
              , HP.classes class_primary
              ]
              [ HH.text "add a new domain!" ]
          ]
      ]

--<div class="field has-addons">
--  <p class="control">
--    <span class="select">
--      <select>
--        <option>$</option>
--        <option>£</option>
--        <option>€</option>
--      </select>
--    </span>
--  </p>
--  <p class="control">
--    <input class="input" type="text" placeholder="Amount of money">
--  </p>
--  <p class="control">
--    <a class="button">
--      Transfer
--    </a>
--  </p>
--</div>

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

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

box :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
box = HH.div [HP.classes class_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 (class_select <> class_primary) ]
           [ HH.select action options]

class_hero  :: Array (HH.ClassName)
class_hero  = [HH.ClassName "hero" ]
class_hero_body  :: Array (HH.ClassName)
class_hero_body  = [HH.ClassName "hero-body" ]
class_is_info  :: Array (HH.ClassName)
class_is_info  = [HH.ClassName "is-info" ]
class_is_small  :: Array (HH.ClassName)
class_is_small  = [HH.ClassName "is-small" ]

hero :: forall w i. String -> String -> HH.HTML w i
hero title subtitle
  = HH.section [ HP.classes (class_hero <> class_is_info <> class_is_small) ]
      [ HH.div [ HP.classes class_hero_body ]
          [ HH.p [ HP.classes class_title ] [ HH.text title ]
          , HH.p [ HP.classes class_subtitle ] [ HH.text subtitle ]
          ]
      ]

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

--<section class="hero">
--  <div class="hero-body">
--    <p class="title">
--      Hero title
--    </p>
--    <p class="subtitle">
--      Hero subtitle
--    </p>
--  </div>
--</section>

class_container  :: Array (HH.ClassName)
class_container  = [HH.ClassName "container" ]

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