Homepage unlogged fixed.
This commit is contained in:
SJost
parent
61ba8bf052
commit
3ea175d315
@ -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|<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
|
||||
}
|
||||
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")
|
||||
|
||||
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|<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
|
||||
-- setTitle "Willkommen zum Uniworky Test!"
|
||||
$(widgetFile "homeUser")
|
||||
$(widgetFile "dsgvDisclaimer")
|
||||
|
||||
@ -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")
|
||||
|
||||
15
templates/dsgvDisclaimer.hamlet
Normal file
15
templates/dsgvDisclaimer.hamlet
Normal file
@ -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.
|
||||
@ -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
|
||||
^{sheetTable}
|
||||
|
||||
|
||||
<h1>
|
||||
Anstehende Klausuren
|
||||
TODO
|
||||
|
||||
<h1>
|
||||
Anstehende Kursanmeldungen
|
||||
TODO
|
||||
^{courseTable}
|
||||
|
||||
|
||||
23
templates/homeUser.hamlet
Normal file
23
templates/homeUser.hamlet
Normal file
@ -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
|
||||
|
||||
@ -76,4 +76,3 @@
|
||||
<a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
|
||||
seit #{display regSince}
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user