From 6d9b1dfa21b7f047013ebc03cf50aa84d2fd11cc Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 18 Jul 2018 13:13:19 +0200 Subject: [PATCH] Fix calls to dbTable --- src/Handler/Home.hs | 9 +++++---- src/Handler/Sheet.hs | 19 +++++++++++-------- src/Handler/Submission.hs | 1 + src/Handler/Term.hs | 1 + src/Handler/Users.hs | 1 + templates/sheetShow.hamlet | 10 ++++++++++ 6 files changed, 29 insertions(+), 12 deletions(-) diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 9cd5147d5..de28d7927 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -123,7 +123,7 @@ homeUser uid = do E.on $ submission E.?. SubmissionSheet E.==. E.just(sheet E.^. SheetId) 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 -- TODO: do this with isAuthorized in dbtProj + E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime -- E.limit nrSheetDeadlines -- arbitrary limits are not intuitive @@ -145,11 +145,11 @@ homeUser uid = do colonnade = mconcat [ -- dbRow sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _, _) } -> - cell [whamlet|#{display csh}|] + anchorCell (CourseR tid csh CShowR) (toWidget $ display csh) , 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, _, _) } -> - cell [whamlet|#{display shn}|] + anchorCell (CSheetR tid csh shn SShowR) (toWidget $ display shn) , sortable (Just "deadline") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline, _) } -> cell $ formatTime SelFormatDateTime deadline >>= toWidget , sortable (Just "done") (textCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, E.Value mbsid) }) -> @@ -162,7 +162,8 @@ homeUser uid = do sheetTable <- dbTable validator $ DBTable { dbtSQLQuery = tableData , dbtColonnade = colonnade - , dbtProj = return + , dbtProj = \dbRow@DBRow{ dbrOutput = (E.Value tid, E.Value csh, E.Value shn, _, _) } + -> dbRow <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid csh shn SShowR) False) , dbtSorting = Map.fromList [ ( "term" , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseTerm diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 49d7ba18e..041f60e9f 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -230,21 +230,18 @@ getSShowR tid csh shn = do [ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> stringCell ftype , sortable (Just "path") "Dateiname" $ anchorCell' (\(E.Value fName,_,E.Value fType) -> CSheetR tid csh shn (SFileR fType fName)) (\(E.Value fName,_,_) -> str2widget fName) - , sortable Nothing "Freigabe" $ \(_,_, E.Value ftype) -> - case ftype of - SheetExercise -> textCell $ display $ sheetActiveFrom sheet - SheetHint -> textCell $ display $ sheetHintFrom sheet - SheetSolution -> textCell $ display $ sheetSolutionFrom sheet , sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> cell $ formatTime SelFormatDateTime (modified :: UTCTime) >>= toWidget ] - fileTable <- dbTable def $ DBTable + let psValidator = def + & defaultSorting [("type", SortAsc), ("path", SortAsc)] + fileTable <- dbTable psValidator $ DBTable { dbtSQLQuery = fileData , dbtColonnade = colonnadeFiles - , dbtProj = return . dbrOutput + , dbtProj = \DBRow{ dbrOutput = dbrOutput@(E.Value fName, _, E.Value fType) } + -> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid csh shn $ SFileR fType fName) False) , dbtStyle = def , dbtFilter = Map.empty , dbtIdent = "files" :: Text - -- TODO: Add column for and visibility date , dbtSorting = [ ( "type" , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> sheetFile E.^. SheetFileType ) @@ -256,10 +253,16 @@ getSShowR tid csh shn = do ) ] } + (hasHints, hasSolution) <- runDB $ do + hasHints <- (/= 0) <$> count [ SheetFileSheet ==. sid, SheetFileType ==. SheetHint ] + hasSolution <- (/= 0) <$> count [ SheetFileSheet ==. sid, SheetFileType ==. SheetSolution ] + return (hasHints, hasSolution) defaultLayout $ do setTitle $ toHtml $ T.append "Übung " $ sheetName sheet sheetFrom <- formatTime SelFormatDateTime $ sheetActiveFrom sheet sheetTo <- formatTime SelFormatDateTime $ sheetActiveTo sheet + hintsFrom <- traverse (formatTime SelFormatDateTime) $ sheetHintFrom sheet + solutionFrom <- traverse (formatTime SelFormatDateTime) $ sheetSolutionFrom sheet $(widgetFile "sheetShow") getSFileR :: TermId -> Text -> Text -> SheetFileType -> FilePath -> Handler TypedContent diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 1f0d3c5a4..483443b75 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -290,6 +290,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do smid2ArchiveTable (smid,cid) = DBTable { dbtSQLQuery = submissionFiles smid , dbtColonnade = colonnadeFiles cid + , dbtProj = return . dbrOutput , dbtStyle = def , dbtIdent = "files" :: Text , dbtSorting = [ ( "path" diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 28cb87731..89547f436 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -81,6 +81,7 @@ getTermShowR = do table <- dbTable def $ DBTable { dbtSQLQuery = termData , dbtColonnade = colonnadeTerms + , dbtProj = return . dbrOutput , dbtSorting = [ ( "start" , SortColumn $ \term -> term E.^. TermStart ) diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 47a27cbaa..ef9d012e1 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -80,6 +80,7 @@ getUsersR = do userList <- dbTable psValidator $ DBTable { dbtSQLQuery = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User)) , dbtColonnade = colonnadeUsers + , dbtProj = return , dbtSorting = Map.fromList [ ( "display-name" , SortColumn $ \user -> user E.^. UserDisplayName diff --git a/templates/sheetShow.hamlet b/templates/sheetShow.hamlet index d10f3dc0c..71b1cf633 100644 --- a/templates/sheetShow.hamlet +++ b/templates/sheetShow.hamlet @@ -19,5 +19,15 @@ Abgabe bis #{sheetTo} + $maybe hints <- hintsFrom <* guard hasHints +

+ Hinweise ab + #{hints} + + $maybe solution <- solutionFrom <* guard hasSolution +

+ Lösung ab + #{solution} +

Dateien ^{fileTable}