From 97140775d87c4a8d9fa80c0b78381ac8929e8e58 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 10 May 2019 12:05:23 +0200 Subject: [PATCH] SheetList even icon spacing @hamannf to check --- src/Handler/Sheet.hs | 9 +++++++-- src/Handler/Utils/Table/Cells.hs | 14 ++++++++++++++ src/Handler/Utils/Table/Pagination.hs | 23 ++++++++++++----------- 3 files changed, 33 insertions(+), 13 deletions(-) diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index a87a70d70..cf8ad5455 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -194,10 +194,15 @@ getSheetListR tid ssh csh = do , sortable (Just "visible-from") (i18nCell MsgAccessibleSince) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> foldMap (dateTimeCellVisible now) sheetVisibleFrom , sortable (toNothing "downloads") (i18nCell MsgFiles) - $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, existFiles)} -> mconcat - [ linkEmptyCell link icn | sft <- hasSFT existFiles + $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, existFiles)} -> mconcat -- $ intersperse spacerCell + [ icnCell & addIconFixedWidth + | let existingSFTs = hasSFT existFiles + , sft <- [minBound..maxBound] , let link = CSheetR tid ssh csh sheetName $ SZipR $ ZIPArchiveName sft , let icn = toWidget $ sheetFile2markup sft + , let icnCell = if sft `elem` existingSFTs + then linkEmptyCell link icn + else spacerCell ] , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> dateTimeCell sheetActiveFrom diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index e2294e46c..5ec84c9fe 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -28,6 +28,10 @@ type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with Wit ---------------- -- 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 = flip mappend . writerCell . tell @@ -64,11 +68,21 @@ ifCell decision cTrue cFalse x | decision x = cTrue 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 --------------------- -- 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 tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a tickmarkCell = cell . toWidget . hasTickmark diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 5fe533e21..574866084 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -23,7 +23,7 @@ module Handler.Utils.Table.Pagination , widgetColonnade, formColonnade, dbColonnade , cell, textCell, stringCell, i18nCell , anchorCell, anchorCell', anchorCellM, anchorCellM' - , linkEmptyCell, linkEmptyCellM, linkEmptyCellM' + , linkEitherCell, linkEitherCellM, linkEitherCellM' , cellTooltip , listCell , formCell, DBFormResult, getDBFormResult @@ -889,22 +889,23 @@ anchorCellM' xM x2route x2widget = cell $ do Authorized -> $(widgetFile "table/cell/link") -- show allowed link _otherwise -> widget -- don't show prohibited link --- | Variant of `anchorCell` that returns `mempty` for unauthorized links -linkEmptyCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a -linkEmptyCell = linkEmptyCellM . return +-- | Variant of `anchorCell` that displays different widgets depending whether the route is authorized for current user +linkEitherCell :: IsDBTable m a => Route UniWorX -> (Widget, Widget) -> DBCell m a +linkEitherCell = linkEitherCellM . return -linkEmptyCellM :: IsDBTable m a => WidgetT UniWorX IO (Route UniWorX) -> Widget -> DBCell m a -linkEmptyCellM routeM widget = linkEmptyCellM' routeM id (const widget) +linkEitherCellM :: IsDBTable m a => WidgetT UniWorX IO (Route UniWorX) -> (Widget, Widget) -> DBCell m a +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 -linkEmptyCellM' xM x2route x2widget = cell $ do +linkEitherCellM' :: IsDBTable m a => WidgetT UniWorX IO x -> (x -> Route UniWorX) -> (x -> Widget, x -> Widget) -> DBCell m a +linkEitherCellM' xM x2route (x2widgetAuth,x2widgetUnauth) = cell $ do x <- xM - let route = x2route x - widget = x2widget x + let route = x2route x + widget = x2widgetAuth x + widgetUnauth = x2widgetUnauth x authResult <- liftHandlerT $ isAuthorized route False case authResult of Authorized -> $(widgetFile "table/cell/link") -- show allowed link - _otherwise -> mempty -- don't show anything for prohibited links + _otherwise -> widgetUnauth -- show alternative widget