Profile page extendend, yet incomplete

messages/de.msg

@@ -54,6 +54,7 @@ SubmissionArchive: Zip-Archiv der Abgabedatei(en)
 SubmissionFile: Datei zur Abgabe
 SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem Übungsblatt.
 
+EMail: E-Mail
 EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer.
 NotAParticipant user@Text tid@TermIdentifier csh@Text: #{user} ist nicht im Kurs #{termToText tid}-#{csh} angemeldet.
 
@@ -63,3 +64,8 @@ TermsHeading: Semesterübersicht
 NumCourses n@Int64: #{tshow n} Kurse
 CloseAlert: Schliessen
 
+Name: Name
+MatrikelNr: Matrikelnummer
+Theme: Oberflächen Design
+Favoriten: Anzahl gespeicherter Favoriten
+

src/Foundation.hs

@@ -427,18 +427,16 @@ instance Yesod UniWorX where
 
         -- Lookup Favourites & Theme if possible -- TODO: cache this info in a cookie?!
         (favourites',show -> currentTheme) <- do
-            muid <- maybeAuthId
+            muid <- maybeAuthPair
             case muid of
-                Nothing    -> return ([],Default)
+                Nothing         -> return ([],Default)
-                (Just uid) -> runDB $ do
+                (Just (uid,user)) -> do
-                    cs <- E.select . E.from $ \(course `E.InnerJoin` courseFavourite) -> do
+                    favs <- runDB $ E.select . E.from $ \(course `E.InnerJoin` courseFavourite) -> do
-                      E.on (course E.^. CourseId E.==. courseFavourite E.^. CourseFavouriteCourse)
+                        E.on (course E.^. CourseId E.==. courseFavourite E.^. CourseFavouriteCourse)
-                      E.where_ (courseFavourite E.^. CourseFavouriteUser E.==. E.val uid)
+                        E.where_ (courseFavourite E.^. CourseFavouriteUser E.==. E.val uid)
-                      E.orderBy [ E.asc $ course E.^. CourseShorthand ]
+                        E.orderBy [ E.asc $ course E.^. CourseShorthand ]
-                      return course
+                        return course
-                    mt <- get uid
+                    return (favs, userTheme user)
-                    return (cs, fromMaybe Default (userTheme <$> mt))
-
         favourites <- forM favourites' $ \(Entity _ c@Course{..})
             -> let
                    courseRoute = CourseR courseTerm courseShorthand CShowR

src/Handler/Profile.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -7,12 +8,18 @@ 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
+    (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
@@ -25,6 +32,18 @@ getProfileR = do
                 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 user <> "'s User page"
+        setTitle . toHtml $ userIdent <> "'s User page"
         $(widgetFile "profile")

templates/profile.hamlet

@@ -7,17 +7,39 @@
       This page is protected and access is allowed only for authenticated users.
 
     <p>
-      Your data is protected with us <strong><span class="username">#{userIdent user}</span></strong>!
+      Your data is protected with us <strong><span class="username">#{userIdent}</span></strong>!
       
     $if not $ null admin_rights
       <h1>
         Administrator für die Institute
       <ul>
         $forall institute <- admin_rights
-          <li>#{show institute}
+          <li>#{E.unValue institute}
     $if not $ null lecturer_rights
       <h1>
         Lehrberechtigung für die Institute
       <ul>
         $forall institute <- lecturer_rights
-          <li>#{show institute}
+          <li>#{E.unValue institute}
+    <p>
+      <h1>
+        Benutzerdaten
+      ^{userTable}
+      <em> TODO: Mehr Daten in Tabelle anzeigen!
+      <h2>
+        Alle Benutzerbezogenen Daten (Abgaben, Klausurnoten, etc.)
+        <p>
+          <em> TODO: Alle Abgaben, Klausurnoten finden und verlinken
+      <h2>
+        <em> TODO: Knopf zum Löschen der Daten erstellen
+      <p>
+        <h4>Hinweise:
+        <ul>
+          <li>
+            Benutzerdaten bleiben so lange gespeichert, bis ein Institutsadministrator über die Exmatrikulation informiert wurde. Dann wird der Account gelöscht.
+            Abgaben/Bonuspunkte werden unwiderruflich gelöscht.
+            Klausurnoten verbleiben aus statistischen Gründen anonymisiert im System.
+          <li>
+            Bei gemeinsamen Gruppenabgaben wird nur die Zuordnung zu diesem Benutzer gelöscht.
+            Die Abgabe selbst wird erst gelöscht, wenn alle Benutzer einer Abgabe deren Löschung veranlasst haben.
+