web-page 0.1.0 → 0.2.0
raw patch · 8 files changed
+630/−128 lines, 8 filesdep +Streamdep +blaze-builderdep +http-typesdep ~mtl
Dependencies added: Stream, blaze-builder, http-types, vector, wai, warp
Dependency ranges changed: mtl
Files
- README.md +140/−1
- Web/Page.hs +10/−0
- Web/Page/GenId.hs +185/−0
- Web/Page/Render.hs +78/−43
- Web/Page/Widget.hs +141/−58
- default.nix +6/−1
- test/Test.hs +50/−23
- web-page.cabal +20/−2
README.md view
@@ -1,7 +1,146 @@ Web-page ======== -This package combines blaze-html, clay, jmacro and web-routes into a+This package combines blaze-html, clay and jmacro into a framework-agnostic library to generate web pages dynamically from individual components. It is inspired by Yesod's widgets, but is more general, more powerful and can be used with other web frameworks.+++Features+--------++The `Widget` type is very expressive. The following features are built+in:++ * works with your web framework of choice,+ * fully embedded stylesheet and script languages (jmacro and clay),+ * page-specific or external stylesheets and script,+ * type-safe routing,+ * flexible polymorphic body type,+ * monoidal piece-by-piece construction of pages,+ * hierarchial titles,+ * additional head markup,+ * optional lens interface,+ * rendering to multiple documents (e.g. separate stylesheet and+ script).++Other features are add-ons:++ * non-HTML bodies (e.g. Pandoc integration),+ * multipart bodies aka *sections*,+ * page-unique identifier generation.+++Usage+-----++This is a brief overview of the process to construct and render a web+page using this library. First of all you will need a few extensions:++ {-# LANGUAGE FlexibleContexts #-}+ {-# LANGUAGE OverloadedStrings #-}+ {-# LANGUAGE QuasiQuotes #-}++The `OverloadedStrings` extension is optional, but makes writing+blaze-html markup and clay stylesheets a lot more convenient. The+`QuasiQuotes` extension is only required for jmacro, if you need scripts+in your widgets. With that aside the first step is to understand the+`Widget` type:++ Widget url h++The type argument `url` is your URL type. If you don't use type-safe+routing, then simply use `url = Text`. This is only significant for+external stylesheets and scripts. If you don't use any of them, just+leave it polymorphic.++The second type argument `h` is the page body type. For now just use+`Html` (from blaze-html), which means that the body of your page will be+simple unstructured HTML markup.+++### Construction++`Widget` is a family of monoids. While you could use the `Monoid`+interface directly it's usually much more convenient to use a writer+monad to construct your widgets. In most cases the correct type will be+inferred, but we will specify it regardless:++ myWidget :: (MonadWriter (Widget url Html) m) => m ()++If you are like me, you prefer to write type signatures for your+top-level definitions. A constraint alias is provided for your+convenience. The following type signature is equivalent to the above:++ myWidget :: (MonadWidget url Html m) => m ()++If writer is the only effect you need, there is an even simpler alias+that you can use, which is equivalent to the above as well:++ myWidget :: WidgetWriter url Html ()++Now we can construct the widget piece by piece:++ myWidget = do+ setTitle "Hello"+ addBody (H.h1 "Hello")+ addBody (H.p "Hello world!")+ addStyle $ html ? do+ background white+ color black++You can build the widget by reducing the writer:++ w :: Widget url Html+ w = execWriter myWidget++This widget can now be rendered to a page.+++### Rendering++To render the widget you can use the `renderWidget` function:++ renderWidget :: ([Text] -> Tl.Text) -> Widget Text Html -> Page++The `Text` type is the strict version, while the `Tl.Text` type is the+lazy version.++The first argument to this function is the title renderer. Widgets+define an optional title, which is not just a text string, but a list of+text strings. That's because this library supports hierarchial titles+by using the `withTitle` function. We will not cover this here. Just+use `titleMinor`:++ page :: Page+ page = renderWidget (titleMinor " - ") w++Pages are an intermediate step between rendering and delivery. They are+necessary, because this library allows you to render to multiple+documents, for example to a markup document, a stylesheet and a script.+You can then use a clever hash-based routing mechanism to tell clients+to cache stylesheets and scripts forever and reduce the required+bandwidth to a minimum.+++### Realisation++To process of finalising a page to an actual set of documents that you+can deliver is referred to as *realisation*. We will simply render to a+single document with an inline stylesheet and no script (because our+widget above doesn't define one). The `realiseInline` function does+exactly that:++ realiseInline :: Page -> Builder++All we need to do is to apply it to our page:++ document :: Builder+ document = realiseInline page++The `Builder` type is the usual one from blaze-builder. Most web+frameworks use it for efficient bytestring concatenation and provide a+simple interface to deliver those strings to clients. For example WAI+provides the `responseBuilder` function. If you want to save the result+to a file, just use `toLazyByteString` or `toByteStringIO`.
Web/Page.hs view
@@ -3,6 +3,16 @@ -- Copyright: (c) 2014 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez <ertesx@gmx.de>+--+-- This package combines blaze-html, clay and jmacro into a+-- framework-agnostic library to generate web pages dynamically from+-- individual components. It is inspired by Yesod's widgets, but is+-- more general, more powerful and can be used with other web+-- frameworks.+--+-- See the @README.md@ file for a full list of features and a quick+-- introduction. More detailed documentation can be found in the+-- individual modules. module Web.Page ( -- * Reexports
+ Web/Page/GenId.hs view
@@ -0,0 +1,185 @@+-- |+-- Module: Web.Page.GenId+-- Copyright: (c) 2014 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <ertesx@gmx.de>+--+-- This module offers a monad transformer and a class for page-unique+-- identifier generation. To use it, simply add a state monad to your+-- monad stack with a state type that is an instance of the+-- 'HasIdStream' class (you can simply use @'Stream' 'Identifier'@, if+-- you don't need any other state). See the 'newId' action to see the+-- exact type of stack you need.+--+-- To construct the initial state you can use the predefined 'idsFrom'+-- function. It constructs a stream of unique identifiers from its+-- argument character set.+--+-- To generate a new identifier use the 'newId' action within your monad+-- stack. The generated identifiers are of type 'Identifier'. There+-- are helper functions for integrating an identifer into markup and the+-- stylesheet. See the DOM helpers and the CSS helpers sections in this+-- module. Also see the documentation for 'Identifier' for more+-- detailed information and an example.+--+-- Hint: It is perfectly valid to combine a widget writer and an+-- identifier generator, so you don't need to alternate between+-- constructing widgets and generating identifiers.++module Web.Page.GenId+ ( -- * Unique identifiers+ Identifier(..),+ HasIdStream(..),+ idsFrom,+ newId,++ -- * DOM helpers+ classId,+ customId,+ dataId,+ domId,++ -- * CSS helpers+ idRef,+ idSel,+ classRef,+ classSel+ )+ where++import qualified Clay as Css+import qualified Data.Stream as Str+import qualified Data.Text as T+import qualified Data.Vector.Unboxed as Vu+import qualified Text.Blaze.Html5.Attributes as A+import Control.Lens+import Control.Monad.State.Class+import Data.Data+import Data.Stream (Stream(..))+import Language.Javascript.JMacro (ToJExpr(..), JExpr(..), JVal(..))+import Text.Blaze.Html+++-- | Instances of this class are types that embed an identifier stream.++class HasIdStream a where+ -- | Lens into the identifier stream.+ idStream :: Lens' a (Stream Identifier)++instance HasIdStream (Stream Identifier) where+ idStream = id+++-- | Identifiers that can be used with clay, jmacro and blaze-html.+--+-- An identifier of this type is supposed to be used for DOM ids,+-- classes or similar names. Note that the 'ToJExpr' instance converts+-- it to a JavaScript string, so that you can use it with jQuery or+-- functions like @getElementById@. When using jQuery, remember that it+-- expects selector syntax as in the following example:+--+-- > myWidget ::+-- > ( HasIdStream s,+-- > MonadState s m,+-- > MonadWidget url (MySection -> Html) m )+-- > => m ()+-- > myWidget = do+-- > myId <- newId+-- > addSection MySection (H.p "My boring paragraph." ! domId myId)+-- > addStyle $ idSel myId ? background gray+-- > addStyle $ idSel myId # ".groovy" ? do+-- > background darkblue+-- > color pink+-- > fontWeight bold+-- > addScriptLink "static/jquery.js"+-- > addScript [jmacro|+-- > fun init ->+-- > window.setTimeout+-- > (\() {+-- > $("#" + `myId`).addClass("groovy");+-- > $(".groovy").text("My groooovy paragraph!") })+-- > 2500;+-- > $(init) |]++newtype Identifier =+ Identifier {+ identifier :: String+ }+ deriving (Data, Eq, Ord, Show, ToValue, Typeable)++instance ToJExpr Identifier where+ toJExpr (Identifier name) = ValExpr (JStr name)+++-- | HTML5 @class@ attribute containing the given identifier.++classId :: Identifier -> Attribute+classId (Identifier n) = A.class_ (toValue n)+++-- | Class refinement for the given identifier.++classRef :: Identifier -> Css.Refinement+classRef = Css.byClass . T.pack . identifier+++-- | Class selector for the given identifier.++classSel :: Identifier -> Css.Selector+classSel n = Css.star Css.# classRef n+++-- | Custom attribute containing the given identifier.++customId :: Tag -> Identifier -> Attribute+customId attr (Identifier n) = customAttribute attr (toValue n)+++-- | HTML5 @id@ attribute containing the given identifier.++domId :: Identifier -> Attribute+domId (Identifier n) = A.id (toValue n)+++-- | HTML5 data attribute (@data-*@) containing the given identifier.++dataId :: Tag -> Identifier -> Attribute+dataId attr (Identifier n) = dataAttribute attr (toValue n)+++-- | Id refinement for the given identifier.++idRef :: Identifier -> Css.Refinement+idRef = Css.byId . T.pack . identifier+++-- | Id selector for the given identifier.++idSel :: Identifier -> Css.Selector+idSel n = Css.star Css.# idRef n+++-- | Infinite stream of identifiers built from the given character set.+-- The stream is sorted by identifier length, shortest first.++idsFrom :: [Char] -> Stream Identifier+idsFrom charList =+ fmap (Identifier . map (chars Vu.!))+ (Str.iterate next [0])++ where+ chars = Vu.fromList charList+ numChars = Vu.length chars++ next [] = [0]+ next (x':xs)+ | x < numChars = x : xs+ | otherwise = 0 : next xs+ where+ x = succ x'+++-- | Fetches the next identifier.++newId :: (HasIdStream a, MonadState a m) => m Identifier+newId = idStream %%= \(Cons x xs) -> (x, xs)
Web/Page/Render.hs view
@@ -4,23 +4,24 @@ -- License: BSD3 -- Maintainer: Ertugrul Soeylemez <ertesx@gmx.de> ----- This module provides the functionality to render web pages. This is--- the process to construct and then render a web page:+-- This module provides the functionality to render web pages. The+-- following is the process to construct and then render a web page: ----- 1. Use a writer monad to construct a 'Widget', which represents a--- web page component and is usually constructed from multiple--- smaller components,+-- 1. __Construction__: Use a writer monad to construct a 'Widget',+-- which represents a web page component and is usually constructed+-- from multiple smaller components. ----- 2. use one of the rendering functions to render a widget to a--- 'Page', which represents a rendered web page, but still abstracts--- over the exact set of documents (everything inline or a set of--- separate documents for markup, script and style),+-- 2. __Rendering__: Use one of the rendering functions to render a+-- widget to a 'Page', which represents a rendered web page, but+-- still abstracts over the exact set of documents (everything+-- inline or a set of separate documents for markup, script and+-- style). ----- 3. turn the page into a set of documents that you can deliver to the--- client, for example by using 'inlinePage'.+-- 3. __Realisation__: Realise the page as a set of documents that you+-- can deliver to the client, for example by using 'realiseInline'. -- -- The motivation for rendering to separate documents is that most web--- pages consist of dynamic markup, but the stylesheet and script is+-- pages consist of dynamic markup, but the stylesheet and script are -- mostly static. The way 'Page' works you can have widgets with -- batteries included and still render to separate documents to utilise -- the client's cache better.@@ -32,19 +33,20 @@ ( -- * Rendering pages Page(..), renderWidget,+ titleMajor,+ titleMinor, - -- * Single document- inlinePage+ -- * Realising pages+ realiseInline ) where import qualified Clay-import qualified Data.ByteString.Lazy as Bl-import qualified Data.Map.Strict as M import qualified Data.Text.Lazy as Tl import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A import qualified Text.PrettyPrint.Leijen.Text as Pp+import Blaze.ByteString.Builder (Builder) import Data.Foldable (foldMap) import Data.Monoid import Data.Text (Text)@@ -54,35 +56,38 @@ import Web.Page.Widget --- | Rendered pages. This type supports rendering to multiple documents--- like an HTML document, as explained above.+-- | Rendered pages. This type supports realising a page as multiple+-- documents like an HTML document, a separate script and a separate+-- stylesheet, as explained above. -- -- If you're running a low-traffic site and don't want to afford the -- complexity, then you can just include the stylesheets and scripts--- inline by using the 'inlinePage' function. Except for external+-- inline by using the 'realiseInline' function. Except for external -- script and style URLs this will give you a self-contained document -- that you can deliver to the client. -- -- The 'pageHtml' field is the function that takes the markup for the--- script and the style respectively and returns a lazy bytestring that--- you can send as @text/html@ to the client. The other two fields are--- the rendered script and stylesheet. The markup is UTF-8-encoded,--- which you should indicate in the @content-type@ header, if you--- deliver via HTTP.+-- script and the style respectively and returns a builder that you can+-- send as @text/html@ to the client. The other two fields are the+-- rendered script and stylesheet. The markup is UTF-8-encoded, which+-- you should indicate in the @content-type@ header, if you deliver via+-- HTTP, although a @meta@ element is included as a fallback. data Page = Page {- pageHtml :: Html -> Html -> Bl.ByteString, -- ^ Markup document.- pageScript :: Tl.Text, -- ^ Page script.- pageStyle :: Tl.Text -- ^ Page stylesheet.+ pageHtml :: Html -> Html -> Builder, -- ^ Markup document.+ pageScript :: Tl.Text, -- ^ Page script.+ pageStyle :: Tl.Text -- ^ Page stylesheet. } --- | Render the given page to a single self-contained document,--- including the script and stylesheet inline.+-- | Realise the given page as a single self-contained document,+-- including the script and stylesheet inline. The resulting string is+-- UTF-8-encoded and contains a @meta@ element to indicate that. Read+-- the documentation of 'Page' for details. -inlinePage :: Page -> Bl.ByteString-inlinePage p = pageHtml p scInc stInc+realiseInline :: Page -> Builder+realiseInline p = pageHtml p scInc stInc where Page { pageScript = sc, pageStyle = st@@ -95,16 +100,25 @@ | otherwise = H.style (toHtml st) --- | This is the most general rendering function for widgets.+-- | This is the most general rendering function for widgets. The title+-- renderer receives the title chunks from outermost to innermost.+--+-- If you use type-safe routing and/or a sectioned or otherwise+-- non-'Html' body type, you should first apply the necessary+-- transformations to perform the routing and/or flattening or+-- conversion of the body.+--+-- Note that 'Widget' is a family of applicative functors. There are+-- also predefined functions to assist you with this transformation.+-- See the "Web.Page.Route" module and the 'mapLinksA', 'mapLinksM' and+-- 'flattenBody' functions. renderWidget ::- (Ord k)- => [k] -- ^ Sections to render.- -> ([Text] -> Text) -- ^ Title renderer.- -> Widget k Text -- ^ Widget to render.+ ([Text] -> Tl.Text) -- ^ Title renderer.+ -> Widget Text Html -- ^ Widget to render. -> Page-renderWidget ss renderTitle w =- Page { pageHtml = \scInc stInc -> renderHtml (html scInc stInc),+renderWidget renderTitle w =+ Page { pageHtml = \scInc stInc -> renderHtmlBuilder (html scInc stInc), pageScript = Pp.displayT . Pp.renderOneLine . renderJs . _wScript $ w, pageStyle = Clay.renderWith Clay.compact [] . _wStyle $ w } @@ -117,20 +131,17 @@ where bodyH =- foldMap section ss <>+ _wBody w <> foldMap scLink (_wScriptLinks w) <> scInc headH = H.title (toHtml title) <>+ H.meta ! A.charset "UTF-8" <> _wHead w <> foldMap stLink (_wStyleLinks w) <> stInc - section =- maybe mempty id .- (`M.lookup` _wSections w)- scLink url = H.script mempty ! A.src (toValue url) stLink url =@@ -138,3 +149,27 @@ ! A.href (toValue url) title = renderTitle . maybe [] id . getLast . _wTitle $ w+++-- | Intercalate the given title chunks using the given separator,+-- highest level title first. For most web sites 'titleMinor' is+-- preferable.+--+-- >>> titleMajor " - " ["site", "department", "page"]+-- "site - department - page"++titleMajor :: Text -> [Text] -> Tl.Text+titleMajor sep = Tl.intercalate (Tl.fromStrict sep) . map Tl.fromStrict+++-- | Intercalate the given title chunks using the given separator,+-- lowest level title first. This is much more common on web sites than+-- 'titleMajor', because it's usually more convenient for the user to+-- have the page title in the leftmost position (think about browser tab+-- captions and title bars).+--+-- >>> titleMinor " - " ["site", "department", "page"]+-- "page - department - site"++titleMinor :: Text -> [Text] -> Tl.Text+titleMinor sep = titleMajor sep . reverse
Web/Page/Widget.hs view
@@ -6,7 +6,8 @@ -- -- A widget is a self-contained web page component represented by the -- 'Widget' type. This type is a family of monoids, so you can use it--- together with a writer monad.+-- together with a writer monad, which is the preferred way to construct+-- widgets. module Web.Page.Widget ( -- * Page widgets@@ -28,24 +29,29 @@ withTitle, -- * Widget lenses+ wBody, wHead, wScript, wScriptLinks,- wSections,+ wSection, wStyle, wStyleLinks,- wTitle+ wTitle,++ -- * Mapping+ flattenBody,+ mapLinksA,+ mapLinksM ) where -import qualified Data.Map.Strict as M import qualified Data.Set as S import Clay (Css) import Control.Applicative import Control.Lens+import Control.Monad import Control.Monad.Writer.Class-import Data.Foldable (Foldable)-import Data.Map (Map)+import Data.Foldable (Foldable, foldMap) import Data.Monoid import Data.Set (Set) import Data.Text (Text)@@ -56,119 +62,193 @@ -- | Convenient constraint alias for widget actions. -type MonadWidget k url = MonadWriter (Widget k url)+type MonadWidget url h = MonadWriter (Widget url h) -- | A widget is a self-contained fragment of a web page together with -- its scripts and styles. This type is inspired by Yesod's widgets,--- but is supposed to be constructed by using a writer monad and may not--- denote effects of its own.+-- but is supposed to be constructed by using a writer monad and does+-- not denote effects of its own. ----- To construct widgets through a writer monad, use lens combinators--- like 'scribe' and 'censoring'. Alternatively you can use the @add*@--- functions like 'addSection' or 'addStyle'. The title is constructed--- by using 'withTitle' and 'setTitle'. This allows you to have a--- hierarchy of titles with a site title, a page title and even a--- component title.+-- To construct widgets through a writer monad, you can use the @add*@+-- functions like 'addSection' or 'addStyle': ----- The first type argument is the key type for the individual body--- sections of the resulting document. You can use it for example to--- divide your document into a header, a menu, a content area and a--- footer and each widget can add to them individually.+-- > do addSection "header" (H.h1 "My fancy header")+-- > addStyle $ html ? do+-- > background yellow+-- > color black ----- The second type argument is the type of URLs. You may use it for--- type-safe routing.+-- Alternatively use can use lens combinators like 'scribe' and+-- 'censoring' together with widget lenses like 'wSection' and 'wStyle':+--+-- > do scribe (wSection "header") (H.h1 "My fancy header")+-- > scribe wStyle $ html ? do+-- > background yellow+-- > color black+--+-- The title is constructed by using 'withTitle' and 'setTitle'. This+-- allows you to have a hierarchy of titles with a site title, a page+-- title and even a component title:+--+-- > withTitle "My site title" $+-- > withTitle "My department title" $+-- > setTitle "My page title"+-- > addSection "header" (H.h1 "My page title")+--+-- The first type argument @url@ is the type of URLs. You may use it+-- for type-safe routing. If you don't use type-safe routing, you can+-- simply use 'Text'.+--+-- The second type argument @h@ is the body type. For simple pages you+-- can use 'Html', but this widget type allows you to have more+-- complicated bodies, as long as you reduce them to 'Html' at some+-- point. For example this library predefines functions like+-- 'addSection' and 'flattenBody' to allow you to construct individual+-- page sections separately and then merge them. You can use it for+-- example to divide your document into a header, a menu, a content area+-- and a footer, and every widget can contribute to each of those+-- sections separately.+--+-- Another way to use this is to construct your body using a completely+-- different document type, for example a Pandoc document, then later+-- convert it to 'Html'. -data Widget k url =+data Widget url h = Widget {+ _wBody :: h, -- ^ Markup body. _wHead :: Html, -- ^ Head content. _wScript :: JStat, -- ^ Inline scripts. _wScriptLinks :: Set url, -- ^ External scripts.- _wSections :: Map k Html, -- ^ Contents of body sections. _wStyle :: Css, -- ^ Stylesheet. _wStyleLinks :: Set url, -- ^ External stylesheets. _wTitle :: Last [Text] -- ^ Page title chunks (outermost first). }- deriving (Foldable, Typeable)+ deriving (Foldable, Functor, Typeable) -instance (Ord k, Ord url) => Monoid (Widget k url) where- mempty =- Widget { _wHead = mempty,+instance (Ord url) => Applicative (Widget url) where+ pure x =+ Widget { _wBody = x,+ _wHead = mempty, _wScript = mempty, _wScriptLinks = mempty,- _wSections = M.empty, _wStyle = return (), _wStyleLinks = mempty, _wTitle = mempty } - mappend w1 w2 =- Widget { _wHead = _wHead w1 <> _wHead w2,- _wScript = _wScript w1 <> _wScript w2,- _wScriptLinks = _wScriptLinks w1 <> _wScriptLinks w2,- _wSections = M.unionWith (<>) (_wSections w1) (_wSections w2),- _wStyle = _wStyle w1 >> _wStyle w2,- _wStyleLinks = _wStyleLinks w1 <> _wStyleLinks w2,- _wTitle = _wTitle w1 <> _wTitle w2 }+ wf <*> wx =+ Widget { _wBody = _wBody wf (_wBody wx),+ _wHead = _wHead wf <> _wHead wx,+ _wScript = _wScript wf <> _wScript wx,+ _wScriptLinks = _wScriptLinks wf <> _wScriptLinks wx,+ _wStyle = _wStyle wf >> _wStyle wx,+ _wStyleLinks = _wStyleLinks wf <> _wStyleLinks wx,+ _wTitle = _wTitle wf <> _wTitle wx } +instance (Monoid h, Ord url) => Monoid (Widget url h) where+ mempty = pure mempty+ mappend = liftA2 (<>) + -- | Convenient type alias for polymorphic widget actions. -type WidgetWriter k url a = forall m. (MonadWidget k url m) => m a+type WidgetWriter url h a = forall m. (MonadWidget url h m) => m a -- | Construct a widget with the given body. Use this combinator if you -- don't need sections. -addBody :: (MonadWriter (Widget () url) m) => Html -> m ()-addBody = addSection ()+addBody :: h -> WidgetWriter url h ()+addBody = scribe wBody -- | Construct a widget with the given head markup. -addHead :: (MonadWriter (Widget k url) m) => Html -> m ()+addHead :: Html -> WidgetWriter url h () addHead = scribe wHead -- | Construct a widget with the given script. -addScript :: (MonadWriter (Widget k url) m) => JStat -> m ()+addScript :: JStat -> WidgetWriter url h () addScript = scribe wScript -- | Construct a widget with the given script link. -addScriptLink :: (MonadWriter (Widget k url) m) => url -> m ()+addScriptLink :: url -> WidgetWriter url h () addScriptLink url = scribe wScriptLinks (S.singleton url) -- | Construct a widget with the given body section. -addSection :: (MonadWriter (Widget k url) m) => k -> Html -> m ()-addSection k = scribe wSections . M.singleton k+addSection :: (Eq k) => k -> h -> WidgetWriter url (k -> h) ()+addSection k = scribe (wSection k) -- | Construct a widget with the given stylesheet. -addStyle :: (MonadWriter (Widget k url) m) => Css -> m ()+addStyle :: Css -> WidgetWriter url h () addStyle = scribe wStyle -- | Construct a widget with the given style link. -addStyleLink :: (MonadWriter (Widget k url) m) => url -> m ()+addStyleLink :: url -> WidgetWriter url h () addStyleLink url = scribe wStyleLinks (S.singleton url) +-- | Flatten the given widget's body by joining the given sections into+-- a single section. It's valid to list sections more than once.++flattenBody :: (Monoid h) => [k] -> Widget url (k -> h) -> Widget url h+flattenBody ks = fmap (`foldMap` ks)+++-- | Map the given action over all URLs in the given widget.++mapLinksA :: (Applicative f, Ord url) => (url' -> f url) -> Widget url' h -> f (Widget url h)+mapLinksA f w =+ liftA2 combine (urlMap $ _wScriptLinks w) (urlMap $ _wStyleLinks w)++ where+ combine sc st =+ w { _wScriptLinks = sc,+ _wStyleLinks = st }++ urlMap = fmap S.fromList . traverse f . S.toList+++-- | Monadic version of 'mapLinksA'.++mapLinksM :: (Monad m, Ord url) => (url' -> m url) -> Widget url' h -> m (Widget url h)+mapLinksM f w =+ liftM2 combine (urlMap $ _wScriptLinks w) (urlMap $ _wStyleLinks w)++ where+ combine sc st =+ w { _wScriptLinks = sc,+ _wStyleLinks = st }++ urlMap = liftM S.fromList . mapM f . S.toList++ -- | Scribe the title of the widget. Use this function to construct the--- lowest level title. For higher level titles use 'withTitle'.+-- lowest level title. For higher level titles use 'withTitle'. The+-- most recently set title wins. -setTitle :: (MonadWriter (Widget k url) m) => Text -> m ()+setTitle :: Text -> WidgetWriter url h () setTitle x = scribe wTitle (Last (Just [x])) +-- | Lens into a widget's body.++wBody :: Lens' (Widget url h) h+wBody l w = (\x -> w { _wBody = x }) <$> l (_wBody w)++ -- | Lens into a widget's head. -wHead :: Lens' (Widget k url) Html+wHead :: Lens' (Widget url h) Html wHead l w = (\x -> w { _wHead = x }) <$> l (_wHead w) @@ -176,7 +256,7 @@ -- Conceptually this wraps the given widget in a higher level title. -- Use 'setTitle' for the lowest level title. -withTitle :: (MonadWriter (Widget k url) m) => Text -> m a -> m a+withTitle :: (MonadWidget url h m) => Text -> m a -> m a withTitle x = censoring wTitle f where f (Last Nothing) = Last Nothing@@ -185,35 +265,38 @@ -- | Lens into a widget's inline script. -wScript :: Lens' (Widget k url) JStat+wScript :: Lens' (Widget url h) JStat wScript l w = (\x -> w { _wScript = x }) <$> l (_wScript w) -- | Lens into a widget's external scripts. -wScriptLinks :: Lens' (Widget k url) (Set url)+wScriptLinks :: Lens' (Widget url h) (Set url) wScriptLinks l w = (\x -> w { _wScriptLinks = x }) <$> l (_wScriptLinks w) --- | Lens into a widget's body sections.+-- | Lens into a specific section of a widget. -wSections :: Lens' (Widget k url) (Map k Html)-wSections l w = (\x -> w { _wSections = x }) <$> l (_wSections w)+wSection :: (Eq k) => k -> Lens' (Widget url (k -> h)) h+wSection k = wBody . point k+ where+ point :: (Eq a) => a -> Lens' (a -> b) b+ point ix l f = (\y -> (\ix' -> if ix' == ix then y else f ix')) <$> l (f ix) -- | Lens into a widget's inline style. -wStyle :: Lens' (Widget k url) Css+wStyle :: Lens' (Widget url h) Css wStyle l w = (\x -> w { _wStyle = x }) <$> l (_wStyle w) -- | Lens into a widget's external styles. -wStyleLinks :: Lens' (Widget k url) (Set url)+wStyleLinks :: Lens' (Widget url h) (Set url) wStyleLinks l w = (\x -> w { _wStyleLinks = x }) <$> l (_wStyleLinks w) -- | Lens into a widget's title. -wTitle :: Lens' (Widget k url) (Last [Text])+wTitle :: Lens' (Widget url h) (Last [Text]) wTitle l w = (\x -> w { _wTitle = x }) <$> l (_wTitle w)
default.nix view
@@ -6,6 +6,8 @@ inherit (hs) cabal; develDepends = with hs; [+ wai+ warp ]; in @@ -18,12 +20,15 @@ src = if devel then ./. else pkgs.fetchdarcs { url = ./.; }; buildDepends = with hs; [+ blazeBuilder blazeHtml clay jmacro lens mtl- webRoutes+ Stream+ text+ vector wlPprintText ] ++ (if devel then develDepends else []); })
test/Test.hs view
@@ -6,38 +6,65 @@ module Main where -import qualified Data.ByteString.Lazy.Char8 as Blc-import qualified Data.Text as T import qualified Text.Blaze.Html5 as H-import Clay+import Clay hiding ((!))+import Control.Monad.State import Data.Text (Text) import Language.Javascript.JMacro+import Network.HTTP.Types+import Network.Wai+import Network.Wai.Handler.Warp+import System.IO+import Text.Blaze.Html import Web.Page+import Web.Page.GenId -data Section = Header | Content | Footer- deriving (Eq, Ord, Show)+myWidget :: (HasIdStream a, MonadState a m, MonadWidget Text Html m) => m ()+myWidget = do+ setTitle "Test page" + myId <- newId -myWidget :: WidgetWriter Section Text ()-myWidget =- withTitle "Test site" $ do- setTitle "Test page"- addSection Footer (H.p "copyright crap")- addScript [jmacro| alert("haha") |]- addSection Header (H.h1 "blah")- addStyle $ "html" ? do- background white- color black+ addBody $+ H.h1 "My example page" <>+ H.p "My boring paragraph." ! domId myId - addScriptLink "/js/blah.js"- addStyleLink "/style/screen.css"+ addStyle $ idSel myId ? do+ background white+ color black + addStyle $ idSel myId # ".groovy" ? do+ background darkblue+ color pink+ fontWeight bold -main :: IO ()-main = do- let w = execWriter myWidget- p = renderWidget [Header, Content, Footer] (T.intercalate " - ") w- d = inlinePage p+ addScriptLink "static/jquery.js"+ addScript [jmacro|+ fun init ->+ window.setTimeout+ (\() {+ $("#" + `myId`).addClass("groovy");+ $(".groovy").text("My grooooooovy paragraph!") })+ 1000; - Blc.putStrLn d+ $(init) |]+++handler :: Application+handler req k | pathInfo req == ["static", "jquery.js"] = do+ let ctype = (hContentType, "text/javascript; charset=UTF-8")+ k (responseFile ok200 [ctype] "static/jquery.js" Nothing)++handler req k = do+ let w = execWriter (evalStateT myWidget (idsFrom ['a'..'z']))+ p = realiseInline (renderWidget (titleMajor ": ") w)++ hdrs = [(hContentType, "text/html; charset=UTF-8")]++ k (responseBuilder ok200 hdrs p)+++main :: IO ()+main =+ run 8000 handler
web-page.cabal view
@@ -1,21 +1,27 @@ name: web-page-version: 0.1.0+version: 0.2.0 category: Web synopsis: Monoidally construct web pages maintainer: Ertugrul Söylemez <ertesx@gmx.de> author: Ertugrul Söylemez <ertesx@gmx.de> copyright: (c) 2014 Ertugrul Söylemez+homepage: http://hub.darcs.net/ertes/web-page+bug-reports: http://hub.darcs.net/ertes/web-page/issues license: BSD3 license-file: LICENSE build-type: Simple cabal-version: >= 1.10 extra-source-files: README.md default.nix description:- This package combines blaze-html, clay, jmacro and web-routes into a+ This package combines blaze-html, clay and jmacro into a framework-agnostic library to generate web pages dynamically from individual components. It is inspired by Yesod's widgets, but is more general, more powerful and can be used with other web frameworks.+ .+ See the @README.md@ file for a full list of features and a quick+ introduction. More detailed documentation can be found in the+ individual modules. flag TestProgram default: False@@ -29,6 +35,7 @@ library build-depends: base >= 4.5 && < 5,+ blaze-builder >= 0.3 && < 1, blaze-html >= 0.7 && < 1, bytestring >= 0.10 && < 1, clay >= 0.9 && < 1,@@ -36,19 +43,26 @@ jmacro >= 0.6 && < 1, lens >= 4.4 && < 5, mtl >= 2.1 && < 3,+ Stream >= 0.4 && < 1, text >= 1.0 && < 2,+ vector >= 0.10 && < 1, wl-pprint-text >= 1.1 && < 2 default-language: Haskell2010 default-extensions: ConstraintKinds DeriveDataTypeable DeriveFoldable+ DeriveFunctor FlexibleContexts+ FlexibleInstances+ GeneralizedNewtypeDeriving OverloadedStrings RankNTypes+ TupleSections ghc-options: -W exposed-modules: Web.Page+ Web.Page.GenId Web.Page.Render Web.Page.Widget @@ -59,8 +73,12 @@ blaze-html, bytestring, clay,+ http-types, jmacro,+ mtl, text,+ wai,+ warp, web-page else buildable: False