SheetList even icon spacing @hamannf to check
This commit is contained in:
parent
86f10ae1ba
commit
97140775d8
@ -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
|
||||||
|
|||||||
@ -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| |]
|
||||||
|
|
||||||
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
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user