Fix calls to dbTable

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|<a href=@{CourseR tid csh CShowR}>#{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|<a href=@{CSheetR tid csh shn SShowR}>#{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

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

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"

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
                          )

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

templates/sheetShow.hamlet

@@ -19,5 +19,15 @@
     Abgabe bis
     #{sheetTo}
 
+  $maybe hints <- hintsFrom <* guard hasHints
+    <p>
+      Hinweise ab
+      #{hints}
+
+  $maybe solution <- solutionFrom <* guard hasSolution
+    <p>
+      Lösung ab
+      #{solution}
+
   <h2>Dateien
   ^{fileTable}