yesod-tableview-0.1.0: Yesod/TableView.hs

-- |
-- Module:     Yesod.TableView
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  experimental
--
-- Table-like view for tabular data.

{-# LANGUAGE
  FlexibleContexts,
  ScopedTypeVariables,
  TemplateHaskell #-}

module Yesod.TableView
    ( -- Table view
      TableView(..),
      defTableView,
      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 s val =
    TableView {
      -- Filter to use (@[]@).
      tableFilter   :: [Filter val],           -- ^ Table filter.
      tableId       :: String,                 -- ^ HTML table id.
      tableOrder    :: [Order val],            -- ^ Table sorting order.
      tableRoute    :: Int -> Int -> Route s,  -- ^ 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@).
    }


-- | Default values for most fields.  The following fields will be left
-- undefined:  'tableId', 'tableRoute', 'tableCurrentLimit' and
-- 'tableCurrentOffset'.

defTableView :: TableView s val
defTableView =
    TableView { tableFilter   = [],
                tableId       = undefined,
                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 }


clamp :: Ord a => Maybe a -> Maybe a -> a -> a
clamp mMin mMax = maybe id max mMin . maybe id min mMax


tableView :: forall s sub val.
             ( PersistBackend (YesodDB s (GGHandler sub s IO)),
               PersistEntity val,
               TableViewWidget val,
               YesodPersist s) =>
             TableView s val -> GHandler sub s (GWidget sub s ())
tableView cfg'@(TableView {
                  tableFilter = filters,
                  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

    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)) -> GWidget sub s ()
    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")