diff --git a/src/Web/Page/Blaze.hs b/src/Web/Page/Blaze.hs
--- a/src/Web/Page/Blaze.hs
+++ b/src/Web/Page/Blaze.hs
@@ -10,23 +10,22 @@
import Web.Page.Types as X
import qualified Text.Blaze.Html5 as H
-
import qualified Data.Text as T
-- | You should really be using Lucid...
-template :: WebPage H.Html T.Text
+template :: WebPage H.Html T.Text H.Attribute
-> H.Html
-> H.Html
-template page content = do
+template page content =
H.docTypeHtml $ do
- (H.head $ do
+ H.head $ do
initScripts page
- (H.title $ H.toHtml $ pageTitle page)
+ H.title $ H.toHtml $ pageTitle page
metaVars page
favicon page
beforeStylesScripts page
styles page
- afterStylesScripts page)
- H.body $ do
+ afterStylesScripts page
+ H.body H.! bodyStyles page $ do
content
bodyScripts page
diff --git a/src/Web/Page/Hastache.hs b/src/Web/Page/Hastache.hs
--- a/src/Web/Page/Hastache.hs
+++ b/src/Web/Page/Hastache.hs
@@ -15,7 +15,7 @@
-- | We choose to not interpolate the @WebPage@ data type as a JSON Hastache
-- template value because I don't want the portions of @WebPage@ visible by
-- @content@.
-template :: WebPage LT.Text T.Text
+template :: WebPage LT.Text T.Text T.Text
-> LT.Text
-> LT.Text
template page content = mconcat
@@ -23,14 +23,14 @@
, ""
, ""
, initScripts page
- , "" <> (LT.fromStrict $ pageTitle page) <> ""
+ , "" <> LT.fromStrict (pageTitle page) <> ""
, metaVars page
, favicon page
, beforeStylesScripts page
, styles page
, afterStylesScripts page
, ""
- , ""
+ , " LT.fromStrict (bodyStyles page) <> "\" >"
, content
, bodyScripts page
, ""
diff --git a/src/Web/Page/Lucid.hs b/src/Web/Page/Lucid.hs
--- a/src/Web/Page/Lucid.hs
+++ b/src/Web/Page/Lucid.hs
@@ -1,7 +1,6 @@
{-# LANGUAGE
OverloadedStrings
, ExtendedDefaultRules
- , BangPatterns
#-}
module Web.Page.Lucid
@@ -18,21 +17,18 @@
-- | Generic page template implemented in Lucid.
template :: Monad m =>
- WebPage (HtmlT m ()) T.Text -- ^ Page information
+ WebPage (HtmlT m ()) T.Text [Attribute] -- ^ Page information
-> HtmlT m () -- ^ Content to insert in @\@
-> HtmlT m ()
-template page content = doctypehtml_ $ mconcat $
- [ head_ [] $ mconcat $
- [ initScripts page
- , title_ $ toHtmlRaw $ pageTitle page
- , metaVars page
- , favicon page
- , beforeStylesScripts page
- , styles page
- , afterStylesScripts page
- ]
- , body_ [] $ mconcat $
- [ content
- , bodyScripts page
- ]
- ]
+template page content = doctypehtml_ $ do
+ head_ [] $ do
+ initScripts page
+ title_ $ toHtmlRaw $ pageTitle page
+ metaVars page
+ favicon page
+ beforeStylesScripts page
+ styles page
+ afterStylesScripts page
+ body_ (bodyStyles page) $ do
+ content
+ bodyScripts page
diff --git a/src/Web/Page/Types.hs b/src/Web/Page/Types.hs
--- a/src/Web/Page/Types.hs
+++ b/src/Web/Page/Types.hs
@@ -15,7 +15,7 @@
-- > page :: WebPage (Html ()) T.Text
-- @ page' = page \{pageTitle = "foo!"\}@
--
-data WebPage markup attr = WebPage
+data WebPage markup attr attrSet = WebPage
{ pageTitle :: attr -- ^ Page title
, favicon :: markup -- ^ Favicon tags
, metaVars :: markup -- ^ @\@ tags
@@ -24,14 +24,16 @@
, styles :: markup -- ^ Styles
, afterStylesScripts :: markup -- ^ JavaScript to include after @\@ tags - ie:
, bodyScripts :: markup -- ^ JavaScript to include at the base of @\@
+ , bodyStyles :: attrSet -- ^ Additional styles to assign to @\@
} deriving (Show, Eq, Ord)
instance ( Monoid m
, Monoid a
- ) => Monoid (WebPage m a) where
- mempty = WebPage mempty mempty mempty mempty mempty mempty mempty mempty
- mappend (WebPage t1 f1 m1 is1 bs1 s1 as1 b1) (WebPage t2 f2 m2 is2 bs2 s2 as2 b2) =
+ , Monoid s
+ ) => Monoid (WebPage m a s) where
+ mempty = WebPage mempty mempty mempty mempty mempty mempty mempty mempty mempty
+ mappend (WebPage t1 f1 m1 is1 bs1 s1 as1 b1 bss1) (WebPage t2 f2 m2 is2 bs2 s2 as2 b2 bss2) =
WebPage (t1 `mappend` t2)
(f1 `mappend` f2)
(m1 `mappend` m2)
@@ -40,9 +42,11 @@
(s1 `mappend` s2)
(as1 `mappend` as2)
(b1 `mappend` b2)
+ (bss1 `mappend` bss2)
instance ( Monoid m
, Monoid a
- ) => Default (WebPage m a) where
+ , Monoid s
+ ) => Default (WebPage m a s) where
def = mempty
diff --git a/webpage.cabal b/webpage.cabal
--- a/webpage.cabal
+++ b/webpage.cabal
@@ -1,5 +1,5 @@
Name: webpage
-Version: 0.0.4
+Version: 0.0.5
Author: Athan Clark
Maintainer: Athan Clark
License: MIT
@@ -9,8 +9,6 @@
This is a general organization scheme for web pages, implemented for Lucid,
and adapted for Blaze-html.
.
- It's as easy as 1-2-3:
- .
> import Web.Page.Lucid
>
> λ> renderText $ template def "some content"
@@ -20,15 +18,8 @@
.
overload the particular areas with record syntax and stuff:
.
- > λ> let page = WebPage
- > "foo"
- > mempty
- > mempty
- > mempty
- > mempty
- > mempty
- > mempty
- > (script_ [src_ "jquery.js"] "")
+ > λ> let page = def { title = "foo"
+ > , bodyScripts = script_ [src_ "jquery.js"] ""}
>
>
> λ> template page "some content"