Profile page cleaned; explicit table now for Felix to refactor.

messages/de.msg

@@ -63,7 +63,9 @@ 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.
 
-HomeHeading: Startseite
+HomeHeading: Aktuelle Termine
+ProfileHeading: Benutzerprofil und Einstellungen
+ProfileDataHeading: Gespeicherte Benutzerdaten
 TermsHeading: Semesterübersicht
 
 NumCourses n@Int64: #{tshow n} Kurse

routes

@@ -31,10 +31,12 @@
 /robots.txt RobotsR GET                                       !free
 
 /                           HomeR             GET                                         !free
-/profile ProfileR GET                                         !free
 /users                      UsersR            GET                                         -- no tags, i.e. admins only
 /admin/test                 AdminTestR        GET POST
 
+/profile                    ProfileR          GET POST        !free                             !free
+/profile/data               ProfileDataR      GET             !free                             !free
+
 /terms                      TermShowR         GET             !free
 /terms/current              TermCurrentR      GET             !free
 /terms/edit                 TermEditR         GET POST

src/Foundation.hs

@@ -579,9 +579,10 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb SubmissionListR = return ("Abgaben", Just HomeR)
 
 
-  breadcrumb HomeR = return ("Uniworky", Nothing)
+  breadcrumb HomeR = return ("UniWorkY", Nothing)
   breadcrumb (AuthR _) = return ("Login", Just HomeR)
   breadcrumb ProfileR = return ("Profile", Just HomeR)
+  breadcrumb ProfileDataR = return ("Data", Just ProfileR)
   breadcrumb  _ = return ("home", Nothing)
 
 pageActions :: Route UniWorX -> [MenuTypes]
@@ -637,6 +638,14 @@ pageActions (TermCourseListR _) =
       , menuItemAccessCallback' = return True
       }
   ]
+pageActions (ProfileR) =
+  [ PageActionPrime $ MenuItem
+      { menuItemLabel = "Gespeicherte Daten anzeigen"
+      , menuItemIcon  = Just "book"
+      , menuItemRoute = ProfileDataR
+      , menuItemAccessCallback' = return True
+      }
+  ]
 pageActions (HomeR) =
   [
 --     NavbarAside $ MenuItem
@@ -662,6 +671,12 @@ i18nHeading msg = liftWidgetT $ toWidget =<< getMessageRender <*> pure msg
 pageHeading :: Route UniWorX -> Maybe Widget
 pageHeading HomeR
   = Just $ i18nHeading MsgHomeHeading
+pageHeading (AdminTestR)
+  = Just $ [whamlet|Internal Code Demonstration Page|]
+pageHeading ProfileR
+  = Just $ i18nHeading MsgProfileHeading
+pageHeading ProfileDataR
+  = Just $ i18nHeading MsgProfileDataHeading
 pageHeading TermShowR
   = Just $ i18nHeading MsgTermsHeading
 pageHeading TermEditR
@@ -675,8 +690,6 @@ pageHeading (CourseR tid csh CShowR)
     Entity _ Course{..} <- handlerToWidget . runDB . getBy404 $ CourseTermShort tid csh
     toWidget courseName
 -- TODO: add headings for more single course- and single term-pages
-pageHeading (AdminTestR)
-  = Just $ [whamlet|Internal Code Demonstration Page|]
 pageHeading _
   = Nothing
 

src/Handler/Home.hs

@@ -44,12 +44,14 @@ offSheetDeadlines   = 15
 getHomeR :: Handler Html
 getHomeR = do
   muid <- maybeAuthId
+  case muid of
+    Nothing   -> defaultLayout [whamlet| Bitte einloggen! |]
+    Just uid  -> do
       -- let uid = fromMaybe (Key 1) muid -- TODO: delete me
       cTime <- liftIO getCurrentTime
       let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime
 
-      tableData :: (Maybe (Key User))
+          tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant))
-                  -> E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant))
                                                 (E.SqlExpr (Entity Course           )))
                                                 (E.SqlExpr (Entity Sheet            ))
                       -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term))
@@ -57,24 +59,24 @@ getHomeR = do
                                     , E.SqlExpr (E.Value Text)
                                     , E.SqlExpr (E.Value UTCTime))
 
---       tableData Nothing    (                          course `E.InnerJoin` sheet) = do
+    --       tableData Nothing    (                          course `E.InnerJoin` sheet) = do
---         E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
+    --         E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
---         E.where_ $ sheet E.^. SheetActiveTo E.<=. E.val fTime
+    --         E.where_ $ sheet E.^. SheetActiveTo E.<=. E.val fTime
---              E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
+    --              E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
---         E.limit nrSheetDeadlines
+    --         E.limit nrSheetDeadlines
---         E.orderBy [ E.asc  $ sheet  E.^. SheetActiveTo
+    --         E.orderBy [ E.asc  $ sheet  E.^. SheetActiveTo
---                   , E.desc $ sheet  E.^. SheetName
+    --                   , E.desc $ sheet  E.^. SheetName
---                   , E.desc $ course E.^. CourseShorthand
+    --                   , E.desc $ course E.^. CourseShorthand
---                   ]
+    --                   ]
---         E.limit nrSheetDeadlines
+    --         E.limit nrSheetDeadlines
---         return
+    --         return
---           ( course  E.^. CourseTerm
+    --           ( course  E.^. CourseTerm
---           , course  E.^. CourseShorthand
+    --           , course  E.^. CourseShorthand
---           , sheet   E.^. SheetName
+    --           , sheet   E.^. SheetName
---           , sheet   E.^. SheetActiveTo
+    --           , sheet   E.^. SheetActiveTo
---           )
+    --           )
 
-      tableData (Just uid) (participant `E.InnerJoin` course `E.InnerJoin` sheet) = do
+          tableData (participant `E.InnerJoin` course `E.InnerJoin` sheet) = do
             E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
             E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
             E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
@@ -105,7 +107,7 @@ getHomeR = do
                 textCell $ "?"
             ]
       sheetTable <- dbTable def $ DBTable
-    { dbtSQLQuery  = tableData muid
+        { dbtSQLQuery  = tableData
         , dbtColonnade = colonnade
         , dbtSorting   =  [ ( "term"
                             , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseTerm

src/Handler/Profile.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -10,8 +11,8 @@ import Import
 
 import Handler.Utils
 
-import Colonnade hiding (fromMaybe, singleton)
+-- import Colonnade hiding (fromMaybe, singleton)
-import Yesod.Colonnade
+-- import Yesod.Colonnade
 
 import qualified Database.Esqueleto as E
 import           Database.Esqueleto      ((^.))
@@ -19,18 +20,18 @@ import           Database.Esqueleto      ((^.))
 getProfileR :: Handler Html
 getProfileR = do
     (uid, User{..}) <- requireAuthPair
-    mr <- getMessageRender
+    -- mr <- getMessageRender
     (admin_rights,lecturer_rights,lecture_owner,lecture_corrector,participant,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)     
+                return (school ^. SchoolShorthand)
             ) 
             <*>
             (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 ^. SchoolShorthand)
             )
             <*>
             (E.select $ E.from $ \(lecturer `E.InnerJoin` course) -> do
@@ -61,20 +62,21 @@ getProfileR = do
                         ,studyfeat   ^. StudyFeaturesSemester)
             )
 
-    let userData =
-          [ (MsgName        ,  userDisplayName   )
-          , (MsgIdent       ,  userIdent )
-          , (MsgPlugin      ,  userPlugin        )
-          , (MsgMatrikelNr  ,  display userMatrikelnummer)
-          , (MsgEMail       ,  userEmail         )
-          , (MsgFavoriten   ,  display userMaxFavourites)
-          , (MsgTheme       ,  display 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")
+
+
+postProfileR :: Handler Html
+postProfileR = do
+  -- TODO
+  getProfileR
+
+
+getProfileDataR  :: Handler Html
+getProfileDataR = do
+  (uid, User{..}) <- requireAuthPair
+  --   mr <- getMessageRender
+
+  defaultLayout $ do
+    $(widgetFile "profileData")

src/Utils.hs

@@ -128,6 +128,12 @@ trd3 (_,_,z) = z
 -- snd3 = $(projNI 3 2)
 
 
+-----------
+-- Lists --
+-----------
+
+-- notNull = not . null
+
 
 ----------
 -- Maps --

templates/home.hamlet

@@ -13,9 +13,12 @@
       $maybe _ <- muid
         ^{sheetTable}
 
-  <h1>Anstehende Klausuren
+
+  <h1>
+    Anstehende Klausuren
   TODO
 
-  <h1>Anstehende Kursanmeldungen
+  <h1>
+    Anstehende Kursanmeldungen
   TODO
 

templates/profile.hamlet

@@ -1,80 +1,79 @@
 <div .ui.container>
 
     <h1>
-      Access granted!
+      _{MsgProfileHeading} #{userDisplayName}
-
-    <p>
-      This page is protected and access is allowed only for authenticated users.
-
-    <p>
-      Your data is protected with us <strong><span class="username">#{userIdent}</span></strong>!
 
+    <table .table .table-striped >
+      <tr>
+        <th> _{MsgName}
+        <td> #{display userDisplayName}
+      <tr>
+        <th> _{MsgMatrikelNr}
+        <td> #{display userMatrikelnummer}
+      <tr>
+        <th> _{MsgEMail}
+        <td> #{display userEmail}
+      <tr>
+        <th> _{MsgIdent}
+        <td> #{display userIdent}
+      <tr>
+        <th> _{MsgPlugin}
+        <td> #{display userPlugin}
       $if not $ null admin_rights
-      <h1>
+        <tr>
-        Administrator für die Institute
+          <th> Administrator
+          <td>
             <ul>
               $forall institute <- admin_rights
                 <li>#{display institute}
       $if not $ null lecturer_rights
-      <h1>
+        <tr>
-        Lehrberechtigung für die Institute
+          <th> Lehrberechtigt
+          <td>
             <ul>
               $forall institute <- lecturer_rights
                 <li>#{display institute}
-
+      $if not $ null lecture_owner
-    <h2>
+        <tr>
-      Zugriffsberechtigung als Lehrender auf:
+          <th> Eigene Kurse
+          <td>
             <ul>
               $forall (E.Value csh, E.Value tid) <- lecture_owner
                 <li>
                   <a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
-    <h2>
+      $if not $ null lecture_corrector
-      Zugriffsberechtigung als Korrekor auf:
+        <tr>
+          <th> Korrektor
+          <td>
             <ul>
               $forall (E.Value csh, E.Value tid) <- lecture_corrector
                 <li>
                   <a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
-    <h2>
+      $if not $ null studies
-      Kursteilnehmer:
+        <tr>
+          <th> Studiengänge
+          <td>
+              <table .table .table-striped .table-hover>
+                <tr>
+                  <th> Abschluss
+                  <th> Studiengang
+                  <th> Studienart
+                  <th> Semester
+
+                $forall (degree,field,fieldtype,semester) <- studies
+                  <tr>
+                    <td> #{display degree}
+                    <td> #{display field}
+                    <td> #{display fieldtype}
+                    <td> #{display semester}
+      $if not $ null participant
+        <tr>
+          <th> Teilnehmer
+          <td>
             <ul>
               $forall (E.Value csh, E.Value tid, regSince) <- participant
                 <li>
                   <a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
-          registriert seit #{display regSince}
+                  seit #{display regSince}
 
-    <h2>
-      Abgegebene Übungsblätter:
-    TODO
-    <p>
-      <h1>
-        Benutzerdaten
-      ^{userTable}
-      <h2>
-        Studiengänge
-        <ul>
-          $forall (degree,field,fieldtype,semester) <- studies
-            <li>#{display degree}
-                #{display field}
-                #{display fieldtype}
-                #{display semester}
-
-      <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>
-            Nicht aufgeführt sind Zeitstempel mit Benutzerinformationen, z.B. bei der Editierung und Korrekturen von Übungen, Übungsgruppenleiterschaft, Raumbuchungen, etc.
-          <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.
 

templates/profileData.hamlet

@@ -0,0 +1,24 @@
+<div .container>
+  <div .alert .alert-danger>
+    <div .alert__content>
+      TODO: Alle Benutzerbezogenen Daten sollen hier angezeigt
+      und verlinkt werden
+      (alle Abgaben, Klausurnoten, etc.)
+
+  <em> TODO: Hier mehr Daten in Tabellen anzeigen!
+
+  <h2>
+        <em> TODO: Knopf zum Löschen aller Daten erstellen
+
+  <p>
+    <h4>Hinweise:
+    <ul>
+      <li>
+        Nicht aufgeführt sind Zeitstempel mit Benutzerinformationen, z.B. bei der Editierung und Korrekturen von Übungen, Übungsgruppenleiterschaft, Raumbuchungen, etc.
+      <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.