module WebWire.Widget
(
Widget(..),
bodyW,
hamletW,
titleW,
cassiusW,
cssLinkW,
cssW,
jsLinkW,
jsW,
juliusW
)
where
import qualified Text.Blaze.Html5 as He
import qualified Text.Blaze.Html5.Attributes as Ha
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Monoid
import Data.Text (Text)
import Text.Blaze
import Text.Cassius
import Text.Hamlet
import Text.Julius
data Widget =
Widget {
wgtBody :: Html,
wgtHeadCSS :: [TL.Text],
wgtHeadJS :: [TL.Text],
wgtLinkCSS :: [Text],
wgtLinkJS :: [Text],
wgtTitle :: [Text]
}
instance Monoid Widget where
mempty =
Widget { wgtBody = mempty,
wgtHeadCSS = [],
wgtHeadJS = [],
wgtLinkCSS = [],
wgtLinkJS = [],
wgtTitle = [] }
mappend w1 w2 =
let ws = [w1, w2] in
Widget { wgtBody = mappend (wgtBody w1) (wgtBody w2),
wgtHeadCSS = concatMap wgtHeadCSS ws,
wgtHeadJS = concatMap wgtHeadJS ws,
wgtLinkCSS = concatMap wgtLinkCSS ws,
wgtLinkJS = concatMap wgtLinkJS ws,
wgtTitle = concatMap wgtTitle ws }
instance ToHtml Widget where
toHtml w =
let title = T.intercalate ": " (wgtTitle w)
linkCSS =
mconcat .
map (\ref -> He.link ! Ha.rel "stylesheet" ! Ha.type_ "text/css" ! Ha.href (toValue ref)) .
wgtLinkCSS $ w
linkJS =
mconcat .
map (\ref -> He.script mempty ! Ha.type_ "text/javascript" ! Ha.src (toValue ref)) .
wgtLinkJS $ w
headCSS =
mconcat .
map (\src -> He.style (toHtml src) ! Ha.type_ "text/css") .
wgtHeadCSS $ w
headJS =
mconcat .
map (\src -> He.script (toHtml src) ! Ha.type_ "text/javascript") .
wgtHeadJS $ w
in
He.docType `mappend`
He.head (
He.title (toHtml title) `mappend`
linkCSS `mappend` linkJS `mappend`
headCSS `mappend` headJS) `mappend`
He.body (wgtBody w)
bodyW :: Html -> Widget
bodyW html = mempty { wgtBody = html }
cassiusW :: CssUrl a -> Widget
cassiusW cass = mempty { wgtHeadCSS = [renderCss $ cass (\_ _ -> "/")] }
cssLinkW :: Text -> Widget
cssLinkW src = mempty { wgtLinkCSS = [src] }
cssW :: TL.Text -> Widget
cssW src = mempty { wgtHeadCSS = [src] }
hamletW :: HtmlUrl a -> Widget
hamletW html = mempty { wgtBody = html (\_ _ -> "/") }
jsLinkW :: Text -> Widget
jsLinkW src = mempty { wgtLinkJS = [src] }
jsW :: TL.Text -> Widget
jsW src = mempty { wgtHeadJS = [src] }
juliusW :: JavascriptUrl a -> Widget
juliusW js = mempty { wgtHeadJS = [renderJavascript $ js (\_ _ -> "/")] }
titleW :: Text -> Widget
titleW title = mempty { wgtTitle = [title] }