xhtml-combinators 0.1 → 0.2
raw patch · 12 files changed
+1131/−289 lines, 12 filesdep +randomdep +transformersdep −mtl
Dependencies added: random, transformers
Dependencies removed: mtl
Files
- src/Text/XHtmlCombinators.hs +13/−4
- src/Text/XHtmlCombinators/Attributes.hs +67/−59
- src/Text/XHtmlCombinators/Attributes/Internal.hs +27/−0
- src/Text/XHtmlCombinators/Attributes/Internal/Safe.hs +28/−0
- src/Text/XHtmlCombinators/Attributes/Safe.hs +133/−0
- src/Text/XHtmlCombinators/Combinators.lhs +212/−196
- src/Text/XHtmlCombinators/Escape.hs +344/−0
- src/Text/XHtmlCombinators/Extras/Lorem.hs +109/−0
- src/Text/XHtmlCombinators/Internal.hs +37/−20
- src/Text/XHtmlCombinators/Render.hs +27/−6
- src/Text/XHtmlCombinators/Safe.hs +123/−0
- xhtml-combinators.cabal +11/−4
src/Text/XHtmlCombinators.hs view
@@ -1,10 +1,18 @@+-- |+-- Module : Text.XHtmlCombinators+-- Copyright : (c) Alasdair Armstrong 2010+-- License : BSD-style+-- Maintainer : alasdair.armstrong@googlemail.com+-- Stability : experimental+-- Portability : GHC+ module Text.XHtmlCombinators ( -- * Types -- ** XHtml- XHtmlM, XHtml+ XHtmlMT, XHtmlT, XHtml , Page- , Content- , Attrs, Attr (Attr)+ , Content, CData+ , Attrs, Attr -- ** Element Types , TopLevelContent , HeadContent@@ -18,6 +26,7 @@ , ListContent, DefinitionListContent -- *** Field Element Types , FieldSetContent+ , OptionContent -- *** Table Element Types , Table1Content, Table2Content, Table3Content , TableColContent@@ -112,7 +121,7 @@ , th', th , td', td -- * Rendering- , render+ , render, renderT ) where import Text.XHtmlCombinators.Combinators
src/Text/XHtmlCombinators/Attributes.hs view
@@ -1,22 +1,30 @@ {-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Text.XHtmlCombinators.Attributes+-- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of Science and Technology 1999-2001+-- (c) Bjorn Bringert 2004-2006+-- (c) Alasdair Armstrong 2010+-- License : BSD-style+-- Maintainer : alasdair.armstrong@googlemail.com+-- Stability : experimental+-- Portability : GHC+ module Text.XHtmlCombinators.Attributes where -import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as T+import Data.Text (Text)+import qualified Data.Text as T -import Text.XHtmlCombinators.Internal+import Text.XHtmlCombinators.Internal (Attr (Attr))+import Text.XHtmlCombinators.Attributes.Internal +attr :: Text -> Text -> Attr+attr = Attr+ -- the following was copied almost verbatim from Bjorn Bringert's xhtml library. -- See: http://hackage.haskell.org/package/xhtml -emptyAttr :: Text -> Attr-emptyAttr name = Attr name name--intAttr :: Text -> Int -> Attr-intAttr name = Attr name . T.pack . show--textAttr :: Text -> Text -> Attr-textAttr name = Attr name+-- TODO: Not all attributes are currently available. action :: Text -> Attr align :: Text -> Attr@@ -67,51 +75,51 @@ value :: Text -> Attr width :: Text -> Attr -action = textAttr "action"-align = textAttr "align"-alt = textAttr "alt"-altcode = textAttr "altcode"-archive = textAttr "archive"-base = textAttr "base"-border = intAttr "border"-bordercolor = textAttr "bordercolor"-cellpadding = intAttr "cellpadding"-cellspacing = intAttr "cellspacing"-checked = emptyAttr "checked"-codebase = textAttr "codebase"-cols = textAttr "cols"-colspan = intAttr "colspan"-content = textAttr "content"-coords = textAttr "coords"-disabled = emptyAttr "disabled"-enctype = textAttr "enctype"-height = textAttr "height"-href = textAttr "href"-hreflang = textAttr "hreflang"-httpEquiv = textAttr "http-equiv"-id_ = textAttr "id"-ismap = emptyAttr "ismap"-lang = textAttr "lang"-maxlength = intAttr "maxlength"-method = textAttr "method"-multiple = emptyAttr "multiple"-name = textAttr "name"-nohref = emptyAttr "nohref"-rel = textAttr "rel"-rev = textAttr "rev"-rows = textAttr "rows"-rowspan = intAttr "rowspan"-rules = textAttr "rules"-selected = emptyAttr "selected"-shape = textAttr "shape"-size = textAttr "size"-src = textAttr "src"-class_ = textAttr "class"-for = textAttr "for"-style = textAttr "style"-type_ = textAttr "type"-title = textAttr "title"-usemap = textAttr "usemap"-valign = textAttr "valign"-value = textAttr "value"-width = textAttr "width"+action = textAttr "action"+align = textAttr "align"+alt = textAttr "alt"+altcode = textAttr "altcode"+archive = textAttr "archive"+base = textAttr "base"+border = intAttr "border"+bordercolor = textAttr "bordercolor"+cellpadding = intAttr "cellpadding"+cellspacing = intAttr "cellspacing"+checked = emptyAttr "checked"+codebase = textAttr "codebase"+cols = textAttr "cols"+colspan = intAttr "colspan"+content = textAttr "content"+coords = textAttr "coords"+disabled = emptyAttr "disabled"+enctype = textAttr "enctype"+height = textAttr "height"+href = textAttr "href"+hreflang = textAttr "hreflang"+httpEquiv = textAttr "http-equiv"+id_ = textAttr "id"+ismap = emptyAttr "ismap"+lang = textAttr "lang"+maxlength = intAttr "maxlength"+method = textAttr "method"+multiple = emptyAttr "multiple"+name = textAttr "name"+nohref = emptyAttr "nohref"+rel = textAttr "rel"+rev = textAttr "rev"+rows = textAttr "rows"+rowspan = intAttr "rowspan"+rules = textAttr "rules"+selected = emptyAttr "selected"+shape = textAttr "shape"+size = textAttr "size"+src = textAttr "src"+class_ = textAttr "class"+for = textAttr "for"+style = textAttr "style"+type_ = textAttr "type"+title = textAttr "title"+usemap = textAttr "usemap"+valign = textAttr "valign"+value = textAttr "value"+width = textAttr "width"
+ src/Text/XHtmlCombinators/Attributes/Internal.hs view
@@ -0,0 +1,27 @@+-- |+-- Module : Text.XHtmlCombinators.Attributes+-- Copyright : (c) Alasdair Armstrong 2010+-- License : BSD-style+-- Maintainer : alasdair.armstrong@googlemail.com+-- Stability : experimental+-- Portability : GHC++module Text.XHtmlCombinators.Attributes.Internal+ ( emptyAttr+ , intAttr+ , textAttr+ ) where++import Data.Text (Text)+import qualified Data.Text as T++import Text.XHtmlCombinators.Internal++emptyAttr :: Text -> Attr+emptyAttr name = Attr name name++intAttr :: Text -> Int -> Attr+intAttr name = Attr name . T.pack . show++textAttr :: Text -> Text -> Attr+textAttr name = Attr name
+ src/Text/XHtmlCombinators/Attributes/Internal/Safe.hs view
@@ -0,0 +1,28 @@+-- |+-- Module : Text.XHtmlCombinators.Attributes+-- Copyright : (c) Alasdair Armstrong 2010+-- License : BSD-style+-- Maintainer : alasdair.armstrong@googlemail.com+-- Stability : experimental+-- Portability : GHC++module Text.XHtmlCombinators.Attributes.Internal.Safe+ ( emptyAttr+ , intAttr+ , textAttr+ ) where++import Data.Text (Text)+import qualified Data.Text as T++import Text.XHtmlCombinators.Internal+import Text.XHtmlCombinators.Escape++emptyAttr :: Text -> Attr+emptyAttr name = Attr name (escapeAttr name)++intAttr :: Text -> Int -> Attr+intAttr name = Attr name . T.pack . show++textAttr :: Text -> Text -> Attr+textAttr name = Attr name . escapeAttr
+ src/Text/XHtmlCombinators/Attributes/Safe.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Text.XHtmlCombinators.Attributes+-- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of Science and Technology 1999-2001+-- (c) Bjorn Bringert 2004-2006+-- (c) Alasdair Armstrong 2010+-- License : BSD-style+-- Maintainer : alasdair.armstrong@googlemail.com+-- Stability : experimental+-- Portability : GHC++module Text.XHtmlCombinators.Attributes.Safe where++import Data.Char (isAsciiLower)++import Data.Text (Text)+import qualified Data.Text as T++import Text.XHtmlCombinators.Internal (Attr (Attr))+import Text.XHtmlCombinators.Escape+import Text.XHtmlCombinators.Attributes.Internal.Safe++attr :: Text -> Text -> Attr+attr name = Attr (T.filter isAsciiLower name) . escapeAttr++-- the following was copied almost verbatim from Bjorn Bringert's xhtml library.+-- See: http://hackage.haskell.org/package/xhtml++-- TODO: Not all attributes are currently available.++action :: Text -> Attr+align :: Text -> Attr+alt :: Text -> Attr+altcode :: Text -> Attr+archive :: Text -> Attr+base :: Text -> Attr+border :: Int -> Attr+bordercolor :: Text -> Attr+cellpadding :: Int -> Attr+cellspacing :: Int -> Attr+checked :: Attr+codebase :: Text -> Attr+cols :: Text -> Attr+colspan :: Int -> Attr+content :: Text -> Attr+coords :: Text -> Attr+disabled :: Attr+enctype :: Text -> Attr+height :: Text -> Attr+href :: Text -> Attr+hreflang :: Text -> Attr+httpEquiv :: Text -> Attr+id_ :: Text -> Attr+ismap :: Attr+lang :: Text -> Attr+maxlength :: Int -> Attr+method :: Text -> Attr+multiple :: Attr+name :: Text -> Attr+nohref :: Attr+rel :: Text -> Attr+rev :: Text -> Attr+rows :: Text -> Attr+rowspan :: Int -> Attr+rules :: Text -> Attr+selected :: Attr+shape :: Text -> Attr+size :: Text -> Attr+src :: Text -> Attr+class_ :: Text -> Attr+for :: Text -> Attr+style :: Text -> Attr+type_ :: Text -> Attr+title :: Text -> Attr+usemap :: Text -> Attr+valign :: Text -> Attr+value :: Text -> Attr+width :: Text -> Attr++action = textAttr "action"+align = textAttr "align"+alt = textAttr "alt"+altcode = textAttr "altcode"+archive = textAttr "archive"+base = textAttr "base"+border = intAttr "border"+bordercolor = textAttr "bordercolor"+cellpadding = intAttr "cellpadding"+cellspacing = intAttr "cellspacing"+checked = emptyAttr "checked"+codebase = textAttr "codebase"+cols = textAttr "cols"+colspan = intAttr "colspan"+content = textAttr "content"+coords = textAttr "coords"+disabled = emptyAttr "disabled"+enctype = textAttr "enctype"+height = textAttr "height"+href = textAttr "href"+hreflang = textAttr "hreflang"+httpEquiv = textAttr "http-equiv"+id_ = textAttr "id"+ismap = emptyAttr "ismap"+lang = textAttr "lang"+maxlength = intAttr "maxlength"+method = textAttr "method"+multiple = emptyAttr "multiple"+name = textAttr "name"+nohref = emptyAttr "nohref"+rel = textAttr "rel"+rev = textAttr "rev"+rows = textAttr "rows"+rowspan = intAttr "rowspan"+rules = textAttr "rules"+selected = emptyAttr "selected"+shape = textAttr "shape"+size = textAttr "size"+src = textAttr "src"+class_ = textAttr "class"+for = textAttr "for"+--style = textAttr "style"+type_ = textAttr "type"+title = textAttr "title"+usemap = textAttr "usemap"+valign = textAttr "valign"+value = textAttr "value"+width = textAttr "width"++-- |+-- Currently data input into the style tag is not+-- escaped.+style = Attr "style"
src/Text/XHtmlCombinators/Combinators.lhs view
@@ -1,11 +1,22 @@-> {-# LANGUAGE OverloadedStrings #-}+> {-# LANGUAGE OverloadedStrings, FlexibleInstances #-}++> -- |+> -- Module : Text.XHtmlCombinators.Combinators+> -- Copyright : (c) Alasdair Armstrong 2010+> -- License : BSD-style+> -- Maintainer : alasdair.armstrong@googlemail.com+> -- Stability : experimental+> -- Portability : GHC+> > module Text.XHtmlCombinators.Combinators where > > import Control.Applicative hiding (empty)-> import Data.Text.Lazy (Text)+> import Data.Sequence (Seq) > import qualified Data.Sequence as Seq-> import qualified Data.Text.Lazy as T >+> import Data.Text (Text)+> import qualified Data.Text as T+> > import Text.XHtmlCombinators.Internal <!--@@ -31,7 +42,7 @@ --> -<!--================ Character mnemonic entities =========================-->+> -- ================ Character mnemonic entities =========================--> <!ENTITY % HTMLlat1 PUBLIC "-//W3C//ENTITIES Latin 1 for XHTML//EN"@@ -48,7 +59,7 @@ "xhtml-special.ent"> %HTMLspecial; -<!--================== Imported Names ====================================-->+> -- ================== Imported Names ====================================--> <!ENTITY % ContentType "CDATA"> <!-- media type, as per [RFC2045] -->@@ -111,7 +122,7 @@ <!ENTITY % Coords "CDATA"> <!-- comma separated list of lengths --> -<!--=================== Generic Attributes ===============================-->+> -- =================== Generic Attributes ===============================--> <!-- core attributes common to most elements id document-wide unique id@@ -176,7 +187,7 @@ <!ENTITY % attrs "%coreattrs; %i18n; %events;"> -<!--=================== Text Elements ====================================-->+> -- =================== Text Elements ====================================--> <!ENTITY % special.pre "br | span | bdo | map">@@ -205,7 +216,7 @@ > class CData c where > cdata :: Text -> c >-> text :: CData c => Text -> XHtml c+> text :: (Functor t, Monad t, CData c) => Text -> XHtmlT t c > text = tellS . cdata > > newtype InlineContent = Inline { inlineToNode :: Node }@@ -222,7 +233,7 @@ > instance Inline InlineContent where inline = Inline > instance Inline FlowContent where inline = Flow -<!--================== Block level elements ==============================-->+> -- ================== Block level elements ==============================--> <!ENTITY % heading "h1|h2|h3|h4|h5|h6"> <!ENTITY % lists "ul | ol | dl">@@ -262,7 +273,7 @@ > instance Flow InlineContent where flow = Inline > instance Flow FlowContent where flow = Flow -<!--================== Content models for exclusions =====================-->+> -- ================== Content models for exclusions =====================--> <!-- a elements use %Inline; excluding a --> @@ -285,7 +296,7 @@ "(#PCDATA | p | %heading; | div | %lists; | %blocktext; | table | %special; | %fontstyle; | %phrase; | %misc;)*"> -<!--================ Document Structure ==================================-->+> -- ================ Document Structure ==================================--> <!-- the namespace URI designates the document profile --> @@ -309,21 +320,24 @@ > xhtml10strict = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\ > \ \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" >+> doctype :: (Functor t, Monad t) => XHtmlT t Page > doctype = tellS . Page . TextNode $ xhtml10strict >+> xmlDec :: (Functor t, Monad t) => XHtmlT t Page > xmlDec = tellS . Page . TextNode $ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" >-> html' :: Bool -- ^ True for XML declaration, false to omit.-> -> Attrs -> XHtml TopLevelContent -> XHtml Page+> html' :: (Functor t, Monad t)+> => Bool -- ^ True for XML declaration, false to omit.+> -> Attrs -> XHtmlT t TopLevelContent -> XHtmlT t Page > html' useXmlDec attrs x = do > if useXmlDec then xmlDec else empty > doctype > tellNode Page "html" [Attr "xmlns" "http://www.w3.org/1999/xhtml"] attrs x >-> html :: Bool -> XHtml TopLevelContent -> XHtml Page+> html :: (Functor t, Monad t) => Bool -> XHtmlT t TopLevelContent -> XHtmlT t Page > html useXmlDec = html' useXmlDec [] -<!--================ Document Head =======================================-->+> -- ================ Document Head =======================================--> <!ENTITY % head.misc "(script|style|meta|link|object)*"> @@ -345,10 +359,10 @@ profile %URI; #IMPLIED > -> head' :: Attrs -> XHtml HeadContent -> XHtml TopLevelContent+> head' :: (Functor t, Monad t) => Attrs -> XHtmlT t HeadContent -> XHtmlT t TopLevelContent > head' = tellNode TopLevel "head" [] >-> head_ :: XHtml HeadContent -> XHtml TopLevelContent+> head_ :: (Functor t, Monad t) => XHtmlT t HeadContent -> XHtmlT t TopLevelContent > head_ = head' [] <!-- The title element is not considered part of the flow of text.@@ -361,10 +375,10 @@ id ID #IMPLIED > -> title' :: Attrs -> Text -> XHtml HeadContent+> title' :: (Functor t, Monad t) => Attrs -> Text -> XHtmlT t HeadContent > title' = tellTextNode Head "title" [] >-> title :: Text -> XHtml HeadContent+> title :: (Functor t, Monad t) => Text -> XHtmlT t HeadContent > title = title' [] <!-- document base URI -->@@ -375,10 +389,10 @@ id ID #IMPLIED > -> base' :: Text -> Attrs -> XHtml HeadContent+> base' :: (Functor t, Monad t) => Text -> Attrs -> XHtmlT t HeadContent > base' href = tellEmptyNode Head "base" [Attr "href" href] >-> base :: Text -> XHtml HeadContent+> base :: (Functor t, Monad t) => Text -> XHtmlT t HeadContent > base = flip base' [] <!-- generic metainformation -->@@ -392,11 +406,11 @@ scheme CDATA #IMPLIED > -> meta' :: Text -- ^ Required content attribute.-> -> Attrs -> XHtml HeadContent+> meta' :: (Functor t, Monad t) => Text -- ^ Required content attribute.+> -> Attrs -> XHtmlT t HeadContent > meta' content = tellEmptyNode Head "meta" [Attr "content" content] >-> meta :: Text -> XHtml HeadContent+> meta :: (Functor t, Monad t) => Text -> XHtmlT t HeadContent > meta = flip meta' [] <!--@@ -425,13 +439,14 @@ media %MediaDesc; #IMPLIED > -> link' :: Attrs -> XHtml HeadContent+> link' :: (Functor t, Monad t) => Attrs -> XHtmlT t HeadContent > link' = tellEmptyNode Head "link" [] >-> link :: XHtml HeadContent+> link :: (Functor t, Monad t) => XHtmlT t HeadContent > link = link' [] > -- ^ 'link' is a bit useless without any attributes, but it's -> -- included anyway for consistency reasons.+> -- included anyway for consistency reasons. As are several+> -- other similar elements. <!-- style info, which may include CDATA sections --> <!ELEMENT style (#PCDATA)>@@ -444,11 +459,11 @@ xml:space (preserve) #FIXED 'preserve' > -> style' :: Text -- ^ Required type attribute.-> -> Attrs -> Text -> XHtml HeadContent-> style' sType = tellTextNode Head "style" [Attr "type" sType]+> style' :: (Functor t, Monad t) => Text -- ^ Required type attribute.+> -> Attrs -> Text -> XHtmlT t HeadContent+> style' type_ = tellTextNode Head "style" [Attr "type" type_] >-> style :: Text -> Text -> XHtml HeadContent+> style :: (Functor t, Monad t) => Text -> Text -> XHtmlT t HeadContent > style = flip style' [] <!-- script statements, which may include CDATA sections -->@@ -462,11 +477,12 @@ xml:space (preserve) #FIXED 'preserve' > -> script' :: Text -- ^ Required type attribute.-> -> Attrs -> Text -> XHtml HeadContent-> script' sType = tellTextNode Head "script" [Attr "type" sType]+> script' :: (Functor t, Monad t) +> => Text -- ^ Required type attribute.+> -> Attrs -> Text -> XHtmlT t HeadContent+> script' type_ = tellTextNode Head "script" [Attr "type" type_] >-> script :: Text -> Text -> XHtml HeadContent+> script :: (Functor t, Monad t) => Text -> Text -> XHtmlT t HeadContent > script = flip script' [] <!-- alternate content container for non script-based rendering -->@@ -476,13 +492,13 @@ %attrs; > -> noscript' :: Block c => Attrs -> XHtml BlockContent -> XHtml c+> noscript' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t BlockContent -> XHtmlT t c > noscript' = tellNode block "noscript" [] >-> noscript :: Block c => XHtml BlockContent -> XHtml c+> noscript :: (Functor t, Monad t, Block c) => XHtmlT t BlockContent -> XHtmlT t c > noscript = noscript' [] -<!--=================== Document Body ====================================-->+> -- =================== Document Body ====================================--> <!ELEMENT body %Block;> <!ATTLIST body@@ -491,10 +507,10 @@ onunload %Script; #IMPLIED > -> body' :: Attrs -> XHtml BlockContent -> XHtml TopLevelContent+> body' :: (Functor t, Monad t) => Attrs -> XHtmlT t BlockContent -> XHtmlT t TopLevelContent > body' = tellNode TopLevel "body" [] >-> body :: XHtml BlockContent -> XHtml TopLevelContent+> body :: (Functor t, Monad t) => XHtmlT t BlockContent -> XHtmlT t TopLevelContent > body = body' [] <!ELEMENT div %Flow;> <!-- generic language/style container -->@@ -502,26 +518,26 @@ %attrs; > -> div' :: Block c => Attrs -> XHtml FlowContent -> XHtml c+> div' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t FlowContent -> XHtmlT t c > div' = tellNode block "div" [] > -> div_ :: Block c => XHtml FlowContent -> XHtml c+> div_ :: (Functor t, Monad t, Block c) => XHtmlT t FlowContent -> XHtmlT t c > div_ = div' [] -<!--=================== Paragraphs =======================================-->+> -- =================== Paragraphs =======================================--> <!ELEMENT p %Inline;> <!ATTLIST p %attrs; > -> p' :: Block c => Attrs -> XHtml InlineContent -> XHtml c+> p' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > p' = tellNode block "p" [] >-> p :: Block c => XHtml InlineContent -> XHtml c+> p :: (Functor t, Monad t, Block c) => XHtmlT t InlineContent -> XHtmlT t c > p = p' [] -<!--=================== Headings =========================================-->+> -- =================== Headings =========================================--> <!-- There are six levels of headings from h1 (the most important)@@ -533,10 +549,10 @@ %attrs; > -> h1' :: Block c => Attrs -> XHtml InlineContent -> XHtml c+> h1' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > h1' = tellNode block "h1" [] >-> h1 :: Block c => XHtml InlineContent -> XHtml c+> h1 :: (Functor t, Monad t, Block c) => XHtmlT t InlineContent -> XHtmlT t c > h1 = h1' [] <!ELEMENT h2 %Inline;>@@ -544,10 +560,10 @@ %attrs; > -> h2' :: Block c => Attrs -> XHtml InlineContent -> XHtml c+> h2' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > h2' = tellNode block "h2" [] >-> h2 :: Block c => XHtml InlineContent -> XHtml c+> h2 :: (Functor t, Monad t, Block c) => XHtmlT t InlineContent -> XHtmlT t c > h2 = h2' [] <!ELEMENT h3 %Inline;>@@ -555,10 +571,10 @@ %attrs; > -> h3' :: Block c => Attrs -> XHtml InlineContent -> XHtml c+> h3' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > h3' = tellNode block "h3" [] >-> h3 :: Block c => XHtml InlineContent -> XHtml c+> h3 :: (Functor t, Monad t, Block c) => XHtmlT t InlineContent -> XHtmlT t c > h3 = h3' [] <!ELEMENT h4 %Inline;>@@ -566,10 +582,10 @@ %attrs; > -> h4' :: Block c => Attrs -> XHtml InlineContent -> XHtml c+> h4' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > h4' = tellNode block "h4" [] >-> h4 :: Block c => XHtml InlineContent -> XHtml c+> h4 :: (Functor t, Monad t, Block c) => XHtmlT t InlineContent -> XHtmlT t c > h4 = h4' [] <!ELEMENT h5 %Inline;>@@ -577,10 +593,10 @@ %attrs; > -> h5' :: Block c => Attrs -> XHtml InlineContent -> XHtml c+> h5' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > h5' = tellNode block "h5" [] >-> h5 :: Block c => XHtml InlineContent -> XHtml c+> h5 :: (Functor t, Monad t, Block c) => XHtmlT t InlineContent -> XHtmlT t c > h5 = h5' [] <!ELEMENT h6 %Inline;>@@ -588,13 +604,13 @@ %attrs; > -> h6' :: Block c => Attrs -> XHtml InlineContent -> XHtml c+> h6' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > h6' = tellNode block "h6" [] >-> h6 :: Block c => XHtml InlineContent -> XHtml c+> h6 :: (Functor t, Monad t, Block c) => XHtmlT t InlineContent -> XHtmlT t c > h6 = h6' [] -<!--=================== Lists ============================================-->+> -- =================== Lists ============================================--> <!-- Unordered list --> @@ -608,10 +624,10 @@ %attrs; > -> ul' :: Block c => Attrs -> XHtml ListContent -> XHtml c+> ul' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t ListContent -> XHtmlT t c > ul' = tellNode block "ul" [] >-> ul :: Block c => XHtml ListContent -> XHtml c+> ul :: (Functor t, Monad t, Block c) => XHtmlT t ListContent -> XHtmlT t c > ul = ul' [] <!-- Ordered (numbered) list -->@@ -621,10 +637,10 @@ %attrs; > -> ol' :: Block c => Attrs -> XHtml ListContent -> XHtml c+> ol' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t ListContent -> XHtmlT t c > ol' = tellNode block "ol" [] >-> ol :: Block c => XHtml ListContent -> XHtml c+> ol :: (Functor t, Monad t, Block c) => XHtmlT t ListContent -> XHtmlT t c > ol = ol' [] <!-- list item -->@@ -634,10 +650,10 @@ %attrs; > -> li' :: Attrs -> XHtml FlowContent -> XHtml ListContent+> li' :: (Functor t, Monad t) => Attrs -> XHtmlT t FlowContent -> XHtmlT t ListContent > li' = tellNode List "li" [] >-> li :: XHtml FlowContent -> XHtml ListContent+> li :: (Functor t, Monad t) => XHtmlT t FlowContent -> XHtmlT t ListContent > li = li' [] <!-- definition lists - dt for term, dd for its definition -->@@ -653,10 +669,10 @@ %attrs; > -> dl' :: Block c => Attrs -> XHtml DefinitionListContent -> XHtml c+> dl' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t DefinitionListContent -> XHtmlT t c > dl' = tellNode block "dl" [] >-> dl :: Block c => XHtml DefinitionListContent -> XHtml c+> dl :: (Functor t, Monad t, Block c) => XHtmlT t DefinitionListContent -> XHtmlT t c > dl = dl' [] <!ELEMENT dt %Inline;>@@ -664,10 +680,10 @@ %attrs; > -> dt' :: Attrs -> XHtml InlineContent -> XHtml DefinitionListContent+> dt' :: (Functor t, Monad t) => Attrs -> XHtmlT t InlineContent -> XHtmlT t DefinitionListContent > dt' = tellNode DefinitionList "dt" [] >-> dt :: XHtml InlineContent -> XHtml DefinitionListContent+> dt :: (Functor t, Monad t) => XHtmlT t InlineContent -> XHtmlT t DefinitionListContent > dt = dt' [] <!ELEMENT dd %Flow;>@@ -675,13 +691,13 @@ %attrs; > -> dd' :: Attrs -> XHtml InlineContent -> XHtml DefinitionListContent+> dd' :: (Functor t, Monad t) => Attrs -> XHtmlT t InlineContent -> XHtmlT t DefinitionListContent > dd' = tellNode DefinitionList "dd" [] >-> dd :: XHtml InlineContent -> XHtml DefinitionListContent+> dd :: (Functor t, Monad t) => XHtmlT t InlineContent -> XHtmlT t DefinitionListContent > dd = dd' [] -<!--=================== Address ==========================================-->+> -- =================== Address ==========================================--> <!-- information on author --> @@ -690,26 +706,26 @@ %attrs; > -> address' :: Block c => Attrs -> XHtml InlineContent -> XHtml c+> address' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > address' = tellNode block "address" [] >-> address :: Block c => XHtml InlineContent -> XHtml c+> address :: (Functor t, Monad t, Block c) => XHtmlT t InlineContent -> XHtmlT t c > address = address' [] -<!--=================== Horizontal Rule ==================================-->+> -- =================== Horizontal Rule ==================================--> <!ELEMENT hr EMPTY> <!ATTLIST hr %attrs; > -> hr' :: Block c => Attrs -> XHtml c+> hr' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t c > hr' = tellEmptyNode block "hr" [] >-> hr :: Block c => XHtml c+> hr :: (Functor t, Monad t, Block c) => XHtmlT t c > hr = hr' [] -<!--=================== Preformatted Text ================================-->+> -- =================== Preformatted Text ================================--> <!-- content is %Inline; excluding "img|object|big|small|sub|sup" --> @@ -719,13 +735,13 @@ xml:space (preserve) #FIXED 'preserve' > -> pre' :: Block c => Attrs -> XHtml InlineContent -> XHtml c+> pre' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > pre' = tellNode block "pre" [] >-> pre :: Block c => XHtml InlineContent -> XHtml c+> pre :: (Functor t, Monad t, Block c) => XHtmlT t InlineContent -> XHtmlT t c > pre = pre' [] -<!--=================== Block-like Quotes ================================-->+> -- =================== Block-like Quotes ================================--> <!ELEMENT blockquote %Block;> <!ATTLIST blockquote@@ -733,13 +749,13 @@ cite %URI; #IMPLIED > -> blockquote' :: Block c => Attrs -> XHtml BlockContent -> XHtml c+> blockquote' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t BlockContent -> XHtmlT t c > blockquote' = tellNode block "blockquote" [] >-> blockquote :: Block c => XHtml BlockContent -> XHtml c+> blockquote :: (Functor t, Monad t, Block c) => XHtmlT t BlockContent -> XHtmlT t c > blockquote = blockquote' [] -<!--=================== Inserted/Deleted Text ============================-->+> -- =================== Inserted/Deleted Text ============================--> <!-- ins/del are allowed in block and inline content, but its@@ -753,10 +769,10 @@ datetime %Datetime; #IMPLIED > -> ins' :: (Flow c, Content c) => Attrs -> XHtml c -> XHtml c+> ins' :: (Functor t, Monad t) => (Flow c, Content c) => Attrs -> XHtmlT t c -> XHtmlT t c > ins' = tellNode flow "ins" [] >-> ins :: (Flow c, Content c) => XHtml c -> XHtml c+> ins :: (Functor t, Monad t) => (Flow c, Content c) => XHtmlT t c -> XHtmlT t c > ins = ins' [] <!ELEMENT del %Flow;>@@ -766,13 +782,13 @@ datetime %Datetime; #IMPLIED > -> del' :: (Flow c, Content c) => Attrs -> XHtml c -> XHtml c+> del' :: (Functor t, Monad t) => (Flow c, Content c) => Attrs -> XHtmlT t c -> XHtmlT t c > del' = tellNode flow "del" [] >-> del :: (Flow c, Content c) => XHtml c -> XHtml c+> del :: (Functor t, Monad t) => (Flow c, Content c) => XHtmlT t c -> XHtmlT t c > del = del' [] -<!--================== The Anchor Element ================================-->+> -- ================== The Anchor Element ================================--> <!-- content is %Inline; except that anchors shouldn't be nested --> @@ -791,23 +807,23 @@ coords %Coords; #IMPLIED > -> a' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> a' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > a' = tellNode inline "a" [] >-> a :: Inline c => XHtml InlineContent -> XHtml c+> a :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > a = a' [] -<!--===================== Inline Elements ================================-->+> -- ===================== Inline Elements ================================--> <!ELEMENT span %Inline;> <!-- generic language/style container --> <!ATTLIST span %attrs; > -> span' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> span' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > span' = tellNode inline "span" [] >-> span_ :: Inline c => XHtml InlineContent -> XHtml c+> span_ :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > span_ = span' [] <!ELEMENT bdo %Inline;> <!-- I18N BiDi over-ride -->@@ -819,12 +835,12 @@ dir (ltr|rtl) #REQUIRED > -> bdo' :: Inline c +> bdo' :: (Functor t, Monad t, Inline c) > => Text -- ^ Required language direction code.-> -> Attrs -> XHtml InlineContent -> XHtml c+> -> Attrs -> XHtmlT t InlineContent -> XHtmlT t c > bdo' dir = tellNode inline "bdo" [Attr "dir" dir] >-> bdo :: Inline c => Text -> XHtml InlineContent -> XHtml c+> bdo :: (Functor t, Monad t, Inline c) => Text -> XHtmlT t InlineContent -> XHtmlT t c > bdo = flip bdo' [] <!ELEMENT br EMPTY> <!-- forced line break -->@@ -832,100 +848,100 @@ %coreattrs; > -> br' :: Inline c => Attrs -> XHtml c+> br' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t c > br' = tellEmptyNode inline "br" [] >-> br :: Inline c => XHtml c+> br :: (Functor t, Monad t, Inline c) => XHtmlT t c > br = br' [] <!ELEMENT em %Inline;> <!-- emphasis --> <!ATTLIST em %attrs;> -> em' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> em' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > em' = tellNode inline "em" [] >-> em :: Inline c => XHtml InlineContent -> XHtml c+> em :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > em = em' [] <!ELEMENT strong %Inline;> <!-- strong emphasis --> <!ATTLIST strong %attrs;> -> strong' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> strong' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > strong' = tellNode inline "strong" [] >-> strong :: Inline c => XHtml InlineContent -> XHtml c+> strong :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > strong = strong' [] <!ELEMENT dfn %Inline;> <!-- definitional --> <!ATTLIST dfn %attrs;> -> dfn' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> dfn' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > dfn' = tellNode inline "dfn" [] >-> dfn :: Inline c => XHtml InlineContent -> XHtml c+> dfn :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > dfn = dfn' [] <!ELEMENT code %Inline;> <!-- program code --> <!ATTLIST code %attrs;> -> code' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> code' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > code' = tellNode inline "code" [] >-> code :: Inline c => XHtml InlineContent -> XHtml c+> code :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > code = code' [] <!ELEMENT samp %Inline;> <!-- sample --> <!ATTLIST samp %attrs;> -> samp' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> samp' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > samp' = tellNode inline "samp" [] >-> samp :: Inline c => XHtml InlineContent -> XHtml c+> samp :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > samp = samp' [] <!ELEMENT kbd %Inline;> <!-- something user would type --> <!ATTLIST kbd %attrs;> -> kbd' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> kbd' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > kbd' = tellNode inline "kbd" [] >-> kbd :: Inline c => XHtml InlineContent -> XHtml c+> kbd :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > kbd = kbd' [] <!ELEMENT var %Inline;> <!-- variable --> <!ATTLIST var %attrs;> -> var' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> var' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > var' = tellNode inline "var" [] >-> var :: Inline c => XHtml InlineContent -> XHtml c+> var :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > var = var' [] <!ELEMENT cite %Inline;> <!-- citation --> <!ATTLIST cite %attrs;> -> cite' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> cite' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > cite' = tellNode inline "cite" [] >-> cite :: Inline c => XHtml InlineContent -> XHtml c+> cite :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > cite = cite' [] <!ELEMENT abbr %Inline;> <!-- abbreviation --> <!ATTLIST abbr %attrs;> -> abbr' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> abbr' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > abbr' = tellNode inline "abbr" [] >-> abbr :: Inline c => XHtml InlineContent -> XHtml c+> abbr :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > abbr = abbr' [] <!ELEMENT acronym %Inline;> <!-- acronym --> <!ATTLIST acronym %attrs;> -> acronym' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> acronym' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > acronym' = tellNode inline "acronym" [] >-> acronym :: Inline c => XHtml InlineContent -> XHtml c+> acronym :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > acronym = acronym' [] <!ELEMENT q %Inline;> <!-- inlined quote -->@@ -934,76 +950,76 @@ cite %URI; #IMPLIED > -> q' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> q' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > q' = tellNode inline "q" [] >-> q :: Inline c => XHtml InlineContent -> XHtml c+> q :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > q = q' [] <!ELEMENT sub %Inline;> <!-- subscript --> <!ATTLIST sub %attrs;> -> sub' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> sub' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > sub' = tellNode inline "sub" [] >-> sub :: Inline c => XHtml InlineContent -> XHtml c+> sub :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > sub = sub' [] <!ELEMENT sup %Inline;> <!-- superscript --> <!ATTLIST sup %attrs;> -> sup' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> sup' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > sup' = tellNode inline "sup" [] >-> sup :: Inline c => XHtml InlineContent -> XHtml c+> sup :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > sup = sup' [] <!ELEMENT tt %Inline;> <!-- fixed pitch font --> <!ATTLIST tt %attrs;> -> tt' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> tt' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > tt' = tellNode inline "tt" [] >-> tt :: Inline c => XHtml InlineContent -> XHtml c+> tt :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > tt = tt' [] <!ELEMENT i %Inline;> <!-- italic font --> <!ATTLIST i %attrs;> -> i' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> i' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > i' = tellNode inline "i" [] >-> i :: Inline c => XHtml InlineContent -> XHtml c+> i :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > i = i' [] <!ELEMENT b %Inline;> <!-- bold font --> <!ATTLIST b %attrs;> -> b' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> b' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > b' = tellNode inline "b" [] >-> b :: Inline c => XHtml InlineContent -> XHtml c+> b :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > b = b' [] <!ELEMENT big %Inline;> <!-- bigger font --> <!ATTLIST big %attrs;> -> big' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> big' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > big' = tellNode inline "big" [] >-> big :: Inline c => XHtml InlineContent -> XHtml c+> big :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > big = big' [] <!ELEMENT small %Inline;> <!-- smaller font --> <!ATTLIST small %attrs;> -> small' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> small' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > small' = tellNode inline "small" [] >-> small :: Inline c => XHtml InlineContent -> XHtml c+> small :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > small = small' [] -<!--==================== Object ======================================-->+> -- ==================== Object ======================================--> > newtype ObjectContent = Object { objectToNode :: Node } >@@ -1039,10 +1055,10 @@ tabindex %Number; #IMPLIED > -> object' :: Flow c => Attrs -> XHtml ObjectContent -> XHtml c+> object' :: (Functor t, Monad t, Flow c) => Attrs -> XHtmlT t ObjectContent -> XHtmlT t c > object' = tellNode flow "object" [] >-> object :: Flow c => XHtml ObjectContent -> XHtml c+> object :: (Functor t, Monad t, Flow c) => XHtmlT t ObjectContent -> XHtmlT t c > object = object' [] <!--@@ -1060,13 +1076,13 @@ type %ContentType; #IMPLIED > -> param' :: Attrs -> XHtml ObjectContent+> param' :: (Functor t, Monad t) => Attrs -> XHtmlT t ObjectContent > param' = tellEmptyNode Object "param" [] >-> param :: XHtml ObjectContent+> param :: (Functor t, Monad t) => XHtmlT t ObjectContent > param = param' [] -<!--=================== Images ===========================================-->+> -- =================== Images ===========================================--> <!-- To avoid accessibility problems for people who aren't@@ -1089,19 +1105,19 @@ ismap (ismap) #IMPLIED > -> img' :: Flow c +> img' :: (Functor t, Monad t, Flow c) > => Text -- ^ Required src attribute. > -> Text -- ^ Required alt attribute.-> -> Attrs -> XHtml c+> -> Attrs -> XHtmlT t c > img' src alt = tellEmptyNode flow "img" [] >-> img :: Flow c => Text -> Text -> XHtml c+> img :: (Functor t, Monad t, Flow c) => Text -> Text -> XHtmlT t c > img src alt = img' src alt [Attr "src" src, Attr "alt" alt] <!-- usemap points to a map element which may be in this document or an external document, although the latter is not widely supported --> -<!--================== Client-side image maps ============================-->+> -- ================== Client-side image maps ============================--> > newtype MapContent = Map { mapToNode :: Node } >@@ -1126,12 +1142,12 @@ name NMTOKEN #IMPLIED > -> map' :: Flow c +> map' :: (Functor t, Monad t, Flow c) > => Text -- ^ Required id attribute. -> -> Attrs -> XHtml MapContent -> XHtml c+> -> Attrs -> XHtmlT t MapContent -> XHtmlT t c > map' id = tellNode flow "map" [Attr "id" id] >-> map_ :: Flow c => Text -> XHtml MapContent -> XHtml c+> map_ :: (Functor t, Monad t, Flow c) => Text -> XHtmlT t MapContent -> XHtmlT t c > map_ = flip map' [] <!ELEMENT area EMPTY>@@ -1145,14 +1161,14 @@ alt %Text; #REQUIRED > -> area' :: Text -- ^ Required alt attribute.-> -> Attrs -> XHtml MapContent+> area' :: (Functor t, Monad t) => Text -- ^ Required alt attribute.+> -> Attrs -> XHtmlT t MapContent > area' alt = tellEmptyNode Map "area" [Attr "alt" alt] >-> area :: Text -> XHtml MapContent+> area :: (Functor t, Monad t) => Text -> XHtmlT t MapContent > area = flip area' [] -<!--================ Forms ===============================================-->+> -- ================ Forms ===============================================--> <!ELEMENT form %form.content;> <!-- forms shouldn't be nested --> @@ -1167,12 +1183,12 @@ accept-charset %Charsets; #IMPLIED > -> form' :: Block c +> form' :: (Functor t, Monad t, Block c) > => Text -- ^ Required action attribute. -> -> Attrs -> XHtml FlowContent -> XHtml c+> -> Attrs -> XHtmlT t FlowContent -> XHtmlT t c > form' action = tellNode block "form" [Attr "action" action] >-> form :: Block c => Text -> XHtml FlowContent -> XHtml c+> form :: (Functor t, Monad t, Block c) => Text -> XHtmlT t FlowContent -> XHtmlT t c > form = flip form' [] <!--@@ -1188,10 +1204,10 @@ onblur %Script; #IMPLIED > -> label' :: Inline c => Attrs -> XHtml InlineContent -> XHtml c+> label' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t InlineContent -> XHtmlT t c > label' = tellNode inline "label" [] >-> label :: Inline c => XHtml InlineContent -> XHtml c+> label :: (Functor t, Monad t, Inline c) => XHtmlT t InlineContent -> XHtmlT t c > label = label' [] <!ENTITY % InputType@@ -1222,10 +1238,10 @@ accept %ContentTypes; #IMPLIED > -> input' :: Inline c => Attrs -> XHtml c+> input' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t c > input' = tellEmptyNode inline "input" [] >-> input :: Inline c => XHtml c+> input :: (Functor t, Monad t, Inline c) => XHtmlT t c > input = input' [] <!ELEMENT select (optgroup|option)+> <!-- option selector -->@@ -1246,10 +1262,10 @@ > instance Content OptionContent where > toContent = optionToNode >-> select' :: Inline c => Attrs -> XHtml OptionContent -> XHtml c +> select' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t OptionContent -> XHtmlT t c > select' = tellNode inline "select" [] >-> select :: Inline c => XHtml OptionContent -> XHtml c+> select :: (Functor t, Monad t, Inline c) => XHtmlT t OptionContent -> XHtmlT t c > select = select' [] <!ELEMENT optgroup (option)+> <!-- option group -->@@ -1259,11 +1275,11 @@ label %Text; #REQUIRED > -> optgroup' :: Text -- ^ Required label attribute. -> -> Attrs -> XHtml OptionContent -> XHtml OptionContent+> optgroup' :: (Functor t, Monad t) => Text -- ^ Required label attribute. +> -> Attrs -> XHtmlT t OptionContent -> XHtmlT t OptionContent > optgroup' label = tellNode Option "optgroup" [Attr "label" label] >-> optgroup :: Text -> XHtml OptionContent -> XHtml OptionContent+> optgroup :: (Functor t, Monad t) => Text -> XHtmlT t OptionContent -> XHtmlT t OptionContent > optgroup = flip optgroup' [] <!ELEMENT option (#PCDATA)> <!-- selectable choice -->@@ -1275,10 +1291,10 @@ value CDATA #IMPLIED > -> option' :: Attrs -> Text -> XHtml OptionContent+> option' :: (Functor t, Monad t) => Attrs -> Text -> XHtmlT t OptionContent > option' = tellTextNode Option "option" [] >-> option :: Text -> XHtml OptionContent+> option :: (Functor t, Monad t) => Text -> XHtmlT t OptionContent > option = option' [] <!ELEMENT textarea (#PCDATA)> <!-- multi-line text field -->@@ -1294,16 +1310,16 @@ onchange %Script; #IMPLIED > -> textarea' :: Inline c+> textarea' :: (Functor t, Monad t, Inline c) > => Int -- ^ Required rows attribute. > -> Int -- ^ Required cols attribute.-> -> Attrs -> Text -> XHtml c+> -> Attrs -> Text -> XHtmlT t c > textarea' rows cols = tellTextNode inline "textarea" > [ Attr "rows" (T.pack (show rows)) > , Attr "cols" (T.pack (show cols)) > ] > -> textarea :: Inline c => Int -> Int -> Text -> XHtml c+> textarea :: (Functor t, Monad t, Inline c) => Int -> Int -> Text -> XHtmlT t c > textarea rows cols = textarea' rows cols [] <!--@@ -1325,10 +1341,10 @@ > instance Inline FieldSetContent where inline = FieldSet > instance Block FieldSetContent where block = FieldSet -> fieldset' :: Block c => Attrs -> XHtml FieldSetContent -> XHtml c+> fieldset' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t FieldSetContent -> XHtmlT t c > fieldset' = tellNode block "fieldset" [] >-> fieldset :: Block c => XHtml FieldSetContent -> XHtml c+> fieldset :: (Functor t, Monad t, Block c) => XHtmlT t FieldSetContent -> XHtmlT t c > fieldset = fieldset' [] <!ELEMENT legend %Inline;> <!-- fieldset label -->@@ -1337,10 +1353,10 @@ accesskey %Character; #IMPLIED > -> legend' :: Attrs -> XHtml InlineContent -> XHtml FieldSetContent +> legend' :: (Functor t, Monad t) => Attrs -> XHtmlT t InlineContent -> XHtmlT t FieldSetContent > legend' = tellNode FieldSet "legend" [] >-> legend :: XHtml InlineContent -> XHtml FieldSetContent+> legend :: (Functor t, Monad t) => XHtmlT t InlineContent -> XHtmlT t FieldSetContent > legend = legend' [] <!--@@ -1356,13 +1372,13 @@ disabled (disabled) #IMPLIED > -> button' :: Inline c => Attrs -> XHtml FlowContent -> XHtml c+> button' :: (Functor t, Monad t, Inline c) => Attrs -> XHtmlT t FlowContent -> XHtmlT t c > button' = tellNode inline "button" [] >-> button :: Inline c => XHtml FlowContent -> XHtml c+> button :: (Functor t, Monad t, Inline c) => XHtmlT t FlowContent -> XHtmlT t c > button = button' [] -<!--======================= Tables =======================================-->+> -- ======================= Tables =======================================--> <!-- Derived from IETF HTML table standard, see [RFC1942] --> @@ -1424,82 +1440,82 @@ <!ELEMENT table (caption?, (col*|colgroup*), thead?, tfoot?, (tbody+|tr+))> -> table' :: Block c => Attrs -> XHtml Table1Content -> XHtml c+> table' :: (Functor t, Monad t, Block c) => Attrs -> XHtmlT t Table1Content -> XHtmlT t c > table' = tellNode block "table" [] > -> table :: Block c => XHtml Table1Content -> XHtml c+> table :: (Functor t, Monad t, Block c) => XHtmlT t Table1Content -> XHtmlT t c > table = table' [] <!ELEMENT caption %Inline;> -> caption' :: Attrs -> XHtml InlineContent -> XHtml Table1Content+> caption' :: (Functor t, Monad t) => Attrs -> XHtmlT t InlineContent -> XHtmlT t Table1Content > caption' = tellNode Table1 "caption" [] >-> caption :: XHtml InlineContent -> XHtml Table1Content+> caption :: (Functor t, Monad t) => XHtmlT t InlineContent -> XHtmlT t Table1Content > caption = caption' [] <!ELEMENT thead (tr)+> -> thead' :: Attrs -> XHtml Table2Content -> XHtml Table1Content+> thead' :: (Functor t, Monad t) => Attrs -> XHtmlT t Table2Content -> XHtmlT t Table1Content > thead' = tellNode Table1 "thead" [] >-> thead :: XHtml Table2Content -> XHtml Table1Content+> thead :: (Functor t, Monad t) => XHtmlT t Table2Content -> XHtmlT t Table1Content > thead = thead' [] <!ELEMENT tfoot (tr)+> -> tfoot' :: Attrs -> XHtml Table2Content -> XHtml Table1Content+> tfoot' :: (Functor t, Monad t) => Attrs -> XHtmlT t Table2Content -> XHtmlT t Table1Content > tfoot' = tellNode Table1 "tfoot" [] >-> tfoot :: XHtml Table2Content -> XHtml Table1Content+> tfoot :: (Functor t, Monad t) => XHtmlT t Table2Content -> XHtmlT t Table1Content > tfoot = tfoot' [] <!ELEMENT tbody (tr)+> -> tbody' :: Attrs -> XHtml Table2Content -> XHtml Table1Content+> tbody' :: (Functor t, Monad t) => Attrs -> XHtmlT t Table2Content -> XHtmlT t Table1Content > tbody' = tellNode Table1 "tbody" [] >-> tbody :: XHtml Table2Content -> XHtml Table1Content+> tbody :: (Functor t, Monad t) => XHtmlT t Table2Content -> XHtmlT t Table1Content > tbody = tbody' [] <!ELEMENT colgroup (col)*> -> colgroup' :: Attrs -> XHtml TableColContent -> XHtml Table1Content+> colgroup' :: (Functor t, Monad t) => Attrs -> XHtmlT t TableColContent -> XHtmlT t Table1Content > colgroup' = tellNode Table1 "colgroup" [] >-> colgroup :: XHtml TableColContent -> XHtml Table1Content+> colgroup :: (Functor t, Monad t) => XHtmlT t TableColContent -> XHtmlT t Table1Content > colgroup = colgroup' [] <!ELEMENT col EMPTY> -> col' :: Attrs -> XHtml TableColContent+> col' :: (Functor t, Monad t) => Attrs -> XHtmlT t TableColContent > col' = tellEmptyNode TableCol "col" [] >-> col :: XHtml TableColContent+> col :: (Functor t, Monad t) => XHtmlT t TableColContent > col = col' [] <!ELEMENT tr (th|td)+> -> tr' :: Attrs -> XHtml Table3Content -> XHtml Table2Content+> tr' :: (Functor t, Monad t) => Attrs -> XHtmlT t Table3Content -> XHtmlT t Table2Content > tr' = tellNode Table2 "tr" [] > -> tr :: XHtml Table3Content -> XHtml Table2Content+> tr :: (Functor t, Monad t) => XHtmlT t Table3Content -> XHtmlT t Table2Content > tr = tr' [] <!ELEMENT th %Flow;> -> th' :: Attrs -> XHtml FlowContent -> XHtml Table3Content+> th' :: (Functor t, Monad t) => Attrs -> XHtmlT t FlowContent -> XHtmlT t Table3Content > th' = tellNode Table3 "th" [] >-> th :: XHtml FlowContent -> XHtml Table3Content+> th :: (Functor t, Monad t) => XHtmlT t FlowContent -> XHtmlT t Table3Content > th = th' [] <!ELEMENT td %Flow;> -> td' :: Attrs -> XHtml FlowContent -> XHtml Table3Content+> td' :: (Functor t, Monad t) => Attrs -> XHtmlT t FlowContent -> XHtmlT t Table3Content > td' = tellNode Table3 "td" [] >-> td :: XHtml FlowContent -> XHtml Table3Content+> td :: (Functor t, Monad t) => XHtmlT t FlowContent -> XHtmlT t Table3Content > td = td' [] <!ATTLIST table
+ src/Text/XHtmlCombinators/Escape.hs view
@@ -0,0 +1,344 @@+{-# LANGUAGE OverloadedStrings, PatternGuards #-}++-- | +-- Module : Text.XHtmlCombinators.Escape+-- Copyright : (c) Jasper Van der Jeugt 2009,+-- (c) Alasdair Armstrong 2010+-- License : BSD-style+-- Maintainer : alasdair.armstrong@googlemail.com+-- Stability : experimental+-- Portability : GHC+-- +-- Escaping is based on the ESAPI project+-- (see 'http://www.owasp.org/index.php/ESAPI')++module Text.XHtmlCombinators.Escape + ( escape+ , escapeAttr+ , escapeJavaScript+ , escapeCSS+ ) where++import Data.Char (toUpper)+import qualified Data.IntMap as I+import Numeric (showHex)++import Data.Text (Text)+import qualified Data.Text as T++-- | Escaping text in generic HTML elements+escape :: Text -> Text+escape = escapeEntity htmlImmune+ where htmlImmune = ",.-_ "+ +-- | Escaping text in attribute values+escapeAttr :: Text -> Text+escapeAttr = escapeEntity attributeImmune+ where attributeImmune = ",.-_"++-- | escaping basic text the be used inside normal HTML-elements +-- based on 'http://code.google.com/p/owasp-esapi-java/source/browse/trunk/src/main/java/org/owasp/esapi/codecs/HTMLEntityCodec.java'+--+-- Should be improved by using an array-based lookup for chars <=0xff+escapeEntity :: String -> Text -> Text+escapeEntity immune = T.concatMap $ escapeChar immune encode+ where + encode c + | Just ent <- I.lookup (fromEnum c) entityMap + = T.concat ["&", ent, ";"]+ | otherwise = T.pack $ concat ["&#", hex c , ";"]+ +-- | Escaping text intended for places where scripts can be used +escapeJavaScript :: Text -> Text+escapeJavaScript = T.concatMap $ escapeChar javaScriptImmune encode+ where + encode c + | c <= toEnum 0xff = T.pack $ concat ["\\x", pad 2 $ hex c]+ | c <= toEnum 0xffff = T.pack $ concat ["\\u", pad 4 $ hex c]+ | c <= toEnum 0xffffff = T.pack $ concat ["\\u", pad 6 $ hex c]+ | otherwise = T.pack $ concat ["\\u", pad 8 $ hex c]+ + javaScriptImmune = ",._"+ + pad n hex = reverse . take n $ reverse hex ++ repeat '0'++-- | Escape text for CSS (style) data +escapeCSS :: Text -> Text+escapeCSS = T.concatMap $ escapeChar "" encode+ where+ encode c = T.pack $ concat ["\\", hex c, " "]++-- | Escape a single character +escapeChar :: + [Char] -- ^ Lists of chars to be used verbatim+ -> (Char -> Text) -- ^ function handling non standard cases+ -> Char -- ^ char to encode+ -> Text +escapeChar immune enc c + | c `elem` immune = T.singleton c+ | c >= toEnum 0x30 && c <= toEnum 0x39 = T.singleton c+ | c >= toEnum 0x41 && c <= toEnum 0x5A = T.singleton c+ | c >= toEnum 0x61 && c <= toEnum 0x7A = T.singleton c+ | c `elem` "\t\n\r" = T.singleton c+ | c <= toEnum 0x1f = " "+ | c >= toEnum 0x7f && c <= toEnum 0x9f = " " + | otherwise = enc c+ +hex :: Char -> String +hex c = map toUpper $ showHex (fromEnum c) [] + +entityMap :: I.IntMap Text+entityMap = I.fromList [+ (34, "quot") {- quotation mark -}, + (38, "amp") {- ampersand -}, + (60, "lt") {- less-than sign -}, + (62, "gt") {- greater-than sign -}, + (160, "nbsp") {- no-break space -}, + (161, "iexcl") {- inverted exclamation mark -}, + (162, "cent") {- cent sign -}, + (163, "pound") {- pound sign -}, + (164, "curren") {- currency sign -}, + (165, "yen") {- yen sign -}, + (166, "brvbar") {- broken bar -}, + (167, "sect") {- section sign -}, + (168, "uml") {- diaeresis -}, + (169, "copy") {- copyright sign -}, + (170, "ordf") {- feminine ordinal indicator -}, + (171, "laquo") {- left-pointing double angle quotation mark -}, + (172, "not") {- not sign -}, + (173, "shy") {- soft hyphen -}, + (174, "reg") {- registered sign -}, + (175, "macr") {- macron -}, + (176, "deg") {- degree sign -}, + (177, "plusmn") {- plus-minus sign -}, + (178, "sup2") {- superscript two -}, + (179, "sup3") {- superscript three -}, + (180, "acute") {- acute accent -}, + (181, "micro") {- micro sign -}, + (182, "para") {- pilcrow sign -}, + (183, "middot") {- middle dot -}, + (184, "cedil") {- cedilla -}, + (185, "sup1") {- superscript one -}, + (186, "ordm") {- masculine ordinal indicator -}, + (187, "raquo") {- right-pointing double angle quotation mark -}, + (188, "frac14") {- vulgar fraction one quarter -}, + (189, "frac12") {- vulgar fraction one half -}, + (190, "frac34") {- vulgar fraction three quarters -}, + (191, "iquest") {- inverted question mark -}, + (192, "Agrave") {- Latin capital letter a with grave -}, + (193, "Aacute") {- Latin capital letter a with acute -}, + (194, "Acirc") {- Latin capital letter a with circumflex -}, + (195, "Atilde") {- Latin capital letter a with tilde -}, + (196, "Auml") {- Latin capital letter a with diaeresis -}, + (197, "Aring") {- Latin capital letter a with ring above -}, + (198, "AElig") {- Latin capital letter ae -}, + (199, "Ccedil") {- Latin capital letter c with cedilla -}, + (200, "Egrave") {- Latin capital letter e with grave -}, + (201, "Eacute") {- Latin capital letter e with acute -}, + (202, "Ecirc") {- Latin capital letter e with circumflex -}, + (203, "Euml") {- Latin capital letter e with diaeresis -}, + (204, "Igrave") {- Latin capital letter i with grave -}, + (205, "Iacute") {- Latin capital letter i with acute -}, + (206, "Icirc") {- Latin capital letter i with circumflex -}, + (207, "Iuml") {- Latin capital letter i with diaeresis -}, + (208, "ETH") {- Latin capital letter eth -}, + (209, "Ntilde") {- Latin capital letter n with tilde -}, + (210, "Ograve") {- Latin capital letter o with grave -}, + (211, "Oacute") {- Latin capital letter o with acute -}, + (212, "Ocirc") {- Latin capital letter o with circumflex -}, + (213, "Otilde") {- Latin capital letter o with tilde -}, + (214, "Ouml") {- Latin capital letter o with diaeresis -}, + (215, "times") {- multiplication sign -}, + (216, "Oslash") {- Latin capital letter o with stroke -}, + (217, "Ugrave") {- Latin capital letter u with grave -}, + (218, "Uacute") {- Latin capital letter u with acute -}, + (219, "Ucirc") {- Latin capital letter u with circumflex -}, + (220, "Uuml") {- Latin capital letter u with diaeresis -}, + (221, "Yacute") {- Latin capital letter y with acute -}, + (222, "THORN") {- Latin capital letter thorn -}, + (223, "szlig") {- Latin small letter sharp s, German Eszett -}, + (224, "agrave") {- Latin small letter a with grave -}, + (225, "aacute") {- Latin small letter a with acute -}, + (226, "acirc") {- Latin small letter a with circumflex -}, + (227, "atilde") {- Latin small letter a with tilde -}, + (228, "auml") {- Latin small letter a with diaeresis -}, + (229, "aring") {- Latin small letter a with ring above -}, + (230, "aelig") {- Latin lowercase ligature ae -}, + (231, "ccedil") {- Latin small letter c with cedilla -}, + (232, "egrave") {- Latin small letter e with grave -}, + (233, "eacute") {- Latin small letter e with acute -}, + (234, "ecirc") {- Latin small letter e with circumflex -}, + (235, "euml") {- Latin small letter e with diaeresis -}, + (236, "igrave") {- Latin small letter i with grave -}, + (237, "iacute") {- Latin small letter i with acute -}, + (238, "icirc") {- Latin small letter i with circumflex -}, + (239, "iuml") {- Latin small letter i with diaeresis -}, + (240, "eth") {- Latin small letter eth -}, + (241, "ntilde") {- Latin small letter n with tilde -}, + (242, "ograve") {- Latin small letter o with grave -}, + (243, "oacute") {- Latin small letter o with acute -}, + (244, "ocirc") {- Latin small letter o with circumflex -}, + (245, "otilde") {- Latin small letter o with tilde -}, + (246, "ouml") {- Latin small letter o with diaeresis -}, + (247, "divide") {- division sign -}, + (248, "oslash") {- Latin small letter o with stroke -}, + (249, "ugrave") {- Latin small letter u with grave -}, + (250, "uacute") {- Latin small letter u with acute -}, + (251, "ucirc") {- Latin small letter u with circumflex -}, + (252, "uuml") {- Latin small letter u with diaeresis -}, + (253, "yacute") {- Latin small letter y with acute -}, + (254, "thorn") {- Latin small letter thorn -}, + (255, "yuml") {- Latin small letter y with diaeresis -}, + (338, "OElig") {- Latin capital ligature oe -}, + (339, "oelig") {- Latin small ligature oe -}, + (352, "Scaron") {- Latin capital letter s with caron -}, + (353, "scaron") {- Latin small letter s with caron -}, + (376, "Yuml") {- Latin capital letter y with diaeresis -}, + (402, "fnof") {- Latin small letter f with hook -}, + (710, "circ") {- modifier letter circumflex accent -}, + (732, "tilde") {- small tilde -}, + (913, "Alpha") {- Greek capital letter alpha -}, + (914, "Beta") {- Greek capital letter beta -}, + (915, "Gamma") {- Greek capital letter gamma -}, + (916, "Delta") {- Greek capital letter delta -}, + (917, "Epsilon") {- Greek capital letter epsilon -}, + (918, "Zeta") {- Greek capital letter zeta -}, + (919, "Eta") {- Greek capital letter eta -}, + (920, "Theta") {- Greek capital letter theta -}, + (921, "Iota") {- Greek capital letter iota -}, + (922, "Kappa") {- Greek capital letter kappa -}, + (923, "Lambda") {- Greek capital letter lambda -}, + (924, "Mu") {- Greek capital letter mu -}, + (925, "Nu") {- Greek capital letter nu -}, + (926, "Xi") {- Greek capital letter xi -}, + (927, "Omicron") {- Greek capital letter omicron -}, + (928, "Pi") {- Greek capital letter pi -}, + (929, "Rho") {- Greek capital letter rho -}, + (931, "Sigma") {- Greek capital letter sigma -}, + (932, "Tau") {- Greek capital letter tau -}, + (933, "Upsilon") {- Greek capital letter upsilon -}, + (934, "Phi") {- Greek capital letter phi -}, + (935, "Chi") {- Greek capital letter chi -}, + (936, "Psi") {- Greek capital letter psi -}, + (937, "Omega") {- Greek capital letter omega -}, + (945, "alpha") {- Greek small letter alpha -}, + (946, "beta") {- Greek small letter beta -}, + (947, "gamma") {- Greek small letter gamma -}, + (948, "delta") {- Greek small letter delta -}, + (949, "epsilon") {- Greek small letter epsilon -}, + (950, "zeta") {- Greek small letter zeta -}, + (951, "eta") {- Greek small letter eta -}, + (952, "theta") {- Greek small letter theta -}, + (953, "iota") {- Greek small letter iota -}, + (954, "kappa") {- Greek small letter kappa -}, + (955, "lambda") {- Greek small letter lambda -}, + (956, "mu") {- Greek small letter mu -}, + (957, "nu") {- Greek small letter nu -}, + (958, "xi") {- Greek small letter xi -}, + (959, "omicron") {- Greek small letter omicron -}, + (960, "pi") {- Greek small letter pi -}, + (961, "rho") {- Greek small letter rho -}, + (962, "sigmaf") {- Greek small letter final sigma -}, + (963, "sigma") {- Greek small letter sigma -}, + (964, "tau") {- Greek small letter tau -}, + (965, "upsilon") {- Greek small letter upsilon -}, + (966, "phi") {- Greek small letter phi -}, + (967, "chi") {- Greek small letter chi -}, + (968, "psi") {- Greek small letter psi -}, + (969, "omega") {- Greek small letter omega -}, + (977, "thetasym") {- Greek theta symbol -}, + (978, "upsih") {- Greek upsilon with hook symbol -}, + (982, "piv") {- Greek pi symbol -}, + (8194, "ensp") {- en space -}, + (8195, "emsp") {- em space -}, + (8201, "thinsp") {- thin space -}, + (8204, "zwnj") {- zero width non-joiner -}, + (8205, "zwj") {- zero width joiner -}, + (8206, "lrm") {- left-to-right mark -}, + (8207, "rlm") {- right-to-left mark -}, + (8211, "ndash") {- en dash -}, + (8212, "mdash") {- em dash -}, + (8216, "lsquo") {- left single quotation mark -}, + (8217, "rsquo") {- right single quotation mark -}, + (8218, "sbquo") {- single low-9 quotation mark -}, + (8220, "ldquo") {- left double quotation mark -}, + (8221, "rdquo") {- right double quotation mark -}, + (8222, "bdquo") {- double low-9 quotation mark -}, + (8224, "dagger") {- dagger -}, + (8225, "Dagger") {- double dagger -}, + (8226, "bull") {- bullet -}, + (8230, "hellip") {- horizontal ellipsis -}, + (8240, "permil") {- per mille sign -}, + (8242, "prime") {- prime -}, + (8243, "Prime") {- double prime -}, + (8249, "lsaquo") {- single left-pointing angle quotation mark -}, + (8250, "rsaquo") {- single right-pointing angle quotation mark -}, + (8254, "oline") {- overline -}, + (8260, "frasl") {- fraction slash -}, + (8364, "euro") {- euro sign -}, + (8465, "image") {- black-letter capital i -}, + (8472, "weierp") {- script capital p, Weierstrass p -}, + (8476, "real") {- black-letter capital r -}, + (8482, "trade") {- trademark sign -}, + (8501, "alefsym") {- alef symbol -}, + (8592, "larr") {- leftwards arrow -}, + (8593, "uarr") {- upwards arrow -}, + (8594, "rarr") {- rightwards arrow -}, + (8595, "darr") {- downwards arrow -}, + (8596, "harr") {- left right arrow -}, + (8629, "crarr") {- downwards arrow with corner leftwards -}, + (8656, "lArr") {- leftwards double arrow -}, + (8657, "uArr") {- upwards double arrow -}, + (8658, "rArr") {- rightwards double arrow -}, + (8659, "dArr") {- downwards double arrow -}, + (8660, "hArr") {- left right double arrow -}, + (8704, "forall") {- for all -}, + (8706, "part") {- partial differential -}, + (8707, "exist") {- there exists -}, + (8709, "empty") {- empty set -}, + (8711, "nabla") {- nabla -}, + (8712, "isin") {- element of -}, + (8713, "notin") {- not an element of -}, + (8715, "ni") {- contains as member -}, + (8719, "prod") {- n-ary product -}, + (8721, "sum") {- n-ary summation -}, + (8722, "minus") {- minus sign -}, + (8727, "lowast") {- asterisk operator -}, + (8730, "radic") {- square root -}, + (8733, "prop") {- proportional to -}, + (8734, "infin") {- infinity -}, + (8736, "ang") {- angle -}, + (8743, "and") {- logical and -}, + (8744, "or") {- logical or -}, + (8745, "cap") {- intersection -}, + (8746, "cup") {- union -}, + (8747, "int") {- integral -}, + (8756, "there4") {- therefore -}, + (8764, "sim") {- tilde operator -}, + (8773, "cong") {- congruent to -}, + (8776, "asymp") {- almost equal to -}, + (8800, "ne") {- not equal to -}, + (8801, "equiv") {- identical to, equivalent to -}, + (8804, "le") {- less-than or equal to -}, + (8805, "ge") {- greater-than or equal to -}, + (8834, "sub") {- subset of -}, + (8835, "sup") {- superset of -}, + (8836, "nsub") {- not a subset of -}, + (8838, "sube") {- subset of or equal to -}, + (8839, "supe") {- superset of or equal to -}, + (8853, "oplus") {- circled plus -}, + (8855, "otimes") {- circled times -}, + (8869, "perp") {- up tack -}, + (8901, "sdot") {- dot operator -}, + (8968, "lceil") {- left ceiling -}, + (8969, "rceil") {- right ceiling -}, + (8970, "lfloor") {- left floor -}, + (8971, "rfloor") {- right floor -}, + (9001, "lang") {- left-pointing angle bracket -}, + (9002, "rang") {- right-pointing angle bracket -}, + (9674, "loz") {- lozenge -}, + (9824, "spades") {- black spade suit -}, + (9827, "clubs") {- black club suit -}, + (9829, "hearts") {- black heart suit -}, + (9830, "diams") {- black diamond suit -}] +
+ src/Text/XHtmlCombinators/Extras/Lorem.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Text.XHtmlCombinators.Extras.Lorem+-- Copyright : (c) Alasdair Armstrong 2010+-- License : BSD-style+-- Maintainer : alasdair.armstrong@googlemail.com+-- Stability : experimental+-- Portability : GHC++module Text.XHtmlCombinators.Extras.Lorem+ ( lorem', lorem+ , loremIO', loremIO+ ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Control.Monad.Trans.State+import Control.Monad.Trans.Writer+import Data.Monoid+import System.Random++import Data.Text (Text)+import qualified Data.Text as T++import Text.XHtmlCombinators.Internal+import Text.XHtmlCombinators.Combinators+++lorem' :: Block c => Attrs -> XHtmlT (State StdGen) c+lorem' attrs = p' attrs (text =<< randomPara)++lorem :: Block c => XHtmlT (State StdGen) c+lorem = lorem' []++loremIO' :: Block c => Attrs -> XHtmlT IO c+loremIO' attrs = p' attrs (text =<< randomParaIO)++loremIO :: Block c => XHtmlT IO c+loremIO = loremIO' []++randomPara :: Monoid a => WriterT a (State StdGen) Text+randomPara = lift . fmap para $ state (randomR (1, 5))++randomParaIO :: Monoid a => WriterT a IO Text+randomParaIO = do+ gen <- lift newStdGen+ return . para . fst $ randomR (1, 5) gen++para :: Int -> Text++para 1 = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Maecenas in nunc\+\ sed nunc scelerisque molestie. Curabitur in mattis sem. Curabitur quis fringilla\+\ tortor. Sed rutrum vehicula diam eu ullamcorper. Vivamus ligula justo, faucibus \+\eget pretium nec, rutrum mollis quam. Nulla hendrerit, orci eu fringilla tempor, \+\risus ligula posuere metus, vitae posuere arcu est non odio. Sed sem ipsum, porta\+\ nec venenatis eget, interdum a quam. Donec et felis vitae urna dignissim digniss\+\im in at orci. Sed varius consequat dapibus. Integer tellus eros, ullamcorper et \+\ullamcorper non, consequat in ante. In ut sem ipsum. Vivamus ante orci, cursus vi\+\tae blandit dapibus, gravida vel enim. Integer volutpat ligula in lorem auctor eg\+\et ornare massa gravida. Nullam in metus diam, eget pellentesque sem. Vestibulum \+\adipiscing accumsan nibh sit amet lobortis. Vivamus a quam turpis. Proin eu sapie\+\n sapien, ut elementum ante. Sed magna eros, consectetur eget consequat nec, pell\+\entesque vitae velit. Etiam mi tortor, cursus vel tristique non, dapibus vel mi. \+\Aenean a lorem non massa porta vulputate ut nec turpis."++para 2 = "Morbi a magna nec orci cursus semper in in lacus. Ut semper tempus lacus,\+\ ut hendrerit mauris volutpat congue. In lacus turpis, tristique eu mattis ut, ti\+\ncidunt eget sem. Ut lacinia lorem at lorem mollis tristique. In nec orci aliquam\+\ enim sagittis sagittis non vitae ante. Morbi faucibus dolor ac mi lacinia tristi\+\que. Aliquam et tortor urna, vel eleifend felis. Curabitur tellus augue, interdum\+\ ac hendrerit at, volutpat tincidunt velit. In est lorem, imperdiet eget consequa\+\t sagittis, sagittis nec quam. Duis non volutpat augue."++para 3 = "Integer semper, elit eget viverra dignissim, lorem ipsum gravida tortor, \+\ut cursus orci ante a diam. Morbi non metus et sem pellentesque dapibus sed vel m\+\assa. Fusce commodo condimentum vulputate. Nullam porta, orci nec aliquam blandit\+\, orci urna sollicitudin libero, non pharetra ligula urna id nibh. In metus nulla\+\, facilisis ut tempor nec, elementum nec nunc. Aenean sapien sem, fringilla a bla\+\ndit vitae, imperdiet nec orci. Integer sit amet nunc ut dui porttitor malesuada \+\eu non mauris. Suspendisse eget diam sed dui auctor tempus eu et erat. In non lib\+\ero id purus facilisis tempus. Nulla nec tellus eget justo dignissim sagittis sit\+\ amet vitae lorem. Donec lobortis velit id massa pretium vitae tincidunt neque ul\+\trices. Duis id erat enim, ac aliquet magna. Maecenas tempus leo eget risus trist\+\ique congue eu ut turpis."++para 4 = "Ut ultrices ante nec neque suscipit ornare. Sed adipiscing diam eu enim s\+\celerisque quis rhoncus mauris pulvinar. Nulla dignissim eros a nisl posuere elei\+\fend. Nullam leo sapien, porttitor quis commodo vel, congue quis nisl. In molesti\+\e rutrum quam at malesuada. Etiam ac pretium lorem. Pellentesque nisl erat, viver\+\ra in tempus eget, pulvinar vel nisi. Curabitur odio nisl, viverra ac faucibus se\+\d, rhoncus et neque. Sed placerat dolor ante, pulvinar ultrices arcu. Nulla id le\+\o odio, ut dignissim nisi. Phasellus id tortor libero, eget aliquet sapien. Nulla\+\ facilisi. Duis ornare ultricies dolor, sed dapibus lorem sollicitudin non. Nulla\+\m augue lorem, consequat ut faucibus ac, tempus id ipsum. Fusce sit amet libero s\+\agittis dolor convallis volutpat. Aenean at elit libero. Phasellus eget odio eget\+\ mauris vehicula luctus id a est."++para 5 = "Sed purus orci, tincidunt non tincidunt a, mattis at justo. Vivamus quis \+\nisl id justo volutpat tristique. Donec mattis, neque posuere aliquam molestie, m\+\assa ipsum fringilla erat, et vehicula lorem libero quis nisi. In tellus nunc, el\+\ementum eget blandit a, pellentesque at risus. Quisque in nulla id nibh eleifend \+\ultricies viverra non felis. Aliquam tempus, libero at ullamcorper venenatis, ero\+\s mauris consectetur urna, sit amet facilisis diam eros at tellus. Vestibulum con\+\dimentum quam non est dapibus non faucibus mi luctus. Aenean quis massa nec diam \+\varius hendrerit. Morbi tempus ornare lectus et dapibus. Sed tortor tellus, lobor\+\tis a ullamcorper id, ornare nec sapien. Quisque varius feugiat ante, eu dictum e\+\nim tempus et."
src/Text/XHtmlCombinators/Internal.hs view
@@ -1,13 +1,27 @@-{-# LANGUAGE PatternGuards, BangPatterns #-}+{-# LANGUAGE PatternGuards #-}++-- |+-- Module : Text.XHtmlCombinators.Internal+-- Copyright : (c) Alasdair Armstrong 2010+-- License : BSD-style+-- Maintainer : alasdair.armstrong@googlemail.com+-- Stability : experimental+-- Portability : GHC+ module Text.XHtmlCombinators.Internal where import Control.Applicative-import Control.Monad.Writer+import Control.Monad+import Control.Monad.Identity+import Control.Monad.Trans+import Control.Monad.Trans.Writer import Data.Sequence import qualified Data.Sequence as Seq-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as T +import Data.Text (Text)+import qualified Data.Text as T+import GHC.Exts (IsString (..))+ type Attrs = [Attr] data Attr = Attr Text Text deriving (Show)@@ -17,6 +31,14 @@ | WithAttrs Attrs deriving (Show) +class Content e where+ toContent :: e -> Node++type XHtmlMT t x a = WriterT (Seq x) t a+type XHtmlT t x = XHtmlMT t x ()++type XHtml x = XHtmlT Identity x+ first :: Seq a -> a first seq | x :< _ <- viewl seq = x @@ -27,30 +49,25 @@ emptyNode :: Text -> Attrs -> Attrs -> Node emptyNode name rattrs attrs = Node name rattrs attrs Seq.empty -node :: Content e => Text -> Attrs -> Attrs -> XHtml e -> Node+node :: (Functor t, Monad t, Content e) => Text -> Attrs -> Attrs -> XHtmlT t e -> t Node node name rattrs attrs content = - Node name rattrs attrs (toContent <$> execXHtml content)--class Content e where- toContent :: e -> Node--type XHtmlM x a = Writer (Seq x) a-type XHtml x = XHtmlM x ()+ Node name rattrs attrs . fmap toContent <$> execXHtml content -tellS :: x -> XHtml x+tellS :: Monad t => x -> XHtmlT t x tellS = tell . singleton -execXHtml :: XHtml x -> Seq x-execXHtml = snd . runWriter+execXHtml :: Monad t => XHtmlT t x -> t (Seq x)+execXHtml = execWriterT -tellTextNode :: (Node -> e) -> Text -> Attrs -> Attrs -> Text -> XHtml e +tellTextNode :: Monad t => (Node -> e) -> Text -> Attrs -> Attrs -> Text -> XHtmlT t e tellTextNode c name rattrs attrs = tellS . c . textNode name rattrs attrs -tellEmptyNode :: (Node -> e) -> Text -> Attrs -> Attrs -> XHtml e +tellEmptyNode :: Monad t => (Node -> e) -> Text -> Attrs -> Attrs -> XHtmlT t e tellEmptyNode c name rattrs = tellS . c . emptyNode name rattrs -tellNode :: Content a => (Node -> b) -> Text -> Attrs -> Attrs -> XHtml a -> XHtml b -tellNode c name rattrs attrs = tellS . c . node name rattrs attrs+tellNode :: (Functor t, Monad t, Content a) + => (Node -> b) -> Text -> Attrs -> Attrs -> XHtmlT t a -> XHtmlT t b+tellNode c name rattrs attrs = tellS . c <=< lift . node name rattrs attrs -empty :: XHtml x+empty :: Monad t => XHtmlT t x empty = return ()
src/Text/XHtmlCombinators/Render.hs view
@@ -1,13 +1,24 @@+-- |+-- Module : Text.XHtmlCombinators.Render+-- Copyright : (c) Alasdair Armstrong 2010+-- License : BSD-style+-- Maintainer : alasdair.armstrong@googlemail.com+-- Stability : experimental+-- Portability : GHC+ module Text.XHtmlCombinators.Render ( render, renderPretty+ , renderT, renderPrettyT ) where import Control.Applicative hiding (empty)+import Control.Monad.Identity import Data.Foldable import qualified Data.Sequence as Seq-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as T++import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T import qualified Text.XML.Light as XML import Text.XHtmlCombinators.Internal@@ -36,8 +47,10 @@ -- -- This function will render the entire page on a single line, which -- is somewhat unreadable. On the plus side, it's relatively fast.-render :: Content c => XHtml c -> Text-render page = fold $ renderNode . toContent <$> execXHtml page+renderT :: (Functor t, Monad t, Content c) => XHtmlT t c -> t Text+renderT page = do+ content <- execXHtml page+ return (fold $ renderNode . toContent <$> content) -- | Renders a pretty xhtml page with readable indentation. -- @@ -48,5 +61,13 @@ -- -- Also, 'Text.XML.Light' will render the document as proper XML, which is -- fine only if you're not trying to pass of your page as text/html.+renderPrettyT :: (Functor t, Monad t, Content c) => XHtmlT t c -> t Text+renderPrettyT page = do+ content <- renderT page+ return (T.pack . unlines . fmap XML.ppContent . XML.parseXML . T.unpack $ content)++render :: Content c => XHtml c -> Text+render = runIdentity . renderT+ renderPretty :: Content c => XHtml c -> Text-renderPretty = T.pack . unlines . fmap XML.ppContent . XML.parseXML . T.unpack . render+renderPretty = runIdentity . renderPrettyT
+ src/Text/XHtmlCombinators/Safe.hs view
@@ -0,0 +1,123 @@+-- |+-- Module : Text.XHtmlCombinators.Safe+-- Copyright : (c) Alasdair Armstrong 2010+-- License : BSD-style+-- Maintainer : alasdair.armstrong@googlemail.com+-- Stability : experimental+-- Portability : GHC++module Text.XHtmlCombinators.Safe+ ( module Text.XHtmlCombinators+ , text+ , title', title+ , base', base+ , meta', meta+ , style', style+ , script', script+ , bdo', bdo+ , map', map_+ , area', area+ , form', form+ , optgroup', optgroup+ , option', option+ , textarea', textarea+ ) where++import Data.Text (Text)+import qualified Data.Text as T++import Text.XHtmlCombinators.Escape+import qualified Text.XHtmlCombinators as X+import Text.XHtmlCombinators hiding + ( text+ , title', title+ , base', base+ , meta', meta+ , style', style+ , script', script+ , bdo', bdo+ , img', img+ , map', map_+ , area', area+ , form', form+ , optgroup', optgroup+ , option', option+ , textarea', textarea+ )++-- TODO: Comment these explaining how escaping is applied.++text :: (Functor t, Monad t, CData c) => Text -> XHtmlT t c+text = X.text . escape++title' :: (Functor t, Monad t) => Attrs -> Text -> XHtmlT t HeadContent+title' attrs = X.title' attrs . escape++title :: (Functor t, Monad t) => Text -> XHtmlT t HeadContent+title = title' []++base' :: (Functor t, Monad t) => Text -> Attrs -> XHtmlT t HeadContent+base' = X.base' . escapeAttr ++base :: (Functor t, Monad t) => Text -> XHtmlT t HeadContent+base = flip base' []++meta' :: (Functor t, Monad t) => Text -> Attrs -> XHtmlT t HeadContent+meta' = X.meta' . escapeAttr++meta :: (Functor t, Monad t) => Text -> XHtmlT t HeadContent+meta = flip meta' []++style' :: (Functor t, Monad t) => Text -> Attrs -> Text -> XHtmlT t HeadContent+style' type_ attrs css = X.style' (escapeAttr type_) attrs (escapeCSS css)++style :: (Functor t, Monad t) => Text -> Text -> XHtmlT t HeadContent+style = flip style' []++script' :: (Functor t, Monad t) => Text -> Attrs -> Text -> XHtmlT t HeadContent+script' type_ attrs js = X.script' (escapeAttr type_) attrs (escapeJavaScript js)++script :: (Functor t, Monad t) => Text -> Text -> XHtmlT t HeadContent+script = flip script' []++bdo' :: (Functor t, Monad t, Inline c) => Text -> Attrs -> XHtmlT t InlineContent -> XHtmlT t c+bdo' dir = X.bdo' (escapeAttr dir)++bdo :: (Functor t, Monad t, Inline c) => Text -> XHtmlT t InlineContent -> XHtmlT t c+bdo = flip bdo' []++map' :: (Functor t, Monad t, Flow c) => Text -> Attrs -> XHtmlT t MapContent -> XHtmlT t c+map' id = X.map' (escapeAttr id)++map_ :: (Functor t, Monad t, Flow c) => Text -> XHtmlT t MapContent -> XHtmlT t c+map_ = flip map' []++area' :: (Functor t, Monad t) => Text -> Attrs -> XHtmlT t MapContent+area' alt = X.area' (escapeAttr alt)++area :: (Functor t, Monad t) => Text -> XHtmlT t MapContent+area = flip area' []++form' :: (Functor t, Monad t, Block c) => Text -> Attrs -> XHtmlT t FlowContent -> XHtmlT t c+form' action = X.form' (escapeAttr action)++form :: (Functor t, Monad t, Block c) => Text -> XHtmlT t FlowContent -> XHtmlT t c+form = flip form' []++optgroup' :: (Functor t, Monad t) => Text -> Attrs -> XHtmlT t OptionContent -> XHtmlT t OptionContent+optgroup' label = X.optgroup' (escapeAttr label)++optgroup :: (Functor t, Monad t) => Text -> XHtmlT t OptionContent -> XHtmlT t OptionContent+optgroup = flip optgroup' []++option' :: (Functor t, Monad t) => Attrs -> Text -> XHtmlT t OptionContent+option' attrs = option' attrs . escape ++option :: (Functor t, Monad t) => Text -> XHtmlT t OptionContent+option = option' []++textarea' :: (Functor t, Monad t, Inline c) => Int -> Int -> Attrs -> Text -> XHtmlT t c+textarea' rows cols attrs = X.textarea' rows cols attrs . escape++textarea :: (Functor t, Monad t, Inline c) => Int -> Int -> Text -> XHtmlT t c+textarea rows cols = textarea' rows cols []
xhtml-combinators.cabal view
@@ -1,5 +1,5 @@ name: xhtml-combinators-version: 0.1+version: 0.2 cabal-version: >= 1.2.3 synopsis: Fast and easy to use XHTML combinators. description: @@ -16,13 +16,20 @@ library build-Depends: - base < 5, containers, mtl, xml >= 1.3.5, text >= 0.7+ base < 5, containers, random, transformers, xml >= 1.3.5, text >= 0.7 hs-source-dirs: src exposed-modules: Text.XHtmlCombinators+ Text.XHtmlCombinators.Safe+ Text.XHtmlCombinators.Attributes+ Text.XHtmlCombinators.Attributes.Safe+ Text.XHtmlCombinators.Escape+ Text.XHtmlCombinators.Render+ Text.XHtmlCombinators.Extras.Lorem+ other-modules: Text.XHtmlCombinators.Internal Text.XHtmlCombinators.Combinators- Text.XHtmlCombinators.Render- Text.XHtmlCombinators.Attributes+ Text.XHtmlCombinators.Attributes.Internal+ Text.XHtmlCombinators.Attributes.Internal.Safe extensions: OverloadedStrings, PatternGuards ghc-options: -O2