Homepage unlogged fixed.

src/Handler/Home.hs

@@ -45,9 +45,65 @@ getHomeR :: Handler Html
 getHomeR = do
   muid <- maybeAuthId
   case muid of
-    Nothing   -> defaultLayout [whamlet| Bitte einloggen! |]
+    Nothing   -> homeAnonymous
-    Just uid  -> do
+    Just uid  -> homeUser uid
-      -- let uid = fromMaybe (Key 1) muid -- TODO: delete me
+
+
+homeAnonymous :: Handler Html
+homeAnonymous = do
+  cTime <- liftIO getCurrentTime
+  let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime
+  let tableData :: E.SqlExpr (Entity Course)
+                  -> E.SqlQuery (E.SqlExpr (Entity Course))
+      tableData course = do
+            E.where_ $ course E.^. CourseHasRegistration E.==. E.val True
+                 E.&&. course E.^. CourseRegisterFrom    E.<=. E.val (Just cTime)
+                 E.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
+                        E.||.         (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
+            E.limit nrSheetDeadlines
+            E.orderBy [ E.asc  $ course E.^. CourseRegisterTo
+                      , E.desc $ course E.^. CourseShorthand
+                      ]
+            E.limit nrSheetDeadlines
+            return course
+
+      colonnade :: Colonnade Sortable (DBRow (Entity Course)) (Cell UniWorX)
+      colonnade = mconcat
+        [ -- dbRow
+          sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
+            let tid = courseTerm course
+                csh = courseShorthand course
+            cell [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
+        , sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
+            textCell $ display $ courseRegisterTo course
+        ]
+  courseTable <- dbTable def $ DBTable
+    { dbtSQLQuery  = tableData
+    , dbtColonnade = colonnade
+    , dbtSorting   =  [ ( "term"
+                        , SortColumn $ \(course) -> course E.^. CourseTerm
+                        )
+                      , ( "course"
+                        , SortColumn $ \(course) -> 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
+    $(widgetFile "dsgvDisclaimer")
+    $(widgetFile "home")
+
+homeUser :: Key User -> Handler Html
+homeUser uid = do
   cTime <- liftIO getCurrentTime
   let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime
 
@@ -58,24 +114,6 @@ getHomeR = do
                                 , E.SqlExpr (E.Value Text)
                                 , E.SqlExpr (E.Value Text)
                                 , E.SqlExpr (E.Value UTCTime))
-
-    --       tableData Nothing    (                          course `E.InnerJoin` sheet) = do
-    --         E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
-    --         E.where_ $ sheet E.^. SheetActiveTo E.<=. E.val fTime
-    --              E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
-    --         E.limit nrSheetDeadlines
-    --         E.orderBy [ E.asc  $ sheet  E.^. SheetActiveTo
-    --                   , E.desc $ sheet  E.^. SheetName
-    --                   , E.desc $ course E.^. CourseShorthand
-    --                   ]
-    --         E.limit nrSheetDeadlines
-    --         return
-    --           ( course  E.^. CourseTerm
-    --           , course  E.^. CourseShorthand
-    --           , sheet   E.^. SheetName
-    --           , sheet   E.^. SheetActiveTo
-    --           )
-
       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
@@ -127,7 +165,7 @@ getHomeR = do
     , dbtIdent     = "upcomingdeadlines" :: Text
     }
 
-
   defaultLayout $ do
-        setTitle "Willkommen zum Uniworky Test!"
+    -- setTitle "Willkommen zum Uniworky Test!"
-        $(widgetFile "home")
+    $(widgetFile "homeUser")
+    $(widgetFile "dsgvDisclaimer")

src/Handler/Profile.hs

@@ -65,7 +65,7 @@ getProfileR = do
     defaultLayout $ do
         setTitle . toHtml $ userIdent <> "'s User page"
         $(widgetFile "profile")
-
+        $(widgetFile "dsgvDisclaimer")
 
 postProfileR :: Handler Html
 postProfileR = do
@@ -80,3 +80,4 @@ getProfileDataR = do
 
   defaultLayout $ do
     $(widgetFile "profileData")
+    $(widgetFile "dsgvDisclaimer")

templates/dsgvDisclaimer.hamlet

@@ -0,0 +1,15 @@
+<div .alert .alert-danger>
+  <div .alert__content>
+    <h1>
+      Hinweis zum Datenschutz
+    <p>
+      Dieses experimentelle Programm wurde noch nicht
+      hinsichtlich des Datenschutzes überprüft.
+      <em>
+        Die Benutzung erfolgt derzeit freiwillig und auf eigene Gefahr!
+
+      Wir sind natürlich bemüht, alle Datenschutzrechtlichen Vorgaben
+      zu erfüllen, doch eine Überprüfung kann erst stattfinden,
+      sobald die Software weitestgehend fertiggestellt wurde und
+      sich nicht mehr verändert. Um dies zu Erreichen sind jedoch Test
+      unter realen Bedingungen erforderlich. Wir bitten um Ihr Verständnis.

templates/home.hamlet

@@ -8,17 +8,7 @@
       Die Implementierung von
       UniWorkY ist noch nicht abgeschlossen.
 
-  <h1>Anstehende Übungsblätter
+  <h1>Kurse mit offener Registrierung
     <div .container>
-      $maybe _ <- muid
+      ^{courseTable}
-        ^{sheetTable}
-
-
-  <h1>
-    Anstehende Klausuren
-  TODO
-
-  <h1>
-    Anstehende Kursanmeldungen
-  TODO
 

templates/homeUser.hamlet

@@ -0,0 +1,23 @@
+<div .container>
+  <h3>
+    Re-Implementierung von <a href="https://uniworx.ifi.lmu.de/">UniWorX</a>
+
+  <div .alert .alert-danger>
+    <div .alert__content>
+      Vorabversion!
+      Die Implementierung von
+      UniWorkY ist noch nicht abgeschlossen.
+
+  <h1>Anstehende Übungsblätter
+    <div .container>
+      ^{sheetTable}
+
+
+  <h1>
+    Anstehende Klausuren
+  TODO
+
+  <h1>
+    Anstehende Kursanmeldungen
+  TODO
+

templates/profile.hamlet

@@ -76,4 +76,3 @@
                   <a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
                   seit #{display regSince}
 
-