tinkering with user menu

This commit is contained in:
nek0 2016-02-29 05:58:28 +01:00
parent 5b2a7daa69
commit a981a9f8f7
3 changed files with 34 additions and 16 deletions

View file

@ -69,20 +69,20 @@ renderLayout widget = do
route <- getCurrentRoute
mmsg <- getMessage
msu <- lookupSession "userId"
username <- case msu of
Just a -> do
let uId = getUserIdFromText a
user <- runDB $ getJust uId
return $ userName user
Nothing ->
return ("" :: T.Text)
slug <- case msu of
Just a -> do
let uId = getUserIdFromText a
user <- runDB $ getJust uId
return $ userSlug user
Nothing ->
return ("" :: T.Text)
-- username <- case msu of
-- Just a -> do
-- let uId = getUserIdFromText a
-- user <- runDB $ getJust uId
-- return $ userName user
-- Nothing ->
-- return ("" :: T.Text)
-- slug <- case msu of
-- Just a -> do
-- let uId = getUserIdFromText a
-- user <- runDB $ getJust uId
-- return $ userSlug user
-- Nothing ->
-- return ("" :: T.Text)
let block = appSignupBlocked $ appSettings master
-- We break up the default layout into two components:

View file

@ -41,6 +41,24 @@ import Network.HTTP.Client
import Network.HTTP.Types.Status as S
import Control.Monad (when)
getUsername :: Maybe T.Text -> Handler (Maybe T.Text)
getUsername mtid =
getSkel mtid userName
getSlug :: Maybe T.Text -> Handler (Maybe T.Text)
getSlug mtid =
getSkel mtid userSlug
getSkel :: Maybe T.Text -> (User -> a) -> Handler (Maybe a)
getSkel mtid fun =
case mtid of
Just tid -> do
let uId = getUserIdFromText tid
user <- runDB $ getJust uId
return $ Just $ fun user
Nothing ->
return Nothing
getUserIdFromText :: T.Text -> UserId
getUserIdFromText tempUserId =
case key of

View file

@ -3,8 +3,8 @@
<ul id="user-nav">
<li>
<a href=@{HomeR}>Home
$maybe _ <- msu
Logged in as <a href=@{UserR username}>#{slug}<br>
$maybe su <- msu
Logged in as <a href=@{UserR $ getUsername su}>#{getSlug su}<br>
<li>
<a href=@{LogoutR}>Logout
<li>