fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix calls to dbTable

Browse Source
This commit is contained in:
Gregor Kleen 2018-07-18 13:13:19 +02:00
parent fcb50859fc
commit 6d9b1dfa21
6 changed files with 29 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Handler/Home.hs
View File

@ -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

19
src/Handler/Sheet.hs
View File

@ -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

1
src/Handler/Submission.hs
View File

@ -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"

1
src/Handler/Term.hs
View File

@ -81,6 +81,7 @@ getTermShowR = do
table <- dbTable def $ DBTable
{ dbtSQLQuery = termData
, dbtColonnade = colonnadeTerms
, dbtProj = return . dbrOutput
, dbtSorting = [ ( "start"
, SortColumn $ \term -> term E.^. TermStart
)

1
src/Handler/Users.hs
View File

@ -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

10
templates/sheetShow.hamlet
View File

@ -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}