Bulma CSS style: WIP.

spago.dhall

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

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
+    = HH.div_
-       [ HP.style wrapperStyle ]
+       [ Bulma.columns_ [ Bulma.column_ auth_form, Bulma.column_ register_form ]
-       [ render_auth_form
-       , render_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!" ]
+        [ 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.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?!

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 =
+    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 = 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 = 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"
         ]
-      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 = 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 }

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]