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

style(dbtable): add rowspan to number column header

Browse Source
This commit is contained in:
Gregor Kleen 2020-08-26 13:29:03 +02:00
parent 9a4f30b811
commit 06375f8cd8
2 changed files with 22 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -74,7 +74,6 @@ import Control.Monad.State (evalStateT, execStateT)
import Control.Monad.Trans.Maybe
import Control.Monad.State.Class (modify)
import qualified Control.Monad.State.Class as State
import Control.Monad.Trans.Writer.Lazy (censor)
import Data.Map ((!))
import qualified Data.Map as Map
@ -1277,22 +1276,22 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
_other -> False
genHeaders :: forall h. Cornice h _ _ (DBCell m x) -> SortableP h -> WriterT x m Widget
genHeaders cornice SortableP{..} = execWriterT . go mempty $ annotate cornice
genHeaders cornice SortableP{..} = fmap wrap' . execWriterT . go mempty $ annotate cornice
where
go :: forall (p' :: Pillar) r'.
[(Int, Int, Int)]
-> AnnotatedCornice (Maybe Int) h p' r' (DBCell m x)
-> WriterT Widget (WriterT x m) ()
go rowspanAcc (AnnotatedCorniceBase _ (Colonnade (toList -> v))) = censor wrap . forM_ (zip (inits v) v) $ \(before, OneColonnade Sized{..} _) -> do
-> WriterT (Seq (Seq (Widget, Int))) (WriterT x m) ()
go rowspanAcc (AnnotatedCorniceBase _ (Colonnade (toList -> v))) = mapWriterT (over (mapped . _2) pure) . forM_ (zip (inits v) v) $ \(before, OneColonnade Sized{..} _) -> do
let (_, cellSize') = compCellSize rowspanAcc (map oneColonnadeHead before) Sized{..}
whenIsJust cellSize' $ \cellSize -> tellM $ fromContent Sized { sizedSize = cellSize, sizedContent }
whenIsJust cellSize' $ \cellSize -> tellM . fmap pure $ fromContent Sized { sizedSize = cellSize, sizedContent }
go rowspanAcc (AnnotatedCorniceCap _ v@(toList -> oneCornices)) = do
rowspanAcc' <- (execStateT ?? rowspanAcc) . hoist (censor wrap) . forM_ (zip (inits oneCornices) oneCornices) $ \(before, OneCornice h (size -> sz')) -> do
rowspanAcc' <- (execStateT ?? rowspanAcc) . hoist (mapWriterT $ over (mapped . _2) pure) . forM_ (zip (inits oneCornices) oneCornices) $ \(before, OneCornice h (size -> sz')) -> do
let sz = Sized sz' h
let (beforeSize, cellSize') = compCellSize rowspanAcc (concatMap (map oneColonnadeHead . toList . getColonnade . uncapAnnotated . oneCorniceBody) before) sz
whenIsJust cellSize' $ \cellSize -> do
let Sized{..} = sz
lift . tellM $ fromContent Sized { sizedSize = cellSize, sizedContent }
lift . tellM . fmap pure $ fromContent Sized { sizedSize = cellSize, sizedContent }
if | [n] <- mapMaybe (\(key, val) -> guardOnM (is _Rowspan key) $ readMay val) (toSortable sizedContent ^. _sortableContent . cellAttrs)
-> State.modify $ (:) (n, beforeSize, cellSize)
| otherwise -> return ()
@ -1309,11 +1308,14 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
guard $ beforeSize < firstCol + sz
return . Sum $ sz - (beforeSize - firstCol)
wrap :: Widget -> Widget
wrap row = case dbsTemplate of
wrap' :: Seq (Seq (Widget, Int)) -> Widget
wrap' wRows = view _2 $ Foldable.foldl (\(stackHeight', acc) row -> (Nothing, (acc <>) . wrap stackHeight' $ foldOf (folded . _1) row)) (stackHeight, mempty) wRows
where stackHeight = maximumOf (folded . to (ala Sum foldMap . fmap (view _2))) wRows
wrap :: Maybe Int -> Widget -> Widget
wrap stackHeight row = case dbsTemplate of
DBSTCourse{} -> row
DBSTDefault{} -> $(widgetFile "table/header")
fromContent :: Sized Int h (DBCell m x) -> WriterT x m Widget
fromContent :: Sized Int h (DBCell m x) -> WriterT x m (Widget, Int)
fromContent Sized{ sizedSize = cellSize, sizedContent = toSortable -> Sortable{..} } = do
widget <- sortableContent ^. cellContents
let
@ -1322,9 +1324,13 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
isSorted dir = fromMaybe False $ (==) <$> (SortingSetting <$> sortableKey <*> pure dir) <*> listToMaybe psSorting
attrs = sortableContent ^. cellAttrs
piSorting' = [ sSet | sSet <- fromMaybe [] piSorting, Just (sortKey sSet) /= sortableKey ]
case dbsTemplate of
DBSTCourse{} -> return $(widgetFile "table/course/header")
DBSTDefault{} -> return $(widgetFile "table/cell/header")
rowspan = preview _head $ do
(key, val) <- attrs
guard $ is _Rowspan key
hoistMaybe $ readMay val
return . (, fromMaybe 1 rowspan) $ case dbsTemplate of
DBSTCourse{} -> $(widgetFile "table/course/header")
DBSTDefault{} -> $(widgetFile "table/cell/header")
in do
wHeaders <- maybe (return Nothing) (fmap Just . genHeaders (dbtColonnade ^. _Cornice)) pSortable
now <- liftIO getCurrentTime

5
templates/table/header.hamlet
View File

@ -1,6 +1,7 @@
$newline never
<tr .table__row.table__row--head>
$if numberColumn
<th .table__th uw-hide-columns--no-hide .table__th--number>
$maybe rowspan <- stackHeight
$if numberColumn
<th .table__th uw-hide-columns--no-hide .table__th--number :rowspan /= 1:rowspan=#{rowspan}>
$# cell/header.hamlet
^{row}