SheetList even icon spacing @hamannf to check

This commit is contained in:
Steffen Jost 2019-05-10 12:05:23 +02:00
parent 86f10ae1ba
commit 97140775d8
3 changed files with 33 additions and 13 deletions

View File

@ -194,10 +194,15 @@ getSheetListR tid ssh csh = do
, sortable (Just "visible-from") (i18nCell MsgAccessibleSince) , sortable (Just "visible-from") (i18nCell MsgAccessibleSince)
$ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> foldMap (dateTimeCellVisible now) sheetVisibleFrom $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> foldMap (dateTimeCellVisible now) sheetVisibleFrom
, sortable (toNothing "downloads") (i18nCell MsgFiles) , sortable (toNothing "downloads") (i18nCell MsgFiles)
$ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, existFiles)} -> mconcat $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, existFiles)} -> mconcat -- $ intersperse spacerCell
[ linkEmptyCell link icn | sft <- hasSFT existFiles [ icnCell & addIconFixedWidth
| let existingSFTs = hasSFT existFiles
, sft <- [minBound..maxBound]
, let link = CSheetR tid ssh csh sheetName $ SZipR $ ZIPArchiveName sft , let link = CSheetR tid ssh csh sheetName $ SZipR $ ZIPArchiveName sft
, let icn = toWidget $ sheetFile2markup sft , let icn = toWidget $ sheetFile2markup sft
, let icnCell = if sft `elem` existingSFTs
then linkEmptyCell link icn
else spacerCell
] ]
, sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom) , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
$ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> dateTimeCell sheetActiveFrom $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> dateTimeCell sheetActiveFrom

View File

@ -28,6 +28,10 @@ type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with Wit
---------------- ----------------
-- Special cells -- Special cells
-- | Display a breakable space
spacerCell :: (IsDBTable m a) => DBCell m a
spacerCell = cell [whamlet|&emsp;|]
tellCell :: (Monoid a, IsDBTable m a) => a -> DBCell m a -> DBCell m a tellCell :: (Monoid a, IsDBTable m a) => a -> DBCell m a -> DBCell m a
tellCell = flip mappend . writerCell . tell tellCell = flip mappend . writerCell . tell
@ -64,11 +68,21 @@ ifCell decision cTrue cFalse x
| decision x = cTrue x | decision x = cTrue x
| otherwise = cFalse x | otherwise = cFalse x
linkEmptyCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
linkEmptyCell link wgt = linkEitherCell link (wgt,mempty)
-- Recall: for line numbers, use dbRow -- Recall: for line numbers, use dbRow
--------------------- ---------------------
-- Icon cells -- Icon cells
addIconFixedWidth :: (IsDBTable m a) => DBCell m a -> DBCell m a
addIconFixedWidth = over cellAttrs $ insertClass "icon-fixed-width"
iconSpacerCell :: (IsDBTable m a) => DBCell m a
iconSpacerCell = mempty & addIconFixedWidth
-- | Maybe display a tickmark/checkmark icon -- | Maybe display a tickmark/checkmark icon
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
tickmarkCell = cell . toWidget . hasTickmark tickmarkCell = cell . toWidget . hasTickmark

View File

@ -23,7 +23,7 @@ module Handler.Utils.Table.Pagination
, widgetColonnade, formColonnade, dbColonnade , widgetColonnade, formColonnade, dbColonnade
, cell, textCell, stringCell, i18nCell , cell, textCell, stringCell, i18nCell
, anchorCell, anchorCell', anchorCellM, anchorCellM' , anchorCell, anchorCell', anchorCellM, anchorCellM'
, linkEmptyCell, linkEmptyCellM, linkEmptyCellM' , linkEitherCell, linkEitherCellM, linkEitherCellM'
, cellTooltip , cellTooltip
, listCell , listCell
, formCell, DBFormResult, getDBFormResult , formCell, DBFormResult, getDBFormResult
@ -889,22 +889,23 @@ anchorCellM' xM x2route x2widget = cell $ do
Authorized -> $(widgetFile "table/cell/link") -- show allowed link Authorized -> $(widgetFile "table/cell/link") -- show allowed link
_otherwise -> widget -- don't show prohibited link _otherwise -> widget -- don't show prohibited link
-- | Variant of `anchorCell` that returns `mempty` for unauthorized links -- | Variant of `anchorCell` that displays different widgets depending whether the route is authorized for current user
linkEmptyCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a linkEitherCell :: IsDBTable m a => Route UniWorX -> (Widget, Widget) -> DBCell m a
linkEmptyCell = linkEmptyCellM . return linkEitherCell = linkEitherCellM . return
linkEmptyCellM :: IsDBTable m a => WidgetT UniWorX IO (Route UniWorX) -> Widget -> DBCell m a linkEitherCellM :: IsDBTable m a => WidgetT UniWorX IO (Route UniWorX) -> (Widget, Widget) -> DBCell m a
linkEmptyCellM routeM widget = linkEmptyCellM' routeM id (const widget) linkEitherCellM routeM (widgetAuth,widgetUnauth) = linkEitherCellM' routeM id (const widgetAuth, const widgetUnauth)
linkEmptyCellM' :: IsDBTable m a => WidgetT UniWorX IO x -> (x -> Route UniWorX) -> (x -> Widget) -> DBCell m a linkEitherCellM' :: IsDBTable m a => WidgetT UniWorX IO x -> (x -> Route UniWorX) -> (x -> Widget, x -> Widget) -> DBCell m a
linkEmptyCellM' xM x2route x2widget = cell $ do linkEitherCellM' xM x2route (x2widgetAuth,x2widgetUnauth) = cell $ do
x <- xM x <- xM
let route = x2route x let route = x2route x
widget = x2widget x widget = x2widgetAuth x
widgetUnauth = x2widgetUnauth x
authResult <- liftHandlerT $ isAuthorized route False authResult <- liftHandlerT $ isAuthorized route False
case authResult of case authResult of
Authorized -> $(widgetFile "table/cell/link") -- show allowed link Authorized -> $(widgetFile "table/cell/link") -- show allowed link
_otherwise -> mempty -- don't show anything for prohibited links _otherwise -> widgetUnauth -- show alternative widget