feat(dbtable): add support for Cornice
This commit is contained in:
Gregor Kleen
parent
b4cf9ca4bb
commit
fdeb2514c0
@ -597,16 +597,17 @@ data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass csvException
|
||||
, dbtCsvRenderException :: csvException -> DB Text
|
||||
}
|
||||
|
||||
data DBTable m x = forall a r r' h i t k k' csv.
|
||||
data DBTable m x = forall a r r' h i t k k' csv colonnade (p :: Pillar).
|
||||
( ToSortable h, Functor h
|
||||
, E.SqlSelect a r, E.SqlIn k k', DBTableKey k'
|
||||
, PathPiece i, Eq i
|
||||
, E.From t
|
||||
, AsCornice h p r' (DBCell m x) colonnade
|
||||
) => DBTable
|
||||
{ dbtSQLQuery :: t -> E.SqlQuery a
|
||||
, dbtRowKey :: t -> k -- ^ required for table forms; always same key for repeated requests. For joins: return unique tuples.
|
||||
, dbtProj :: DBRow r -> DB r'
|
||||
, dbtColonnade :: Colonnade h r' (DBCell m x)
|
||||
, dbtColonnade :: colonnade
|
||||
, dbtSorting :: Map SortingKey (SortColumn t r')
|
||||
, dbtFilter :: Map FilterKey (FilterColumn t r')
|
||||
, dbtFilterUI :: DBFilterUI
|
||||
@ -1259,21 +1260,32 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
table' :: WriterT x m Widget
|
||||
table' = let
|
||||
columnCount :: Int64
|
||||
columnCount = olength64 $ getColonnade dbtColonnade
|
||||
columnCount = olength64 . getColonnade . discard $ dbtColonnade ^. _Cornice
|
||||
|
||||
genHeaders SortableP{..} = forM (toSortable . oneColonnadeHead <$> getColonnade dbtColonnade) $ \Sortable{..} -> do
|
||||
widget <- sortableContent ^. cellContents
|
||||
let
|
||||
directions = [dir | SortingSetting k dir <- psSorting, Just k == sortableKey ]
|
||||
isSortable = isJust sortableKey
|
||||
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")
|
||||
numberColumn = case dbsTemplate of
|
||||
DBSTDefault{..} -> dbstmNumber rowCount
|
||||
_other -> False
|
||||
|
||||
genHeaders :: _ -> [WriterT x m Widget]
|
||||
genHeaders SortableP{..} = flip (headersMonoidal Nothing) (annotate $ dbtColonnade ^. _Cornice) $ pure
|
||||
( \Sized{ sizedSize, sizedContent = toSortable -> Sortable{..} } -> pure $ do
|
||||
widget <- sortableContent ^. cellContents
|
||||
let
|
||||
cellSize = fromMaybe 1 sizedSize
|
||||
directions = [dir | SortingSetting k dir <- psSorting, Just k == sortableKey ]
|
||||
isSortable = isJust sortableKey
|
||||
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")
|
||||
, case dbsTemplate of
|
||||
DBSTCourse{} -> id
|
||||
DBSTDefault{} -> pure . (>>= \row -> return $(widgetFile "table/header")) . foldMapM id
|
||||
)
|
||||
in do
|
||||
wHeaders <- maybe (return Nothing) (fmap Just . genHeaders) pSortable
|
||||
wHeaders <- maybe (return Nothing) (fmap Just . foldMapM id . genHeaders) pSortable
|
||||
case dbsTemplate of
|
||||
DBSTCourse c l r s a -> do
|
||||
wRows <- forM rows $ \row' -> let
|
||||
@ -1287,12 +1299,12 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
in return $(widgetFile "table/course/course-teaser")
|
||||
return $(widgetFile "table/course/colonnade")
|
||||
DBSTDefault{..} -> do
|
||||
wRows' <- forM rows $ \row' -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row') -> cell') -> do
|
||||
let colonnade = discard $ dbtColonnade ^. _Cornice
|
||||
wRows' <- forM rows $ \row' -> forM (oneColonnadeEncode <$> getColonnade colonnade) $ \(($ row') -> cell') -> do
|
||||
widget <- cell' ^. cellContents
|
||||
let attrs = cell' ^. cellAttrs
|
||||
return $(widgetFile "table/cell/body")
|
||||
let numberColumn = dbstmNumber rowCount
|
||||
wRows = zip [firstRow..] wRows'
|
||||
let wRows = zip [firstRow..] wRows'
|
||||
return $(widgetFile "table/colonnade")
|
||||
|
||||
pageCount
|
||||
|
||||
@ -1,12 +1,13 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Handler.Utils.Table.Pagination.Types
|
||||
( FilterKey, SortingKey
|
||||
( FilterKey(FilterKey), SortingKey(SortingKey)
|
||||
, Sortable(..)
|
||||
, sortable
|
||||
, ToSortable(..), FromSortable(..)
|
||||
, SortableP(..)
|
||||
, DBTableInvalid(..)
|
||||
, AsCornice(..)
|
||||
) where
|
||||
|
||||
import Import hiding (singleton)
|
||||
@ -74,3 +75,13 @@ data DBTableInvalid = DBTIRowsMissing Int
|
||||
instance Exception DBTableInvalid
|
||||
|
||||
embedRenderMessage ''UniWorX ''DBTableInvalid id
|
||||
|
||||
|
||||
class AsCornice h (p :: Pillar) a c x | x -> h p a c where
|
||||
_Cornice :: Iso' x (Cornice h p a c)
|
||||
|
||||
instance AsCornice h p a c (Cornice h p a c) where
|
||||
_Cornice = id
|
||||
|
||||
instance AsCornice h 'Base a c (Colonnade h a c) where
|
||||
_Cornice = iso CorniceBase $ \(CorniceBase c) -> c
|
||||
|
||||
@ -30,9 +30,13 @@ extra-deps:
|
||||
- serversession-backend-acid-state
|
||||
- git: git@gitlab2.rz.ifi.lmu.de:uni2work/xss-sanitize.git
|
||||
commit: 074ed7c8810aca81f60f2c535f9e7bad67e9d95a
|
||||
- git: git@gitlab2.rz.ifi.lmu.de:uni2work/colonnade.git
|
||||
commit: 65164334e9704afc24603a9f3197b4581c996ad8
|
||||
subdirs:
|
||||
- colonnade
|
||||
|
||||
|
||||
- colonnade-1.2.0.2
|
||||
# - colonnade-1.2.0.2
|
||||
- hsass-0.8.0
|
||||
- hlibsass-0.1.8.1
|
||||
- tz-0.1.3.3
|
||||
|
||||
@ -135,12 +135,21 @@ packages:
|
||||
git: git@gitlab2.rz.ifi.lmu.de:uni2work/xss-sanitize.git
|
||||
commit: 074ed7c8810aca81f60f2c535f9e7bad67e9d95a
|
||||
- completed:
|
||||
hackage: colonnade-1.2.0.2@sha256:c95c2ecff5cfa28c736d8fa662d28b71129f67457068e3f4467b296a621607ab,2099
|
||||
subdir: colonnade
|
||||
cabal-file:
|
||||
size: 2020
|
||||
sha256: 28f603d097aee65ddf8fe032e7e0f87523a58c516253cba196922027c8fd54d5
|
||||
name: colonnade
|
||||
version: 1.2.0.2
|
||||
git: git@gitlab2.rz.ifi.lmu.de:uni2work/colonnade.git
|
||||
pantry-tree:
|
||||
size: 327
|
||||
sha256: 98ccdd327916e0ff0ea2fa93ff9a96f5d492ae88258b330e991e6dcc4d332496
|
||||
size: 481
|
||||
sha256: c7137405813404f4e0d2334d67876ab7150e7dc7f8b9f23ad452c5ee76ce4737
|
||||
commit: 65164334e9704afc24603a9f3197b4581c996ad8
|
||||
original:
|
||||
hackage: colonnade-1.2.0.2
|
||||
subdir: colonnade
|
||||
git: git@gitlab2.rz.ifi.lmu.de:uni2work/colonnade.git
|
||||
commit: 65164334e9704afc24603a9f3197b4581c996ad8
|
||||
- completed:
|
||||
hackage: hsass-0.8.0@sha256:82d55fb2a10342accbc4fe80d263163f40a138d8636e275aa31ffa81b14abf01,2792
|
||||
pantry-tree:
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
$newline never
|
||||
<th .table__th *{attrs} :isSortable:.sortable :isSorted SortAsc:.sorted-asc :isSorted SortDesc:.sorted-desc uw-hide-column-header=#{maybe "" toPathPiece sortableKey}>
|
||||
<th .table__th *{attrs} :isSortable:.sortable :isSorted SortAsc:.sorted-asc :isSorted SortDesc:.sorted-desc uw-hide-column-header=#{maybe "" toPathPiece sortableKey} :cellSize /= 1:colspan=#{cellSize}>
|
||||
$maybe flag <- sortableKey
|
||||
$case directions
|
||||
$of [SortAsc]
|
||||
|
||||
@ -2,14 +2,9 @@ $newline never
|
||||
<div table-utils>
|
||||
<div .scrolltable .scrolltable--bordered>
|
||||
<table *{dbsAttrs'}>
|
||||
$maybe wHeaders' <- wHeaders
|
||||
$maybe wdgt <- wHeaders
|
||||
<thead>
|
||||
<tr .table__row.table__row--head>
|
||||
$if numberColumn
|
||||
<th .table__th uw-hide-columns--no-hide .table__th--number>
|
||||
$forall widget <- wHeaders'
|
||||
$# cell/header.hamlet
|
||||
^{widget}
|
||||
^{wdgt}
|
||||
$nothing
|
||||
<tbody>
|
||||
$if null wRows && (dbsEmptyStyle == DBESHeading)
|
||||
|
||||
@ -1,12 +1,10 @@
|
||||
$newline never
|
||||
<div .scrolltable .div__course-teaser *{dbsAttrs'}>
|
||||
$maybe wHeaders' <- wHeaders
|
||||
$maybe wdgt <- wHeaders
|
||||
<div .course-teaser-header>
|
||||
$forall widget <- wHeaders'
|
||||
^{widget}
|
||||
$nothing
|
||||
^{wdgt}
|
||||
$if null wRows && (dbsEmptyStyle == DBESHeading)
|
||||
<p>_{dbsEmptyMessage}
|
||||
$else
|
||||
$forall row <- wRows
|
||||
^{row}
|
||||
^{row}
|
||||
|
||||
6
templates/table/header.hamlet
Normal file
6
templates/table/header.hamlet
Normal file
@ -0,0 +1,6 @@
|
||||
$newline never
|
||||
<tr .table__row.table__row--head>
|
||||
$if numberColumn
|
||||
<th .table__th uw-hide-columns--no-hide .table__th--number>
|
||||
$# cell/header.hamlet
|
||||
^{row}
|
||||
Loading…
Reference in New Issue
Block a user