219 lines
8.7 KiB
Plaintext
219 lines
8.7 KiB
Plaintext
-- | `App.NavigationInterface` is the navbar module.
|
|
-- |
|
|
-- | This module is required since some javascript is needed to toggle display of hidden resources.
|
|
-- | On mobile, a burger menu is displayed and hides the navigation buttons.
|
|
-- | On desktop, there is no need for this, all the navigation buttons are displayed by default.
|
|
module App.Page.Navigation where
|
|
|
|
import Prelude (Unit, (<>), not, ($), discard, pure)
|
|
|
|
-- import Data.Array as A
|
|
import Data.Maybe (Maybe(..))
|
|
-- import Data.Either (Either(..))
|
|
import Effect.Aff.Class (class MonadAff)
|
|
import Halogen as H
|
|
import Halogen.HTML as HH
|
|
import Halogen.HTML.Events as HE
|
|
import Halogen.HTML.Properties as HP
|
|
import Halogen.HTML.Properties.ARIA as ARIA
|
|
|
|
import CSSClasses as C
|
|
import Bulma as Bulma
|
|
|
|
import App.Type.Pages (Page(..))
|
|
import App.Type.LogMessage (LogMessage)
|
|
|
|
data Output
|
|
= Log LogMessage
|
|
-- | Once someone clicks on a routing button, `App.Container` needs to know.
|
|
| Routing Page
|
|
-- | Once someone clicks on a the Disconnection button, `App.Container` needs to know.
|
|
| Disconnection
|
|
|
|
-- | The component needs to know when the user is logged or not.
|
|
data Query a
|
|
= ToggleLogged Boolean a
|
|
| ToggleAdmin Boolean a
|
|
| TellLogin (Maybe String) a
|
|
|
|
type Slot = H.Slot Query Output
|
|
|
|
type Input = Unit
|
|
|
|
data Action
|
|
-- | `ToggleMenu`: display or hide the content of the burger menu.
|
|
= ToggleMenu
|
|
-- | The navigation interface must be informed when the client wants to change page.
|
|
-- | The request will be propagated to the parent (`App.Container`).
|
|
-- | (`Navigate` is `App.Container.Routing`)
|
|
| Navigate Page
|
|
-- | The navigation interface must be informed when the client wants to disconnect.
|
|
-- | The request will be propagated to the parent (`App.Container`).
|
|
-- | (`UnLog` is `App.Container.Disconnection`)
|
|
| UnLog
|
|
|
|
-- | State is composed of:
|
|
-- | - `logged`, a boolean to toggle the display of some parts of the menu.
|
|
-- | - `active`, a boolean to toggle the display of the menu.
|
|
-- | - `admin`, a boolean to toggle the display of administration page link.
|
|
type State = { logged :: Boolean, login :: Maybe String, active :: Boolean, admin :: Boolean }
|
|
|
|
component :: forall m. MonadAff m => H.Component Query Input Output m
|
|
component =
|
|
H.mkComponent
|
|
{ initialState
|
|
, render
|
|
, eval: H.mkEval $ H.defaultEval { handleAction = handleAction
|
|
, handleQuery = handleQuery
|
|
}
|
|
}
|
|
|
|
initialState :: Input -> State
|
|
initialState _ = { logged: false, login: Nothing, active: false, admin: false }
|
|
|
|
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
|
|
handleAction = case _ of
|
|
ToggleMenu -> H.modify_ \state -> state { active = not state.active }
|
|
-- | Page change.
|
|
Navigate page -> do
|
|
-- Automatically close the menu.
|
|
H.modify_ \state -> state { active = false }
|
|
H.raise $ Routing page
|
|
UnLog -> do
|
|
H.raise $ Disconnection
|
|
H.modify_ _ { logged = false }
|
|
|
|
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
|
handleQuery = case _ of
|
|
ToggleLogged islogged a -> do
|
|
H.modify_ _ { logged = islogged }
|
|
pure (Just a)
|
|
ToggleAdmin isadmin a -> do
|
|
H.modify_ _ { admin = isadmin }
|
|
pure (Just a)
|
|
TellLogin login a -> do
|
|
H.modify_ _ { login = login }
|
|
pure (Just a)
|
|
|
|
|
|
-- | The navigation bar is a complex component to render.
|
|
-- | The component changes when the user is authenticated.
|
|
-- | A button has to appear for administrators.
|
|
-- |
|
|
-- | On mobile (a device with low resolution), a `burger icon` appears instead of the navigation bar.
|
|
-- | When clicked, a list of options (such as pages or a disconnection button) should appear.
|
|
-- | Also, when clicked again, the list disappears.
|
|
|
|
render :: forall m. State -> H.ComponentHTML Action () m
|
|
render { logged, active, admin, login } =
|
|
main_nav
|
|
[ nav_brand [ logo, burger_menu ]
|
|
, nav_menu
|
|
[ navbar_start left_bar_div
|
|
, navbar_end right_bar_div
|
|
]
|
|
]
|
|
|
|
where
|
|
left_bar_div =
|
|
case logged, admin of
|
|
false, _ -> [ link_home, code_dropdown ]
|
|
_, false -> [ link_home, link_domains, code_dropdown ]
|
|
_, _ -> [ link_home, link_domains, link_authd_admin, code_dropdown ]
|
|
|
|
right_bar_div =
|
|
case logged of
|
|
false -> [ link_auth, link_register, link_mail_validation ]
|
|
_ -> render_login login <> [ link_setup, link_disconnection ]
|
|
|
|
navbar_color = C.is_success
|
|
|
|
main_nav =
|
|
HH.nav [ HP.classes $ C.navbar <> navbar_color
|
|
, ARIA.label "main navigation"
|
|
, ARIA.role "navigation"
|
|
]
|
|
|
|
logo = HH.strong [HP.classes $ C.navbar_item <> (C.is_size 4)] [HH.text "🍉"]
|
|
-- HH.a [HP.classes C.navbar_item, HP.href "/"]
|
|
-- [HH.img [HP.src "/logo.jpeg", HP.width 112, HP.height 28]]
|
|
|
|
burger_menu =
|
|
HH.a [ HP.classes $ C.navbar_burger <> if active then C.is_active else []
|
|
, ARIA.label "menu"
|
|
, ARIA.expanded "false"
|
|
, Bulma.data_target "navbar-netlibre"
|
|
, HE.onClick (\_ -> ToggleMenu)
|
|
] [ HH.span [ARIA.hidden "true"] []
|
|
, HH.span [ARIA.hidden "true"] []
|
|
, HH.span [ARIA.hidden "true"] []
|
|
]
|
|
|
|
nav_brand = HH.div [HP.classes C.navbar_brand]
|
|
nav_menu = HH.div
|
|
[ HP.id "navbar-netlibre"
|
|
, HP.classes $ C.navbar_menu <> C.is_spaced <> if active then C.is_active else []
|
|
]
|
|
|
|
navbar_start = HH.div [HP.classes C.navbar_start]
|
|
navbar_end = HH.div [HP.classes C.navbar_end]
|
|
|
|
link_home = nav_link "Home" (Navigate Home)
|
|
link_domains = nav_link "Domains" (Navigate DomainList)
|
|
link_authd_admin = nav_link "Admin" (Navigate Administration)
|
|
link_auth = nav_link "Login" (Navigate Authentication)
|
|
link_register = nav_link_strong "Register" (Navigate Registration)
|
|
link_mail_validation = nav_link "Mail verification" (Navigate MailValidation)
|
|
link_setup = nav_link_warn "⚒ Setup" (Navigate Setup)
|
|
render_login Nothing = []
|
|
render_login (Just l)= [nav_link ("logged as " <> l) (Navigate Setup)]
|
|
link_disconnection =
|
|
nav_link_ (C.has_text_light <> C.has_background_danger) "Disconnection" UnLog
|
|
|
|
dropdown title dropdown_elements
|
|
= HH.div [HP.classes $ C.navbar_item <> C.has_dropdown <> C.is_hoverable]
|
|
[ dropdown_title title, HH.div [HP.classes C.navbar_dropdown] dropdown_elements ]
|
|
dropdown_title str = HH.a [HP.classes C.navbar_link] [HH.text str]
|
|
dropdown_separator = HH.hr [HP.classes C.navbar_divider]
|
|
|
|
--nav_button_strong str action = btn C.is_primary action (HH.strong [] [ HH.text str ])
|
|
--nav_button classes str action = btn classes action (HH.text str)
|
|
|
|
nav_link_strong str action =
|
|
HH.a [ HP.classes (C.navbar_item <> C.is_danger <> C.has_background_success_dark)
|
|
, HE.onClick (\_ -> action)
|
|
] [ (HH.strong [] [ HH.text str ]) ]
|
|
|
|
nav_link str action = nav_link_ navbar_color str action
|
|
nav_link_warn str action = nav_link_ (C.has_background_warning <> C.has_text_dark) str action
|
|
|
|
nav_link_ classes str action =
|
|
HH.a [ HP.classes (C.navbar_item <> classes)
|
|
, HE.onClick (\_ -> action)
|
|
] [ (HH.text str) ]
|
|
|
|
dropdown_element classes link str = HH.a [HP.classes (C.navbar_item <> classes), HP.href link] [HH.text str]
|
|
dropdown_element_primary link str = dropdown_element C.has_background_info_light link str
|
|
dropdown_element_secondary link str = dropdown_element C.has_background_warning_light link str
|
|
|
|
dropdown_section_primary t
|
|
= HH.p [HP.classes $ C.has_background_info <> C.has_text_light <> C.navbar_item] [HH.text t]
|
|
dropdown_section_secondary t
|
|
= HH.p [HP.classes $ C.has_background_warning <> C.navbar_item] [HH.text t]
|
|
code_dropdown =
|
|
dropdown "Source code"
|
|
[ dropdown_section_primary "Main parts of this service"
|
|
, dropdown_element_primary "https://git.baguette.netlib.re/Baguette/authd" "authentication daemon"
|
|
, dropdown_element_primary "https://git.baguette.netlib.re/Baguette/dnsmanager" "dnsmanager daemon"
|
|
, dropdown_element_primary "https://git.baguette.netlib.re/Baguette/dnsmanager-webclient" "dnsmanager web client"
|
|
, dropdown_separator
|
|
, dropdown_section_secondary "A few more links (for nerds)"
|
|
, dropdown_element_secondary "https://git.baguette.netlib.re/Baguette/libipc" "libIPC: communication library"
|
|
, dropdown_element_secondary "https://git.baguette.netlib.re/Baguette/dodb.cr" "DoDB: document-oriented database"
|
|
]
|
|
|
|
--btn c action str
|
|
-- = HH.a [ HP.classes (C.navbar_item <> C.button <> c)
|
|
-- , HE.onClick (\_ -> action)
|
|
-- ] [ str ]
|