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

@@ -30,16 +30,18 @@
 /favicon.ico FaviconR GET                                     !free
 /robots.txt RobotsR GET                                       !free
 
-/        HomeR    GET                                         !free
+/                           HomeR             GET                                         !free
-/profile ProfileR GET                                         !free
+/users                      UsersR            GET                                         -- no tags, i.e. admins only
-/users   UsersR   GET                                         -- no tags, i.e. admins only
+/admin/test                 AdminTestR        GET POST
-/admin/test AdminTestR GET POST
 
-/terms                       TermShowR         GET            !free
+/profile                    ProfileR          GET POST        !free                             !free
-/terms/current               TermCurrentR      GET            !free
+/profile/data               ProfileDataR      GET             !free                             !free
-/terms/edit                  TermEditR         GET POST
+
-/terms/#TermId/edit          TermEditExistR    GET
+/terms                      TermShowR         GET             !free
-!/terms/#TermId              TermCourseListR   GET            !free
+/terms/current              TermCurrentR      GET             !free
+/terms/edit                 TermEditR         GET POST
+/terms/#TermId/edit         TermEditExistR    GET
+!/terms/#TermId             TermCourseListR   GET             !free
 
 -- For Pattern Synonyms see Foundation
 /course/                    CourseListR       GET             !free

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,88 +44,90 @@ offSheetDeadlines   = 15
 getHomeR :: Handler Html
 getHomeR = do
   muid <- maybeAuthId
-  -- let uid = fromMaybe (Key 1) muid -- TODO: delete me
+  case muid of
-  cTime <- liftIO getCurrentTime
+    Nothing   -> defaultLayout [whamlet| Bitte einloggen! |]
-  let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime
+    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 Course           )))
+                                                (E.SqlExpr (Entity Sheet            ))
-                                            (E.SqlExpr (Entity Sheet            ))
+                      -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term))
-                  -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term))
+                                    , E.SqlExpr (E.Value Text)
-                                , E.SqlExpr (E.Value Text)
+                                    , E.SqlExpr (E.Value Text)
-                                , E.SqlExpr (E.Value Text)
+                                    , E.SqlExpr (E.Value UTCTime))
-                                , 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.==. sheet E.^. SheetCourse
-        E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
+            E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
-        E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
+            E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
-             E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime
+                E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime
-             E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
+                E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
-        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
-        return
-          ( course  E.^. CourseTerm
-          , course  E.^. CourseShorthand
-          , sheet   E.^. SheetName
-          , sheet   E.^. SheetActiveTo
-          )
-
-      colonnade :: Colonnade Sortable (DBRow (E.Value (Key Term), E.Value Text, E.Value Text, E.Value UTCTime)) (Cell UniWorX)
-      colonnade = mconcat
-        [ -- dbRow
-          sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _) } ->
-            cell [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
-        , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _) } ->
-            cell [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
-        , sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline) } ->
-            textCell $ display deadline
-        , sortable (Just "done") (i18nCell MsgDone) $ \DBRow{ dbrOutput=(_, _, _, _) } ->
-            textCell $ "?"
-        ]
-  sheetTable <- dbTable def $ DBTable
-    { dbtSQLQuery  = tableData muid
-    , dbtColonnade = colonnade
-    , dbtSorting   =  [ ( "term"
-                        , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseTerm
-                        )
-                      , ( "course"
-                        , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseShorthand
-                        )
-                        -- TODO
                       ]
-    , dbtFilter    =  mempty {- [ ( "term"
+            E.limit nrSheetDeadlines
-                        , FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if
+            return
-                            | Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
+              ( course  E.^. CourseTerm
-                            | otherwise     -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
+              , course  E.^. CourseShorthand
-                        )
+              , sheet   E.^. SheetName
-                        ] -}
+              , sheet   E.^. SheetActiveTo
-    , dbtAttrs     = tableDefault
+              )
-    , dbtIdent     = "upcomingdeadlines" :: Text
+
-    }
+          colonnade :: Colonnade Sortable (DBRow (E.Value (Key Term), E.Value Text, E.Value Text, E.Value UTCTime)) (Cell UniWorX)
+          colonnade = mconcat
+            [ -- dbRow
+              sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _) } ->
+                cell [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
+            , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _) } ->
+                cell [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
+            , sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline) } ->
+                textCell $ display deadline
+            , sortable (Just "done") (i18nCell MsgDone) $ \DBRow{ dbrOutput=(_, _, _, _) } ->
+                textCell $ "?"
+            ]
+      sheetTable <- dbTable def $ DBTable
+        { dbtSQLQuery  = tableData
+        , dbtColonnade = colonnade
+        , dbtSorting   =  [ ( "term"
+                            , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseTerm
+                            )
+                          , ( "course"
+                            , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseShorthand
+                            )
+                            -- TODO
+                          ]
+        , dbtFilter    =  mempty {- [ ( "term"
+                            , FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if
+                                | Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
+                                | otherwise     -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
+                            )
+                            ] -}
+        , dbtAttrs     = tableDefault
+        , dbtIdent     = "upcomingdeadlines" :: Text
+        }
 
 
-  defaultLayout $ do
+      defaultLayout $ do
-    setTitle "Willkommen zum Uniworky Test!"
+        setTitle "Willkommen zum Uniworky Test!"
-    $(widgetFile "home")
+        $(widgetFile "home")

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
-    TODO
 
-  <h1>Anstehende Kursanmeldungen
+  <h1>
-    TODO
+    Anstehende Klausuren
+  TODO
+
+  <h1>
+    Anstehende Kursanmeldungen
+  TODO
 

templates/profile.hamlet

@@ -1,80 +1,79 @@
 <div .ui.container>
 
     <h1>
-      Access granted!
+      _{MsgProfileHeading} #{userDisplayName}
 
-    <p>
+    <table .table .table-striped >
-      This page is protected and access is allowed only for authenticated users.
+      <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
+        <tr>
+          <th> Administrator
+          <td>
+            <ul>
+              $forall institute <- admin_rights
+                <li>#{display institute}
+      $if not $ null lecturer_rights
+        <tr>
+          <th> Lehrberechtigt
+          <td>
+            <ul>
+              $forall institute <- lecturer_rights
+                <li>#{display institute}
+      $if not $ null lecture_owner
+        <tr>
+          <th> Eigene Kurse
+          <td>
+            <ul>
+              $forall (E.Value csh, E.Value tid) <- lecture_owner
+                <li>
+                  <a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
+      $if not $ null lecture_corrector
+        <tr>
+          <th> Korrektor
+          <td>
+            <ul>
+              $forall (E.Value csh, E.Value tid) <- lecture_corrector
+                <li>
+                  <a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
+      $if not $ null studies
+        <tr>
+          <th> Studiengänge
+          <td>
+              <table .table .table-striped .table-hover>
+                <tr>
+                  <th> Abschluss
+                  <th> Studiengang
+                  <th> Studienart
+                  <th> Semester
 
-    <p>
+                $forall (degree,field,fieldtype,semester) <- studies
-      Your data is protected with us <strong><span class="username">#{userIdent}</span></strong>!
+                  <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}
+                  seit #{display regSince}
 
-    $if not $ null admin_rights
-      <h1>
-        Administrator für die Institute
-      <ul>
-        $forall institute <- admin_rights
-          <li>#{display institute}
-    $if not $ null lecturer_rights
-      <h1>
-        Lehrberechtigung für die Institute
-      <ul>
-        $forall institute <- lecturer_rights
-          <li>#{display institute}
-
-    <h2>
-      Zugriffsberechtigung als Lehrender auf:
-    <ul>
-      $forall (E.Value csh, E.Value tid) <- lecture_owner
-        <li>
-          <a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
-    <h2>
-      Zugriffsberechtigung als Korrekor auf:
-    <ul>
-      $forall (E.Value csh, E.Value tid) <- lecture_corrector
-        <li>
-          <a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
-    <h2>
-      Kursteilnehmer:
-    <ul>
-      $forall (E.Value csh, E.Value tid, regSince) <- participant
-        <li>
-          <a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
-          registriert 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.