Bulma CSS style: WIP.

master
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-encoding"
, "web-events" , "web-events"
, "web-socket" , "web-socket"
, "web-uievents"
] ]
, packages = ./packages.dhall , packages = ./packages.dhall
, sources = [ "src/**/*.purs", "test/**/*.purs" ] , 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 Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=))
import Bulma as Bulma
import Control.Monad.Except (runExcept) import Control.Monad.Except (runExcept)
import Control.Monad.State (class MonadState) import Control.Monad.State (class MonadState)
import Data.Array as A import Data.Array as A
@ -125,7 +127,7 @@ type WebSocketMessageType = ArrayBuffer
-- Root component module -- Root component module
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
data Output = AuthToken String data Output = AuthToken (Tuple Int String)
type Slot = H.Slot Query Output type Slot = H.Slot Query Output
type Query :: forall k. k -> Type type Query :: forall k. k -> Type
@ -196,19 +198,6 @@ initialState input =
, canReconnect: false , 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 :: forall m. State -> H.ComponentHTML Action () m
render { render {
messages, messages,
@ -217,53 +206,73 @@ render {
authenticationForm, authenticationForm,
registrationForm } registrationForm }
= HH.div = HH.div_
[ HP.style wrapperStyle ] [ Bulma.columns_ [ Bulma.column_ auth_form, Bulma.column_ register_form ]
[ render_auth_form
, render_register_form
, render_messages , render_messages
--, renderMaxHistoryLength messageHistoryLength
, renderReconnectButton (isNothing wsConnection && canReconnect) , renderReconnectButton (isNothing wsConnection && canReconnect)
] ]
where 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 render_auth_form = HH.form
[ HE.onSubmit AuthenticationAttempt ] [ HE.onSubmit AuthenticationAttempt ]
[ HH.h2_ [ HH.text "Authentication!" ] [ box_input
, HH.p_ "Login" -- title
[ HH.div_ "login" -- placeholder
[ HH.input (HandleAuthenticationInput <<< AUTH_INP_login) -- action
[ inputCSS authenticationForm.login -- value
, HP.type_ HP.InputText true -- validity (TODO)
, HP.value authenticationForm.login (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) -- condition
, HE.onValueInput $ HandleAuthenticationInput <<< AUTH_INP_login , box_password
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection "Password" -- title
] "password" -- placeholder
] (HandleAuthenticationInput <<< AUTH_INP_pass) -- action
, HH.div_ authenticationForm.pass -- value
[ HH.input true -- validity (TODO)
[ inputCSS (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) -- condition
, HP.type_ HP.InputPassword , HH.button
, 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.style "padding: 0.5rem 1.25rem;"
, HP.type_ HP.ButtonSubmit , HP.type_ HP.ButtonSubmit
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
] ]
[ HH.text "Send Message to Server" ] [ HH.text "Send Message to Server" ]
] ]
]
]
render_register_form = HH.form render_register_form = HH.form
[ HE.onSubmit RegisterAttempt ] [ HE.onSubmit RegisterAttempt ]
[ HH.h2_ [ HH.text "Register!" ] [ HH.p_
, HH.p_
[ HH.div_ [ HH.div_
[ HH.input [ HH.input
[ inputCSS [ inputCSS
@ -460,7 +469,7 @@ handleAction = case _ of
-- The authentication was a success! -- The authentication was a success!
(AuthD.GotToken msg) -> do (AuthD.GotToken msg) -> do
appendMessage $ "[😈] Success! user " <> (show msg.uid) <> " has token: " <> msg.token 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 (AuthD.GotUserAdded msg) -> do
appendMessage $ "[😈] Success! Server added user: " <> show msg.user appendMessage $ "[😈] Success! Server added user: " <> show msg.user
-- WTH?! -- WTH?!

View File

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