Cleanup links in dbTable

This commit is contained in:
Gregor Kleen 2018-07-05 11:43:01 +02:00
parent 9fc50e8736
commit 68bf10f72f
5 changed files with 22 additions and 24 deletions

View File

@ -153,16 +153,11 @@ homeUser uid = do
cell [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
, sortable (Just "deadline") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline, _) } ->
textCell $ display deadline
, sortable (Just "done") (textCell MsgDone) $ \dbrow@(DBRow{ dbrOutput=(_, _, _, _, E.Value mbsid) }) ->
, sortable (Just "done") (textCell MsgDone) $ \dbrow@(DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, 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
(Just sid) -> anchorCell (CSheetR tid csh shn SubmissionOwnR)
tickmark
]
let validator = def & defaultSorting [("done",SortDesc), ("deadline",SortDesc)]
sheetTable <- dbTable validator $ DBTable

View File

@ -219,8 +219,8 @@ getSShowR tid csh shn = do
return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
let colonnadeFiles = widgetColonnade $ mconcat
[ 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 (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

View File

@ -246,16 +246,14 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
corrIsFile = fmap (isJust . fileContent . entityVal . snd) mCorr
Just isFile = origIsFile <|> corrIsFile
in if
| Just True <- origIsFile -> anchorCell (\() -> CSubmissionR tid csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
(\() -> [whamlet|#{fileTitle'}|])
()
| Just True <- origIsFile -> anchorCell (CSubmissionR tid csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
([whamlet|#{fileTitle'}|])
| otherwise -> textCell $ bool (<> "/") id isFile fileTitle'
, sortable Nothing (cell mempty) $ \(coalesce -> (_, mCorr)) -> case mCorr of
Nothing -> cell mempty
Just (_, Entity _ File{..})
| isJust fileContent -> anchorCell (\() -> CSubmissionR tid csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
(\() -> [whamlet|_{MsgFileCorrected}|])
()
| isJust fileContent -> anchorCell (CSubmissionR tid csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
([whamlet|_{MsgFileCorrected}|])
| otherwise -> textCell MsgFileCorrected
, sortable (Just "time") (textCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
origTime = fileModified . entityVal . snd <$> mOrig

View File

@ -43,8 +43,8 @@ getTermShowR = do
provideRep $ do
let colonnadeTerms = widgetColonnade $ mconcat
[ sortable Nothing "Kürzel" $
anchorCell (\(Entity tid _, _) -> TermCourseListR tid)
(\(Entity tid _, _) -> [whamlet|#{display tid}|])
anchorCell' (\(Entity tid _, _) -> TermCourseListR tid)
(\(Entity tid _, _) -> [whamlet|#{display tid}|])
, sortable (Just "lecture-start") (i18nCell MsgLectureStart) $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termLectureStart
, sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) ->

View File

@ -14,6 +14,7 @@
, ScopedTypeVariables
, TupleSections
, RankNTypes
, MultiWayIf
#-}
module Handler.Utils.Table.Pagination
@ -28,7 +29,7 @@ module Handler.Utils.Table.Pagination
, ToSortable(..), Sortable(..), sortable
, dbTable
, widgetColonnade, formColonnade
, textCell, stringCell, i18nCell, anchorCell
, textCell, stringCell, i18nCell, anchorCell, anchorCell'
, formCell, DBFormResult, getDBFormResult
, dbRow, dbSelect
) where
@ -369,14 +370,18 @@ stringCell = textCell
i18nCell = textCell
textCell msg = cell [whamlet|_{msg}|]
anchorCell :: IsDBTable m a
anchorCell' :: IsDBTable m a
=> (r -> Route UniWorX)
-> (r -> Widget)
-> (r -> DBCell m a)
anchorCell mkRoute mkWidget val = cell $(widgetFile "table/cell/link")
where
route = mkRoute val
widget = mkWidget val
anchorCell' mkRoute mkWidget val = anchorCell (mkRoute val) (mkWidget val)
anchorCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
anchorCell route widget = cell $ do
authResult <- liftHandlerT $ isAuthorized route False
if
| Authorized <- authResult -> $(widgetFile "table/cell/link")
| otherwise -> widget
newtype DBFormResult r i a = DBFormResult (Map i (r, a -> a))