tinkering with user menu

Foundation.hs

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

Helper.hs

@@ -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

templates/default-layout.hamlet

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