Make notifications temporary.
This commit is contained in:
parent
999d801eaf
commit
987c3e100b
3 changed files with 95 additions and 18 deletions
|
@ -66,6 +66,9 @@ import App.Message.AuthenticationDaemon as AuthD
|
||||||
|
|
||||||
import App.Log as AppLog
|
import App.Log as AppLog
|
||||||
import App.WS as WS
|
import App.WS as WS
|
||||||
|
-- import App.Tick as Tick
|
||||||
|
import App.Notification as Notification
|
||||||
|
import App.Type.Notification (Notification (..))
|
||||||
|
|
||||||
import Scroll (scrollToTop)
|
import Scroll (scrollToTop)
|
||||||
|
|
||||||
|
@ -124,6 +127,8 @@ data PageEvent
|
||||||
| EventPageZone PageZone.Output
|
| EventPageZone PageZone.Output
|
||||||
| EventPageMigration PageMigration.Output
|
| EventPageMigration PageMigration.Output
|
||||||
|
|
||||||
|
| EventPageNotification Notification.Output
|
||||||
|
|
||||||
data NetworkEvent
|
data NetworkEvent
|
||||||
= EventWSAuthenticationDaemon WS.Output
|
= EventWSAuthenticationDaemon WS.Output
|
||||||
| EventWSDNSmanagerd WS.Output
|
| EventWSDNSmanagerd WS.Output
|
||||||
|
@ -157,18 +162,13 @@ data Action
|
||||||
-- | Currently, this handles the navigation bar.
|
-- | Currently, this handles the navigation bar.
|
||||||
| ToggleAuthenticated (Maybe Token)
|
| ToggleAuthenticated (Maybe Token)
|
||||||
|
|
||||||
-- | Add a main notification, at the top of the page.
|
|
||||||
| AddNotif Notification
|
|
||||||
|
|
||||||
-- | Close the main notification, at the top of the page.
|
|
||||||
| CloseNotif
|
|
||||||
|
|
||||||
-- | In order to keep the websocket overhead to a minimum, unused connections are
|
-- | In order to keep the websocket overhead to a minimum, unused connections are
|
||||||
-- | closed automatically by the client. In practice, this is handled by a simple counter
|
-- | closed automatically by the client. In practice, this is handled by a simple counter
|
||||||
-- | incremented each time a KeepAlive message is sent.
|
-- | incremented each time a KeepAlive message is sent.
|
||||||
| ResetKeepAliveCounter
|
| ResetKeepAliveCounter
|
||||||
|
|
||||||
data Notification = NoNotification | GoodNotification String | BadNotification String
|
-- | Add a main notification, at the top of the page.
|
||||||
|
| AddNotif Notification
|
||||||
|
|
||||||
-- | The component's state is composed of:
|
-- | The component's state is composed of:
|
||||||
-- | a potential authentication token,
|
-- | a potential authentication token,
|
||||||
|
@ -179,7 +179,6 @@ type State = { token :: Maybe String
|
||||||
, user_data :: Maybe (Tuple (Maybe Email.Email) (Maybe Email.Email))
|
, user_data :: Maybe (Tuple (Maybe Email.Email) (Maybe Email.Email))
|
||||||
, current_page :: Page
|
, current_page :: Page
|
||||||
, childstates :: ChildStates
|
, childstates :: ChildStates
|
||||||
, notif :: Notification
|
|
||||||
, login :: Maybe String
|
, login :: Maybe String
|
||||||
, keepalive_counter :: Int
|
, keepalive_counter :: Int
|
||||||
, are_we_connected_to_authd :: Boolean
|
, are_we_connected_to_authd :: Boolean
|
||||||
|
@ -203,6 +202,8 @@ type ChildSlots =
|
||||||
, dli :: PageDomainList.Slot Unit
|
, dli :: PageDomainList.Slot Unit
|
||||||
, zi :: PageZone.Slot Unit
|
, zi :: PageZone.Slot Unit
|
||||||
, mi :: PageMigration.Slot Unit
|
, mi :: PageMigration.Slot Unit
|
||||||
|
|
||||||
|
, notificationinterface :: Notification.Slot Unit
|
||||||
)
|
)
|
||||||
|
|
||||||
_ho = Proxy :: Proxy "ho" -- Home Interface
|
_ho = Proxy :: Proxy "ho" -- Home Interface
|
||||||
|
@ -218,6 +219,7 @@ _setupi = Proxy :: Proxy "setupi" -- Setup Interface
|
||||||
_dli = Proxy :: Proxy "dli" -- Domain List
|
_dli = Proxy :: Proxy "dli" -- Domain List
|
||||||
_zi = Proxy :: Proxy "zi" -- Zone Interface
|
_zi = Proxy :: Proxy "zi" -- Zone Interface
|
||||||
_mi = Proxy :: Proxy "mi" -- Migration Interface
|
_mi = Proxy :: Proxy "mi" -- Migration Interface
|
||||||
|
_notificationinterface = Proxy :: Proxy "notificationinterface" -- Setup Interface
|
||||||
|
|
||||||
component :: forall q i o m. MonadAff m => H.Component q i o m
|
component :: forall q i o m. MonadAff m => H.Component q i o m
|
||||||
component =
|
component =
|
||||||
|
@ -243,7 +245,6 @@ initialState _ = { token: Nothing
|
||||||
{ domainlist: Nothing
|
{ domainlist: Nothing
|
||||||
, administration: Nothing
|
, administration: Nothing
|
||||||
}
|
}
|
||||||
, notif: NoNotification
|
|
||||||
, login: Nothing
|
, login: Nothing
|
||||||
, keepalive_counter: 0
|
, keepalive_counter: 0
|
||||||
, are_we_connected_to_authd: false
|
, are_we_connected_to_authd: false
|
||||||
|
@ -325,11 +326,8 @@ render state
|
||||||
render_dnsmanager_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
render_dnsmanager_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||||
render_dnsmanager_WS = HH.slot _ws_dns unit WS.component (Tuple wsURLdnsmanagerd "dnsmanagerd") (EventOnNetwork <<< EventWSDNSmanagerd)
|
render_dnsmanager_WS = HH.slot _ws_dns unit WS.component (Tuple wsURLdnsmanagerd "dnsmanagerd") (EventOnNetwork <<< EventWSDNSmanagerd)
|
||||||
|
|
||||||
render_notifications =
|
notification_duration = 3000 :: Int -- in ms
|
||||||
case state.notif of
|
render_notifications = HH.slot _notificationinterface unit Notification.component notification_duration (EventOnPage <<< EventPageNotification)
|
||||||
NoNotification -> HH.div_ []
|
|
||||||
GoodNotification v -> Web.box [Web.notification_success v CloseNotif]
|
|
||||||
BadNotification v -> Web.box [Web.notification_danger v CloseNotif]
|
|
||||||
|
|
||||||
render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||||
render_home = HH.slot_ _ho unit PageHome.component unit
|
render_home = HH.slot_ _ho unit PageHome.component unit
|
||||||
|
@ -421,7 +419,7 @@ handleAction = case _ of
|
||||||
H.modify_ _ { current_page = page }
|
H.modify_ _ { current_page = page }
|
||||||
|
|
||||||
-- Finally, when changing page, the notification should be discarded.
|
-- Finally, when changing page, the notification should be discarded.
|
||||||
handleAction CloseNotif
|
handleAction $ AddNotif NoNotification
|
||||||
|
|
||||||
Log message -> do
|
Log message -> do
|
||||||
_ <- case message of
|
_ <- case message of
|
||||||
|
@ -465,13 +463,12 @@ handleAction = case _ of
|
||||||
EventOnPage page_event -> act_on_page_event page_event
|
EventOnPage page_event -> act_on_page_event page_event
|
||||||
EventOnNetwork network_event -> act_on_network_event network_event
|
EventOnNetwork network_event -> act_on_network_event network_event
|
||||||
|
|
||||||
AddNotif n -> H.modify_ _ { notif = n }
|
AddNotif n -> H.tell _notificationinterface unit (Notification.Set n)
|
||||||
CloseNotif -> H.modify_ _ { notif = NoNotification }
|
|
||||||
|
|
||||||
Reconnection -> do
|
Reconnection -> do
|
||||||
H.tell _ws_auth unit WS.Connect
|
H.tell _ws_auth unit WS.Connect
|
||||||
H.tell _ws_dns unit WS.Connect
|
H.tell _ws_dns unit WS.Connect
|
||||||
H.modify_ _ { notif = NoNotification }
|
handleAction $ AddNotif NoNotification
|
||||||
|
|
||||||
Disconnection -> do
|
Disconnection -> do
|
||||||
handleAction $ Routing Home
|
handleAction $ Routing Home
|
||||||
|
@ -646,6 +643,8 @@ act_on_page_event page_event = case page_event of
|
||||||
H.tell _ws_auth unit (WS.ToSend message)
|
H.tell _ws_auth unit (WS.ToSend message)
|
||||||
PageMigration.Log message -> handleAction $ Log message
|
PageMigration.Log message -> handleAction $ Log message
|
||||||
|
|
||||||
|
EventPageNotification _ -> handleAction $ Log $ SystemLog "Weird, just received a notification from the notification component."
|
||||||
|
|
||||||
act_on_network_event :: forall o monad. MonadAff monad => NetworkEvent -> H.HalogenM State Action ChildSlots o monad Unit
|
act_on_network_event :: forall o monad. MonadAff monad => NetworkEvent -> H.HalogenM State Action ChildSlots o monad Unit
|
||||||
act_on_network_event network_event = case network_event of
|
act_on_network_event network_event = case network_event of
|
||||||
-- | `authd websocket component` wants to do something.
|
-- | `authd websocket component` wants to do something.
|
||||||
|
|
75
src/App/Notification.purs
Normal file
75
src/App/Notification.purs
Normal file
|
@ -0,0 +1,75 @@
|
||||||
|
-- | Handle a notification subsystem.
|
||||||
|
module App.Notification where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Data.Int (toNumber)
|
||||||
|
import Data.Maybe (Maybe(..))
|
||||||
|
import Effect.Aff as Aff
|
||||||
|
import Effect.Aff (Milliseconds(..))
|
||||||
|
import Effect.Aff.Class (class MonadAff)
|
||||||
|
import Halogen as H
|
||||||
|
import Halogen.HTML as HH
|
||||||
|
import Halogen.Subscription as HS
|
||||||
|
|
||||||
|
import App.Type.Notification (Notification (..))
|
||||||
|
|
||||||
|
import Web as Web
|
||||||
|
|
||||||
|
-- | Input = delay.
|
||||||
|
type Input = Int
|
||||||
|
|
||||||
|
-- | No output.
|
||||||
|
data Output = Unit
|
||||||
|
|
||||||
|
type Slot = H.Slot Query Output
|
||||||
|
|
||||||
|
-- | `timer` triggers an action after `tick_delay` ms.
|
||||||
|
timer :: forall m a. MonadAff m => Number -> a -> m (HS.Emitter a)
|
||||||
|
timer tick_delay action = do
|
||||||
|
{ emitter, listener } <- H.liftEffect HS.create
|
||||||
|
_ <- H.liftAff $ Aff.forkAff do
|
||||||
|
Aff.delay $ Milliseconds tick_delay
|
||||||
|
H.liftEffect $ HS.notify listener action
|
||||||
|
pure emitter
|
||||||
|
|
||||||
|
data Action = CloseNotif
|
||||||
|
|
||||||
|
type State = { delay :: Int, notification :: Notification }
|
||||||
|
|
||||||
|
data Query a = Set Notification a
|
||||||
|
|
||||||
|
component :: forall m. MonadAff m => H.Component Query Input Output m
|
||||||
|
component =
|
||||||
|
H.mkComponent
|
||||||
|
{ initialState
|
||||||
|
, render
|
||||||
|
, eval: H.mkEval $ H.defaultEval
|
||||||
|
{ initialize = Nothing
|
||||||
|
, handleAction = handleAction
|
||||||
|
, handleQuery = handleQuery
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
||||||
|
handleQuery = case _ of
|
||||||
|
Set notif a -> do
|
||||||
|
H.modify_ _ { notification = notif }
|
||||||
|
state <- H.get
|
||||||
|
_ <- H.subscribe =<< timer (toNumber state.delay) CloseNotif
|
||||||
|
pure (Just a)
|
||||||
|
|
||||||
|
initialState :: Input -> State
|
||||||
|
initialState delay = { delay: delay, notification: NoNotification }
|
||||||
|
|
||||||
|
render :: forall m. State -> H.ComponentHTML Action () m
|
||||||
|
render state = do
|
||||||
|
case state.notification of
|
||||||
|
NoNotification -> HH.div_ []
|
||||||
|
GoodNotification v -> Web.box [Web.notification_success v CloseNotif]
|
||||||
|
BadNotification v -> Web.box [Web.notification_danger v CloseNotif]
|
||||||
|
|
||||||
|
handleAction :: forall m.
|
||||||
|
MonadAff m => Action -> H.HalogenM State Action () Output m Unit
|
||||||
|
handleAction action = case action of
|
||||||
|
CloseNotif -> H.modify_ _ { notification = NoNotification }
|
3
src/App/Type/Notification.purs
Normal file
3
src/App/Type/Notification.purs
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
module App.Type.Notification where
|
||||||
|
|
||||||
|
data Notification = NoNotification | GoodNotification String | BadNotification String
|
Loading…
Add table
Reference in a new issue