This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/Profile.hs
2018-06-19 19:14:50 +02:00

50 lines
1.8 KiB
Haskell

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Handler.Profile where
import Import
import Handler.Utils
import Colonnade hiding (fromMaybe, singleton)
import Yesod.Colonnade
import qualified Database.Esqueleto as E
import Database.Esqueleto ((^.))
getProfileR :: Handler Html
getProfileR = do
(uid, User{..}) <- requireAuthPair
mr <- getMessageRender
(admin_rights,lecturer_rights) <- runDB $ (,) <$>
(E.select $ E.from $ \(adright `E.InnerJoin` school) -> do
E.where_ $ adright ^. UserAdminUser E.==. E.val uid
E.on $ adright ^. UserAdminSchool E.==. school ^. SchoolId
return (school ^. SchoolName)
)
<*>
(E.select $ E.from $ \(lecright `E.InnerJoin` school) -> do
E.where_ $ lecright ^. UserLecturerUser E.==. E.val uid
E.on $ lecright ^. UserLecturerSchool E.==. school ^. SchoolId
return (school ^. SchoolName)
)
let userData =
[ (MsgName , userDisplayName )
, (MsgMatrikelNr , fromMaybe "" userMatrikelnummer)
, (MsgEMail , userEmail )
, (MsgFavoriten , pack $ show userMaxFavourites)
, (MsgTheme , pack $ show userTheme )
]
userDisplay = mconcat
[ headless $ toWgt . mr . fst
, headless $ toWgt . snd
] --TODO Continue here!!!
userTable = encodeWidgetTable tableDefault userDisplay userData
defaultLayout $ do
setTitle . toHtml $ userIdent <> "'s User page"
$(widgetFile "profile")