fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Homepage shows all Deadlines correctly now.

Browse Source
This commit is contained in:
SJost 2018-07-03 13:39:02 +02:00
parent aa6f35d9c8
commit 0944b5984e
1 changed files with 39 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
src/Handler/Home.hs
View File

@ -22,7 +22,7 @@ import Data.Time
-- import Web.PathPieces (showToPathPiece, readFromPathPiece)
-- import Control.Lens
import Control.Lens
import Colonnade hiding (fromMaybe, singleton)
-- import Yesod.Colonnade
import qualified Database.Esqueleto as E
@ -110,63 +110,77 @@ 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))
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) `E.LeftOuterJoin` (submission `E.LeftOuterJoin` sedit)) = do
E.on $ submission E.^. SubmissionId E.==. sedit E.^. SubmissionId
E.on $ sheet E.^. SheetId E.==. sedit E.^. SubmissionSheet
, E.SqlExpr (E.Value UTCTime)
, E.SqlExpr (E.Value (Maybe SubmissionId)))
tableData ((participant `E.InnerJoin` course `E.InnerJoin` sheet) `E.LeftOuterJoin` submission) = do
E.on $ E.just(sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
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.limit nrSheetDeadlines
-- E.limit nrSheetDeadlines
return
( course E.^. CourseTerm
, course E.^. CourseShorthand
, sheet E.^. SheetName
, sheet E.^. SheetActiveTo
, submission E.^. SubmissionId
, sedit
, submission E.?. SubmissionId
)
colonnade :: Colonnade Sortable (DBRow (E.Value (Key Term), E.Value Text, E.Value Text, E.Value UTCTime)) (DBCell (WidgetT UniWorX IO) ())
colonnade :: Colonnade Sortable (DBRow ( E.Value (Key Term)
, E.Value Text
, E.Value Text
, E.Value UTCTime
, E.Value (Maybe SubmissionId)
))
(DBCell (WidgetT UniWorX IO) ())
colonnade = mconcat
[ -- dbRow
sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _) } ->
sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _, _) } ->
cell [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
, sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(E.Value tid, _,_,_) } ->
, sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(E.Value tid, _,_,_,_) } ->
textCell $ display tid
, sortable (Just "sheet") (textCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _) } ->
, sortable (Just "sheet") (textCell 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") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline) } ->
, sortable (Just "deadline") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline, _) } ->
textCell $ display deadline
, sortable (Just "done") (textCell MsgDone) $ \DBRow{ dbrOutput=(_, _, _, _) } ->
textCell ("?" :: Text)
, sortable (Just "done") (textCell MsgDone) $ \dbrow@(DBRow{ dbrOutput=(_, _, _, _, E.Value mbsid) }) ->
case mbsid of
Nothing -> textCell (" " :: Text)
(Just sid) -> anchorCell
(\DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, _mbsid) } ->
-- CSubmissionR tid csh shn scid SubShowR
CSheetR tid csh shn SubmissionOwnR
) (\DBRow{ dbrOutput=(_, _, _, _, _mbsid) } ->
toWidget (tickmark :: Text)
) dbrow
]
sheetTable <- dbTable def $ DBTable
let validator = def & defaultSorting [("done",SortDesc),("deadline",SortDesc)]
sheetTable <- dbTable validator $ DBTable
{ dbtSQLQuery = tableData
, dbtColonnade = colonnade
, dbtSorting = Map.fromList
[ ( "term"
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseTerm
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseTerm
)
, ( "course"
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseShorthand
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseShorthand
)
, ( "sheet"
, SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet ) -> sheet E.^. SheetName
, SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
)
, ( "deadline"
, SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet ) -> sheet E.^. SheetActiveTo
, SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveTo
)
, ( "done"
, SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet ) -> sheet E.^. SheetActiveTo
, SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` _ `E.LeftOuterJoin` subm) -> E.isNothing $ subm E.?. SubmissionId
)
]
, dbtFilter = mempty {- [ ( "term"