module Yesod.Colonnade
(
Cell(..)
, cell
, stringCell
, textCell
, builderCell
, anchorCell
, anchorWidget
, encodeWidgetTable
, encodeCellTable
, encodeDefinitionTable
, encodeListItems
) where
import Yesod.Core
import Yesod.Core.Types (Body(..),GWData(..),WidgetFor(..),wdRef)
import Colonnade (Colonnade,Headed,Headless)
import Data.Text (Text)
import Control.Monad
import Data.IORef (modifyIORef')
import Data.Monoid
import Data.String (IsString(..))
import Text.Blaze (Attribute,toValue)
import Data.Foldable
import Yesod.Elements (table_,thead_,tbody_,tr_,td_,th_,ul_,li_,a_)
import Data.Semigroup (Semigroup)
import qualified Data.Semigroup as SG
import qualified Text.Blaze.Html5.Attributes as HA
import qualified Text.Blaze.Html5 as H
import qualified Colonnade.Encode as E
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Builder as TBuilder
data Cell site = Cell
{ cellAttrs :: [Attribute]
, cellContents :: !(WidgetFor site ())
}
instance IsString (Cell site) where
fromString = stringCell
instance Semigroup (Cell site) where
Cell a1 c1 <> Cell a2 c2 = Cell (mappend a1 a2) (mappend c1 c2)
instance Monoid (Cell site) where
mempty = Cell mempty mempty
mappend = (SG.<>)
cell :: WidgetFor site () -> Cell site
cell = Cell mempty
stringCell :: String -> Cell site
stringCell = cell . fromString
textCell :: Text -> Cell site
textCell = cell . toWidget . toHtml
builderCell :: TBuilder.Builder -> Cell site
builderCell = cell . toWidget . toHtml . LText.toStrict . TBuilder.toLazyText
anchorCell ::
(a -> Route site)
-> (a -> WidgetFor site ())
-> a
-> Cell site
anchorCell getRoute getContent = cell . anchorWidget getRoute getContent
anchorWidget ::
(a -> Route site)
-> (a -> WidgetFor site ())
-> a
-> WidgetFor site ()
anchorWidget getRoute getContent a = do
urlRender <- getUrlRender
a_ [HA.href (toValue (urlRender (getRoute a)))] (getContent a)
encodeListItems ::
(WidgetFor site () -> WidgetFor site ())
-> (WidgetFor site () -> WidgetFor site () -> WidgetFor site ())
-> Colonnade Headed a (Cell site)
-> a
-> WidgetFor site ()
encodeListItems ulWrap combine enc =
ulWrap . E.bothMonadic_ enc
(\(Cell ha hc) (Cell ba bc) ->
li_ (ha <> ba) (combine hc bc)
)
encodeDefinitionTable ::
[Attribute]
-> Colonnade Headed a (Cell site)
-> a
-> WidgetFor site ()
encodeDefinitionTable attrs enc a = table_ attrs $ tbody_ [] $
E.bothMonadic_ enc
(\theKey theValue -> tr_ [] $ do
widgetFromCell td_ theKey
widgetFromCell td_ theValue
) a
encodeCellTable :: (Foldable f, E.Headedness h)
=> [Attribute]
-> Colonnade h a (Cell site)
-> f a
-> WidgetFor site ()
encodeCellTable = encodeTable
(E.headednessPure mempty) mempty (const mempty) widgetFromCell
encodeWidgetTable :: (Foldable f, E.Headedness h)
=> [Attribute]
-> Colonnade h a (WidgetFor site ())
-> f a
-> WidgetFor site ()
encodeWidgetTable = encodeTable
(E.headednessPure mempty) mempty (const mempty) ($ mempty)
encodeTable ::
(Foldable f, E.Headedness h)
=> h [Attribute]
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> WidgetFor site () -> WidgetFor site ()) -> c -> WidgetFor site ())
-> [Attribute]
-> Colonnade h a c
-> f a
-> WidgetFor site ()
encodeTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =
table_ tableAttrs $ do
for_ E.headednessExtract $ \unhead ->
thead_ (unhead theadAttrs) $ do
E.headerMonadicGeneral_ colonnade (wrapContent th_)
tbody_ tbodyAttrs $ do
forM_ xs $ \x -> do
tr_ (trAttrs x) (E.rowMonadic_ colonnade (wrapContent td_) x)
widgetFromCell ::
([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> Cell site
-> WidgetFor site ()
widgetFromCell f (Cell attrs contents) =
f attrs contents