diff --git a/colonnade/src/Colonnade/Encoding.hs b/colonnade/src/Colonnade/Encoding.hs index 3042755..616b419 100644 --- a/colonnade/src/Colonnade/Encoding.hs +++ b/colonnade/src/Colonnade/Encoding.hs @@ -26,6 +26,14 @@ runRow :: (c1 -> c2) -> Encoding f c1 a -> a -> Vector c2 runRow g (Encoding v) a = flip Vector.map v $ \(OneEncoding _ encode) -> g (encode a) +runBothMonadic_ :: Monad m + => Encoding Headed content a + -> (content -> content -> m b) + -> a + -> m () +runBothMonadic_ (Encoding v) g a = + forM_ v $ \(OneEncoding (Headed h) encode) -> g h (encode a) + runRowMonadic :: (Monad m, Monoid b) => Encoding f content a -> (content -> m b) @@ -35,6 +43,14 @@ runRowMonadic (Encoding v) g a = flip Internal.foldlMapM v $ \e -> g (oneEncodingEncode e a) +runRowMonadic_ :: Monad m + => Encoding f content a + -> (content -> m b) + -> a + -> m () +runRowMonadic_ (Encoding v) g a = + forM_ v $ \e -> g (oneEncodingEncode e a) + runRowMonadicWith :: (Monad m) => b -> (b -> b -> b) diff --git a/yesod-colonnade/src/Yesod/Colonnade.hs b/yesod-colonnade/src/Yesod/Colonnade.hs index 5e2a207..67e201f 100644 --- a/yesod-colonnade/src/Yesod/Colonnade.hs +++ b/yesod-colonnade/src/Yesod/Colonnade.hs @@ -3,12 +3,17 @@ module Yesod.Colonnade ( table + , listItems + , Cell(..) + , cell + , textCell ) where import Yesod.Core import Colonnade.Types import Data.Text (Text) import Control.Monad +import Data.String (IsString(..)) import qualified Colonnade.Encoding as Encoding data Cell site = Cell @@ -16,12 +21,38 @@ data Cell site = Cell , cellContents :: !(WidgetT site IO ()) } +instance IsString (Cell site) where + fromString = Cell [] . fromString + cell :: WidgetT site IO () -> Cell site cell = Cell [] textCell :: Text -> Cell site textCell = cell . toWidget . toHtml +-- | This determines the attributes that are added +-- to the individual @li@s by concatenating the header\'s +-- attributes with the data\'s attributes. +listItems :: Foldable f + => (WidgetT site IO () -> WidgetT site IO ()) + -- ^ Wrapper for items, often @ul@ + -> (WidgetT site IO () -> WidgetT site IO () -> WidgetT site IO ()) + -- ^ Combines header with data + -> Encoding Headed (Cell site) a + -- ^ How to encode data as a row + -> f a + -- ^ Rows of data + -> WidgetT site IO () +listItems ulWrap combine enc xs = + forM_ xs $ ulWrap . Encoding.runBothMonadic_ enc + (\(Cell ha hc) (Cell ba bc) -> + li (ha ++ ba) (combine hc bc) + ) + +-- | If you are using the bootstrap css framework, then you may want +-- to call this with the first argument as: +-- +-- > table [("class","table table-striped")] ... table :: Foldable f => [(Text,Text)] -- ^ Attributes of @table@ element -> Encoding Headed (Cell site) a -- ^ How to encode data as a row @@ -53,7 +84,8 @@ widgetFromCell :: widgetFromCell f (Cell attrs contents) = f attrs contents -tr,tbody,thead,tableEl,td,th :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () +tr,tbody,thead,tableEl,td,th,ul,li :: + [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () tableEl str b = [whamlet|
^{b}
|]
+ul str b = [whamlet|
+
|