diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index cf84ceb8c..b2e514610 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -45,89 +45,127 @@ 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 + Nothing -> homeAnonymous + Just uid -> homeUser uid - tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) - (E.SqlExpr (Entity Course ))) - (E.SqlExpr (Entity Sheet )) - -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term)) - , 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 - E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid - E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime - E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime - E.orderBy [ E.asc $ sheet E.^. SheetActiveTo - , E.desc $ sheet E.^. SheetName +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 E.^. CourseTerm - , course E.^. CourseShorthand - , sheet E.^. SheetName - , sheet E.^. SheetActiveTo - ) + return course - 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|#{display csh}|] - , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _) } -> - cell [whamlet|#{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 - } + 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|#{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") - defaultLayout $ do - setTitle "Willkommen zum Uniworky Test!" - $(widgetFile "home") +homeUser :: Key User -> Handler Html +homeUser uid = do + cTime <- liftIO getCurrentTime + let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime + + tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) + (E.SqlExpr (Entity Course ))) + (E.SqlExpr (Entity Sheet )) + -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term)) + , E.SqlExpr (E.Value Text) + , E.SqlExpr (E.Value Text) + , E.SqlExpr (E.Value UTCTime)) + 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 + E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime + E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime + 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 + ) + + 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|#{display csh}|] + , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _) } -> + cell [whamlet|#{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 + -- setTitle "Willkommen zum Uniworky Test!" + $(widgetFile "homeUser") + $(widgetFile "dsgvDisclaimer") diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index e4f3ee9bb..e5886e839 100644 --- a/src/Handler/Profile.hs +++ b/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") diff --git a/templates/dsgvDisclaimer.hamlet b/templates/dsgvDisclaimer.hamlet new file mode 100644 index 000000000..21817fcee --- /dev/null +++ b/templates/dsgvDisclaimer.hamlet @@ -0,0 +1,15 @@ +
+
+

+ Hinweis zum Datenschutz +

+ Dieses experimentelle Programm wurde noch nicht + hinsichtlich des Datenschutzes überprüft. + + 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. diff --git a/templates/home.hamlet b/templates/home.hamlet index cd79b6192..79d063cef 100644 --- a/templates/home.hamlet +++ b/templates/home.hamlet @@ -8,17 +8,7 @@ Die Implementierung von UniWorkY ist noch nicht abgeschlossen. -

Anstehende Übungsblätter +

Kurse mit offener Registrierung