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

Cleanup links in dbTable

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Handler/Home.hs
View File

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

4
src/Handler/Sheet.hs
View File

@ -219,8 +219,8 @@ getSShowR tid csh shn = do
return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType) return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
let colonnadeFiles = widgetColonnade $ mconcat let colonnadeFiles = widgetColonnade $ mconcat
[ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> stringCell ftype [ 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)) , sortable (Just "path") "Dateiname" $ anchorCell' (\(E.Value fName,_,E.Value fType) -> CSheetR tid csh shn (SFileR fType fName))
(\(E.Value fName,_,_) -> str2widget fName) (\(E.Value fName,_,_) -> str2widget fName)
, sortable Nothing "Freigabe" $ \(_,_, E.Value ftype) -> , sortable Nothing "Freigabe" $ \(_,_, E.Value ftype) ->
case ftype of case ftype of
SheetExercise -> textCell $ display $ sheetActiveFrom sheet SheetExercise -> textCell $ display $ sheetActiveFrom sheet

10
src/Handler/Submission.hs
View File

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

4
src/Handler/Term.hs
View File

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

17
src/Handler/Utils/Table/Pagination.hs
View File

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