Split Bulma module into many small modules.

This commit is contained in:
Philippe Pittoli 2025-05-05 21:26:05 +02:00
parent b21cebaf30
commit bf20d79570
14 changed files with 378 additions and 305 deletions

View file

@ -35,6 +35,7 @@ import App.Type.ResourceRecord as RR
import App.DisplayErrors (error_to_paragraph, show_error_email) import App.DisplayErrors (error_to_paragraph, show_error_email)
type ActionCancelModal :: forall k. k -> k
type ActionCancelModal i = i type ActionCancelModal i = i
modal_rr_delete :: forall w i. Int -> (Int -> i) -> ActionCancelModal i -> HH.HTML w i modal_rr_delete :: forall w i. Int -> (Int -> i) -> ActionCancelModal i -> HH.HTML w i
modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting a resource record" modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting a resource record"
@ -55,6 +56,7 @@ type ActionUpdateForm i = (Field.Field -> i)
type ActionNewToken i = (RRId -> i) type ActionNewToken i = (RRId -> i)
type ActionUpdateRR i = (RRUpdateValue -> i) type ActionUpdateRR i = (RRUpdateValue -> i)
type ActionValidateNewRR i = (AcceptedRRTypes -> i) type ActionValidateNewRR i = (AcceptedRRTypes -> i)
type ActionValidateLocalRR :: forall k. k -> k
type ActionValidateLocalRR i = i type ActionValidateLocalRR i = i
current_rr_modal :: forall w i. current_rr_modal :: forall w i.
Domain -> RRForm -> RRModal Domain -> RRForm -> RRModal

View file

@ -47,9 +47,9 @@ txt_name t
owned_domains :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i owned_domains :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i
owned_domains domains_i_exclusively_own action_enter_domain action_transfer_domain action_share_domain action_delete_domain owned_domains domains_i_exclusively_own action_enter_domain action_transfer_domain action_share_domain action_delete_domain
= if A.length domains_i_exclusively_own > 0 = if A.length domains_i_exclusively_own > 0
then Bulma.table [] [ owned_domains_table_header then Web.table [] [ owned_domains_table_header
, HH.tbody_ $ map owned_domain_row domains_i_exclusively_own , HH.tbody_ $ map owned_domain_row domains_i_exclusively_own
] ]
else Bulma.p "No domain yet." else Bulma.p "No domain yet."
where where
owned_domains_table_header :: HH.HTML w i owned_domains_table_header :: HH.HTML w i
@ -72,9 +72,9 @@ owned_domains domains_i_exclusively_own action_enter_domain action_transfer_doma
shared_domains :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i shared_domains :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i
shared_domains domains_i_share action_enter_domain action_unshare_domain action_delete_domain shared_domains domains_i_share action_enter_domain action_unshare_domain action_delete_domain
= if A.length domains_i_share > 0 = if A.length domains_i_share > 0
then Bulma.table [] [ shared_domains_table_header then Web.table [] [ shared_domains_table_header
, HH.tbody_ $ map shared_domain_row domains_i_share , HH.tbody_ $ map shared_domain_row domains_i_share
] ]
else Bulma.p "No domain yet." else Bulma.p "No domain yet."
where where
shared_domains_table_header :: HH.HTML w i shared_domains_table_header :: HH.HTML w i
@ -143,7 +143,7 @@ resource_records records action_create_or_update_rr action_delete_rr action_new_
-> Array (HH.HTML w i) -> Array (HH.HTML w i)
rr_box colors title header dp rrs = rr_box colors title header dp rrs =
if A.length rrs > 0 if A.length rrs > 0
then [ Bulma.box_with_tag colors title [Bulma.table_ [C.margin_left 3] [] [header, dp rrs]] ] then [ Bulma.box_with_tag colors title [Web.table_ [C.margin_left 3] [] [header, dp rrs]] ]
else [] else []
--title_col_props = C.is 1 --title_col_props = C.is 1

View file

@ -1,11 +1,8 @@
-- | The `Bulma` module is a wrapper around the BULMA css framework. -- | The `Bulma` module is a wrapper around the BULMA css framework.
module Bulma where module Bulma where
import Prelude (class Show, map, show, ($), (<>), (==)) import Prelude (map, ($), (<>))
import Data.Maybe (Maybe, fromMaybe)
import Data.Tuple (Tuple, fst, snd)
import Halogen.HTML as HH import Halogen.HTML as HH
import DOM.HTML.Indexed as DHI
import Halogen.HTML.Properties as HP import Halogen.HTML.Properties as HP
import Halogen.HTML.Events as HE import Halogen.HTML.Events as HE
@ -15,15 +12,6 @@ import Halogen.HTML.Core (AttrName(..))
-- import Web.Event.Event (type_, Event, EventType(..)) -- import Web.Event.Event (type_, Event, EventType(..))
-- import Web.UIEvent.MouseEvent (MouseEvent) -- package web-uievents -- import Web.UIEvent.MouseEvent (MouseEvent) -- package web-uievents
checkbox :: forall w i. Array (HH.HTML w i) -> i -> HH.HTML w i
checkbox content_ action
= HH.label
[ HP.classes [C.label] ] $ [ HH.input [ HE.onValueInput \ _ -> action, HP.type_ HP.InputCheckbox ] ] <> content_
-- <label class="checkbox">
-- <input type="checkbox" />
-- I agree to the <a href="#">terms and conditions</a>
-- </label>
outside_link :: forall w i. Array HH.ClassName -> String -> String -> HH.HTML w i outside_link :: forall w i. Array HH.ClassName -> String -> String -> HH.HTML w i
outside_link classes url title = HH.a [ HP.classes classes, HP.target "_blank", HP.href url ] [ HH.text title ] outside_link classes url title = HH.a [ HP.classes classes, HP.target "_blank", HP.href url ] [ HH.text title ]
@ -41,15 +29,6 @@ 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_ :: forall (w :: Type) (i :: Type). Array (HH.HTML w i) -> HH.HTML w i
column_ = column [] 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] ] [ HH.text title ]
h4 :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
h4 title = HH.h4 [ HP.classes [C.title] ] [ HH.text title ]
zone_rr_title :: forall (w :: Type) (a :: Type). String -> HH.HTML w a zone_rr_title :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
zone_rr_title title zone_rr_title title
= HH.h3 [ HP.classes [C.title, C.has_text_light, C.has_background_dark] ] = HH.h3 [ HP.classes [C.title, C.has_text_light, C.has_background_dark] ]
@ -67,15 +46,6 @@ hdiv = HH.div [ HP.classes [HH.ClassName "mt-5"] ]
--offcolumn offset size --offcolumn offset size
-- = column [ HH.ClassName ("is-offset-" <> (show offset) <> " is-" <> (show 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
textarea_ :: forall w i. Array HH.ClassName -> String -> String -> (String -> i) -> HH.HTML w i textarea_ :: forall w i. Array HH.ClassName -> String -> String -> (String -> i) -> HH.HTML w i
textarea_ classes placeholder value action textarea_ classes placeholder value action
= HH.textarea = HH.textarea
@ -97,117 +67,18 @@ level left right = HH.nav [ HP.classes [C.level] ]
] ]
where itemize = map (\v -> HH.div [ HP.classes [C.level_item] ] [v]) where itemize = map (\v -> HH.div [ HP.classes [C.level_item] ] [v])
-- | 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 :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
section_small = HH.section [ HP.classes [C.section, C.is_small] ] 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 :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
section_medium = HH.section [ HP.classes [C.section, C.medium] ] 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 ]
]
box :: forall w i. Array (HH.HTML w i) -> HH.HTML w i box :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
box = HH.div [HP.classes [C.box]] box = HH.div [HP.classes [C.box]]
box_ :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i 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] box_ classes = HH.div [HP.classes $ [C.box] <> classes]
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 :: forall w i. String -> String -> HH.HTML w i
hero _title _subtitle hero _title _subtitle
= HH.section [ HP.classes [C.hero, C.is_info, C.is_small] ] = HH.section [ HP.classes [C.hero, C.is_info, C.is_small] ]
@ -295,58 +166,6 @@ 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 :: 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 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] ]
]
]
]
side_text_above_input :: forall w i.
String -> String -> HH.HTML w i -> HH.HTML w i
side_text_above_input id title 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]] [ sidetext ] ]
]
]
-- | `modal`: create a modal by providing a few things: -- | `modal`: create a modal by providing a few things:
-- | - a title (a simple String) -- | - a title (a simple String)
-- | - a body (`HTML` content) -- | - a body (`HTML` content)
@ -359,38 +178,6 @@ modal title body foot =
, modal_foot foot , 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 :: 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] tag_light_info str = HH.span [HP.classes [C.tag, C.is_info, C.is_light]] [HH.text str]
@ -409,60 +196,6 @@ quote content = div_content [] [ explanation content ]
simple_quote :: forall w i. String -> HH.HTML w i simple_quote :: forall w i. String -> HH.HTML w i
simple_quote content = quote [ p content ] 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
-- | Box with tags. -- | Box with tags.
-- |``` -- |```
-- |box_with_tag [C.has_background_danger_light] some_tag [Bulma.p "Hello"] -- |box_with_tag [C.has_background_danger_light] some_tag [Bulma.p "Hello"]
@ -479,20 +212,6 @@ box_with_tag colors tag xs
-- GENERIC HTML API -- GENERIC HTML API
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 ]
code :: forall w i. String -> HH.HTML w i code :: forall w i. String -> HH.HTML w i
code str = HH.code_ [ HH.text str ] code str = HH.code_ [ HH.text str ]
@ -505,9 +224,6 @@ p str = HH.p_ [ HH.text str ]
p_ :: forall w i. Array HH.ClassName -> String -> HH.HTML w i p_ :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
p_ classes str = HH.p [HP.classes classes] [ HH.text str ] p_ classes str = HH.p [HP.classes classes] [ HH.text str ]
option :: forall w i. String -> HH.HTML w i
option value = HH.option_ [HH.text value]
strong :: forall w i. String -> HH.HTML w i strong :: forall w i. String -> HH.HTML w i
strong str = HH.strong_ [ HH.text str ] strong str = HH.strong_ [ HH.text str ]

View file

@ -3,12 +3,24 @@
module Web module Web
( module Bulma ( module Bulma
, module Web.Button , module Web.Button
, module Web.Checkbox
, module Web.Field
, module Web.Header
, module Web.Input , module Web.Input
, module Web.Notification
, module Web.Table
, module Web.Tab
, module Web.Tag , module Web.Tag
) where ) where
import Web.Button import Web.Button (alert_btn, alert_btn_abbr, btn, btn_, btn_abbr, btn_abbr_, btn_add, btn_delete, btn_delete_ro, btn_modify, btn_modify_ro, btn_readonly, btn_ro, btn_save, btn_validation, btn_validation_, delete_btn)
import Web.Input import Web.Checkbox (checkbox)
import Web.Tag import Web.Field (btn_labeled, div_field, div_field_, div_field_content, div_field_label, error_field_entry, field_entry, new_domain_field, option, select, selection, selection', selection_field, selection_field', selection_field'', side_text_above_input)
import Web.Header (h1, h3, h4)
import Web.Input (box_input, box_input_, box_password, box_password_, email_input, field_inner, input_classes, input_with_side_text, password_input, password_input_confirmation, password_input_new, render_input, token_input, username_input)
import Web.Notification (error_box, notification, notification', notification_block', notification_danger, notification_danger', notification_danger_block', notification_primary, notification_primary', notification_success, notification_warning, notification_warning')
import Web.Table (table, table_)
import Web.Tab (fancy_tabs, tab_entry, tabs)
import Web.Tag (tag, tag_ro, tags)
import Bulma import Bulma

View file

@ -15,6 +15,7 @@ module Web.Button
, btn_save , btn_save
, btn_validation , btn_validation
, btn_validation_ , btn_validation_
, delete_btn
) where ) where
import Prelude (($), (<>)) import Prelude (($), (<>))
@ -93,3 +94,6 @@ btn title action = btn_ [] title action
alert_btn :: forall w action. String -> action -> HH.HTML w action alert_btn :: forall w action. String -> action -> HH.HTML w action
alert_btn title action = btn_ [C.is_danger] title action alert_btn title action = btn_ [C.is_danger] title action
delete_btn :: forall w i. i -> HH.HTML w i
delete_btn action = HH.button [HE.onClick \_ -> action, HP.classes [C.delete]] []

17
src/Web/Checkbox.purs Normal file
View file

@ -0,0 +1,17 @@
module Web.Checkbox where
import Prelude (($), (<>))
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import Halogen.HTML.Events as HE
import CSSClasses as C
checkbox :: forall w i. Array (HH.HTML w i) -> i -> HH.HTML w i
checkbox content_ action
= HH.label
[ HP.classes [C.label] ] $ [ HH.input [ HE.onValueInput \ _ -> action, HP.type_ HP.InputCheckbox ] ] <> content_
-- <label class="checkbox">
-- <input type="checkbox" />
-- I agree to the <a href="#">terms and conditions</a>
-- </label>

8
src/Web/Div.purs Normal file
View file

@ -0,0 +1,8 @@
module Web.Div where
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import CSSClasses as C

136
src/Web/Field.purs Normal file
View file

@ -0,0 +1,136 @@
module Web.Field where
import Prelude (class Show, map, show, ($), (<>), (==))
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 CSSClasses as C
-- | 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
]
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 ]
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)
side_text_above_input :: forall w i.
String -> String -> HH.HTML w i -> HH.HTML w i
side_text_above_input id title 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]] [ sidetext ] ]
]
]
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 ]
]
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]
-- 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': 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
]
option :: forall w i. String -> HH.HTML w i
option value = HH.option_ [HH.text value]

3
src/Web/Form.purs Normal file
View file

@ -0,0 +1,3 @@
module Web.Form where

15
src/Web/Header.purs Normal file
View file

@ -0,0 +1,15 @@
module Web.Header where
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import CSSClasses as C
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] ] [ HH.text title ]
h4 :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
h4 title = HH.h4 [ HP.classes [C.title] ] [ HH.text title ]

View file

@ -1,21 +1,20 @@
module Web.Input module Web.Input where
( email_input
, password_input
, password_input_confirmation
, password_input_new
, token_input
, username_input
) where
import Prelude (($)) import Prelude (($), (<>))
import Bulma import Web.Field
import DOM.HTML.Indexed.AutocompleteType (AutocompleteType(..)) import DOM.HTML.Indexed.AutocompleteType (AutocompleteType(..))
import DOM.HTML.Indexed as DHI
import Halogen.HTML as HH import Halogen.HTML as HH
import Halogen.HTML.Properties as HP import Halogen.HTML.Properties as HP
import Halogen.HTML.Events as HE import Halogen.HTML.Events as HE
import CSSClasses as C
input_classes :: Array HH.ClassName
input_classes = [C.input, C.is_small, C.is_info]
username_input :: forall w i. String -> String -> (String -> i) -> HH.HTML w i username_input :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
username_input title value action username_input title value action
= div_field [] = div_field []
@ -111,3 +110,75 @@ token_input title value action
, HP.classes input_classes , HP.classes input_classes
] ]
] ]
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)
-- | 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] ]
]
]
]
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 -> (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

53
src/Web/Notification.purs Normal file
View file

@ -0,0 +1,53 @@
module Web.Notification where
import Prelude (($), (<>))
import Web.Field
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import CSSClasses as C
import Web.Button (delete_btn)
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
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

21
src/Web/Tab.purs Normal file
View file

@ -0,0 +1,21 @@
module Web.Tab where
import Prelude (($), (<>))
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import Halogen.HTML.Events as HE
import CSSClasses as C
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] ]

15
src/Web/Table.purs Normal file
View file

@ -0,0 +1,15 @@
module Web.Table where
import Prelude ((<>), ($))
import Halogen.HTML as HH
import DOM.HTML.Indexed as DHI
import Halogen.HTML.Properties as HP
import CSSClasses as C
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