Homepage unlogged fixed.
This commit is contained in:
SJost
parent
61ba8bf052
commit
3ea175d315
@ -45,89 +45,127 @@ getHomeR :: Handler Html
|
|||||||
getHomeR = do
|
getHomeR = do
|
||||||
muid <- maybeAuthId
|
muid <- maybeAuthId
|
||||||
case muid of
|
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
|
|
||||||
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 Nothing ( course `E.InnerJoin` sheet) = do
|
homeAnonymous :: Handler Html
|
||||||
-- E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
homeAnonymous = do
|
||||||
-- E.where_ $ sheet E.^. SheetActiveTo E.<=. E.val fTime
|
cTime <- liftIO getCurrentTime
|
||||||
-- E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
|
let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime
|
||||||
-- E.limit nrSheetDeadlines
|
let tableData :: E.SqlExpr (Entity Course)
|
||||||
-- E.orderBy [ E.asc $ sheet E.^. SheetActiveTo
|
-> E.SqlQuery (E.SqlExpr (Entity Course))
|
||||||
-- , E.desc $ sheet E.^. SheetName
|
tableData course = do
|
||||||
-- , E.desc $ course E.^. CourseShorthand
|
E.where_ $ course E.^. CourseHasRegistration E.==. E.val True
|
||||||
-- ]
|
E.&&. course E.^. CourseRegisterFrom E.<=. E.val (Just cTime)
|
||||||
-- E.limit nrSheetDeadlines
|
E.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
|
||||||
-- return
|
E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
|
||||||
-- ( course E.^. CourseTerm
|
E.limit nrSheetDeadlines
|
||||||
-- , course E.^. CourseShorthand
|
E.orderBy [ E.asc $ course E.^. CourseRegisterTo
|
||||||
-- , 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
|
|
||||||
, E.desc $ course E.^. CourseShorthand
|
, E.desc $ course E.^. CourseShorthand
|
||||||
]
|
]
|
||||||
E.limit nrSheetDeadlines
|
E.limit nrSheetDeadlines
|
||||||
return
|
return course
|
||||||
( 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 :: Colonnade Sortable (DBRow (Entity Course)) (Cell UniWorX)
|
||||||
colonnade = mconcat
|
colonnade = mconcat
|
||||||
[ -- dbRow
|
[ -- dbRow
|
||||||
sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _) } ->
|
sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
||||||
cell [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
|
let tid = courseTerm course
|
||||||
, sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _) } ->
|
csh = courseShorthand course
|
||||||
cell [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
|
cell [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
|
||||||
, sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline) } ->
|
, sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||||
textCell $ display deadline
|
textCell $ display $ courseRegisterTo course
|
||||||
, sortable (Just "done") (i18nCell MsgDone) $ \DBRow{ dbrOutput=(_, _, _, _) } ->
|
]
|
||||||
textCell $ "?"
|
courseTable <- dbTable def $ DBTable
|
||||||
]
|
{ dbtSQLQuery = tableData
|
||||||
sheetTable <- dbTable def $ DBTable
|
, dbtColonnade = colonnade
|
||||||
{ dbtSQLQuery = tableData
|
, dbtSorting = [ ( "term"
|
||||||
, dbtColonnade = colonnade
|
, SortColumn $ \(course) -> course E.^. CourseTerm
|
||||||
, dbtSorting = [ ( "term"
|
)
|
||||||
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseTerm
|
, ( "course"
|
||||||
)
|
, SortColumn $ \(course) -> course E.^. CourseShorthand
|
||||||
, ( "course"
|
)
|
||||||
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseShorthand
|
-- TODO
|
||||||
)
|
]
|
||||||
-- TODO
|
, dbtFilter = mempty {- [ ( "term"
|
||||||
]
|
, FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if
|
||||||
, dbtFilter = mempty {- [ ( "term"
|
| Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||||
, FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if
|
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
|
||||||
| 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
|
||||||
, dbtAttrs = tableDefault
|
}
|
||||||
, dbtIdent = "upcomingdeadlines" :: Text
|
|
||||||
}
|
|
||||||
|
|
||||||
|
defaultLayout $ do
|
||||||
|
$(widgetFile "dsgvDisclaimer")
|
||||||
|
$(widgetFile "home")
|
||||||
|
|
||||||
defaultLayout $ do
|
homeUser :: Key User -> Handler Html
|
||||||
setTitle "Willkommen zum Uniworky Test!"
|
homeUser uid = do
|
||||||
$(widgetFile "home")
|
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
|
defaultLayout $ do
|
||||||
setTitle . toHtml $ userIdent <> "'s User page"
|
setTitle . toHtml $ userIdent <> "'s User page"
|
||||||
$(widgetFile "profile")
|
$(widgetFile "profile")
|
||||||
|
$(widgetFile "dsgvDisclaimer")
|
||||||
|
|
||||||
postProfileR :: Handler Html
|
postProfileR :: Handler Html
|
||||||
postProfileR = do
|
postProfileR = do
|
||||||
@ -80,3 +80,4 @@ getProfileDataR = do
|
|||||||
|
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
$(widgetFile "profileData")
|
$(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
|
Die Implementierung von
|
||||||
UniWorkY ist noch nicht abgeschlossen.
|
UniWorkY ist noch nicht abgeschlossen.
|
||||||
|
|
||||||
<h1>Anstehende Übungsblätter
|
<h1>Kurse mit offener Registrierung
|
||||||
<div .container>
|
<div .container>
|
||||||
$maybe _ <- muid
|
^{courseTable}
|
||||||
^{sheetTable}
|
|
||||||
|
|
||||||
|
|
||||||
<h1>
|
|
||||||
Anstehende Klausuren
|
|
||||||
TODO
|
|
||||||
|
|
||||||
<h1>
|
|
||||||
Anstehende Kursanmeldungen
|
|
||||||
TODO
|
|
||||||
|
|
||||||
|
|||||||
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}
|
<a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
|
||||||
seit #{display regSince}
|
seit #{display regSince}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user