{-# LANGUAGE OverloadedStrings #-} -- | This module exports HTML combinators used to create documents. -- module Text.Blaze.Html4.Strict ( module Text.Blaze , html , docType , a , abbr , acronym , address , area , b , bdo , big , blockquote , body , br , button , caption , cite , code , col , colgroup , dd , del , dfn , div , dl , dt , em , fieldset , form , h1 , h2 , h3 , h4 , h5 , h6 , head , hr , htmlNoDocType , i , img , input , ins , kbd , label , legend , li , link , map , meta , noscript , object , ol , optgroup , option , p , param , pre , q , samp , script , select , small , span , strong , style , sub , sup , table , tbody , td , textarea , tfoot , th , thead , title , tr , tt , ul , var ) where import Prelude () import Data.Monoid (mappend) import Text.Blaze import Text.Blaze.Internal (parent, leaf, open) -- | Combinator for the @\@ element. This combinator will also -- insert the correct doctype. -- -- Example: -- -- > html $ span $ text "foo" -- -- Result: -- -- > "http://www.w3.org/TR/html4/strict.dtd"> -- > foo -- html :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. html inner = docType `mappend` htmlNoDocType inner {-# INLINE html #-} -- | Combinator for the document type. This should be placed at the top -- of every HTML page. -- -- Example: -- -- > docType -- -- Result: -- -- > "http://www.w3.org/TR/html4/strict.dtd"> -- docType :: Html a -- ^ The document type HTML. docType = preEscapedText "\n" {-# INLINE docType #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > a $ span $ text "foo" -- -- Result: -- -- > foo -- a :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. a = parent "" {-# INLINE a #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > abbr $ span $ text "foo" -- -- Result: -- -- > foo -- abbr :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. abbr = parent "" {-# INLINE abbr #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > acronym $ span $ text "foo" -- -- Result: -- -- > foo -- acronym :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. acronym = parent "" {-# INLINE acronym #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > address $ span $ text "foo" -- -- Result: -- -- >
foo
-- address :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. address = parent "" {-# INLINE address #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > area -- -- Result: -- -- > -- area :: Html a -- ^ Resulting HTML. area = open "@ element. -- -- Example: -- -- > b $ span $ text "foo" -- -- Result: -- -- > foo -- b :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. b = parent "" {-# INLINE b #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > bdo $ span $ text "foo" -- -- Result: -- -- > foo -- bdo :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. bdo = parent "" {-# INLINE bdo #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > big $ span $ text "foo" -- -- Result: -- -- > foo -- big :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. big = parent "" {-# INLINE big #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > blockquote $ span $ text "foo" -- -- Result: -- -- >
foo
-- blockquote :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. blockquote = parent "" {-# INLINE blockquote #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > body $ span $ text "foo" -- -- Result: -- -- > foo -- body :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. body = parent "" {-# INLINE body #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > br -- -- Result: -- -- >
-- br :: Html a -- ^ Resulting HTML. br = open "@ element. -- -- Example: -- -- > button $ span $ text "foo" -- -- Result: -- -- > -- button :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. button = parent "" {-# INLINE button #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > caption $ span $ text "foo" -- -- Result: -- -- > foo -- caption :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. caption = parent "" {-# INLINE caption #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > cite $ span $ text "foo" -- -- Result: -- -- > foo -- cite :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. cite = parent "" {-# INLINE cite #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > code $ span $ text "foo" -- -- Result: -- -- > foo -- code :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. code = parent "" {-# INLINE code #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > col -- -- Result: -- -- > -- col :: Html a -- ^ Resulting HTML. col = open "@ element. -- -- Example: -- -- > colgroup $ span $ text "foo" -- -- Result: -- -- > foo -- colgroup :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. colgroup = parent "" {-# INLINE colgroup #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > dd $ span $ text "foo" -- -- Result: -- -- >
foo
-- dd :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. dd = parent "" {-# INLINE dd #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > del $ span $ text "foo" -- -- Result: -- -- > foo -- del :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. del = parent "" {-# INLINE del #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > dfn $ span $ text "foo" -- -- Result: -- -- > foo -- dfn :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. dfn = parent "" {-# INLINE dfn #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > div $ span $ text "foo" -- -- Result: -- -- >
foo
-- div :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. div = parent "" {-# INLINE div #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > dl $ span $ text "foo" -- -- Result: -- -- >
foo
-- dl :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. dl = parent "" {-# INLINE dl #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > dt $ span $ text "foo" -- -- Result: -- -- >
foo
-- dt :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. dt = parent "" {-# INLINE dt #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > em $ span $ text "foo" -- -- Result: -- -- > foo -- em :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. em = parent "" {-# INLINE em #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > fieldset $ span $ text "foo" -- -- Result: -- -- >
foo
-- fieldset :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. fieldset = parent "" {-# INLINE fieldset #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > form $ span $ text "foo" -- -- Result: -- -- > foo
-- form :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. form = parent "" {-# INLINE form #-} -- | Combinator for the @\

@ element. -- -- Example: -- -- > h1 $ span $ text "foo" -- -- Result: -- -- >

foo

-- h1 :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. h1 = parent "" {-# INLINE h1 #-} -- | Combinator for the @\

@ element. -- -- Example: -- -- > h2 $ span $ text "foo" -- -- Result: -- -- >

foo

-- h2 :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. h2 = parent "" {-# INLINE h2 #-} -- | Combinator for the @\

@ element. -- -- Example: -- -- > h3 $ span $ text "foo" -- -- Result: -- -- >

foo

-- h3 :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. h3 = parent "" {-# INLINE h3 #-} -- | Combinator for the @\

@ element. -- -- Example: -- -- > h4 $ span $ text "foo" -- -- Result: -- -- >

foo

-- h4 :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. h4 = parent "" {-# INLINE h4 #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > h5 $ span $ text "foo" -- -- Result: -- -- >
foo
-- h5 :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. h5 = parent "" {-# INLINE h5 #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > h6 $ span $ text "foo" -- -- Result: -- -- >
foo
-- h6 :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. h6 = parent "" {-# INLINE h6 #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > head $ span $ text "foo" -- -- Result: -- -- > foo -- head :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. head = parent "" {-# INLINE head #-} -- | Combinator for the @\
@ element. -- -- Example: -- -- > hr -- -- Result: -- -- >
-- hr :: Html a -- ^ Resulting HTML. hr = open "@ element. -- -- Example: -- -- > htmlNoDocType $ span $ text "foo" -- -- Result: -- -- > foo -- htmlNoDocType :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. htmlNoDocType = parent "" {-# INLINE htmlNoDocType #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > i $ span $ text "foo" -- -- Result: -- -- > foo -- i :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. i = parent "" {-# INLINE i #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > img -- -- Result: -- -- > -- img :: Html a -- ^ Resulting HTML. img = open "@ element. -- -- Example: -- -- > input -- -- Result: -- -- > -- input :: Html a -- ^ Resulting HTML. input = open "@ element. -- -- Example: -- -- > ins $ span $ text "foo" -- -- Result: -- -- > foo -- ins :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. ins = parent "" {-# INLINE ins #-} -- | Combinator for the @\@ element. -- -- Example: -- -- > kbd $ span $ text "foo" -- -- Result: -- -- > foo -- kbd :: Html a -- ^ Inner HTML. -> Html b -- ^ Resulting HTML. kbd = parent "" {-# INLINE kbd #-} -- | Combinator for the @\