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

Bugfix: MaterialShow empty table indicator working

Browse Source
This commit is contained in:
Steffen Jost 2019-05-03 17:18:22 +02:00
parent d2546745da
commit dc4ec6148f
1 changed files with 43 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
src/Handler/Material.hs
View File

@ -79,16 +79,44 @@ fetchMaterial tid ssh csh mnm = do
getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialListR _tid _ssh _csh = do getMaterialListR tid ssh csh = do
-- muid <- maybeAuthId let matLink :: MaterialName -> Route UniWorX
-- cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh matLink = CourseR tid ssh csh . flip MaterialR MShowR
-- table <- return $ error "unimplemented" -- TODO _muid <- maybeAuthId
-- let headingLong = prependCourseTitle tid ssh csh $ MsgMaterialListHeading table <- runDB $ do
-- headingShort = prependCourseTitle tid ssh csh $ MsgMaterialListHeading cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-- siteLayoutMsg headingLong $ do let psValidator = def & defaultSorting [SortDescBy "last-edit"]
-- setTitleI headingShort table <- dbTableWidget' psValidator DBTable
-- $(widgetFile "material-list") { dbtIdent = "material-list" :: Text
error "unimplemented" -- TODO , dbtStyle = def
, dbtParams = def
, dbtSQLQuery = \material -> do
E.where_ $ material E.^. MaterialCourse E.==. E.val cid
return material
, dbtRowKey = (E.^. MaterialId)
, dbtProj = \dbr@DBRow{ dbrOutput=(Entity _ Material{..}) } ->
let link = matLink materialName
in guardAuthorizedFor link dbr
, dbtColonnade = widgetColonnade $ mconcat
[ dbRow
, sortable (Just "name") (i18nCell MsgMaterialName)
$ \DBRow{dbrOutput=(Entity _ Material{..})} -> cell $ toWgt materialName
]
, dbtSorting = const Map.empty -- Map.fromList
[
]
, dbtFilter = mempty
, dbtFilterUI = mempty
}
return table
let headingLong = prependCourseTitle tid ssh csh $ MsgMaterialListHeading
headingShort = prependCourseTitle tid ssh csh $ MsgMaterialListHeading
siteLayoutMsg headingLong $ do
setTitleI headingShort
$(widgetFile "material-list")
getMFileR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> FilePath -> Handler TypedContent getMFileR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> FilePath -> Handler TypedContent
getMFileR tid ssh csh mnm title = serveOneFile fileQuery getMFileR tid ssh csh mnm title = serveOneFile fileQuery
@ -125,14 +153,12 @@ getMShowR tid ssh csh mnm = do
return (file E.^. FileTitle, file E.^. FileModified) return (file E.^. FileTitle, file E.^. FileModified)
, dbtRowKey = \(_ `E.InnerJoin` file) -> file E.^. FileId , dbtRowKey = \(_ `E.InnerJoin` file) -> file E.^. FileId
, dbtColonnade = widgetColonnade $ mconcat , dbtColonnade = widgetColonnade $ mconcat
[ -- dbRowIndicator -- important: contains writer to indicate that the tables is not empty [ dbRowIndicator -- important: contains writer to indicate that the tables is not empty
colFilePathSimple (view _1) matLink , colFilePathSimple (view $ _dbrOutput . _1) matLink
, colFileModification (view _2) , colFileModification (view $ _dbrOutput . _2)
] ]
, dbtProj = \row -> , dbtProj = \dbr@DBRow{ dbrOutput=(E.Value fPath, _) } ->
let dbrOutput = row ^. _dbrOutput guardAuthorizedFor (matLink fPath) dbr
fPath = dbrOutput ^. _1 . _Value
in guardAuthorizedFor (matLink fPath) dbrOutput
, dbtStyle = def , dbtStyle = def
, dbtParams = def , dbtParams = def
, dbtFilter = mempty , dbtFilter = mempty