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 Web.PathPieces (showToPathPiece, readFromPathPiece)
-- import Control.Lens import Control.Lens
import Colonnade hiding (fromMaybe, singleton) import Colonnade hiding (fromMaybe, singleton)
-- import Yesod.Colonnade -- import Yesod.Colonnade
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
@ -110,63 +110,77 @@ homeUser uid = do
cTime <- liftIO getCurrentTime cTime <- liftIO getCurrentTime
let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime
tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) tableData :: -- E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant))
(E.SqlExpr (Entity Course ))) -- (E.SqlExpr (Entity Course )))
(E.SqlExpr (Entity Sheet )) -- (E.SqlExpr (Entity Sheet ))
-> E.SqlQuery ( E.SqlExpr (E.Value (Key Term)) _ -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term))
, E.SqlExpr (E.Value Text) , E.SqlExpr (E.Value Text)
, E.SqlExpr (E.Value Text) , E.SqlExpr (E.Value Text)
, E.SqlExpr (E.Value UTCTime)) , E.SqlExpr (E.Value UTCTime)
tableData ((participant `E.InnerJoin` course `E.InnerJoin` sheet) `E.LeftOuterJoin` (submission `E.LeftOuterJoin` sedit)) = do , E.SqlExpr (E.Value (Maybe SubmissionId)))
E.on $ submission E.^. SubmissionId E.==. sedit E.^. SubmissionId tableData ((participant `E.InnerJoin` course `E.InnerJoin` sheet) `E.LeftOuterJoin` submission) = do
E.on $ sheet E.^. SheetId E.==. sedit E.^. SubmissionSheet 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.==. sheet E.^. SheetCourse
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime
E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
E.limit nrSheetDeadlines -- E.limit nrSheetDeadlines
return return
( course E.^. CourseTerm ( course E.^. CourseTerm
, course E.^. CourseShorthand , course E.^. CourseShorthand
, sheet E.^. SheetName , sheet E.^. SheetName
, sheet E.^. SheetActiveTo , sheet E.^. SheetActiveTo
, submission E.^. SubmissionId , submission E.?. SubmissionId
, sedit
) )
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 colonnade = mconcat
[ -- dbRow [ -- 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}|] 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 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}|] 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 textCell $ display deadline
, sortable (Just "done") (textCell MsgDone) $ \DBRow{ dbrOutput=(_, _, _, _) } -> , sortable (Just "done") (textCell MsgDone) $ \dbrow@(DBRow{ dbrOutput=(_, _, _, _, E.Value mbsid) }) ->
textCell ("?" :: Text) 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 { dbtSQLQuery = tableData
, dbtColonnade = colonnade , dbtColonnade = colonnade
, dbtSorting = Map.fromList , dbtSorting = Map.fromList
[ ( "term" [ ( "term"
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseTerm , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseTerm
) )
, ( "course" , ( "course"
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseShorthand , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseShorthand
) )
, ( "sheet" , ( "sheet"
, SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet ) -> sheet E.^. SheetName , SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
) )
, ( "deadline" , ( "deadline"
, SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet ) -> sheet E.^. SheetActiveTo , SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveTo
) )
, ( "done" , ( "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" , dbtFilter = mempty {- [ ( "term"