main.hs

main :: IO ()
main = mainWidgetWithHead headElement bodyElement

headElement :: MonadWidget t m => m ()
headElement = do
  el "title" $ text "Rizilab - Home"
  styleSheet "index.css"
  where
    styleSheet link = elAttr "link" (Map.fromList [
          ("rel", "stylesheet")
        , ("type", "text/css")
        , ("href", link)
      ]) $ return ()

bodyElement :: (MonadWidget t m) => m ()
bodyElement = do
  RNT.runRouteWithPathInFragment $ fmap snd $ RWT.runRouteWriterT $ do
    void $ withRoute $ \route -> case fromMaybe "" route of
      "Dashboard"          -> basePage >> pure never
      ""                   -> ((["Dashboard"] <$) <$> (toCustomClick "Button" "back to home" BtnHome "" Nothing))

basePage :: (MonadWidget t m) => m ()
basePage = do
  elAttr' "div" ("class" =: "container") $ do
    rec
      wv <- DOM.currentWindowUnchecked
      storage <- getLocalStorage wv
      let
        bxLabel = join (fst <$> boxLabel)
        regisAct = switchDyn $ (((fromMaybe ([] <$ never)) . snd) <$> boxLabel)
        response = (toUserCred <$> (leftmost [validation,logoutAction,regisAct]))
      (credBox,validation)   <- credentialBox bxLabel
      (logOBox,logoutAction) <- logoutBox bxLabel
      boxLabel <- widgetHold (pageLanding credBox) $ ffor response (navWithRoute validation credBox logOBox)
    return ()
  return ()

pageLanding :: (MonadWidget t m)
                     => Event t (Maybe LoginBox)
                     -> m ((Dynamic t (Maybe NavBox)), (Maybe (Event t [(Either String UserCredentialResponse)])))
pageLanding cb = do
  navHeader <- navHeaderLoggedOut cb
  lPage <- landingPage
  return (navHeader,Nothing)

navWithRoute :: (MonadWidget t m)
             => Event t [(Either String UserCredentialResponse)]
             -> Event t (Maybe LoginBox)
             -> Event t (Maybe LoginBox)
             -> UserCredentialResponse
             -> m ((Dynamic t  (Maybe NavBox)), (Maybe (Event t [(Either String UserCredentialResponse)])))
navWithRoute evRoute cB lB usrC =
  case usrC of
    (InvalidAction _ msg) -> do
      --dynText $ constDyn msg
      pageLanding cB
    (LoginCredential suc msg jwt usr role) -> do
        pageLoggedIn lB jwt usr role
    (RegisterCredential suc msg usrN usrE) -> do
      rec
        navHeader <- navHeaderRegister rB
        (rB, regisAction) <- registerBox msg navHeader
      return (navHeader,(Just regisAction))