-- | -- Module: Yesod.TableView -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez -- Stability: experimental -- -- Table-like view for tabular data. {-# LANGUAGE FlexibleContexts, ScopedTypeVariables, TemplateHaskell #-} module Yesod.TableView ( -- * Table view TableView(..), defTableView, makeTableView, tableView, -- * Reexports module Yesod.TableView.Widget ) where import Control.Monad import Text.Cassius import Text.Hamlet import Yesod import Yesod.TableView.NumEntriesForm import Yesod.TableView.Widget -- | Table view settings. Defaults are given in parentheses. data TableView val = TableView { -- Filter to use (@[]@). tableFilter :: [Filter val], -- ^ Table filter. tableId :: Maybe String, -- ^ HTML table id. tableOrder :: [Order val], -- ^ Table sorting order. tableRoute :: Int -> Int -> Route (TableSite val), -- ^ Table route. tableShowHead :: Bool, -- ^ Show table header? tableStyled :: Bool, -- ^ Add CSS styles? -- Limits. tableCurrentLimit :: Int, -- ^ Current pager limit. tableCurrentOffset :: Int, -- ^ Current offset. tableLimitPrompt :: String, -- ^ Prompt in limit form. tableLimits :: [Int], -- ^ Selectable limits (@[10, 20, 50, 100]@). tableMinLimit :: Maybe Int, -- ^ Minimum pager limit (@Just 10@). tableMaxLimit :: Maybe Int -- ^ Maximum pager limit (@Just 100@). } -- | Clamp to the given bounds. clamp :: Ord a => Maybe a -> Maybe a -> a -> a clamp mMin mMax = maybe id max mMin . maybe id min mMax -- | Default values for most fields. The following fields will be left -- undefined: 'tableRoute', 'tableCurrentLimit' and -- 'tableCurrentOffset'. defTableView :: TableView val defTableView = TableView { tableFilter = [], tableId = Nothing, tableOrder = [], tableRoute = undefined, tableShowHead = True, tableStyled = True, tableCurrentLimit = undefined, tableCurrentOffset = undefined, tableLimitPrompt = "Number of entries per page:", tableLimits = [10, 20, 50, 100], tableMinLimit = Just 10, tableMaxLimit = Just 100 } -- | Simple smart constructor for common table view configurations. makeTableView :: [Filter val] -> [Order val] -> Int -> Int -> (Int -> Int -> Route (TableSite val)) -> TableView val makeTableView filters orders limit offset route = defTableView { tableFilter = filters, tableOrder = orders, tableRoute = route, tableCurrentLimit = limit, tableCurrentOffset = offset } -- | Generate a table view widget from the given configuration. tableView :: forall val. ( PersistBackend (YesodDB (TableSite val) (GTableHandler val IO)), PersistEntity val, TableViewWidget val, YesodPersist (TableSite val)) => TableView val -> TableHandler val (TableWidget val ()) tableView cfg'@(TableView { tableFilter = filters, tableId = mTableId, tableOrder = orders, tableLimitPrompt = limitPrompt, tableLimits = limitOpts, tableRoute = thisRoute, tableShowHead = showHead, tableStyled = styled, tableCurrentLimit = limit', tableCurrentOffset = offset', tableMinLimit = minLimit, tableMaxLimit = maxLimit }) = do let minOffset = Just 0 maxOffset = Nothing let limit = clamp minLimit maxLimit limit' offset = clamp minOffset maxOffset offset' prevOffset = clamp minOffset maxOffset (offset - limit) nextOffset = clamp minOffset maxOffset (offset + limit) (entries, numEntries) <- runDB $ liftM2 (,) (selectList filters orders limit offset) (count filters) numEntriesWidget <- runNumEntriesForm styled limitPrompt limitOpts limit (`thisRoute` offset) let lastOffset = (numEntries - 1) `div` limit * limit tableId <- maybe newIdent return mTableId return $ do let entryRows = mapM_ row (zip [0..] entries) firstRoute = guard (offset > 0) >> Just (thisRoute limit 0) lastRoute = guard (offset < lastOffset) >> Just (thisRoute limit lastOffset) forwardRoute = guard (nextOffset < numEntries) >> Just (thisRoute limit nextOffset) backRoute = guard (offset > 0) >> Just (thisRoute limit prevOffset) mHeader = guard showHead >> Just (tableHeader (undefined :: val)) when styled $ addCassius $(cassiusFile "templates/tableview.cassius") addWidget $(hamletFile "templates/tableview.hamlet") where row :: (Int, (Key val, val)) -> TableWidget val () row (ix, (entryId, entry)) = let rowClass = if even ix then "even-row" else "odd-row" entryWidget = tableRecord ix entryId entry in addWidget $(hamletFile "templates/tableview-row.hamlet")