diff --git a/messages/de.msg b/messages/de.msg index 4f13532d5..c5d90d5b3 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -68,4 +68,5 @@ Name: Name MatrikelNr: Matrikelnummer Theme: Oberflächen Design Favoriten: Anzahl gespeicherter Favoriten - +Plugin: Plugin +Ident: Identifizierung diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 38f2f15dc..f09b7de41 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -20,20 +20,33 @@ getProfileR :: Handler Html getProfileR = do (uid, User{..}) <- requireAuthPair mr <- getMessageRender - (admin_rights,lecturer_rights) <- runDB $ (,) <$> + (admin_rights,lecturer_rights,studies) <- 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) - ) + return (school ^. SchoolName) + ) + <*> + (E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do + E.where_ $ studyfeat ^. StudyFeaturesUser E.==. E.val uid + E.on $ studyfeat ^. StudyFeaturesField E.==. studyterms ^. StudyTermsId + E.on $ studyfeat ^. StudyFeaturesDegree E.==. studydegree ^. StudyDegreeId + return (studydegree ^. StudyDegreeName + ,studyterms ^. StudyTermsName + ,studyfeat ^. StudyFeaturesType + ,studyfeat ^. StudyFeaturesSemester) + ) + let userData = [ (MsgName , userDisplayName ) + , (MsgIdent , userIdent ) + , (MsgPlugin , userPlugin ) , (MsgMatrikelNr , fromMaybe "" userMatrikelnummer) , (MsgEMail , userEmail ) , (MsgFavoriten , pack $ show userMaxFavourites) diff --git a/src/Utils.hs b/src/Utils.hs index b4066c5f1..b31056a01 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, UndecidableInstances #-} {-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-} {-# LANGUAGE QuasiQuotes #-} @@ -28,6 +29,8 @@ import Control.Monad.Trans.Maybe (MaybeT(..)) import Control.Monad.Catch +import qualified Database.Esqueleto as E (Value, unValue) + ----------- -- Yesod -- ----------- @@ -78,6 +81,28 @@ uncamel = ("theme-" ++) . reverse . foldl helper [] | otherwise = c : acc +-- Convert anything to Text, and I don't care how +class DisplayAble a where + display :: a -> Text + +instance DisplayAble Text where + display = id + +instance DisplayAble String where + display = pack + +instance DisplayAble a => DisplayAble (Maybe a) where + display Nothing = "" + display (Just x) = display x + +instance DisplayAble a => DisplayAble (E.Value a) where + display = display . E.unValue + +-- The easy way out of UndecidableInstances (TypeFamilies would have been proper, but are much more complicated) +instance {-# OVERLAPPABLE #-} Show a => DisplayAble a where + display = pack . show + + ------------ -- Tuples -- @@ -90,6 +115,10 @@ snd3 (_,y,_) = y trd3 :: (a,b,c) -> c trd3 (_,_,z) = z +-- Further projections are available via TemplateHaskell, defined in Utils.Common: +-- $(projN n m) :: (t1,..,tn) -> tm (for m<=n) +-- snd3 = $(projNI 3 2) + ---------- diff --git a/templates/profile.hamlet b/templates/profile.hamlet index 16a4f7160..48c4a6adf 100644 --- a/templates/profile.hamlet +++ b/templates/profile.hamlet @@ -14,17 +14,26 @@ Administrator für die Institute