Bulma CSS style: WIP.

This commit is contained in:
Philippe Pittoli 2023-06-08 21:51:12 +02:00
parent 3831b275b4
commit 987133954f
4 changed files with 365 additions and 75 deletions

View File

@ -31,6 +31,7 @@
, "web-encoding"
, "web-events"
, "web-socket"
, "web-uievents"
]
, packages = ./packages.dhall
, sources = [ "src/**/*.purs", "test/**/*.purs" ]

View File

@ -2,6 +2,8 @@ module App.AuthenticationForm where
import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=))
import Bulma as Bulma
import Control.Monad.Except (runExcept)
import Control.Monad.State (class MonadState)
import Data.Array as A
@ -125,7 +127,7 @@ type WebSocketMessageType = ArrayBuffer
-- Root component module
--------------------------------------------------------------------------------
data Output = AuthToken String
data Output = AuthToken (Tuple Int String)
type Slot = H.Slot Query Output
type Query :: forall k. k -> Type
@ -196,19 +198,6 @@ initialState input =
, canReconnect: false
}
wrapperStyle :: String
wrapperStyle =
"""
display: block;
flex-direction: column;
justify-content: space-between;
height: calc(100vh - 30px);
background: #282c34;
color: #e06c75;
font-family: 'Consolas';
padding: 5px 20px 5px 20px;
"""
render :: forall m. State -> H.ComponentHTML Action () m
render {
messages,
@ -217,53 +206,73 @@ render {
authenticationForm,
registrationForm }
= HH.div
[ HP.style wrapperStyle ]
[ render_auth_form
, render_register_form
= HH.div_
[ Bulma.columns_ [ Bulma.column_ auth_form, Bulma.column_ register_form ]
, render_messages
--, renderMaxHistoryLength messageHistoryLength
, renderReconnectButton (isNothing wsConnection && canReconnect)
]
where
auth_form
= [ Bulma.h3 "Authentication"
, render_auth_form
]
register_form
= [ Bulma.h3 "Register!"
, render_register_form
]
render_input password placeholder action value validity cond
= HH.input $
[ HE.onValueInput action
, HP.value value
, HP.placeholder placeholder
, Bulma.input_classes validity
, cond
] <> case password of
false -> []
true -> [ HP.type_ HP.InputPassword ]
box_input title placeholder action value validity cond
= HH.label [ ]
[ HH.label [HP.classes Bulma.class_label ] [ HH.text title ]
, HH.div [HP.classes Bulma.class_control ] [ render_input false placeholder action value validity cond ]
]
box_password title placeholder action value validity cond
= HH.label [ ]
[ HH.label [HP.classes Bulma.class_label ] [ HH.text title ]
, HH.div [HP.classes Bulma.class_control ] [ render_input true placeholder action value validity cond ]
]
render_auth_form = HH.form
[ HE.onSubmit AuthenticationAttempt ]
[ HH.h2_ [ HH.text "Authentication!" ]
, HH.p_
[ HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value authenticationForm.login
, HE.onValueInput $ HandleAuthenticationInput <<< AUTH_INP_login
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputPassword
, HP.value authenticationForm.pass
, HE.onValueInput $ HandleAuthenticationInput <<< AUTH_INP_pass
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.button
[ HP.style "padding: 0.5rem 1.25rem;"
, HP.type_ HP.ButtonSubmit
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
[ HH.text "Send Message to Server" ]
]
[ box_input
"Login" -- title
"login" -- placeholder
(HandleAuthenticationInput <<< AUTH_INP_login) -- action
authenticationForm.login -- value
true -- validity (TODO)
(maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) -- condition
, box_password
"Password" -- title
"password" -- placeholder
(HandleAuthenticationInput <<< AUTH_INP_pass) -- action
authenticationForm.pass -- value
true -- validity (TODO)
(maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) -- condition
, HH.button
[ HP.style "padding: 0.5rem 1.25rem;"
, HP.type_ HP.ButtonSubmit
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
[ HH.text "Send Message to Server" ]
]
render_register_form = HH.form
[ HE.onSubmit RegisterAttempt ]
[ HH.h2_ [ HH.text "Register!" ]
, HH.p_
[ HH.p_
[ HH.div_
[ HH.input
[ inputCSS
@ -460,7 +469,7 @@ handleAction = case _ of
-- The authentication was a success!
(AuthD.GotToken msg) -> do
appendMessage $ "[😈] Success! user " <> (show msg.uid) <> " has token: " <> msg.token
H.raise $ AuthToken msg.token
H.raise $ AuthToken (Tuple msg.uid msg.token)
(AuthD.GotUserAdded msg) -> do
appendMessage $ "[😈] Success! Server added user: " <> show msg.user
-- WTH?!

View File

@ -2,20 +2,21 @@ module App.Container where
import Prelude
import Bulma as Bulma
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import App.AuthenticationForm as AF
import App.AuthenticationDaemonAdminInterface as AAI
import Halogen as H
import Halogen.HTML as HH
-- import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Type.Proxy (Proxy(..))
import Effect.Aff.Class (class MonadAff)
data Action
= Authenticated AF.Output -- User has been authenticated.
type State = { token :: Maybe String }
type State = { token :: Maybe String, uid :: Maybe Int }
type ChildSlots =
( af :: AF.Slot Unit
@ -34,7 +35,7 @@ component =
}
initialState :: forall i. i -> State
initialState _ = { token: Nothing }
initialState _ = { token: Nothing, uid: Nothing }
render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
render state
@ -45,33 +46,21 @@ render state
]
where
div_token :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
div_token =
HH.div_ [
HH.p_ [ HH.text ("Token is: " <> show state.token) ]
]
div_token = Bulma.box [ Bulma.p ("User [" <> show state.uid <> "] has token: " <> show state.token) ]
render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_auth_form = case state.token of
Nothing -> HH.div
[ HP.class_ (H.ClassName "box") ]
[ HH.h1_ [ HH.text "Authentication form" ]
, HH.slot _af unit AF.component "ws://127.0.0.1:8081" Authenticated
]
Just current_token -> HH.div
[ HP.class_ (H.ClassName "box") ]
[ HH.p_ [ HH.text ("Token is: " <> current_token) ] ]
render_auth_form = Bulma.box $ case state.token of
Nothing -> [ HH.slot _af unit AF.component "ws://127.0.0.1:8081" Authenticated ]
Just current_token -> [ Bulma.p ("Token is: " <> current_token) ]
render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_authd_admin_interface = case state.token of
Just _ -> HH.div
[ HP.class_ (H.ClassName "box") ]
[ HH.h1_ [ HH.text "Administrative interface for authd" ]
render_authd_admin_interface = Bulma.box $ case state.token of
Just _ ->
[ Bulma.h1 "Administrative interface for authd"
, HH.slot_ _aai unit AAI.component "ws://127.0.0.1:8081"
]
Nothing -> HH.div
[ HP.class_ (H.ClassName "box") ]
[ HH.p_ [ HH.text ("Here will be the administrative box.") ] ]
Nothing -> [ Bulma.p "Here will be the administrative box." ]
handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit
handleAction = case _ of
Authenticated (AF.AuthToken newtoken) -> H.modify_ _ { token = Just newtoken }
Authenticated (AF.AuthToken (Tuple uid token)) -> H.modify_ _ { uid = Just uid, token = Just token }

291
src/Bulma.purs Normal file
View File

@ -0,0 +1,291 @@
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" ]
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
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]