-- | `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 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, 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, 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 -> 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) -- | 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 } = 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 ] _ -> [ 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) 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 ]