From 0944b5984e4ac110cfb6be6d90d7236e230b07a9 Mon Sep 17 00:00:00 2001 From: SJost Date: Tue, 3 Jul 2018 13:39:02 +0200 Subject: [PATCH] Homepage shows all Deadlines correctly now. --- src/Handler/Home.hs | 64 +++++++++++++++++++++++++++------------------ 1 file changed, 39 insertions(+), 25 deletions(-) diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 6e24d5b69..a7a67244f 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -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|#{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|#{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"