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"