diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,32 @@ +yesod-tableview license +Copyright (c) 2010, Ertugrul Soeylemez + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + + * Neither the name of the author nor the names of any contributors + may be used to endorse or promote products derived from this + software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,12 @@ +yesod-tableview setup script +Copyright (C) 2010, Ertugrul Soeylemez + +Please see the LICENSE file for terms and conditions of use, +modification and distribution of this package, including this file. + +> module Main where +> +> import Distribution.Simple +> +> main :: IO () +> main = return () diff --git a/Yesod/TableView.hs b/Yesod/TableView.hs new file mode 100644 --- /dev/null +++ b/Yesod/TableView.hs @@ -0,0 +1,136 @@ +-- | +-- 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, + 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") diff --git a/Yesod/TableView/NumEntriesForm.hs b/Yesod/TableView/NumEntriesForm.hs new file mode 100644 --- /dev/null +++ b/Yesod/TableView/NumEntriesForm.hs @@ -0,0 +1,47 @@ +-- | +-- Module: Yesod.TableView.NumEntriesForm +-- Copyright: (c) 2010 Ertugrul Soeylemez +-- License: BSD3 +-- Maintainer: Ertugrul Soeylemez +-- Stability: experimental +-- +-- Little form for selecting the number of entries to show. + +{-# LANGUAGE TemplateHaskell #-} + +module Yesod.TableView.NumEntriesForm + ( runNumEntriesForm ) + where + + +import Control.Arrow +import Control.Monad +import Data.String +import Text.Cassius +import Text.Hamlet +import Yesod + + +numEntriesForm :: String -> [Int] -> FormletField sub s Int +numEntriesForm prompt options mdata = + let numbers = map (id &&& show) options + in selectField numbers (fromString prompt) mdata + + +-- | Run the number of entries form with the given prompt, options, +-- initial value and route function. If POST data is present, redirects +-- to the given route with the specified limit, otherwise just returns +-- the form widget. + +runNumEntriesForm :: Bool -> String -> [Int] -> Int -> (Int -> Route s) -> + GHandler sub s (GWidget sub s ()) +runNumEntriesForm styled prompt options limit thisRoute = do + let formField = numEntriesForm prompt options (Just limit) + (res, form) <- runFormDivs (thisRoute limit) "Ok" formField + case res of + FormSuccess newLimit -> + redirect RedirectTemporary (thisRoute newLimit) + _ -> return $ do + when styled $ addCassius $(cassiusFile + "templates/form-numentries.cassius") + addWidget $(hamletFile "templates/form-numentries.hamlet") diff --git a/Yesod/TableView/Widget.hs b/Yesod/TableView/Widget.hs new file mode 100644 --- /dev/null +++ b/Yesod/TableView/Widget.hs @@ -0,0 +1,29 @@ +-- | +-- Module: Yesod.TableView.Widget +-- Copyright: (c) 2010 Ertugrul Soeylemez +-- License: BSD3 +-- Maintainer: Ertugrul Soeylemez +-- Stability: experimental +-- +-- Class for datatypes displayable in a table view as widgets. + +module Yesod.TableView.Widget + ( -- Table view widgets. + TableViewWidget(..) + ) + where + +import Yesod + + +-- | This class defines how types will be rendered in the table view. + +class TableViewWidget val where + -- | Table header (wrapped in a @thead@ element). This function + -- will be called once per table. + tableHeader :: val -> GWidget sub s () + + -- | Table row. This function will be called once for each entry in + -- the table. All rows will be rendered inside of a @tbody@ + -- element. + tableRecord :: Int -> Key val -> val -> GWidget sub s () diff --git a/templates/form-numentries.cassius b/templates/form-numentries.cassius new file mode 100644 --- /dev/null +++ b/templates/form-numentries.cassius @@ -0,0 +1,7 @@ +/* -*-css-*- */ + +.tableview-form-numentries + text-align: right + +.tableview-form-numentries div + display: inline diff --git a/templates/form-numentries.hamlet b/templates/form-numentries.hamlet new file mode 100644 --- /dev/null +++ b/templates/form-numentries.hamlet @@ -0,0 +1,2 @@ +<.tableview-form-numentries> + ^{form} diff --git a/templates/tableview-row.hamlet b/templates/tableview-row.hamlet new file mode 100644 --- /dev/null +++ b/templates/tableview-row.hamlet @@ -0,0 +1,2 @@ + + ^{entryWidget} diff --git a/templates/tableview.cassius b/templates/tableview.cassius new file mode 100644 --- /dev/null +++ b/templates/tableview.cassius @@ -0,0 +1,36 @@ +/* -*-css-*- */ + +.tableview + border: 2px solid + border-collapse: collapse + text-align: left + +.tableview .even-row + background: #cfc + +.tableview .odd-row + background: #efe + +.tableview thead th + background: #cde + border-bottom: 1px solid + padding: 0.1em 1ex + +.tableview tbody td + padding: 0.2em 1ex + +.tableview-nav + text-align: center + +.tableview-nav a + background: #ddf + border: 1px solid + margin: 0 1ex + padding: 0 1ex + +.tableview-nav span + background: #eef + border: 1px solid + color: #bbb + margin: 0 1ex + padding: 0 1ex diff --git a/templates/tableview.hamlet b/templates/tableview.hamlet new file mode 100644 --- /dev/null +++ b/templates/tableview.hamlet @@ -0,0 +1,30 @@ +^{numEntriesWidget} + + + $maybe header <- mHeader + + + ^{header} + + ^{entryRows} + +

+ $maybe r <- firstRoute + << + $nothing + << + + $maybe r <- backRoute + < + $nothing + < + + $maybe r <- forwardRoute + > + $nothing + > + + $maybe r <- lastRoute + >> + $nothing + >> diff --git a/yesod-tableview.cabal b/yesod-tableview.cabal new file mode 100644 --- /dev/null +++ b/yesod-tableview.cabal @@ -0,0 +1,28 @@ +Name: yesod-tableview +Version: 0.1.0 +Category: Yesod +Synopsis: Table view for Yesod applications +Maintainer: Ertugrul Söylemez +Author: Ertugrul Söylemez +Copyright: (c) 2010 Ertugrul Söylemez +License: BSD3 +License-file: LICENSE +Build-type: Simple +Stability: experimental +Cabal-version: >= 1.6 +Description: Table view for Yesod applications. +Extra-source-files: + templates/*.cassius + templates/*.hamlet + +Library + Build-depends: + base >= 4 && <= 5, + hamlet >= 0.7.0, + persistent >= 0.4.0, + yesod >= 0.7.0 + GHC-Options: -W + Exposed-modules: + Yesod.TableView + Yesod.TableView.NumEntriesForm + Yesod.TableView.Widget