From 987133954f1aae40ca74c6cbda4563f349eb1b4d Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Thu, 8 Jun 2023 21:51:12 +0200 Subject: [PATCH] Bulma CSS style: WIP. --- spago.dhall | 1 + src/App/AuthenticationForm.purs | 109 ++++++------ src/App/Container.purs | 39 ++--- src/Bulma.purs | 291 ++++++++++++++++++++++++++++++++ 4 files changed, 365 insertions(+), 75 deletions(-) create mode 100644 src/Bulma.purs diff --git a/spago.dhall b/spago.dhall index f1830b8..a7dd531 100644 --- a/spago.dhall +++ b/spago.dhall @@ -31,6 +31,7 @@ , "web-encoding" , "web-events" , "web-socket" + , "web-uievents" ] , packages = ./packages.dhall , sources = [ "src/**/*.purs", "test/**/*.purs" ] diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs index 1bfdcb6..0ae5231 100644 --- a/src/App/AuthenticationForm.purs +++ b/src/App/AuthenticationForm.purs @@ -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?! diff --git a/src/App/Container.purs b/src/App/Container.purs index 0cc998f..70d8cdf 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -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 } diff --git a/src/Bulma.purs b/src/Bulma.purs new file mode 100644 index 0000000..1a128a7 --- /dev/null +++ b/src/Bulma.purs @@ -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]