module Yesod.Colonnade
(
Cell (..)
, cell
, stringCell
, textCell
, builderCell
, anchorCell
, anchorWidget
, encodeWidgetTable
, encodeCellTable
, encodeDefinitionTable
, encodeListItems
) where
import Colonnade (Colonnade, Headed)
import qualified Colonnade.Encode as E
import Control.Monad
import Data.Foldable
import qualified Data.Semigroup as SG
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Builder as TBuilder
import Text.Blaze (Attribute, toValue)
import qualified Text.Blaze.Html5.Attributes as HA
import Yesod.Core
import Yesod.Elements (a_, li_, table_, tbody_, td_, th_, thead_, tr_)
data Cell site = Cell
{ forall site. Cell site -> [Attribute]
cellAttrs :: [Attribute]
, forall site. Cell site -> WidgetFor site ()
cellContents :: !(WidgetFor site ())
}
instance IsString (Cell site) where
fromString :: String -> Cell site
fromString = String -> Cell site
forall site. String -> Cell site
stringCell
instance Semigroup (Cell site) where
Cell [Attribute]
a1 WidgetFor site ()
c1 <> :: Cell site -> Cell site -> Cell site
<> Cell [Attribute]
a2 WidgetFor site ()
c2 = [Attribute] -> WidgetFor site () -> Cell site
forall site. [Attribute] -> WidgetFor site () -> Cell site
Cell ([Attribute] -> [Attribute] -> [Attribute]
forall a. Monoid a => a -> a -> a
mappend [Attribute]
a1 [Attribute]
a2) (WidgetFor site () -> WidgetFor site () -> WidgetFor site ()
forall a. Monoid a => a -> a -> a
mappend WidgetFor site ()
c1 WidgetFor site ()
c2)
instance Monoid (Cell site) where
mempty :: Cell site
mempty = [Attribute] -> WidgetFor site () -> Cell site
forall site. [Attribute] -> WidgetFor site () -> Cell site
Cell [Attribute]
forall a. Monoid a => a
mempty WidgetFor site ()
forall a. Monoid a => a
mempty
mappend :: Cell site -> Cell site -> Cell site
mappend = Cell site -> Cell site -> Cell site
forall a. Semigroup a => a -> a -> a
(SG.<>)
cell :: WidgetFor site () -> Cell site
cell :: forall site. WidgetFor site () -> Cell site
cell = [Attribute] -> WidgetFor site () -> Cell site
forall site. [Attribute] -> WidgetFor site () -> Cell site
Cell [Attribute]
forall a. Monoid a => a
mempty
stringCell :: String -> Cell site
stringCell :: forall site. String -> Cell site
stringCell = WidgetFor site () -> Cell site
forall site. WidgetFor site () -> Cell site
cell (WidgetFor site () -> Cell site)
-> (String -> WidgetFor site ()) -> String -> Cell site
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> WidgetFor site ()
forall a. IsString a => String -> a
fromString
textCell :: Text -> Cell site
textCell :: forall site. Text -> Cell site
textCell = WidgetFor site () -> Cell site
forall site. WidgetFor site () -> Cell site
cell (WidgetFor site () -> Cell site)
-> (Text -> WidgetFor site ()) -> Text -> Cell site
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> WidgetFor site ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ site) =>
Html -> m ()
toWidget (Html -> WidgetFor site ())
-> (Text -> Html) -> Text -> WidgetFor site ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
forall a. ToMarkup a => a -> Html
toHtml
builderCell :: TBuilder.Builder -> Cell site
builderCell :: forall site. Builder -> Cell site
builderCell = WidgetFor site () -> Cell site
forall site. WidgetFor site () -> Cell site
cell (WidgetFor site () -> Cell site)
-> (Builder -> WidgetFor site ()) -> Builder -> Cell site
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> WidgetFor site ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ site) =>
Html -> m ()
toWidget (Html -> WidgetFor site ())
-> (Builder -> Html) -> Builder -> WidgetFor site ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> (Builder -> Text) -> Builder -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TBuilder.toLazyText
anchorCell ::
(a -> Route site) ->
(a -> WidgetFor site ()) ->
a ->
Cell site
anchorCell :: forall a site.
(a -> Route site) -> (a -> WidgetFor site ()) -> a -> Cell site
anchorCell a -> Route site
getRoute a -> WidgetFor site ()
getContent = WidgetFor site () -> Cell site
forall site. WidgetFor site () -> Cell site
cell (WidgetFor site () -> Cell site)
-> (a -> WidgetFor site ()) -> a -> Cell site
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Route site)
-> (a -> WidgetFor site ()) -> a -> WidgetFor site ()
forall a site.
(a -> Route site)
-> (a -> WidgetFor site ()) -> a -> WidgetFor site ()
anchorWidget a -> Route site
getRoute a -> WidgetFor site ()
getContent
anchorWidget ::
(a -> Route site) ->
(a -> WidgetFor site ()) ->
a ->
WidgetFor site ()
anchorWidget :: forall a site.
(a -> Route site)
-> (a -> WidgetFor site ()) -> a -> WidgetFor site ()
anchorWidget a -> Route site
getRoute a -> WidgetFor site ()
getContent a
a = do
Route site -> Text
urlRender <- WidgetFor site (Route site -> Text)
WidgetFor site (Route (HandlerSite (WidgetFor site)) -> Text)
forall (m :: * -> *).
MonadHandler m =>
m (Route (HandlerSite m) -> Text)
getUrlRender
[Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
a_ [AttributeValue -> Attribute
HA.href (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Route site -> Text
urlRender (a -> Route site
getRoute a
a)))] (a -> WidgetFor site ()
getContent a
a)
encodeListItems ::
(WidgetFor site () -> WidgetFor site ()) ->
(WidgetFor site () -> WidgetFor site () -> WidgetFor site ()) ->
Colonnade Headed a (Cell site) ->
a ->
WidgetFor site ()
encodeListItems :: forall site a.
(WidgetFor site () -> WidgetFor site ())
-> (WidgetFor site () -> WidgetFor site () -> WidgetFor site ())
-> Colonnade Headed a (Cell site)
-> a
-> WidgetFor site ()
encodeListItems WidgetFor site () -> WidgetFor site ()
ulWrap WidgetFor site () -> WidgetFor site () -> WidgetFor site ()
combine Colonnade Headed a (Cell site)
enc =
WidgetFor site () -> WidgetFor site ()
ulWrap
(WidgetFor site () -> WidgetFor site ())
-> (a -> WidgetFor site ()) -> a -> WidgetFor site ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colonnade Headed a (Cell site)
-> (Cell site -> Cell site -> WidgetFor site ())
-> a
-> WidgetFor site ()
forall (m :: * -> *) a c b.
Monad m =>
Colonnade Headed a c -> (c -> c -> m b) -> a -> m ()
E.bothMonadic_
Colonnade Headed a (Cell site)
enc
( \(Cell [Attribute]
ha WidgetFor site ()
hc) (Cell [Attribute]
ba WidgetFor site ()
bc) ->
[Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
li_ ([Attribute]
ha [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute]
ba) (WidgetFor site () -> WidgetFor site () -> WidgetFor site ()
combine WidgetFor site ()
hc WidgetFor site ()
bc)
)
encodeDefinitionTable ::
[Attribute] ->
Colonnade Headed a (Cell site) ->
a ->
WidgetFor site ()
encodeDefinitionTable :: forall a site.
[Attribute]
-> Colonnade Headed a (Cell site) -> a -> WidgetFor site ()
encodeDefinitionTable [Attribute]
attrs Colonnade Headed a (Cell site)
enc a
a =
[Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
table_ [Attribute]
attrs (WidgetFor site () -> WidgetFor site ())
-> WidgetFor site () -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$
[Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
tbody_ [] (WidgetFor site () -> WidgetFor site ())
-> WidgetFor site () -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$
Colonnade Headed a (Cell site)
-> (Cell site -> Cell site -> WidgetFor site ())
-> a
-> WidgetFor site ()
forall (m :: * -> *) a c b.
Monad m =>
Colonnade Headed a c -> (c -> c -> m b) -> a -> m ()
E.bothMonadic_
Colonnade Headed a (Cell site)
enc
( \Cell site
theKey Cell site
theValue -> [Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
tr_ [] (WidgetFor site () -> WidgetFor site ())
-> WidgetFor site () -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$ do
([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> Cell site -> WidgetFor site ()
forall site.
([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> Cell site -> WidgetFor site ()
widgetFromCell [Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
td_ Cell site
theKey
([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> Cell site -> WidgetFor site ()
forall site.
([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> Cell site -> WidgetFor site ()
widgetFromCell [Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
td_ Cell site
theValue
)
a
a
encodeCellTable ::
(Foldable f, E.Headedness h) =>
[Attribute] ->
Colonnade h a (Cell site) ->
f a ->
WidgetFor site ()
encodeCellTable :: forall (f :: * -> *) (h :: * -> *) a site.
(Foldable f, Headedness h) =>
[Attribute]
-> Colonnade h a (Cell site) -> f a -> WidgetFor site ()
encodeCellTable =
h [Attribute]
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> Cell site -> WidgetFor site ())
-> [Attribute]
-> Colonnade h a (Cell site)
-> f a
-> WidgetFor site ()
forall (f :: * -> *) (h :: * -> *) a site c.
(Foldable f, 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
([Attribute] -> h [Attribute]
forall a. a -> h a
forall (h :: * -> *) a. Headedness h => a -> h a
E.headednessPure [Attribute]
forall a. Monoid a => a
mempty)
[Attribute]
forall a. Monoid a => a
mempty
([Attribute] -> a -> [Attribute]
forall a b. a -> b -> a
const [Attribute]
forall a. Monoid a => a
mempty)
([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> Cell site -> WidgetFor site ()
forall site.
([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> Cell site -> WidgetFor site ()
widgetFromCell
encodeWidgetTable ::
(Foldable f, E.Headedness h) =>
[Attribute] ->
Colonnade h a (WidgetFor site ()) ->
f a ->
WidgetFor site ()
encodeWidgetTable :: forall (f :: * -> *) (h :: * -> *) a site.
(Foldable f, Headedness h) =>
[Attribute]
-> Colonnade h a (WidgetFor site ()) -> f a -> WidgetFor site ()
encodeWidgetTable =
h [Attribute]
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> WidgetFor site () -> WidgetFor site ())
-> [Attribute]
-> Colonnade h a (WidgetFor site ())
-> f a
-> WidgetFor site ()
forall (f :: * -> *) (h :: * -> *) a site c.
(Foldable f, 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
([Attribute] -> h [Attribute]
forall a. a -> h a
forall (h :: * -> *) a. Headedness h => a -> h a
E.headednessPure [Attribute]
forall a. Monoid a => a
mempty)
[Attribute]
forall a. Monoid a => a
mempty
([Attribute] -> a -> [Attribute]
forall a b. a -> b -> a
const [Attribute]
forall a. Monoid a => a
mempty)
(([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> [Attribute] -> WidgetFor site () -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$ [Attribute]
forall a. Monoid a => a
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 :: forall (f :: * -> *) (h :: * -> *) a site c.
(Foldable f, 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 h [Attribute]
theadAttrs [Attribute]
tbodyAttrs a -> [Attribute]
trAttrs ([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> c -> WidgetFor site ()
wrapContent [Attribute]
tableAttrs Colonnade h a c
colonnade f a
xs =
[Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
table_ [Attribute]
tableAttrs (WidgetFor site () -> WidgetFor site ())
-> WidgetFor site () -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$ do
Maybe (h [Attribute] -> [Attribute])
-> ((h [Attribute] -> [Attribute]) -> WidgetFor site ())
-> WidgetFor site ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (h [Attribute] -> [Attribute])
forall a. Maybe (h a -> a)
forall (h :: * -> *) a. Headedness h => Maybe (h a -> a)
E.headednessExtract (((h [Attribute] -> [Attribute]) -> WidgetFor site ())
-> WidgetFor site ())
-> ((h [Attribute] -> [Attribute]) -> WidgetFor site ())
-> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$ \h [Attribute] -> [Attribute]
unhead ->
[Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
thead_ (h [Attribute] -> [Attribute]
unhead h [Attribute]
theadAttrs) (WidgetFor site () -> WidgetFor site ())
-> WidgetFor site () -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$ do
Colonnade h a c -> (c -> WidgetFor site ()) -> WidgetFor site ()
forall (m :: * -> *) (h :: * -> *) a c b.
(Monad m, Headedness h) =>
Colonnade h a c -> (c -> m b) -> m ()
E.headerMonadicGeneral_ Colonnade h a c
colonnade (([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> c -> WidgetFor site ()
wrapContent [Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
th_)
[Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
tbody_ [Attribute]
tbodyAttrs (WidgetFor site () -> WidgetFor site ())
-> WidgetFor site () -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$ do
f a -> (a -> WidgetFor site ()) -> WidgetFor site ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ f a
xs ((a -> WidgetFor site ()) -> WidgetFor site ())
-> (a -> WidgetFor site ()) -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
[Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
tr_ (a -> [Attribute]
trAttrs a
x) (Colonnade h a c
-> (c -> WidgetFor site ()) -> a -> WidgetFor site ()
forall (m :: * -> *) (f :: * -> *) a c b.
Monad m =>
Colonnade f a c -> (c -> m b) -> a -> m ()
E.rowMonadic_ Colonnade h a c
colonnade (([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> c -> WidgetFor site ()
wrapContent [Attribute] -> WidgetFor site () -> WidgetFor site ()
forall (t :: * -> *) site a.
Foldable t =>
t Attribute -> WidgetFor site a -> WidgetFor site a
td_) a
x)
widgetFromCell ::
([Attribute] -> WidgetFor site () -> WidgetFor site ()) ->
Cell site ->
WidgetFor site ()
widgetFromCell :: forall site.
([Attribute] -> WidgetFor site () -> WidgetFor site ())
-> Cell site -> WidgetFor site ()
widgetFromCell [Attribute] -> WidgetFor site () -> WidgetFor site ()
f (Cell [Attribute]
attrs WidgetFor site ()
contents) =
[Attribute] -> WidgetFor site () -> WidgetFor site ()
f [Attribute]
attrs WidgetFor site ()
contents