Hide FilterUI by default

This commit is contained in:
Gregor Kleen 2018-12-29 13:38:31 +01:00
parent 74e87c6d54
commit f238759270
2 changed files with 17 additions and 5 deletions

View File

@ -179,7 +179,7 @@ makeCourseTable whereClause colChoices psValidator = do
[ Map.singleton "search" . maybeToList <$> aopt textField (fslI MsgCourseFilterSearch) (Just <$> listToMaybe =<< Map.lookup "search" =<< mPrev) [ Map.singleton "search" . maybeToList <$> aopt textField (fslI MsgCourseFilterSearch) (Just <$> listToMaybe =<< Map.lookup "search" =<< mPrev)
, Map.singleton "registered" . fmap toPathPiece . maybeToList <$> aopt boolField (fslI MsgCourseFilterRegistered) (Just <$> fromPathPiece =<< listToMaybe =<< Map.lookup "registered" =<< mPrev) , Map.singleton "registered" . fmap toPathPiece . maybeToList <$> aopt boolField (fslI MsgCourseFilterRegistered) (Just <$> fromPathPiece =<< listToMaybe =<< Map.lookup "registered" =<< mPrev)
] ]
, dbtStyle = def , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
, dbtParams = def , dbtParams = def
, dbtIdent = "courses" :: Text , dbtIdent = "courses" :: Text
} }

View File

@ -6,7 +6,7 @@ module Handler.Utils.Table.Pagination
, pattern SortAscBy, pattern SortDescBy , pattern SortAscBy, pattern SortDescBy
, FilterColumn(..), IsFilterColumn , FilterColumn(..), IsFilterColumn
, DBRow(..), _dbrOutput, _dbrIndex, _dbrCount , DBRow(..), _dbrOutput, _dbrIndex, _dbrCount
, DBStyle(..), DBEmptyStyle(..) , DBStyle(..), defaultDBSFilterLayout, DBEmptyStyle(..)
, DBTable(..), IsDBTable(..), DBCell(..) , DBTable(..), IsDBTable(..), DBCell(..)
, DBParams(..) , DBParams(..)
, cellAttrs, cellContents , cellAttrs, cellContents
@ -316,7 +316,7 @@ data DBStyle = DBStyle
{ dbsEmptyStyle :: DBEmptyStyle { dbsEmptyStyle :: DBEmptyStyle
, dbsEmptyMessage :: UniWorXMessage , dbsEmptyMessage :: UniWorXMessage
, dbsAttrs :: [(Text, Text)] , dbsAttrs :: [(Text, Text)]
, dbsLayoutFilter :: Widget -- ^ Filter UI , dbsFilterLayout :: Widget -- ^ Filter UI
-> Enctype -> Enctype
-> Text -- ^ Filter action (target uri) -> Text -- ^ Filter action (target uri)
-> Widget -- ^ Table -> Widget -- ^ Table
@ -328,9 +328,21 @@ instance Default DBStyle where
{ dbsEmptyStyle = def { dbsEmptyStyle = def
, dbsEmptyMessage = MsgNoTableContent , dbsEmptyMessage = MsgNoTableContent
, dbsAttrs = [ ("class", "table table--striped table--hover table--sortable") ] , dbsAttrs = [ ("class", "table table--striped table--hover table--sortable") ]
, dbsLayoutFilter = \filterWgdt filterEnctype filterAction scrolltable -> $(widgetFile "table/layout-filter-default") , dbsFilterLayout = \_filterWgdt _filterEnctype _filterAction scrolltable ->
[whamlet|
$newline never
<!-- No Filter UI -->
^{scrolltable}
|]
} }
defaultDBSFilterLayout :: Widget -- ^ Filter UI
-> Enctype
-> Text -- ^ Filter action (target uri)
-> Widget -- ^ Table
-> Widget
defaultDBSFilterLayout filterWgdt filterEnctype filterAction scrolltable = $(widgetFile "table/layout-filter-default")
data DBTable m x = forall a r r' h i t k k'. data DBTable m x = forall a r r' h i t k k'.
( ToSortable h, Functor h ( ToSortable h, Functor h
, E.SqlSelect a r, SqlIn k k', ToJSON k', FromJSON k', Eq k' , E.SqlSelect a r, SqlIn k k', ToJSON k', FromJSON k', Eq k'
@ -677,7 +689,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
return $(widgetFile "table/layout") return $(widgetFile "table/layout")
bool (dbHandler (Proxy @m) (Proxy @x) $ (\table -> $(widgetFile "table/layout-wrapper")) . dbsLayoutFilter filterWdgt filterEnc rawAction) (sendResponse <=< tblLayout . dbsLayoutFilter filterWdgt filterEnc rawAction <=< dbWidget (Proxy @m) (Proxy @x)) psShortcircuit <=< runDBTable dbtable paginationInput currentKeys . fmap swap $ runWriterT table' bool (dbHandler (Proxy @m) (Proxy @x) $ (\table -> $(widgetFile "table/layout-wrapper")) . dbsFilterLayout filterWdgt filterEnc rawAction) (sendResponse <=< tblLayout . dbsFilterLayout filterWdgt filterEnc rawAction <=< dbWidget (Proxy @m) (Proxy @x)) psShortcircuit <=< runDBTable dbtable paginationInput currentKeys . fmap swap $ runWriterT table'
where where
tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html
tblLayout tbl' = do tblLayout tbl' = do