From 675085c2e0b0b851378da08b7d73024766107c87 Mon Sep 17 00:00:00 2001 From: Johannes Gerer Date: Wed, 26 Oct 2016 02:07:02 +0200 Subject: Initial --- src/BackwardsCompatibilty.hs | 29 ++ src/Benchmarks/BenchmarkUtils.hs | 107 +++++ src/Benchmarks/BlazeTBenchmarks.hs | 133 ++++++ src/Benchmarks/HtmlBenchmarks.hs | 132 ++++++ src/Benchmarks/LICENSE | 30 ++ src/Benchmarks/RunHtmlBenchmarks.hs | 36 ++ src/Benchmarks/ServerChunkSize.hs | 52 +++ src/Benchmarks/bigtable/erb.rb | 32 ++ src/Benchmarks/bigtable/erubis.rb | 31 ++ src/Benchmarks/bigtable/hamlet.hs | 33 ++ src/Benchmarks/bigtable/html-minimalist.hs | 20 + src/Benchmarks/bigtable/html.hs | 19 + src/Benchmarks/bigtable/php.php | 30 ++ src/Benchmarks/bigtable/xhtml.hs | 19 + src/Text/BlazeT.hs | 81 ++++ src/Text/BlazeT/Html.hs | 22 + src/Text/BlazeT/Html4/FrameSet.hs | 198 +++++++++ src/Text/BlazeT/Html4/FrameSet/Attributes.hs | 11 + src/Text/BlazeT/Html4/Strict.hs | 172 +++++++ src/Text/BlazeT/Html4/Strict/Attributes.hs | 11 + src/Text/BlazeT/Html4/Transitional.hs | 194 ++++++++ src/Text/BlazeT/Html4/Transitional/Attributes.hs | 11 + src/Text/BlazeT/Html5.hs | 234 ++++++++++ src/Text/BlazeT/Html5/Attributes.hs | 11 + src/Text/BlazeT/Internal.hs | 238 ++++++++++ src/Text/BlazeT/Renderer/Pretty.hs | 22 + src/Text/BlazeT/Renderer/String.hs | 27 ++ src/Text/BlazeT/Renderer/Text.hs | 75 ++++ src/Text/BlazeT/Renderer/Utf8.hs | 66 +++ src/Text/BlazeT/XHtml1/FrameSet.hs | 198 +++++++++ src/Text/BlazeT/XHtml1/FrameSet/Attributes.hs | 11 + src/Text/BlazeT/XHtml1/Strict.hs | 172 +++++++ src/Text/BlazeT/XHtml1/Strict/Attributes.hs | 11 + src/Text/BlazeT/XHtml1/Transitional.hs | 194 ++++++++ src/Text/BlazeT/XHtml1/Transitional/Attributes.hs | 11 + src/Text/BlazeT/XHtml5.hs | 234 ++++++++++ src/Text/BlazeT/XHtml5/Attributes.hs | 11 + src/Util/GenerateHtmlCombinators.hs | 519 ++++++++++++++++++++++ src/Util/GenerateHtmlTCombinators.hs | 62 +++ src/Util/Sanitize.hs | 112 +++++ 40 files changed, 3611 insertions(+) create mode 100644 src/BackwardsCompatibilty.hs create mode 100644 src/Benchmarks/BenchmarkUtils.hs create mode 100644 src/Benchmarks/BlazeTBenchmarks.hs create mode 100644 src/Benchmarks/HtmlBenchmarks.hs create mode 100644 src/Benchmarks/LICENSE create mode 100644 src/Benchmarks/RunHtmlBenchmarks.hs create mode 100644 src/Benchmarks/ServerChunkSize.hs create mode 100644 src/Benchmarks/bigtable/erb.rb create mode 100644 src/Benchmarks/bigtable/erubis.rb create mode 100644 src/Benchmarks/bigtable/hamlet.hs create mode 100644 src/Benchmarks/bigtable/html-minimalist.hs create mode 100644 src/Benchmarks/bigtable/html.hs create mode 100644 src/Benchmarks/bigtable/php.php create mode 100644 src/Benchmarks/bigtable/xhtml.hs create mode 100644 src/Text/BlazeT.hs create mode 100644 src/Text/BlazeT/Html.hs create mode 100644 src/Text/BlazeT/Html4/FrameSet.hs create mode 100644 src/Text/BlazeT/Html4/FrameSet/Attributes.hs create mode 100644 src/Text/BlazeT/Html4/Strict.hs create mode 100644 src/Text/BlazeT/Html4/Strict/Attributes.hs create mode 100644 src/Text/BlazeT/Html4/Transitional.hs create mode 100644 src/Text/BlazeT/Html4/Transitional/Attributes.hs create mode 100644 src/Text/BlazeT/Html5.hs create mode 100644 src/Text/BlazeT/Html5/Attributes.hs create mode 100644 src/Text/BlazeT/Internal.hs create mode 100644 src/Text/BlazeT/Renderer/Pretty.hs create mode 100644 src/Text/BlazeT/Renderer/String.hs create mode 100644 src/Text/BlazeT/Renderer/Text.hs create mode 100644 src/Text/BlazeT/Renderer/Utf8.hs create mode 100644 src/Text/BlazeT/XHtml1/FrameSet.hs create mode 100644 src/Text/BlazeT/XHtml1/FrameSet/Attributes.hs create mode 100644 src/Text/BlazeT/XHtml1/Strict.hs create mode 100644 src/Text/BlazeT/XHtml1/Strict/Attributes.hs create mode 100644 src/Text/BlazeT/XHtml1/Transitional.hs create mode 100644 src/Text/BlazeT/XHtml1/Transitional/Attributes.hs create mode 100644 src/Text/BlazeT/XHtml5.hs create mode 100644 src/Text/BlazeT/XHtml5/Attributes.hs create mode 100644 src/Util/GenerateHtmlCombinators.hs create mode 100755 src/Util/GenerateHtmlTCombinators.hs create mode 100644 src/Util/Sanitize.hs (limited to 'src') diff --git a/src/BackwardsCompatibilty.hs b/src/BackwardsCompatibilty.hs new file mode 100644 index 0000000..a8733ed --- /dev/null +++ b/src/BackwardsCompatibilty.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE CPP #-} + +import Text.Blaze.Html5.Attributes +#if 1 +import Text.BlazeT +import Text.BlazeT.Html5 hiding (main) +import Text.BlazeT.Renderer.Utf8 +#else +import Text.Blaze +import Text.Blaze.Html5 hiding (main) +import Text.Blaze.Renderer.Utf8 +#endif + +main :: IO () +main = print $ renderMarkup $ do + docType + -- "some text" -- does not work + html $ do text "some text" -- does not work + br + ("wow" :: Markup) -- overloaded strings + text "asd" ! href "asd" + string "string" ! href "asd" + toMarkup ("more text" :: String) + html "wow" + html ! src "asd" $ br + diff --git a/src/Benchmarks/BenchmarkUtils.hs b/src/Benchmarks/BenchmarkUtils.hs new file mode 100644 index 0000000..4b9546c --- /dev/null +++ b/src/Benchmarks/BenchmarkUtils.hs @@ -0,0 +1,107 @@ +-- | This is a module which contains some ad-hoc HTML combinators for use when +-- benchmarking +-- +{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction #-} +module Benchmarks.BenchmarkUtils + ( Html + , toHtml + + , tr + , td + , html + , head + , title + , body + , div + , h1 + , h2 + , p + , ol + , li + , table + , img + , id + ) where + +import Prelude hiding (div, head, id) +import Text.Blaze +import Text.Blaze.Internal + +type Html = Markup + +toHtml :: ToMarkup a => a -> Html +toHtml = toMarkup + +tr :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +tr = Parent "tr" "" +{-# INLINE tr #-} + +td :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +td = Parent "td" "" +{-# INLINE td #-} + +html :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +html = Parent "html" "" +{-# INLINE html #-} + +head :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +head = Parent "head" "" +{-# INLINE head #-} + +title :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +title = Parent "title" "" +{-# INLINE title #-} + +body :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +body = Parent "body" "" +{-# INLINE body #-} + +div :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +div = Parent "div" "" +{-# INLINE div #-} + +h1 :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +h1 = Parent "h1" "" +{-# INLINE h1 #-} + +h2 :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +h2 = Parent "h2" "" +{-# INLINE h2 #-} + +p :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +p = Parent "p" "" +{-# INLINE p #-} + +ol :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +ol = Parent "ol" "" +{-# INLINE ol #-} + +li :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +li = Parent "li" "" +{-# INLINE li #-} + +table :: Html -- ^ Inner HTML. + -> Html -- ^ Resulting HTML. +table = Parent "table" "" +{-# INLINE table #-} + +img :: Html -- ^ Resulting HTML. +img = Leaf "img" "" +{-# INLINE img #-} + +id :: AttributeValue -- ^ Attribute value. + -> Attribute -- ^ Resulting attribute. +id = attribute "id" " id=\"" +{-# INLINE id #-} diff --git a/src/Benchmarks/BlazeTBenchmarks.hs b/src/Benchmarks/BlazeTBenchmarks.hs new file mode 100644 index 0000000..83a38ad --- /dev/null +++ b/src/Benchmarks/BlazeTBenchmarks.hs @@ -0,0 +1,133 @@ +-- | This is a collection of HTML benchmarks for BlazeMarkup. +-- +{-# LANGUAGE OverloadedStrings, ExistentialQuantification, RankNTypes #-} +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} +module Benchmarks.BlazeTBenchmarks where + +import Data.Monoid (Monoid, mempty, mconcat, mappend) +import Prelude hiding (div, id,map) +import qualified Prelude as P + +import Text.BlazeT +import Text.BlazeT.Html5 +import qualified Text.BlazeT.Html5 as H +import qualified Text.BlazeT.Html5.Attributes as A + +-- | Description of an HTML benchmark +-- +data HtmlBenchmark = forall a. HtmlBenchmark + String -- ^ Name. + (a -> Html) -- ^ Rendering function. + a -- ^ Data. + Html -- ^ Longer description. + +-- | List containing all benchmarks. +-- +benchmarks :: [HtmlBenchmark] +benchmarks = + [ HtmlBenchmark "bigTable" bigTable bigTableData $ + let h = toHtml $ length bigTableData + w = toHtml $ length $ P.head bigTableData + in (string "Rendering of a big (") >> h >> (string "x") >> w >> ") HTML table" + , HtmlBenchmark "basic" basic basicData + "A simple, small basic template with a few holes to fill in" + , HtmlBenchmark "wideTree" wideTree wideTreeData $ + (string "A very wide tree (") >> toHtml (length wideTreeData) >> " elements)" + , HtmlBenchmark "wideTreeEscaping" wideTree wideTreeEscapingData $ do + (string "A very wide tree (") >> toHtml (length wideTreeData) >> (string " elements)") + " with lots of escaping" + , HtmlBenchmark "deepTree" deepTree deepTreeData $ do + (string "A really deep tree (") >> toHtml deepTreeData >> " nested templates)" + , HtmlBenchmark "manyAttributes" manyAttributes manyAttributesData $ do + (string "A single element with ") >> toHtml (length manyAttributesData) + " attributes." + , HtmlBenchmark "customAttribute" customAttributes customAttributesData $ + "Creating custom attributes" + ] + +rows :: Int +rows = 1000 + +bigTableData :: [[Int]] +bigTableData = replicate rows [1..10] +{-# NOINLINE bigTableData #-} + +basicData :: (String, String, [String]) +basicData = ("Just a test", "joe", items) +{-# NOINLINE basicData #-} + +items :: [String] +items = fmap (("Number " `mappend`) . show) [1 :: Int .. 14] +{-# NOINLINE items #-} + +wideTreeData :: [String] +wideTreeData = take 5000 $ + cycle ["λf.(λx.fxx)(λx.fxx)", "These old days", "Foobar", "lol", "x ∈ A"] +{-# NOINLINE wideTreeData #-} + +wideTreeEscapingData :: [String] +wideTreeEscapingData = take 1000 $ + cycle ["<><>", "\"lol\"", "<&>", "'>>'"] +{-# NOINLINE wideTreeEscapingData #-} + +deepTreeData :: Int +deepTreeData = 1000 +{-# NOINLINE deepTreeData #-} + +manyAttributesData :: [String] +manyAttributesData = wideTreeData + +customAttributesData :: [(String, String)] +customAttributesData = zip wideTreeData wideTreeData + +-- | Render the argument matrix as an HTML table. +-- +bigTable :: [[Int]] -- ^ Matrix. + -> Html -- ^ Result. +bigTable t = table $ mconcat $ fmap row t + where + row r = tr $ mconcat $ fmap (td . toHtml) r + +-- | Render a simple HTML page with some data. +-- +basic :: (String, String, [String]) -- ^ (Title, User, Items) + -> Html -- ^ Result. +basic (title', user, items') = html $ do + H.head $ title $ toHtml title' + body $ do + div ! A.id "header" $ (h1 $ toHtml title') + p $ "Hello, " `mappend` toHtml user `mappend` "!" + p $ "Hello, me!" + p $ "Hello, world!" + h2 $ "loop" + ol $ mconcat $ fmap (li . toHtml) items' + div ! A.id "footer" $ mempty + +-- | A benchmark producing a very wide but very shallow tree. +-- +wideTree :: [String] -- ^ Text to create a tree from. + -> Html -- ^ Result. +wideTree = div . mapM_ ((p ! A.id "foo") . toHtml) + +-- | Create a very deep tree. +-- +deepTree :: Int -- ^ Depth of the tree. + -> Html -- ^ Result. +deepTree 0 = "foo" +deepTree n = p $ table $ tr $ td $ div $ deepTree (n - 1) + +-- | Create an element with many attributes. +-- +manyAttributes :: [String] -- ^ List of attribute values. + -> Html -- ^ Result. +manyAttributes = foldl setAttribute img + where + setAttribute html' value' = html' ! A.id (toValue value') + {-# INLINE setAttribute #-} + +customAttributes :: [(String, String)] -- ^ List of attribute name, value pairs + -> Html -- ^ Result +customAttributes = foldl setAttribute img + where + setAttribute html' (name, value') = + html' ! customAttribute (stringTag name) (toValue value') diff --git a/src/Benchmarks/HtmlBenchmarks.hs b/src/Benchmarks/HtmlBenchmarks.hs new file mode 100644 index 0000000..3070d52 --- /dev/null +++ b/src/Benchmarks/HtmlBenchmarks.hs @@ -0,0 +1,132 @@ +-- | This is a collection of HTML benchmarks for BlazeMarkup. +-- +{-# LANGUAGE OverloadedStrings, ExistentialQuantification #-} +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} +module Benchmarks.HtmlBenchmarks where + +import Data.Monoid (Monoid, mempty, mconcat, mappend) +import Prelude hiding (div, id) +import qualified Prelude as P + +import Benchmarks.BenchmarkUtils +import Text.Blaze +import qualified Benchmarks.BenchmarkUtils as H + +-- | Description of an HTML benchmark +-- +data HtmlBenchmark = forall a. HtmlBenchmark + { hName :: String -- ^ Name. + , hR :: (a -> Html) -- ^ Rendering function. + , hD :: a -- ^ Data. + , hH :: Html } -- ^ Longer description. + +-- | List containing all benchmarks. +-- +benchmarks :: [HtmlBenchmark] +benchmarks = + [ HtmlBenchmark "bigTable" bigTable bigTableData $ + let h = toHtml $ length bigTableData + w = toHtml $ length $ P.head bigTableData + in "Rendering of a big (" >> h >> "x" >> w >> ") HTML table" + , HtmlBenchmark "basic" basic basicData + "A simple, small basic template with a few holes to fill in" + , HtmlBenchmark "wideTree" wideTree wideTreeData $ + "A very wide tree (" >> toHtml (length wideTreeData) >> " elements)" + , HtmlBenchmark "wideTreeEscaping" wideTree wideTreeEscapingData $ do + "A very wide tree (" >> toHtml (length wideTreeData) >> " elements)" + " with lots of escaping" + , HtmlBenchmark "deepTree" deepTree deepTreeData $ do + "A really deep tree (" >> toHtml deepTreeData >> " nested templates)" + , HtmlBenchmark "manyAttributes" manyAttributes manyAttributesData $ do + "A single element with " >> toHtml (length manyAttributesData) + " attributes." + , HtmlBenchmark "customAttribute" customAttributes customAttributesData $ + "Creating custom attributes" + ] + +rows :: Int +rows = 1000 + +bigTableData :: [[Int]] +bigTableData = replicate rows [1..10] +{-# NOINLINE bigTableData #-} + +basicData :: (String, String, [String]) +basicData = ("Just a test", "joe", items) +{-# NOINLINE basicData #-} + +items :: [String] +items = map (("Number " `mappend`) . show) [1 :: Int .. 14] +{-# NOINLINE items #-} + +wideTreeData :: [String] +wideTreeData = take 5000 $ + cycle ["λf.(λx.fxx)(λx.fxx)", "These old days", "Foobar", "lol", "x ∈ A"] +{-# NOINLINE wideTreeData #-} + +wideTreeEscapingData :: [String] +wideTreeEscapingData = take 1000 $ + cycle ["<><>", "\"lol\"", "<&>", "'>>'"] +{-# NOINLINE wideTreeEscapingData #-} + +deepTreeData :: Int +deepTreeData = 1000 +{-# NOINLINE deepTreeData #-} + +manyAttributesData :: [String] +manyAttributesData = wideTreeData + +customAttributesData :: [(String, String)] +customAttributesData = zip wideTreeData wideTreeData + +-- | Render the argument matrix as an HTML table. +-- +bigTable :: [[Int]] -- ^ Matrix. + -> Html -- ^ Result. +bigTable t = table $ mconcat $ map row t + where + row r = tr $ mconcat $ map (td . toHtml) r + +-- | Render a simple HTML page with some data. +-- +basic :: (String, String, [String]) -- ^ (Title, User, Items) + -> Html -- ^ Result. +basic (title', user, items') = html $ do + H.head $ title $ toHtml title' + body $ do + div ! id "header" $ (h1 $ toHtml title') + p $ "Hello, " `mappend` toHtml user `mappend` "!" + p $ "Hello, me!" + p $ "Hello, world!" + h2 $ "loop" + ol $ mconcat $ map (li . toHtml) items' + div ! id "footer" $ mempty + +-- | A benchmark producing a very wide but very shallow tree. +-- +wideTree :: [String] -- ^ Text to create a tree from. + -> Html -- ^ Result. +wideTree = div . mapM_ ((p ! id "foo") . toHtml) + +-- | Create a very deep tree. +-- +deepTree :: Int -- ^ Depth of the tree. + -> Html -- ^ Result. +deepTree 0 = "foo" +deepTree n = p $ table $ tr $ td $ div $ deepTree (n - 1) + +-- | Create an element with many attributes. +-- +manyAttributes :: [String] -- ^ List of attribute values. + -> Html -- ^ Result. +manyAttributes = foldl setAttribute img + where + setAttribute html' value' = html' ! id (toValue value') + {-# INLINE setAttribute #-} + +customAttributes :: [(String, String)] -- ^ List of attribute name, value pairs + -> Html -- ^ Result +customAttributes = foldl setAttribute img + where + setAttribute html' (name, value') = + html' ! customAttribute (stringTag name) (toValue value') diff --git a/src/Benchmarks/LICENSE b/src/Benchmarks/LICENSE new file mode 100644 index 0000000..8122505 --- /dev/null +++ b/src/Benchmarks/LICENSE @@ -0,0 +1,30 @@ +Copyright Jasper Van der Jeugt 2010 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Jasper Van der Jeugt nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/src/Benchmarks/RunHtmlBenchmarks.hs b/src/Benchmarks/RunHtmlBenchmarks.hs new file mode 100644 index 0000000..04c28ff --- /dev/null +++ b/src/Benchmarks/RunHtmlBenchmarks.hs @@ -0,0 +1,36 @@ +-- | This is a module which runs the 'HtmlBenchmarks' module using the different +-- renderers available. +-- +module Benchmarks.RunHtmlBenchmarks where + +import Criterion.Main +import qualified Data.Text.Lazy as LT +import Data.List +import qualified Data.ByteString.Lazy as LB + +import qualified Text.Blaze.Renderer.Utf8 as Utf8 +import qualified Text.Blaze.Renderer.String as String +import qualified Text.Blaze.Renderer.Text as Text + +import Benchmarks.HtmlBenchmarks (HtmlBenchmark (..), benchmarks) +import qualified Benchmarks.BlazeTBenchmarks as BT (HtmlBenchmark (..), benchmarks) +import qualified Text.BlazeT.Renderer.Utf8 as TUtf8 +import qualified Text.BlazeT.Renderer.String as TString +import qualified Text.BlazeT.Renderer.Text as TText + +-- | Function to run the benchmarks using criterion +-- +main :: IO () +main = defaultMain $ zipWith g benchmarks BT.benchmarks + where + g x y = bgroup (hName x) $ benchHtml x ++ benchHtml2 y + benchHtml (HtmlBenchmark _ f x _) = + [ bench "Utf8" $ nf (LB.length . Utf8.renderMarkup . f) x + , bench "String" $ nf (String.renderMarkup . f) x + , bench "Text" $ nf (LT.length . Text.renderMarkup . f) x + ] + benchHtml2 (BT.HtmlBenchmark _ f x _) = + [ bench "BlazeT.Utf8" $ nf (LB.length . TUtf8.renderMarkup . f) x + , bench "BlazeT.String" $ nf (TString.renderMarkup . f) x + , bench "BlazeT.Text" $ nf (LT.length . TText.renderMarkup . f) x + ] diff --git a/src/Benchmarks/ServerChunkSize.hs b/src/Benchmarks/ServerChunkSize.hs new file mode 100644 index 0000000..7b01c68 --- /dev/null +++ b/src/Benchmarks/ServerChunkSize.hs @@ -0,0 +1,52 @@ +-- | A benchmark for measuring the impact of lazy bytestring chunk size on +-- server performance. +-- +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Control.Concurrent (forkIO) +import Control.Monad (forever) +import Data.Monoid (mappend) +import Network (listenOn, PortID (PortNumber)) +import Network.Socket (accept, sClose) +import Prelude hiding (putStrLn) +import System.Environment (getArgs) + +import Network.Socket.ByteString (recv, send) +import Network.Socket.ByteString.Lazy (sendAll) +import qualified Data.ByteString.Char8 as SBC +import qualified Data.ByteString.Lazy as LB + +-- | Generate a 128k response, with a given chunk size. +-- +makeResponse :: Int -- ^ Chunk size. + -> LB.ByteString -- ^ Result. +makeResponse chunkSize = + let chunks = createChunks chunkSize totalSize + in LB.fromChunks chunks + where + -- A 64 kilobyte response. + totalSize = 128 * 1024 + + createChunks c s + | c < s = SBC.replicate c 'a' : createChunks c (s - c) + | otherwise = SBC.replicate s 'a' : [] + +main :: IO () +main = do + args <- getArgs + let port = PortNumber $ fromIntegral $ (read $ head args :: Int) + chunkSize = read $ args !! 1 + + socket <- listenOn port + forever $ do + (s, _) <- accept socket + forkIO (respond chunkSize s) + where + respond chunkSize s = do + _ <- recv s 1024 + _ <- send s $ "HTTP/1.1 200 OK\r\n" + `mappend` "Content-Type: text/html; charset=UTF-8\r\n" + `mappend` "\r\n" + sendAll s $ makeResponse chunkSize + sClose s diff --git a/src/Benchmarks/bigtable/erb.rb b/src/Benchmarks/bigtable/erb.rb new file mode 100644 index 0000000..c3a675a --- /dev/null +++ b/src/Benchmarks/bigtable/erb.rb @@ -0,0 +1,32 @@ +# BigTable benchmark implemented in ERB. +# +require 'erb' +require 'benchmark' +include ERB::Util + +table = (1 .. 1000).map do |_| (1 .. 10) end + +template = ERB.new <<-EOF + + <% table.each do |row| %> + + <% row.each do |value| %> + + <% end %> + + <% end %> +
+ <%= value %> +
+EOF + +number_runs = 100 +start_time = Time.now.to_f +number_runs.times do + template.result(binding) +end +end_time = Time.now.to_f + +# start_time and end_time are both in seconds now +ms = (end_time - start_time) * 1000 / number_runs +puts "\"ERB\", #{ms}" diff --git a/src/Benchmarks/bigtable/erubis.rb b/src/Benchmarks/bigtable/erubis.rb new file mode 100644 index 0000000..9a1edf9 --- /dev/null +++ b/src/Benchmarks/bigtable/erubis.rb @@ -0,0 +1,31 @@ +# BigTable benchmark implemented in erubis +# +require 'erubis' +require 'benchmark' + +table = (1 .. 1000).map do |_| (1 .. 10) end + +template = Erubis::Eruby.new <<-EOF + + <% table.each do |row| %> + + <% row.each do |value| %> + + <% end %> + + <% end %> +
+ <%= value %> +
+EOF + +number_runs = 100 +start_time = Time.now.to_f +number_runs.times do + template.result(binding) +end +end_time = Time.now.to_f + +# start_time and end_time are both in seconds now +ms = (end_time - start_time) * 1000 / number_runs +puts "\"Erubis\", #{ms}" diff --git a/src/Benchmarks/bigtable/hamlet.hs b/src/Benchmarks/bigtable/hamlet.hs new file mode 100644 index 0000000..2778f2d --- /dev/null +++ b/src/Benchmarks/bigtable/hamlet.hs @@ -0,0 +1,33 @@ +-- | BigTable benchmark implemented using Hamlet. +-- +{-# LANGUAGE QuasiQuotes #-} +module Main where + +import Criterion.Main +import Text.Hamlet +import Text.Hamlet.Monad +import Numeric (showInt) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Maybe (fromJust) + +main = defaultMain + [ bench "bigTable" $ nf bigTable bigTableData + ] + where + rows :: Int + rows = 1000 + + bigTableData :: [[Int]] + bigTableData = replicate rows [1..10] + {-# NOINLINE bigTableData #-} + +bigTable rows = fromJust $ hamletToText undefined [$hamlet| +%table + $forall rows row + %tr + $forall row cell + %td $showInt'.cell$ +|] + where + showInt' i = Encoded $ T.pack $ showInt i "" diff --git a/src/Benchmarks/bigtable/html-minimalist.hs b/src/Benchmarks/bigtable/html-minimalist.hs new file mode 100644 index 0000000..2a52751 --- /dev/null +++ b/src/Benchmarks/bigtable/html-minimalist.hs @@ -0,0 +1,20 @@ +-- | BigTable benchmark using the html-minimalist package from hackage. +-- +import Text.HTML.Light hiding (map) +import Criterion.Main + +bigTable :: [[Int]] -> String +bigTable t = + renderXHTML xhtml_1_0_strict $ html [] $ return $ table [] $ map row t + where + row r = tr [] $ map (td [] . return . cdata . show) r + +main = defaultMain + [ bench "bigTable" $ nf bigTable myTable ] + where + rows :: Int + rows = 1000 + + myTable :: [[Int]] + myTable = replicate rows [1..10] + {-# NOINLINE myTable #-} diff --git a/src/Benchmarks/bigtable/html.hs b/src/Benchmarks/bigtable/html.hs new file mode 100644 index 0000000..57a62b3 --- /dev/null +++ b/src/Benchmarks/bigtable/html.hs @@ -0,0 +1,19 @@ +-- | BigTable benchmark using the HTML package from hackage. +-- +import Text.Html +import Criterion.Main + +bigTable :: [[Int]] -> String +bigTable t = renderHtml $ table $ concatHtml $ map row t + where + row r = tr $ concatHtml $ map (td . stringToHtml . show) r + +main = defaultMain + [ bench "bigTable" $ nf bigTable myTable ] + where + rows :: Int + rows = 1000 + + myTable :: [[Int]] + myTable = replicate rows [1..10] + {-# NOINLINE myTable #-} diff --git a/src/Benchmarks/bigtable/php.php b/src/Benchmarks/bigtable/php.php new file mode 100644 index 0000000..f2e51a4 --- /dev/null +++ b/src/Benchmarks/bigtable/php.php @@ -0,0 +1,30 @@ + + + + + + + + + +
+ diff --git a/src/Benchmarks/bigtable/xhtml.hs b/src/Benchmarks/bigtable/xhtml.hs new file mode 100644 index 0000000..993994c --- /dev/null +++ b/src/Benchmarks/bigtable/xhtml.hs @@ -0,0 +1,19 @@ +-- | BigTable benchmark using the XHTML package from hackage. +-- +import Text.XHtml.Strict +import Criterion.Main + +bigTable :: [[Int]] -> String +bigTable t = renderHtml $ table $ concatHtml $ map row t + where + row r = tr $ concatHtml $ map (td . stringToHtml . show) r + +main = defaultMain + [ bench "bigTable" $ nf bigTable myTable ] + where + rows :: Int + rows = 1000 + + myTable :: [[Int]] + myTable = replicate rows [1..10] + {-# NOINLINE myTable #-} diff --git a/src/Text/BlazeT.hs b/src/Text/BlazeT.hs new file mode 100644 index 0000000..27228fa --- /dev/null +++ b/src/Text/BlazeT.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +module Text.BlazeT + ( + -- * Important types. + Markup + , Tag + , Attribute + , AttributeValue + + -- * Creating attributes. + , dataAttribute + , customAttribute + + -- * Converting values to Markup. + , ToMarkup (..) + , text + , preEscapedText + , lazyText + , preEscapedLazyText + , string + , preEscapedString + , unsafeByteString + , unsafeLazyByteString + + -- * Comments + , textComment + , lazyTextComment + , stringComment + , unsafeByteStringComment + , unsafeLazyByteStringComment + + -- * Creating tags. + , textTag + , stringTag + + -- * Converting values to attribute values. + , B.ToValue (..) + , textValue + , preEscapedTextValue + , lazyTextValue + , preEscapedLazyTextValue + , stringValue + , preEscapedStringValue + , unsafeByteStringValue + , unsafeLazyByteStringValue + + -- * Setting attributes + , (!) + , (!?) + + -- * Modifiying Markup trees + , contents + + -- * BlazeT new stuff + ,MarkupM + ,Markup2 + ,mapMarkupT + ,MarkupT + ,runMarkup + ,runMarkupT + ,execMarkup + ,execMarkupT + ) where + +import qualified Text.Blaze as B +import Text.BlazeT.Internal + +class ToMarkup a where + toMarkup :: a -> Markup + preEscapedToMarkup :: a -> Markup + +-- test :: (ToMarkup a, Monad m) => a -> MarkupT m () +-- test = toMarkup + +instance B.ToMarkup a => ToMarkup a where + toMarkup = wrapMarkup . B.toMarkup + {-# INLINE toMarkup #-} + preEscapedToMarkup = wrapMarkup . B.preEscapedToMarkup + {-# INLINE preEscapedToMarkup #-} diff --git a/src/Text/BlazeT/Html.hs b/src/Text/BlazeT/Html.hs new file mode 100644 index 0000000..4a21c03 --- /dev/null +++ b/src/Text/BlazeT/Html.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE RankNTypes #-} +module Text.BlazeT.Html + ( module Text.BlazeT + , Html + , toHtml + , preEscapedToHtml + -- * BlazeT new stuff + ,HtmlM + ,HtmlT + ) where + +import Text.BlazeT + +type HtmlT = MarkupT +type HtmlM = MarkupM +type Html = Markup + +toHtml ::(ToMarkup a) => a -> Html +toHtml = toMarkup + +preEscapedToHtml ::(ToMarkup a) => a -> Html +preEscapedToHtml = preEscapedToMarkup diff --git a/src/Text/BlazeT/Html4/FrameSet.hs b/src/Text/BlazeT/Html4/FrameSet.hs new file mode 100644 index 0000000..5d6ec03 --- /dev/null +++ b/src/Text/BlazeT/Html4/FrameSet.hs @@ -0,0 +1,198 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module wraps all exports of "Text.Blaze.Html4.FrameSet" using 'wrapMarkup' and 'wrapMarkup'. +-} +module Text.BlazeT.Html4.FrameSet + (module Text.BlazeT.Html4.FrameSet + ,module Text.BlazeT.Html + ) where +import qualified Text.Blaze.Html4.FrameSet +import Text.BlazeT +import Text.BlazeT.Html +import Text.BlazeT.Internal + +docTypeHtml :: Markup2 +docTypeHtml = wrapMarkup2 Text.Blaze.Html4.FrameSet.docTypeHtml +a :: Markup2 +a = wrapMarkup2 Text.Blaze.Html4.FrameSet.a +abbr :: Markup2 +abbr = wrapMarkup2 Text.Blaze.Html4.FrameSet.abbr +acronym :: Markup2 +acronym = wrapMarkup2 Text.Blaze.Html4.FrameSet.acronym +address :: Markup2 +address = wrapMarkup2 Text.Blaze.Html4.FrameSet.address +b :: Markup2 +b = wrapMarkup2 Text.Blaze.Html4.FrameSet.b +bdo :: Markup2 +bdo = wrapMarkup2 Text.Blaze.Html4.FrameSet.bdo +big :: Markup2 +big = wrapMarkup2 Text.Blaze.Html4.FrameSet.big +blockquote :: Markup2 +blockquote = wrapMarkup2 Text.Blaze.Html4.FrameSet.blockquote +body :: Markup2 +body = wrapMarkup2 Text.Blaze.Html4.FrameSet.body +button :: Markup2 +button = wrapMarkup2 Text.Blaze.Html4.FrameSet.button +caption :: Markup2 +caption = wrapMarkup2 Text.Blaze.Html4.FrameSet.caption +cite :: Markup2 +cite = wrapMarkup2 Text.Blaze.Html4.FrameSet.cite +code :: Markup2 +code = wrapMarkup2 Text.Blaze.Html4.FrameSet.code +colgroup :: Markup2 +colgroup = wrapMarkup2 Text.Blaze.Html4.FrameSet.colgroup +dd :: Markup2 +dd = wrapMarkup2 Text.Blaze.Html4.FrameSet.dd +del :: Markup2 +del = wrapMarkup2 Text.Blaze.Html4.FrameSet.del +dfn :: Markup2 +dfn = wrapMarkup2 Text.Blaze.Html4.FrameSet.dfn +div :: Markup2 +div = wrapMarkup2 Text.Blaze.Html4.FrameSet.div +dl :: Markup2 +dl = wrapMarkup2 Text.Blaze.Html4.FrameSet.dl +dt :: Markup2 +dt = wrapMarkup2 Text.Blaze.Html4.FrameSet.dt +em :: Markup2 +em = wrapMarkup2 Text.Blaze.Html4.FrameSet.em +fieldset :: Markup2 +fieldset = wrapMarkup2 Text.Blaze.Html4.FrameSet.fieldset +form :: Markup2 +form = wrapMarkup2 Text.Blaze.Html4.FrameSet.form +h1 :: Markup2 +h1 = wrapMarkup2 Text.Blaze.Html4.FrameSet.h1 +h2 :: Markup2 +h2 = wrapMarkup2 Text.Blaze.Html4.FrameSet.h2 +h3 :: Markup2 +h3 = wrapMarkup2 Text.Blaze.Html4.FrameSet.h3 +h4 :: Markup2 +h4 = wrapMarkup2 Text.Blaze.Html4.FrameSet.h4 +h5 :: Markup2 +h5 = wrapMarkup2 Text.Blaze.Html4.FrameSet.h5 +h6 :: Markup2 +h6 = wrapMarkup2 Text.Blaze.Html4.FrameSet.h6 +head :: Markup2 +head = wrapMarkup2 Text.Blaze.Html4.FrameSet.head +html :: Markup2 +html = wrapMarkup2 Text.Blaze.Html4.FrameSet.html +i :: Markup2 +i = wrapMarkup2 Text.Blaze.Html4.FrameSet.i +ins :: Markup2 +ins = wrapMarkup2 Text.Blaze.Html4.FrameSet.ins +kbd :: Markup2 +kbd = wrapMarkup2 Text.Blaze.Html4.FrameSet.kbd +label :: Markup2 +label = wrapMarkup2 Text.Blaze.Html4.FrameSet.label +legend :: Markup2 +legend = wrapMarkup2 Text.Blaze.Html4.FrameSet.legend +li :: Markup2 +li = wrapMarkup2 Text.Blaze.Html4.FrameSet.li +map :: Markup2 +map = wrapMarkup2 Text.Blaze.Html4.FrameSet.map +noscript :: Markup2 +noscript = wrapMarkup2 Text.Blaze.Html4.FrameSet.noscript +object :: Markup2 +object = wrapMarkup2 Text.Blaze.Html4.FrameSet.object +ol :: Markup2 +ol = wrapMarkup2 Text.Blaze.Html4.FrameSet.ol +optgroup :: Markup2 +optgroup = wrapMarkup2 Text.Blaze.Html4.FrameSet.optgroup +option :: Markup2 +option = wrapMarkup2 Text.Blaze.Html4.FrameSet.option +p :: Markup2 +p = wrapMarkup2 Text.Blaze.Html4.FrameSet.p +pre :: Markup2 +pre = wrapMarkup2 Text.Blaze.Html4.FrameSet.pre +q :: Markup2 +q = wrapMarkup2 Text.Blaze.Html4.FrameSet.q +samp :: Markup2 +samp = wrapMarkup2 Text.Blaze.Html4.FrameSet.samp +script :: Markup2 +script = wrapMarkup2 Text.Blaze.Html4.FrameSet.script +select :: Markup2 +select = wrapMarkup2 Text.Blaze.Html4.FrameSet.select +small :: Markup2 +small = wrapMarkup2 Text.Blaze.Html4.FrameSet.small +span :: Markup2 +span = wrapMarkup2 Text.Blaze.Html4.FrameSet.span +strong :: Markup2 +strong = wrapMarkup2 Text.Blaze.Html4.FrameSet.strong +style :: Markup2 +style = wrapMarkup2 Text.Blaze.Html4.FrameSet.style +sub :: Markup2 +sub = wrapMarkup2 Text.Blaze.Html4.FrameSet.sub +sup :: Markup2 +sup = wrapMarkup2 Text.Blaze.Html4.FrameSet.sup +table :: Markup2 +table = wrapMarkup2 Text.Blaze.Html4.FrameSet.table +tbody :: Markup2 +tbody = wrapMarkup2 Text.Blaze.Html4.FrameSet.tbody +td :: Markup2 +td = wrapMarkup2 Text.Blaze.Html4.FrameSet.td +textarea :: Markup2 +textarea = wrapMarkup2 Text.Blaze.Html4.FrameSet.textarea +tfoot :: Markup2 +tfoot = wrapMarkup2 Text.Blaze.Html4.FrameSet.tfoot +th :: Markup2 +th = wrapMarkup2 Text.Blaze.Html4.FrameSet.th +thead :: Markup2 +thead = wrapMarkup2 Text.Blaze.Html4.FrameSet.thead +title :: Markup2 +title = wrapMarkup2 Text.Blaze.Html4.FrameSet.title +tr :: Markup2 +tr = wrapMarkup2 Text.Blaze.Html4.FrameSet.tr +tt :: Markup2 +tt = wrapMarkup2 Text.Blaze.Html4.FrameSet.tt +ul :: Markup2 +ul = wrapMarkup2 Text.Blaze.Html4.FrameSet.ul +var :: Markup2 +var = wrapMarkup2 Text.Blaze.Html4.FrameSet.var +applet :: Markup2 +applet = wrapMarkup2 Text.Blaze.Html4.FrameSet.applet +center :: Markup2 +center = wrapMarkup2 Text.Blaze.Html4.FrameSet.center +dir :: Markup2 +dir = wrapMarkup2 Text.Blaze.Html4.FrameSet.dir +font :: Markup2 +font = wrapMarkup2 Text.Blaze.Html4.FrameSet.font +iframe :: Markup2 +iframe = wrapMarkup2 Text.Blaze.Html4.FrameSet.iframe +isindex :: Markup2 +isindex = wrapMarkup2 Text.Blaze.Html4.FrameSet.isindex +menu :: Markup2 +menu = wrapMarkup2 Text.Blaze.Html4.FrameSet.menu +noframes :: Markup2 +noframes = wrapMarkup2 Text.Blaze.Html4.FrameSet.noframes +s :: Markup2 +s = wrapMarkup2 Text.Blaze.Html4.FrameSet.s +u :: Markup2 +u = wrapMarkup2 Text.Blaze.Html4.FrameSet.u +frameset :: Markup2 +frameset = wrapMarkup2 Text.Blaze.Html4.FrameSet.frameset +docType :: Markup +docType = wrapMarkup Text.Blaze.Html4.FrameSet.docType +area :: Markup +area = wrapMarkup Text.Blaze.Html4.FrameSet.area +br :: Markup +br = wrapMarkup Text.Blaze.Html4.FrameSet.br +col :: Markup +col = wrapMarkup Text.Blaze.Html4.FrameSet.col +hr :: Markup +hr = wrapMarkup Text.Blaze.Html4.FrameSet.hr +link :: Markup +link = wrapMarkup Text.Blaze.Html4.FrameSet.link +img :: Markup +img = wrapMarkup Text.Blaze.Html4.FrameSet.img +input :: Markup +input = wrapMarkup Text.Blaze.Html4.FrameSet.input +meta :: Markup +meta = wrapMarkup Text.Blaze.Html4.FrameSet.meta +param :: Markup +param = wrapMarkup Text.Blaze.Html4.FrameSet.param +basefont :: Markup +basefont = wrapMarkup Text.Blaze.Html4.FrameSet.basefont +frame :: Markup +frame = wrapMarkup Text.Blaze.Html4.FrameSet.frame + diff --git a/src/Text/BlazeT/Html4/FrameSet/Attributes.hs b/src/Text/BlazeT/Html4/FrameSet/Attributes.hs new file mode 100644 index 0000000..d806f29 --- /dev/null +++ b/src/Text/BlazeT/Html4/FrameSet/Attributes.hs @@ -0,0 +1,11 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module simply reexports the corresponding @blaze-html@ module. +-} +module Text.BlazeT.Html4.FrameSet.Attributes + (module Text.Blaze.Html4.FrameSet.Attributes + ) where +import Text.Blaze.Html4.FrameSet.Attributes + diff --git a/src/Text/BlazeT/Html4/Strict.hs b/src/Text/BlazeT/Html4/Strict.hs new file mode 100644 index 0000000..90fd65a --- /dev/null +++ b/src/Text/BlazeT/Html4/Strict.hs @@ -0,0 +1,172 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module wraps all exports of "Text.Blaze.Html4.Strict" using 'wrapMarkup' and 'wrapMarkup'. +-} +module Text.BlazeT.Html4.Strict + (module Text.BlazeT.Html4.Strict + ,module Text.BlazeT.Html + ) where +import qualified Text.Blaze.Html4.Strict +import Text.BlazeT +import Text.BlazeT.Html +import Text.BlazeT.Internal + +docTypeHtml :: Markup2 +docTypeHtml = wrapMarkup2 Text.Blaze.Html4.Strict.docTypeHtml +a :: Markup2 +a = wrapMarkup2 Text.Blaze.Html4.Strict.a +abbr :: Markup2 +abbr = wrapMarkup2 Text.Blaze.Html4.Strict.abbr +acronym :: Markup2 +acronym = wrapMarkup2 Text.Blaze.Html4.Strict.acronym +address :: Markup2 +address = wrapMarkup2 Text.Blaze.Html4.Strict.address +b :: Markup2 +b = wrapMarkup2 Text.Blaze.Html4.Strict.b +bdo :: Markup2 +bdo = wrapMarkup2 Text.Blaze.Html4.Strict.bdo +big :: Markup2 +big = wrapMarkup2 Text.Blaze.Html4.Strict.big +blockquote :: Markup2 +blockquote = wrapMarkup2 Text.Blaze.Html4.Strict.blockquote +body :: Markup2 +body = wrapMarkup2 Text.Blaze.Html4.Strict.body +button :: Markup2 +button = wrapMarkup2 Text.Blaze.Html4.Strict.button +caption :: Markup2 +caption = wrapMarkup2 Text.Blaze.Html4.Strict.caption +cite :: Markup2 +cite = wrapMarkup2 Text.Blaze.Html4.Strict.cite +code :: Markup2 +code = wrapMarkup2 Text.Blaze.Html4.Strict.code +colgroup :: Markup2 +colgroup = wrapMarkup2 Text.Blaze.Html4.Strict.colgroup +dd :: Markup2 +dd = wrapMarkup2 Text.Blaze.Html4.Strict.dd +del :: Markup2 +del = wrapMarkup2 Text.Blaze.Html4.Strict.del +dfn :: Markup2 +dfn = wrapMarkup2 Text.Blaze.Html4.Strict.dfn +div :: Markup2 +div = wrapMarkup2 Text.Blaze.Html4.Strict.div +dl :: Markup2 +dl = wrapMarkup2 Text.Blaze.Html4.Strict.dl +dt :: Markup2 +dt = wrapMarkup2 Text.Blaze.Html4.Strict.dt +em :: Markup2 +em = wrapMarkup2 Text.Blaze.Html4.Strict.em +fieldset :: Markup2 +fieldset = wrapMarkup2 Text.Blaze.Html4.Strict.fieldset +form :: Markup2 +form = wrapMarkup2 Text.Blaze.Html4.Strict.form +h1 :: Markup2 +h1 = wrapMarkup2 Text.Blaze.Html4.Strict.h1 +h2 :: Markup2 +h2 = wrapMarkup2 Text.Blaze.Html4.Strict.h2 +h3 :: Markup2 +h3 = wrapMarkup2 Text.Blaze.Html4.Strict.h3 +h4 :: Markup2 +h4 = wrapMarkup2 Text.Blaze.Html4.Strict.h4 +h5 :: Markup2 +h5 = wrapMarkup2 Text.Blaze.Html4.Strict.h5 +h6 :: Markup2 +h6 = wrapMarkup2 Text.Blaze.Html4.Strict.h6 +head :: Markup2 +head = wrapMarkup2 Text.Blaze.Html4.Strict.head +html :: Markup2 +html = wrapMarkup2 Text.Blaze.Html4.Strict.html +i :: Markup2 +i = wrapMarkup2 Text.Blaze.Html4.Strict.i +ins :: Markup2 +ins = wrapMarkup2 Text.Blaze.Html4.Strict.ins +kbd :: Markup2 +kbd = wrapMarkup2 Text.Blaze.Html4.Strict.kbd +label :: Markup2 +label = wrapMarkup2 Text.Blaze.Html4.Strict.label +legend :: Markup2 +legend = wrapMarkup2 Text.Blaze.Html4.Strict.legend +li :: Markup2 +li = wrapMarkup2 Text.Blaze.Html4.Strict.li +map :: Markup2 +map = wrapMarkup2 Text.Blaze.Html4.Strict.map +noscript :: Markup2 +noscript = wrapMarkup2 Text.Blaze.Html4.Strict.noscript +object :: Markup2 +object = wrapMarkup2 Text.Blaze.Html4.Strict.object +ol :: Markup2 +ol = wrapMarkup2 Text.Blaze.Html4.Strict.ol +optgroup :: Markup2 +optgroup = wrapMarkup2 Text.Blaze.Html4.Strict.optgroup +option :: Markup2 +option = wrapMarkup2 Text.Blaze.Html4.Strict.option +p :: Markup2 +p = wrapMarkup2 Text.Blaze.Html4.Strict.p +pre :: Markup2 +pre = wrapMarkup2 Text.Blaze.Html4.Strict.pre +q :: Markup2 +q = wrapMarkup2 Text.Blaze.Html4.Strict.q +samp :: Markup2 +samp = wrapMarkup2 Text.Blaze.Html4.Strict.samp +script :: Markup2 +script = wrapMarkup2 Text.Blaze.Html4.Strict.script +select :: Markup2 +select = wrapMarkup2 Text.Blaze.Html4.Strict.select +small :: Markup2 +small = wrapMarkup2 Text.Blaze.Html4.Strict.small +span :: Markup2 +span = wrapMarkup2 Text.Blaze.Html4.Strict.span +strong :: Markup2 +strong = wrapMarkup2 Text.Blaze.Html4.Strict.strong +style :: Markup2 +style = wrapMarkup2 Text.Blaze.Html4.Strict.style +sub :: Markup2 +sub = wrapMarkup2 Text.Blaze.Html4.Strict.sub +sup :: Markup2 +sup = wrapMarkup2 Text.Blaze.Html4.Strict.sup +table :: Markup2 +table = wrapMarkup2 Text.Blaze.Html4.Strict.table +tbody :: Markup2 +tbody = wrapMarkup2 Text.Blaze.Html4.Strict.tbody +td :: Markup2 +td = wrapMarkup2 Text.Blaze.Html4.Strict.td +textarea :: Markup2 +textarea = wrapMarkup2 Text.Blaze.Html4.Strict.textarea +tfoot :: Markup2 +tfoot = wrapMarkup2 Text.Blaze.Html4.Strict.tfoot +th :: Markup2 +th = wrapMarkup2 Text.Blaze.Html4.Strict.th +thead :: Markup2 +thead = wrapMarkup2 Text.Blaze.Html4.Strict.thead +title :: Markup2 +title = wrapMarkup2 Text.Blaze.Html4.Strict.title +tr :: Markup2 +tr = wrapMarkup2 Text.Blaze.Html4.Strict.tr +tt :: Markup2 +tt = wrapMarkup2 Text.Blaze.Html4.Strict.tt +ul :: Markup2 +ul = wrapMarkup2 Text.Blaze.Html4.Strict.ul +var :: Markup2 +var = wrapMarkup2 Text.Blaze.Html4.Strict.var +docType :: Markup +docType = wrapMarkup Text.Blaze.Html4.Strict.docType +area :: Markup +area = wrapMarkup Text.Blaze.Html4.Strict.area +br :: Markup +br = wrapMarkup Text.Blaze.Html4.Strict.br +col :: Markup +col = wrapMarkup Text.Blaze.Html4.Strict.col +hr :: Markup +hr = wrapMarkup Text.Blaze.Html4.Strict.hr +link :: Markup +link = wrapMarkup Text.Blaze.Html4.Strict.link +img :: Markup +img = wrapMarkup Text.Blaze.Html4.Strict.img +input :: Markup +input = wrapMarkup Text.Blaze.Html4.Strict.input +meta :: Markup +meta = wrapMarkup Text.Blaze.Html4.Strict.meta +param :: Markup +param = wrapMarkup Text.Blaze.Html4.Strict.param + diff --git a/src/Text/BlazeT/Html4/Strict/Attributes.hs b/src/Text/BlazeT/Html4/Strict/Attributes.hs new file mode 100644 index 0000000..18d1fe2 --- /dev/null +++ b/src/Text/BlazeT/Html4/Strict/Attributes.hs @@ -0,0 +1,11 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module simply reexports the corresponding @blaze-html@ module. +-} +module Text.BlazeT.Html4.Strict.Attributes + (module Text.Blaze.Html4.Strict.Attributes + ) where +import Text.Blaze.Html4.Strict.Attributes + diff --git a/src/Text/BlazeT/Html4/Transitional.hs b/src/Text/BlazeT/Html4/Transitional.hs new file mode 100644 index 0000000..a6dead6 --- /dev/null +++ b/src/Text/BlazeT/Html4/Transitional.hs @@ -0,0 +1,194 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module wraps all exports of "Text.Blaze.Html4.Transitional" using 'wrapMarkup' and 'wrapMarkup'. +-} +module Text.BlazeT.Html4.Transitional + (module Text.BlazeT.Html4.Transitional + ,module Text.BlazeT.Html + ) where +import qualified Text.Blaze.Html4.Transitional +import Text.BlazeT +import Text.BlazeT.Html +import Text.BlazeT.Internal + +docTypeHtml :: Markup2 +docTypeHtml = wrapMarkup2 Text.Blaze.Html4.Transitional.docTypeHtml +a :: Markup2 +a = wrapMarkup2 Text.Blaze.Html4.Transitional.a +abbr :: Markup2 +abbr = wrapMarkup2 Text.Blaze.Html4.Transitional.abbr +acronym :: Markup2 +acronym = wrapMarkup2 Text.Blaze.Html4.Transitional.acronym +address :: Markup2 +address = wrapMarkup2 Text.Blaze.Html4.Transitional.address +b :: Markup2 +b = wrapMarkup2 Text.Blaze.Html4.Transitional.b +bdo :: Markup2 +bdo = wrapMarkup2 Text.Blaze.Html4.Transitional.bdo +big :: Markup2 +big = wrapMarkup2 Text.Blaze.Html4.Transitional.big +blockquote :: Markup2 +blockquote = wrapMarkup2 Text.Blaze.Html4.Transitional.blockquote +body :: Markup2 +body = wrapMarkup2 Text.Blaze.Html4.Transitional.body +button :: Markup2 +button = wrapMarkup2 Text.Blaze.Html4.Transitional.button +caption :: Markup2 +caption = wrapMarkup2 Text.Blaze.Html4.Transitional.caption +cite :: Markup2 +cite = wrapMarkup2 Text.Blaze.Html4.Transitional.cite +code :: Markup2 +code = wrapMarkup2 Text.Blaze.Html4.Transitional.code +colgroup :: Markup2 +colgroup = wrapMarkup2 Text.Blaze.Html4.Transitional.colgroup +dd :: Markup2 +dd = wrapMarkup2 Text.Blaze.Html4.Transitional.dd +del :: Markup2 +del = wrapMarkup2 Text.Blaze.Html4.Transitional.del +dfn :: Markup2 +dfn = wrapMarkup2 Text.Blaze.Html4.Transitional.dfn +div :: Markup2 +div = wrapMarkup2 Text.Blaze.Html4.Transitional.div +dl :: Markup2 +dl = wrapMarkup2 Text.Blaze.Html4.Transitional.dl +dt :: Markup2 +dt = wrapMarkup2 Text.Blaze.Html4.Transitional.dt +em :: Markup2 +em = wrapMarkup2 Text.Blaze.Html4.Transitional.em +fieldset :: Markup2 +fieldset = wrapMarkup2 Text.Blaze.Html4.Transitional.fieldset +form :: Markup2 +form = wrapMarkup2 Text.Blaze.Html4.Transitional.form +h1 :: Markup2 +h1 = wrapMarkup2 Text.Blaze.Html4.Transitional.h1 +h2 :: Markup2 +h2 = wrapMarkup2 Text.Blaze.Html4.Transitional.h2 +h3 :: Markup2 +h3 = wrapMarkup2 Text.Blaze.Html4.Transitional.h3 +h4 :: Markup2 +h4 = wrapMarkup2 Text.Blaze.Html4.Transitional.h4 +h5 :: Markup2 +h5 = wrapMarkup2 Text.Blaze.Html4.Transitional.h5 +h6 :: Markup2 +h6 = wrapMarkup2 Text.Blaze.Html4.Transitional.h6 +head :: Markup2 +head = wrapMarkup2 Text.Blaze.Html4.Transitional.head +html :: Markup2 +html = wrapMarkup2 Text.Blaze.Html4.Transitional.html +i :: Markup2 +i = wrapMarkup2 Text.Blaze.Html4.Transitional.i +ins :: Markup2 +ins = wrapMarkup2 Text.Blaze.Html4.Transitional.ins +kbd :: Markup2 +kbd = wrapMarkup2 Text.Blaze.Html4.Transitional.kbd +label :: Markup2 +label = wrapMarkup2 Text.Blaze.Html4.Transitional.label +legend :: Markup2 +legend = wrapMarkup2 Text.Blaze.Html4.Transitional.legend +li :: Markup2 +li = wrapMarkup2 Text.Blaze.Html4.Transitional.li +map :: Markup2 +map = wrapMarkup2 Text.Blaze.Html4.Transitional.map +noscript :: Markup2 +noscript = wrapMarkup2 Text.Blaze.Html4.Transitional.noscript +object :: Markup2 +object = wrapMarkup2 Text.Blaze.Html4.Transitional.object +ol :: Markup2 +ol = wrapMarkup2 Text.Blaze.Html4.Transitional.ol +optgroup :: Markup2 +optgroup = wrapMarkup2 Text.Blaze.Html4.Transitional.optgroup +option :: Markup2 +option = wrapMarkup2 Text.Blaze.Html4.Transitional.option +p :: Markup2 +p = wrapMarkup2 Text.Blaze.Html4.Transitional.p +pre :: Markup2 +pre = wrapMarkup2 Text.Blaze.Html4.Transitional.pre +q :: Markup2 +q = wrapMarkup2 Text.Blaze.Html4.Transitional.q +samp :: Markup2 +samp = wrapMarkup2 Text.Blaze.Html4.Transitional.samp +script :: Markup2 +script = wrapMarkup2 Text.Blaze.Html4.Transitional.script +select :: Markup2 +select = wrapMarkup2 Text.Blaze.Html4.Transitional.select +small :: Markup2 +small = wrapMarkup2 Text.Blaze.Html4.Transitional.small +span :: Markup2 +span = wrapMarkup2 Text.Blaze.Html4.Transitional.span +strong :: Markup2 +strong = wrapMarkup2 Text.Blaze.Html4.Transitional.strong +style :: Markup2 +style = wrapMarkup2 Text.Blaze.Html4.Transitional.style +sub :: Markup2 +sub = wrapMarkup2 Text.Blaze.Html4.Transitional.sub +sup :: Markup2 +sup = wrapMarkup2 Text.Blaze.Html4.Transitional.sup +table :: Markup2 +table = wrapMarkup2 Text.Blaze.Html4.Transitional.table +tbody :: Markup2 +tbody = wrapMarkup2 Text.Blaze.Html4.Transitional.tbody +td :: Markup2 +td = wrapMarkup2 Text.Blaze.Html4.Transitional.td +textarea :: Markup2 +textarea = wrapMarkup2 Text.Blaze.Html4.Transitional.textarea +tfoot :: Markup2 +tfoot = wrapMarkup2 Text.Blaze.Html4.Transitional.tfoot +th :: Markup2 +th = wrapMarkup2 Text.Blaze.Html4.Transitional.th +thead :: Markup2 +thead = wrapMarkup2 Text.Blaze.Html4.Transitional.thead +title :: Markup2 +title = wrapMarkup2 Text.Blaze.Html4.Transitional.title +tr :: Markup2 +tr = wrapMarkup2 Text.Blaze.Html4.Transitional.tr +tt :: Markup2 +tt = wrapMarkup2 Text.Blaze.Html4.Transitional.tt +ul :: Markup2 +ul = wrapMarkup2 Text.Blaze.Html4.Transitional.ul +var :: Markup2 +var = wrapMarkup2 Text.Blaze.Html4.Transitional.var +applet :: Markup2 +applet = wrapMarkup2 Text.Blaze.Html4.Transitional.applet +center :: Markup2 +center = wrapMarkup2 Text.Blaze.Html4.Transitional.center +dir :: Markup2 +dir = wrapMarkup2 Text.Blaze.Html4.Transitional.dir +font :: Markup2 +font = wrapMarkup2 Text.Blaze.Html4.Transitional.font +iframe :: Markup2 +iframe = wrapMarkup2 Text.Blaze.Html4.Transitional.iframe +isindex :: Markup2 +isindex = wrapMarkup2 Text.Blaze.Html4.Transitional.isindex +menu :: Markup2 +menu = wrapMarkup2 Text.Blaze.Html4.Transitional.menu +noframes :: Markup2 +noframes = wrapMarkup2 Text.Blaze.Html4.Transitional.noframes +s :: Markup2 +s = wrapMarkup2 Text.Blaze.Html4.Transitional.s +u :: Markup2 +u = wrapMarkup2 Text.Blaze.Html4.Transitional.u +docType :: Markup +docType = wrapMarkup Text.Blaze.Html4.Transitional.docType +area :: Markup +area = wrapMarkup Text.Blaze.Html4.Transitional.area +br :: Markup +br = wrapMarkup Text.Blaze.Html4.Transitional.br +col :: Markup +col = wrapMarkup Text.Blaze.Html4.Transitional.col +hr :: Markup +hr = wrapMarkup Text.Blaze.Html4.Transitional.hr +link :: Markup +link = wrapMarkup Text.Blaze.Html4.Transitional.link +img :: Markup +img = wrapMarkup Text.Blaze.Html4.Transitional.img +input :: Markup +input = wrapMarkup Text.Blaze.Html4.Transitional.input +meta :: Markup +meta = wrapMarkup Text.Blaze.Html4.Transitional.meta +param :: Markup +param = wrapMarkup Text.Blaze.Html4.Transitional.param +basefont :: Markup +basefont = wrapMarkup Text.Blaze.Html4.Transitional.basefont + diff --git a/src/Text/BlazeT/Html4/Transitional/Attributes.hs b/src/Text/BlazeT/Html4/Transitional/Attributes.hs new file mode 100644 index 0000000..2fc0d97 --- /dev/null +++ b/src/Text/BlazeT/Html4/Transitional/Attributes.hs @@ -0,0 +1,11 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module simply reexports the corresponding @blaze-html@ module. +-} +module Text.BlazeT.Html4.Transitional.Attributes + (module Text.Blaze.Html4.Transitional.Attributes + ) where +import Text.Blaze.Html4.Transitional.Attributes + diff --git a/src/Text/BlazeT/Html5.hs b/src/Text/BlazeT/Html5.hs new file mode 100644 index 0000000..8e93bf9 --- /dev/null +++ b/src/Text/BlazeT/Html5.hs @@ -0,0 +1,234 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module wraps all exports of "Text.Blaze.Html5" using 'wrapMarkup' and 'wrapMarkup'. +-} +module Text.BlazeT.Html5 + (module Text.BlazeT.Html5 + ,module Text.BlazeT.Html + ) where +import qualified Text.Blaze.Html5 +import Text.BlazeT +import Text.BlazeT.Html +import Text.BlazeT.Internal + +docTypeHtml :: Markup2 +docTypeHtml = wrapMarkup2 Text.Blaze.Html5.docTypeHtml +a :: Markup2 +a = wrapMarkup2 Text.Blaze.Html5.a +abbr :: Markup2 +abbr = wrapMarkup2 Text.Blaze.Html5.abbr +address :: Markup2 +address = wrapMarkup2 Text.Blaze.Html5.address +article :: Markup2 +article = wrapMarkup2 Text.Blaze.Html5.article +aside :: Markup2 +aside = wrapMarkup2 Text.Blaze.Html5.aside +audio :: Markup2 +audio = wrapMarkup2 Text.Blaze.Html5.audio +b :: Markup2 +b = wrapMarkup2 Text.Blaze.Html5.b +bdo :: Markup2 +bdo = wrapMarkup2 Text.Blaze.Html5.bdo +blockquote :: Markup2 +blockquote = wrapMarkup2 Text.Blaze.Html5.blockquote +body :: Markup2 +body = wrapMarkup2 Text.Blaze.Html5.body +button :: Markup2 +button = wrapMarkup2 Text.Blaze.Html5.button +canvas :: Markup2 +canvas = wrapMarkup2 Text.Blaze.Html5.canvas +caption :: Markup2 +caption = wrapMarkup2 Text.Blaze.Html5.caption +cite :: Markup2 +cite = wrapMarkup2 Text.Blaze.Html5.cite +code :: Markup2 +code = wrapMarkup2 Text.Blaze.Html5.code +colgroup :: Markup2 +colgroup = wrapMarkup2 Text.Blaze.Html5.colgroup +command :: Markup2 +command = wrapMarkup2 Text.Blaze.Html5.command +datalist :: Markup2 +datalist = wrapMarkup2 Text.Blaze.Html5.datalist +dd :: Markup2 +dd = wrapMarkup2 Text.Blaze.Html5.dd +del :: Markup2 +del = wrapMarkup2 Text.Blaze.Html5.del +details :: Markup2 +details = wrapMarkup2 Text.Blaze.Html5.details +dfn :: Markup2 +dfn = wrapMarkup2 Text.Blaze.Html5.dfn +div :: Markup2 +div = wrapMarkup2 Text.Blaze.Html5.div +dl :: Markup2 +dl = wrapMarkup2 Text.Blaze.Html5.dl +dt :: Markup2 +dt = wrapMarkup2 Text.Blaze.Html5.dt +em :: Markup2 +em = wrapMarkup2 Text.Blaze.Html5.em +fieldset :: Markup2 +fieldset = wrapMarkup2 Text.Blaze.Html5.fieldset +figcaption :: Markup2 +figcaption = wrapMarkup2 Text.Blaze.Html5.figcaption +figure :: Markup2 +figure = wrapMarkup2 Text.Blaze.Html5.figure +footer :: Markup2 +footer = wrapMarkup2 Text.Blaze.Html5.footer +form :: Markup2 +form = wrapMarkup2 Text.Blaze.Html5.form +h1 :: Markup2 +h1 = wrapMarkup2 Text.Blaze.Html5.h1 +h2 :: Markup2 +h2 = wrapMarkup2 Text.Blaze.Html5.h2 +h3 :: Markup2 +h3 = wrapMarkup2 Text.Blaze.Html5.h3 +h4 :: Markup2 +h4 = wrapMarkup2 Text.Blaze.Html5.h4 +h5 :: Markup2 +h5 = wrapMarkup2 Text.Blaze.Html5.h5 +h6 :: Markup2 +h6 = wrapMarkup2 Text.Blaze.Html5.h6 +head :: Markup2 +head = wrapMarkup2 Text.Blaze.Html5.head +header :: Markup2 +header = wrapMarkup2 Text.Blaze.Html5.header +hgroup :: Markup2 +hgroup = wrapMarkup2 Text.Blaze.Html5.hgroup +html :: Markup2 +html = wrapMarkup2 Text.Blaze.Html5.html +i :: Markup2 +i = wrapMarkup2 Text.Blaze.Html5.i +iframe :: Markup2 +iframe = wrapMarkup2 Text.Blaze.Html5.iframe +ins :: Markup2 +ins = wrapMarkup2 Text.Blaze.Html5.ins +kbd :: Markup2 +kbd = wrapMarkup2 Text.Blaze.Html5.kbd +label :: Markup2 +label = wrapMarkup2 Text.Blaze.Html5.label +legend :: Markup2 +legend = wrapMarkup2 Text.Blaze.Html5.legend +li :: Markup2 +li = wrapMarkup2 Text.Blaze.Html5.li +main :: Markup2 +main = wrapMarkup2 Text.Blaze.Html5.main +map :: Markup2 +map = wrapMarkup2 Text.Blaze.Html5.map +mark :: Markup2 +mark = wrapMarkup2 Text.Blaze.Html5.mark +menu :: Markup2 +menu = wrapMarkup2 Text.Blaze.Html5.menu +meter :: Markup2 +meter = wrapMarkup2 Text.Blaze.Html5.meter +nav :: Markup2 +nav = wrapMarkup2 Text.Blaze.Html5.nav +noscript :: Markup2 +noscript = wrapMarkup2 Text.Blaze.Html5.noscript +object :: Markup2 +object = wrapMarkup2 Text.Blaze.Html5.object +ol :: Markup2 +ol = wrapMarkup2 Text.Blaze.Html5.ol +optgroup :: Markup2 +optgroup = wrapMarkup2 Text.Blaze.Html5.optgroup +option :: Markup2 +option = wrapMarkup2 Text.Blaze.Html5.option +output :: Markup2 +output = wrapMarkup2 Text.Blaze.Html5.output +p :: Markup2 +p = wrapMarkup2 Text.Blaze.Html5.p +pre :: Markup2 +pre = wrapMarkup2 Text.Blaze.Html5.pre +progress :: Markup2 +progress = wrapMarkup2 Text.Blaze.Html5.progress +q :: Markup2 +q = wrapMarkup2 Text.Blaze.Html5.q +rp :: Markup2 +rp = wrapMarkup2 Text.Blaze.Html5.rp +rt :: Markup2 +rt = wrapMarkup2 Text.Blaze.Html5.rt +ruby :: Markup2 +ruby = wrapMarkup2 Text.Blaze.Html5.ruby +samp :: Markup2 +samp = wrapMarkup2 Text.Blaze.Html5.samp +script :: Markup2 +script = wrapMarkup2 Text.Blaze.Html5.script +section :: Markup2 +section = wrapMarkup2 Text.Blaze.Html5.section +select :: Markup2 +select = wrapMarkup2 Text.Blaze.Html5.select +small :: Markup2 +small = wrapMarkup2 Text.Blaze.Html5.small +span :: Markup2 +span = wrapMarkup2 Text.Blaze.Html5.span +strong :: Markup2 +strong = wrapMarkup2 Text.Blaze.Html5.strong +style :: Markup2 +style = wrapMarkup2 Text.Blaze.Html5.style +sub :: Markup2 +sub = wrapMarkup2 Text.Blaze.Html5.sub +summary :: Markup2 +summary = wrapMarkup2 Text.Blaze.Html5.summary +sup :: Markup2 +sup = wrapMarkup2 Text.Blaze.Html5.sup +table :: Markup2 +table = wrapMarkup2 Text.Blaze.Html5.table +tbody :: Markup2 +tbody = wrapMarkup2 Text.Blaze.Html5.tbody +td :: Markup2 +td = wrapMarkup2 Text.Blaze.Html5.td +textarea :: Markup2 +textarea = wrapMarkup2 Text.Blaze.Html5.textarea +tfoot :: Markup2 +tfoot = wrapMarkup2 Text.Blaze.Html5.tfoot +th :: Markup2 +th = wrapMarkup2 Text.Blaze.Html5.th +thead :: Markup2 +thead = wrapMarkup2 Text.Blaze.Html5.thead +time :: Markup2 +time = wrapMarkup2 Text.Blaze.Html5.time +title :: Markup2 +title = wrapMarkup2 Text.Blaze.Html5.title +tr :: Markup2 +tr = wrapMarkup2 Text.Blaze.Html5.tr +ul :: Markup2 +ul = wrapMarkup2 Text.Blaze.Html5.ul +var :: Markup2 +var = wrapMarkup2 Text.Blaze.Html5.var +video :: Markup2 +video = wrapMarkup2 Text.Blaze.Html5.video +docType :: Markup +docType = wrapMarkup Text.Blaze.Html5.docType +area :: Markup +area = wrapMarkup Text.Blaze.Html5.area +base :: Markup +base = wrapMarkup Text.Blaze.Html5.base +br :: Markup +br = wrapMarkup Text.Blaze.Html5.br +col :: Markup +col = wrapMarkup Text.Blaze.Html5.col +embed :: Markup +embed = wrapMarkup Text.Blaze.Html5.embed +hr :: Markup +hr = wrapMarkup Text.Blaze.Html5.hr +img :: Markup +img = wrapMarkup Text.Blaze.Html5.img +input :: Markup +input = wrapMarkup Text.Blaze.Html5.input +keygen :: Markup +keygen = wrapMarkup Text.Blaze.Html5.keygen +link :: Markup +link = wrapMarkup Text.Blaze.Html5.link +menuitem :: Markup +menuitem = wrapMarkup Text.Blaze.Html5.menuitem +meta :: Markup +meta = wrapMarkup Text.Blaze.Html5.meta +param :: Markup +param = wrapMarkup Text.Blaze.Html5.param +source :: Markup +source = wrapMarkup Text.Blaze.Html5.source +track :: Markup +track = wrapMarkup Text.Blaze.Html5.track +wbr :: Markup +wbr = wrapMarkup Text.Blaze.Html5.wbr + diff --git a/src/Text/BlazeT/Html5/Attributes.hs b/src/Text/BlazeT/Html5/Attributes.hs new file mode 100644 index 0000000..1bcd773 --- /dev/null +++ b/src/Text/BlazeT/Html5/Attributes.hs @@ -0,0 +1,11 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module simply reexports the corresponding @blaze-html@ module. +-} +module Text.BlazeT.Html5.Attributes + (module Text.Blaze.Html5.Attributes + ) where +import Text.Blaze.Html5.Attributes + diff --git a/src/Text/BlazeT/Internal.hs b/src/Text/BlazeT/Internal.hs new file mode 100644 index 0000000..24ef1fe --- /dev/null +++ b/src/Text/BlazeT/Internal.hs @@ -0,0 +1,238 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE CPP #-} +#if MIN_VERSION_blaze_markup(0,7,1) +#define PRE_BUILDER +#endif +module Text.BlazeT.Internal + ( + -- * Important types. + B.ChoiceString (..) + , B.StaticString (..) + , MarkupM + , Markup + , B.Tag + , B.Attribute + , B.AttributeValue + + -- * Creating custom tags and attributes. + , customParent + , customLeaf + , B.attribute + , B.dataAttribute + , B.customAttribute + + -- * Converting values to Markup. + , text + , preEscapedText + , lazyText + , preEscapedLazyText + , textBuilder + , preEscapedTextBuilder + , string + , preEscapedString + , unsafeByteString + , unsafeLazyByteString + + -- * Comments + , B.textComment + , B.lazyTextComment + , B.stringComment + , B.unsafeByteStringComment + , B.unsafeLazyByteStringComment + + -- * Converting values to tags. + , B.textTag + , B.stringTag + + -- * Converting values to attribute values. + , B.textValue + , B.preEscapedTextValue + , B.lazyTextValue + , B.preEscapedLazyTextValue + , B.textBuilderValue + , B.preEscapedTextBuilderValue + , B.stringValue + , B.preEscapedStringValue + , B.unsafeByteStringValue + , B.unsafeLazyByteStringValue + + -- * Setting attributes + , B.Attributable + , (B.!) + , (B.!?) + + -- * Modifying Markup elements + , contents + , external + + -- * Querying Markup elements + , null + + -- * BlazeT new stuff + ,Markup2 + ,mapMarkupT + ,MarkupT + ,runMarkup + ,runMarkupT + ,execMarkup + ,execMarkupT + ,wrapMarkup + ,wrapMarkupT + ,wrapMarkup2 + ,wrapMarkupT2 + ) where + +import Control.Monad.Identity +import Control.Monad.Trans.Class +import Control.Monad.Writer.Strict +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Data.String +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Builder as LTB +import qualified Text.Blaze as B +import qualified Text.Blaze.Internal as B + +newtype MarkupT m a= MarkupT { fromMarkupT :: WriterT B.Markup m a } + deriving (Functor +#if MIN_VERSION_base(4,8,0) + ,Applicative +#endif + ,Monad + ,MonadWriter B.Markup + ,MonadTrans + ) + +-- | Map both the return value and markup of a computation using the +-- given function +mapMarkupT :: (m (a,B.Markup) -> n (b,B.Markup)) -> MarkupT m a -> MarkupT n b +mapMarkupT f = MarkupT . mapWriterT f . fromMarkupT +{-# INLINE mapMarkupT #-} + +type MarkupM = MarkupT Identity +type Markup = forall m . Monad m => MarkupT m () +type Markup2 = forall m . Monad m => MarkupT m () -> MarkupT m () + +runMarkupT :: MarkupT m a -> m (a,B.Markup) +runMarkupT = runWriterT . fromMarkupT +{-# INLINE runMarkupT #-} + +execMarkupT :: Monad m => MarkupT m a -> m B.Markup +execMarkupT = liftM snd . runMarkupT +{-# INLINE execMarkupT #-} + +runMarkup :: MarkupM a -> (a,B.Markup) +runMarkup = runIdentity . runMarkupT +{-# INLINE runMarkup #-} + +execMarkup :: MarkupM a -> B.Markup +execMarkup = snd . runMarkup +{-# INLINE execMarkup #-} + +-- instance MonadTrans MarkupT where + + +instance (Monad m,Monoid a) => Monoid (MarkupT m a) where + mempty = return mempty + {-# INLINE mempty #-} + a `mappend` b = do {a' <- a; b >>= return . (mappend a')} + {-# INLINE mappend #-} + + +instance Monad m => B.Attributable (MarkupT m a) where + h ! a = wrapMarkupT2 (B.! a) h + {-# INLINE (!) #-} + +instance Monad m => B.Attributable (a -> MarkupT m b) where + h ! a = \x -> wrapMarkupT2 (B.! a) $ h x + {-# INLINE (!) #-} + +instance Monad m => IsString (MarkupT m ()) where + fromString = wrapMarkup . fromString + {-# INLINE fromString #-} + +wrapMarkupT :: Monad m => B.Markup -> MarkupT m () +wrapMarkupT = tell +{-# INLINE wrapMarkupT #-} + +wrapMarkup :: B.Markup -> Markup +wrapMarkup = wrapMarkupT +{-# INLINE wrapMarkup #-} + +wrapMarkupT2 :: Monad m => (B.Markup -> B.Markup) + -> MarkupT m a -> MarkupT m a +wrapMarkupT2 = censor +{-# INLINE wrapMarkupT2 #-} + +wrapMarkup2 :: (B.Markup -> B.Markup) -> Markup2 +wrapMarkup2 = wrapMarkupT2 +{-# INLINE wrapMarkup2 #-} + +unsafeByteString :: BS.ByteString -> Markup +unsafeByteString = wrapMarkup . B.unsafeByteString +{-# INLINE unsafeByteString #-} + +-- | Insert a lazy 'BL.ByteString'. See 'unsafeByteString' for reasons why this +-- is an unsafe operation. +-- +unsafeLazyByteString :: BL.ByteString -- ^ Value to insert + -> Markup -- ^ Resulting HTML fragment +unsafeLazyByteString = wrapMarkup . B.unsafeLazyByteString +{-# INLINE unsafeLazyByteString #-} + +external :: Monad m => MarkupT m a -> MarkupT m a +external = wrapMarkupT2 B.external +{-# INLINE external #-} + +contents :: Monad m => MarkupT m a -> MarkupT m a +contents = wrapMarkupT2 B.contents +{-# INLINE contents #-} + +customParent ::B.Tag -> Markup2 +customParent = wrapMarkup2 . B.customParent +{-# INLINE customParent #-} + +customLeaf :: B.Tag -> Bool -> Markup +customLeaf = fmap wrapMarkup . B.customLeaf +{-# INLINE customLeaf #-} + +preEscapedText :: T.Text -> Markup +preEscapedText = wrapMarkup . B.preEscapedText +{-# INLINE preEscapedText #-} + +preEscapedLazyText :: LT.Text -> Markup +preEscapedLazyText = wrapMarkup . B.preEscapedLazyText +{-# INLINE preEscapedLazyText #-} + +preEscapedTextBuilder :: LTB.Builder -> Markup +textBuilder :: LTB.Builder -> Markup + +#ifdef PRE_BUILDER +preEscapedTextBuilder = wrapMarkup . B.preEscapedTextBuilder +textBuilder = wrapMarkup . B.textBuilder +{-# INLINE preEscapedTextBuilder #-} +{-# INLINE textBuilder #-} +#else +preEscapedTextBuilder = error "This function needs blaze-markup 0.7.1.0" +textBuilder = error "This function needs blaze-markup 0.7.1.0" +#endif + +preEscapedString :: String -> Markup +preEscapedString = wrapMarkup . B.preEscapedString +{-# INLINE preEscapedString #-} + +string :: String -> Markup +string = wrapMarkup . B.string +{-# INLINE string #-} + +text :: T.Text -> Markup +text = wrapMarkup . B.text +{-# INLINE text #-} + +lazyText :: LT.Text -> Markup +lazyText = wrapMarkup . B.lazyText +{-# INLINE lazyText #-} diff --git a/src/Text/BlazeT/Renderer/Pretty.hs b/src/Text/BlazeT/Renderer/Pretty.hs new file mode 100644 index 0000000..8977c94 --- /dev/null +++ b/src/Text/BlazeT/Renderer/Pretty.hs @@ -0,0 +1,22 @@ +module Text.BlazeT.Renderer.Pretty + ( renderMarkup + , renderHtml + , renderMarkupT + , renderHtmlT + ) where + +import Control.Monad +import Control.Monad.Identity +import qualified Text.Blaze.Renderer.Pretty as BU +import Text.BlazeT + +renderMarkup :: MarkupM a -> String +renderMarkup = runIdentity . renderMarkupT +renderMarkupT :: Monad m => MarkupT m a -> m String +renderMarkupT = liftM BU.renderMarkup . execMarkupT + +renderHtml :: MarkupM a -> String +renderHtml = renderMarkup +renderHtmlT :: Monad m => MarkupT m a -> m String +renderHtmlT = renderMarkupT + diff --git a/src/Text/BlazeT/Renderer/String.hs b/src/Text/BlazeT/Renderer/String.hs new file mode 100644 index 0000000..0a2de8a --- /dev/null +++ b/src/Text/BlazeT/Renderer/String.hs @@ -0,0 +1,27 @@ +module Text.BlazeT.Renderer.String + ( fromChoiceString + , renderMarkup + , renderHtml + , renderMarkupT + , renderHtmlT + ) where + +import Control.Monad +import Control.Monad.Identity +import Text.Blaze.Internal (ChoiceString) +import qualified Text.Blaze.Renderer.String as BU +import Text.BlazeT + +fromChoiceString :: ChoiceString -> String -> String +fromChoiceString = BU.fromChoiceString + +renderMarkup :: MarkupM a -> String +renderMarkup = runIdentity . renderMarkupT +renderMarkupT :: Monad m => MarkupT m a -> m String +renderMarkupT = liftM BU.renderMarkup . execMarkupT + +renderHtml :: MarkupM a -> String +renderHtml = renderMarkup +renderHtmlT :: Monad m => MarkupT m a -> m String +renderHtmlT = renderMarkupT + diff --git a/src/Text/BlazeT/Renderer/Text.hs b/src/Text/BlazeT/Renderer/Text.hs new file mode 100644 index 0000000..31181eb --- /dev/null +++ b/src/Text/BlazeT/Renderer/Text.hs @@ -0,0 +1,75 @@ +module Text.BlazeT.Renderer.Text + ( renderMarkupBuilderT + , renderMarkupBuilder + , renderMarkupBuilderWithT + , renderMarkupT + , renderMarkupWithT + , renderHtmlBuilderT + , renderHtmlBuilderWithT + , renderHtmlT + , renderHtmlWithT + , renderMarkupBuilderWith + , renderMarkup + , renderMarkupWith + , renderHtmlBuilder + , renderHtmlBuilderWith + , renderHtml + , renderHtmlWith + ) where + +import Control.Monad +import Data.ByteString (ByteString) +import Control.Monad.Identity +import Data.Text (Text) +import qualified Data.Text.Lazy as L +import qualified Data.Text.Lazy.Builder as B +import qualified Text.Blaze.Html.Renderer.Text as BH +import qualified Text.Blaze.Renderer.Text as BU +import Text.BlazeT + +renderMarkupBuilder :: MarkupM a -> B.Builder +renderMarkupBuilder = runIdentity . renderMarkupBuilderT + +renderMarkupBuilderT :: Monad m => MarkupT m a -> m B.Builder +renderMarkupBuilderT = liftM BU.renderMarkupBuilder . execMarkupT + +renderHtmlBuilder :: MarkupM a -> B.Builder +renderHtmlBuilder = renderMarkupBuilder + +renderHtmlBuilderT :: Monad m => MarkupT m a -> m B.Builder +renderHtmlBuilderT = renderMarkupBuilderT + +renderMarkup :: MarkupM a -> L.Text +renderMarkup = runIdentity . renderMarkupT +renderMarkupT :: Monad m => MarkupT m a -> m L.Text +renderMarkupT = liftM BU.renderMarkup . execMarkupT + +renderHtml :: MarkupM a -> L.Text +renderHtml = renderMarkup +renderHtmlT :: Monad m => MarkupT m a -> m L.Text +renderHtmlT = renderMarkupT + +renderMarkupWithT :: Monad m => (ByteString -> Text) -> MarkupT m a -> m L.Text +renderMarkupWithT g = liftM (BU.renderMarkupWith g) . execMarkupT + +renderMarkupWith :: (ByteString -> Text) -> MarkupM a -> L.Text +renderMarkupWith g = runIdentity . renderMarkupWithT g + +renderHtmlWithT :: Monad m => (ByteString -> Text) -> MarkupT m a -> m L.Text +renderHtmlWithT g = liftM (BH.renderHtmlWith g) . execMarkupT + +renderHtmlWith :: (ByteString -> Text) -> MarkupM a -> L.Text +renderHtmlWith g = runIdentity . renderHtmlWithT g + +renderHtmlBuilderWithT :: Monad m => (ByteString -> Text) -> MarkupT m a -> m B.Builder +renderHtmlBuilderWithT g = liftM (BH.renderHtmlBuilderWith g) . execMarkupT + +renderHtmlBuilderWith :: (ByteString -> Text) -> MarkupM a -> B.Builder +renderHtmlBuilderWith g = runIdentity . renderHtmlBuilderWithT g + + +renderMarkupBuilderWithT :: Monad m => (ByteString -> Text) -> MarkupT m a -> m B.Builder +renderMarkupBuilderWithT g = liftM (BU.renderMarkupBuilderWith g) . execMarkupT + +renderMarkupBuilderWith :: (ByteString -> Text) -> MarkupM a -> B.Builder +renderMarkupBuilderWith g = runIdentity . renderMarkupBuilderWithT g diff --git a/src/Text/BlazeT/Renderer/Utf8.hs b/src/Text/BlazeT/Renderer/Utf8.hs new file mode 100644 index 0000000..292f81f --- /dev/null +++ b/src/Text/BlazeT/Renderer/Utf8.hs @@ -0,0 +1,66 @@ +{-# OPTIONS_GHC -fsimpl-tick-factor=230 #-} + +-- the above option was not needed with + -- ,blaze-html >= 0.6.0.0 && < 0.7.0.0 + -- ,blaze-builder >= 0.2 + -- ,text < 1.2 + +module Text.BlazeT.Renderer.Utf8 + ( + renderMarkupBuilder + , renderMarkup + , renderMarkupToByteStringIO + , renderHtmlBuilder + , renderHtml + , renderHtmlToByteStringIO + + -- * new BlazeT stuff + , renderMarkupBuilderT + , renderMarkupT + , renderMarkupToByteStringIOT + , renderHtmlToByteStringIOT + , renderHtmlBuilderT + , renderHtmlT + ) where + +import qualified Blaze.ByteString.Builder as B +import Control.Monad +import Control.Monad.Identity +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Text.Blaze.Renderer.Utf8 as BU +import Text.BlazeT + +renderMarkupBuilder :: MarkupM a -> B.Builder +renderMarkupBuilder = runIdentity . renderMarkupBuilderT + +renderMarkupBuilderT :: Monad m => MarkupT m a -> m B.Builder +renderMarkupBuilderT = liftM BU.renderMarkupBuilder . execMarkupT + +renderHtmlBuilder :: MarkupM a -> B.Builder +renderHtmlBuilder = renderMarkupBuilder + +renderHtmlBuilderT :: Monad m => MarkupT m a -> m B.Builder +renderHtmlBuilderT = renderMarkupBuilderT + +renderMarkup :: MarkupM a -> BL.ByteString +renderMarkup = runIdentity . renderMarkupT +renderMarkupT :: Monad m => MarkupT m a -> m BL.ByteString +renderMarkupT = liftM BU.renderMarkup . execMarkupT + +renderHtml :: MarkupM a -> BL.ByteString +renderHtml = renderMarkup +renderHtmlT :: Monad m => MarkupT m a -> m BL.ByteString +renderHtmlT = renderMarkupT + +renderMarkupToByteStringIO :: (BS.ByteString -> IO ()) -> MarkupM a -> IO () +renderMarkupToByteStringIO g = runIdentity . renderMarkupToByteStringIOT g +renderMarkupToByteStringIOT :: Monad m => (BS.ByteString -> IO ()) -> + MarkupT m a -> m (IO ()) +renderMarkupToByteStringIOT g = liftM (BU.renderMarkupToByteStringIO g) . execMarkupT + +renderHtmlToByteStringIO :: (BS.ByteString -> IO ()) -> MarkupM a -> IO () +renderHtmlToByteStringIO g = runIdentity . renderMarkupToByteStringIOT g +renderHtmlToByteStringIOT :: Monad m => (BS.ByteString -> IO ()) -> + MarkupT m a -> m (IO ()) +renderHtmlToByteStringIOT g = liftM (BU.renderMarkupToByteStringIO g) . execMarkupT diff --git a/src/Text/BlazeT/XHtml1/FrameSet.hs b/src/Text/BlazeT/XHtml1/FrameSet.hs new file mode 100644 index 0000000..57edcd5 --- /dev/null +++ b/src/Text/BlazeT/XHtml1/FrameSet.hs @@ -0,0 +1,198 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module wraps all exports of "Text.Blaze.XHtml1.FrameSet" using 'wrapMarkup' and 'wrapMarkup'. +-} +module Text.BlazeT.XHtml1.FrameSet + (module Text.BlazeT.XHtml1.FrameSet + ,module Text.BlazeT.Html + ) where +import qualified Text.Blaze.XHtml1.FrameSet +import Text.BlazeT +import Text.BlazeT.Html +import Text.BlazeT.Internal + +docTypeHtml :: Markup2 +docTypeHtml = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.docTypeHtml +a :: Markup2 +a = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.a +abbr :: Markup2 +abbr = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.abbr +acronym :: Markup2 +acronym = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.acronym +address :: Markup2 +address = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.address +b :: Markup2 +b = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.b +bdo :: Markup2 +bdo = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.bdo +big :: Markup2 +big = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.big +blockquote :: Markup2 +blockquote = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.blockquote +body :: Markup2 +body = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.body +button :: Markup2 +button = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.button +caption :: Markup2 +caption = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.caption +cite :: Markup2 +cite = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.cite +code :: Markup2 +code = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.code +colgroup :: Markup2 +colgroup = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.colgroup +dd :: Markup2 +dd = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.dd +del :: Markup2 +del = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.del +dfn :: Markup2 +dfn = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.dfn +div :: Markup2 +div = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.div +dl :: Markup2 +dl = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.dl +dt :: Markup2 +dt = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.dt +em :: Markup2 +em = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.em +fieldset :: Markup2 +fieldset = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.fieldset +form :: Markup2 +form = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.form +h1 :: Markup2 +h1 = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.h1 +h2 :: Markup2 +h2 = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.h2 +h3 :: Markup2 +h3 = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.h3 +h4 :: Markup2 +h4 = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.h4 +h5 :: Markup2 +h5 = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.h5 +h6 :: Markup2 +h6 = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.h6 +head :: Markup2 +head = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.head +html :: Markup2 +html = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.html +i :: Markup2 +i = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.i +ins :: Markup2 +ins = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.ins +kbd :: Markup2 +kbd = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.kbd +label :: Markup2 +label = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.label +legend :: Markup2 +legend = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.legend +li :: Markup2 +li = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.li +map :: Markup2 +map = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.map +noscript :: Markup2 +noscript = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.noscript +object :: Markup2 +object = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.object +ol :: Markup2 +ol = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.ol +optgroup :: Markup2 +optgroup = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.optgroup +option :: Markup2 +option = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.option +p :: Markup2 +p = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.p +pre :: Markup2 +pre = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.pre +q :: Markup2 +q = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.q +samp :: Markup2 +samp = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.samp +script :: Markup2 +script = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.script +select :: Markup2 +select = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.select +small :: Markup2 +small = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.small +span :: Markup2 +span = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.span +strong :: Markup2 +strong = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.strong +style :: Markup2 +style = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.style +sub :: Markup2 +sub = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.sub +sup :: Markup2 +sup = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.sup +table :: Markup2 +table = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.table +tbody :: Markup2 +tbody = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.tbody +td :: Markup2 +td = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.td +textarea :: Markup2 +textarea = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.textarea +tfoot :: Markup2 +tfoot = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.tfoot +th :: Markup2 +th = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.th +thead :: Markup2 +thead = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.thead +title :: Markup2 +title = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.title +tr :: Markup2 +tr = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.tr +tt :: Markup2 +tt = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.tt +ul :: Markup2 +ul = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.ul +var :: Markup2 +var = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.var +applet :: Markup2 +applet = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.applet +center :: Markup2 +center = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.center +dir :: Markup2 +dir = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.dir +font :: Markup2 +font = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.font +iframe :: Markup2 +iframe = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.iframe +isindex :: Markup2 +isindex = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.isindex +menu :: Markup2 +menu = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.menu +noframes :: Markup2 +noframes = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.noframes +s :: Markup2 +s = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.s +u :: Markup2 +u = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.u +frameset :: Markup2 +frameset = wrapMarkup2 Text.Blaze.XHtml1.FrameSet.frameset +docType :: Markup +docType = wrapMarkup Text.Blaze.XHtml1.FrameSet.docType +area :: Markup +area = wrapMarkup Text.Blaze.XHtml1.FrameSet.area +br :: Markup +br = wrapMarkup Text.Blaze.XHtml1.FrameSet.br +col :: Markup +col = wrapMarkup Text.Blaze.XHtml1.FrameSet.col +hr :: Markup +hr = wrapMarkup Text.Blaze.XHtml1.FrameSet.hr +link :: Markup +link = wrapMarkup Text.Blaze.XHtml1.FrameSet.link +img :: Markup +img = wrapMarkup Text.Blaze.XHtml1.FrameSet.img +input :: Markup +input = wrapMarkup Text.Blaze.XHtml1.FrameSet.input +meta :: Markup +meta = wrapMarkup Text.Blaze.XHtml1.FrameSet.meta +param :: Markup +param = wrapMarkup Text.Blaze.XHtml1.FrameSet.param +basefont :: Markup +basefont = wrapMarkup Text.Blaze.XHtml1.FrameSet.basefont +frame :: Markup +frame = wrapMarkup Text.Blaze.XHtml1.FrameSet.frame + diff --git a/src/Text/BlazeT/XHtml1/FrameSet/Attributes.hs b/src/Text/BlazeT/XHtml1/FrameSet/Attributes.hs new file mode 100644 index 0000000..af4ecbe --- /dev/null +++ b/src/Text/BlazeT/XHtml1/FrameSet/Attributes.hs @@ -0,0 +1,11 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module simply reexports the corresponding @blaze-html@ module. +-} +module Text.BlazeT.XHtml1.FrameSet.Attributes + (module Text.Blaze.XHtml1.FrameSet.Attributes + ) where +import Text.Blaze.XHtml1.FrameSet.Attributes + diff --git a/src/Text/BlazeT/XHtml1/Strict.hs b/src/Text/BlazeT/XHtml1/Strict.hs new file mode 100644 index 0000000..0bca241 --- /dev/null +++ b/src/Text/BlazeT/XHtml1/Strict.hs @@ -0,0 +1,172 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module wraps all exports of "Text.Blaze.XHtml1.Strict" using 'wrapMarkup' and 'wrapMarkup'. +-} +module Text.BlazeT.XHtml1.Strict + (module Text.BlazeT.XHtml1.Strict + ,module Text.BlazeT.Html + ) where +import qualified Text.Blaze.XHtml1.Strict +import Text.BlazeT +import Text.BlazeT.Html +import Text.BlazeT.Internal + +docTypeHtml :: Markup2 +docTypeHtml = wrapMarkup2 Text.Blaze.XHtml1.Strict.docTypeHtml +a :: Markup2 +a = wrapMarkup2 Text.Blaze.XHtml1.Strict.a +abbr :: Markup2 +abbr = wrapMarkup2 Text.Blaze.XHtml1.Strict.abbr +acronym :: Markup2 +acronym = wrapMarkup2 Text.Blaze.XHtml1.Strict.acronym +address :: Markup2 +address = wrapMarkup2 Text.Blaze.XHtml1.Strict.address +b :: Markup2 +b = wrapMarkup2 Text.Blaze.XHtml1.Strict.b +bdo :: Markup2 +bdo = wrapMarkup2 Text.Blaze.XHtml1.Strict.bdo +big :: Markup2 +big = wrapMarkup2 Text.Blaze.XHtml1.Strict.big +blockquote :: Markup2 +blockquote = wrapMarkup2 Text.Blaze.XHtml1.Strict.blockquote +body :: Markup2 +body = wrapMarkup2 Text.Blaze.XHtml1.Strict.body +button :: Markup2 +button = wrapMarkup2 Text.Blaze.XHtml1.Strict.button +caption :: Markup2 +caption = wrapMarkup2 Text.Blaze.XHtml1.Strict.caption +cite :: Markup2 +cite = wrapMarkup2 Text.Blaze.XHtml1.Strict.cite +code :: Markup2 +code = wrapMarkup2 Text.Blaze.XHtml1.Strict.code +colgroup :: Markup2 +colgroup = wrapMarkup2 Text.Blaze.XHtml1.Strict.colgroup +dd :: Markup2 +dd = wrapMarkup2 Text.Blaze.XHtml1.Strict.dd +del :: Markup2 +del = wrapMarkup2 Text.Blaze.XHtml1.Strict.del +dfn :: Markup2 +dfn = wrapMarkup2 Text.Blaze.XHtml1.Strict.dfn +div :: Markup2 +div = wrapMarkup2 Text.Blaze.XHtml1.Strict.div +dl :: Markup2 +dl = wrapMarkup2 Text.Blaze.XHtml1.Strict.dl +dt :: Markup2 +dt = wrapMarkup2 Text.Blaze.XHtml1.Strict.dt +em :: Markup2 +em = wrapMarkup2 Text.Blaze.XHtml1.Strict.em +fieldset :: Markup2 +fieldset = wrapMarkup2 Text.Blaze.XHtml1.Strict.fieldset +form :: Markup2 +form = wrapMarkup2 Text.Blaze.XHtml1.Strict.form +h1 :: Markup2 +h1 = wrapMarkup2 Text.Blaze.XHtml1.Strict.h1 +h2 :: Markup2 +h2 = wrapMarkup2 Text.Blaze.XHtml1.Strict.h2 +h3 :: Markup2 +h3 = wrapMarkup2 Text.Blaze.XHtml1.Strict.h3 +h4 :: Markup2 +h4 = wrapMarkup2 Text.Blaze.XHtml1.Strict.h4 +h5 :: Markup2 +h5 = wrapMarkup2 Text.Blaze.XHtml1.Strict.h5 +h6 :: Markup2 +h6 = wrapMarkup2 Text.Blaze.XHtml1.Strict.h6 +head :: Markup2 +head = wrapMarkup2 Text.Blaze.XHtml1.Strict.head +html :: Markup2 +html = wrapMarkup2 Text.Blaze.XHtml1.Strict.html +i :: Markup2 +i = wrapMarkup2 Text.Blaze.XHtml1.Strict.i +ins :: Markup2 +ins = wrapMarkup2 Text.Blaze.XHtml1.Strict.ins +kbd :: Markup2 +kbd = wrapMarkup2 Text.Blaze.XHtml1.Strict.kbd +label :: Markup2 +label = wrapMarkup2 Text.Blaze.XHtml1.Strict.label +legend :: Markup2 +legend = wrapMarkup2 Text.Blaze.XHtml1.Strict.legend +li :: Markup2 +li = wrapMarkup2 Text.Blaze.XHtml1.Strict.li +map :: Markup2 +map = wrapMarkup2 Text.Blaze.XHtml1.Strict.map +noscript :: Markup2 +noscript = wrapMarkup2 Text.Blaze.XHtml1.Strict.noscript +object :: Markup2 +object = wrapMarkup2 Text.Blaze.XHtml1.Strict.object +ol :: Markup2 +ol = wrapMarkup2 Text.Blaze.XHtml1.Strict.ol +optgroup :: Markup2 +optgroup = wrapMarkup2 Text.Blaze.XHtml1.Strict.optgroup +option :: Markup2 +option = wrapMarkup2 Text.Blaze.XHtml1.Strict.option +p :: Markup2 +p = wrapMarkup2 Text.Blaze.XHtml1.Strict.p +pre :: Markup2 +pre = wrapMarkup2 Text.Blaze.XHtml1.Strict.pre +q :: Markup2 +q = wrapMarkup2 Text.Blaze.XHtml1.Strict.q +samp :: Markup2 +samp = wrapMarkup2 Text.Blaze.XHtml1.Strict.samp +script :: Markup2 +script = wrapMarkup2 Text.Blaze.XHtml1.Strict.script +select :: Markup2 +select = wrapMarkup2 Text.Blaze.XHtml1.Strict.select +small :: Markup2 +small = wrapMarkup2 Text.Blaze.XHtml1.Strict.small +span :: Markup2 +span = wrapMarkup2 Text.Blaze.XHtml1.Strict.span +strong :: Markup2 +strong = wrapMarkup2 Text.Blaze.XHtml1.Strict.strong +style :: Markup2 +style = wrapMarkup2 Text.Blaze.XHtml1.Strict.style +sub :: Markup2 +sub = wrapMarkup2 Text.Blaze.XHtml1.Strict.sub +sup :: Markup2 +sup = wrapMarkup2 Text.Blaze.XHtml1.Strict.sup +table :: Markup2 +table = wrapMarkup2 Text.Blaze.XHtml1.Strict.table +tbody :: Markup2 +tbody = wrapMarkup2 Text.Blaze.XHtml1.Strict.tbody +td :: Markup2 +td = wrapMarkup2 Text.Blaze.XHtml1.Strict.td +textarea :: Markup2 +textarea = wrapMarkup2 Text.Blaze.XHtml1.Strict.textarea +tfoot :: Markup2 +tfoot = wrapMarkup2 Text.Blaze.XHtml1.Strict.tfoot +th :: Markup2 +th = wrapMarkup2 Text.Blaze.XHtml1.Strict.th +thead :: Markup2 +thead = wrapMarkup2 Text.Blaze.XHtml1.Strict.thead +title :: Markup2 +title = wrapMarkup2 Text.Blaze.XHtml1.Strict.title +tr :: Markup2 +tr = wrapMarkup2 Text.Blaze.XHtml1.Strict.tr +tt :: Markup2 +tt = wrapMarkup2 Text.Blaze.XHtml1.Strict.tt +ul :: Markup2 +ul = wrapMarkup2 Text.Blaze.XHtml1.Strict.ul +var :: Markup2 +var = wrapMarkup2 Text.Blaze.XHtml1.Strict.var +docType :: Markup +docType = wrapMarkup Text.Blaze.XHtml1.Strict.docType +area :: Markup +area = wrapMarkup Text.Blaze.XHtml1.Strict.area +br :: Markup +br = wrapMarkup Text.Blaze.XHtml1.Strict.br +col :: Markup +col = wrapMarkup Text.Blaze.XHtml1.Strict.col +hr :: Markup +hr = wrapMarkup Text.Blaze.XHtml1.Strict.hr +link :: Markup +link = wrapMarkup Text.Blaze.XHtml1.Strict.link +img :: Markup +img = wrapMarkup Text.Blaze.XHtml1.Strict.img +input :: Markup +input = wrapMarkup Text.Blaze.XHtml1.Strict.input +meta :: Markup +meta = wrapMarkup Text.Blaze.XHtml1.Strict.meta +param :: Markup +param = wrapMarkup Text.Blaze.XHtml1.Strict.param + diff --git a/src/Text/BlazeT/XHtml1/Strict/Attributes.hs b/src/Text/BlazeT/XHtml1/Strict/Attributes.hs new file mode 100644 index 0000000..c7e07d4 --- /dev/null +++ b/src/Text/BlazeT/XHtml1/Strict/Attributes.hs @@ -0,0 +1,11 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module simply reexports the corresponding @blaze-html@ module. +-} +module Text.BlazeT.XHtml1.Strict.Attributes + (module Text.Blaze.XHtml1.Strict.Attributes + ) where +import Text.Blaze.XHtml1.Strict.Attributes + diff --git a/src/Text/BlazeT/XHtml1/Transitional.hs b/src/Text/BlazeT/XHtml1/Transitional.hs new file mode 100644 index 0000000..b1e6aad --- /dev/null +++ b/src/Text/BlazeT/XHtml1/Transitional.hs @@ -0,0 +1,194 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module wraps all exports of "Text.Blaze.XHtml1.Transitional" using 'wrapMarkup' and 'wrapMarkup'. +-} +module Text.BlazeT.XHtml1.Transitional + (module Text.BlazeT.XHtml1.Transitional + ,module Text.BlazeT.Html + ) where +import qualified Text.Blaze.XHtml1.Transitional +import Text.BlazeT +import Text.BlazeT.Html +import Text.BlazeT.Internal + +docTypeHtml :: Markup2 +docTypeHtml = wrapMarkup2 Text.Blaze.XHtml1.Transitional.docTypeHtml +a :: Markup2 +a = wrapMarkup2 Text.Blaze.XHtml1.Transitional.a +abbr :: Markup2 +abbr = wrapMarkup2 Text.Blaze.XHtml1.Transitional.abbr +acronym :: Markup2 +acronym = wrapMarkup2 Text.Blaze.XHtml1.Transitional.acronym +address :: Markup2 +address = wrapMarkup2 Text.Blaze.XHtml1.Transitional.address +b :: Markup2 +b = wrapMarkup2 Text.Blaze.XHtml1.Transitional.b +bdo :: Markup2 +bdo = wrapMarkup2 Text.Blaze.XHtml1.Transitional.bdo +big :: Markup2 +big = wrapMarkup2 Text.Blaze.XHtml1.Transitional.big +blockquote :: Markup2 +blockquote = wrapMarkup2 Text.Blaze.XHtml1.Transitional.blockquote +body :: Markup2 +body = wrapMarkup2 Text.Blaze.XHtml1.Transitional.body +button :: Markup2 +button = wrapMarkup2 Text.Blaze.XHtml1.Transitional.button +caption :: Markup2 +caption = wrapMarkup2 Text.Blaze.XHtml1.Transitional.caption +cite :: Markup2 +cite = wrapMarkup2 Text.Blaze.XHtml1.Transitional.cite +code :: Markup2 +code = wrapMarkup2 Text.Blaze.XHtml1.Transitional.code +colgroup :: Markup2 +colgroup = wrapMarkup2 Text.Blaze.XHtml1.Transitional.colgroup +dd :: Markup2 +dd = wrapMarkup2 Text.Blaze.XHtml1.Transitional.dd +del :: Markup2 +del = wrapMarkup2 Text.Blaze.XHtml1.Transitional.del +dfn :: Markup2 +dfn = wrapMarkup2 Text.Blaze.XHtml1.Transitional.dfn +div :: Markup2 +div = wrapMarkup2 Text.Blaze.XHtml1.Transitional.div +dl :: Markup2 +dl = wrapMarkup2 Text.Blaze.XHtml1.Transitional.dl +dt :: Markup2 +dt = wrapMarkup2 Text.Blaze.XHtml1.Transitional.dt +em :: Markup2 +em = wrapMarkup2 Text.Blaze.XHtml1.Transitional.em +fieldset :: Markup2 +fieldset = wrapMarkup2 Text.Blaze.XHtml1.Transitional.fieldset +form :: Markup2 +form = wrapMarkup2 Text.Blaze.XHtml1.Transitional.form +h1 :: Markup2 +h1 = wrapMarkup2 Text.Blaze.XHtml1.Transitional.h1 +h2 :: Markup2 +h2 = wrapMarkup2 Text.Blaze.XHtml1.Transitional.h2 +h3 :: Markup2 +h3 = wrapMarkup2 Text.Blaze.XHtml1.Transitional.h3 +h4 :: Markup2 +h4 = wrapMarkup2 Text.Blaze.XHtml1.Transitional.h4 +h5 :: Markup2 +h5 = wrapMarkup2 Text.Blaze.XHtml1.Transitional.h5 +h6 :: Markup2 +h6 = wrapMarkup2 Text.Blaze.XHtml1.Transitional.h6 +head :: Markup2 +head = wrapMarkup2 Text.Blaze.XHtml1.Transitional.head +html :: Markup2 +html = wrapMarkup2 Text.Blaze.XHtml1.Transitional.html +i :: Markup2 +i = wrapMarkup2 Text.Blaze.XHtml1.Transitional.i +ins :: Markup2 +ins = wrapMarkup2 Text.Blaze.XHtml1.Transitional.ins +kbd :: Markup2 +kbd = wrapMarkup2 Text.Blaze.XHtml1.Transitional.kbd +label :: Markup2 +label = wrapMarkup2 Text.Blaze.XHtml1.Transitional.label +legend :: Markup2 +legend = wrapMarkup2 Text.Blaze.XHtml1.Transitional.legend +li :: Markup2 +li = wrapMarkup2 Text.Blaze.XHtml1.Transitional.li +map :: Markup2 +map = wrapMarkup2 Text.Blaze.XHtml1.Transitional.map +noscript :: Markup2 +noscript = wrapMarkup2 Text.Blaze.XHtml1.Transitional.noscript +object :: Markup2 +object = wrapMarkup2 Text.Blaze.XHtml1.Transitional.object +ol :: Markup2 +ol = wrapMarkup2 Text.Blaze.XHtml1.Transitional.ol +optgroup :: Markup2 +optgroup = wrapMarkup2 Text.Blaze.XHtml1.Transitional.optgroup +option :: Markup2 +option = wrapMarkup2 Text.Blaze.XHtml1.Transitional.option +p :: Markup2 +p = wrapMarkup2 Text.Blaze.XHtml1.Transitional.p +pre :: Markup2 +pre = wrapMarkup2 Text.Blaze.XHtml1.Transitional.pre +q :: Markup2 +q = wrapMarkup2 Text.Blaze.XHtml1.Transitional.q +samp :: Markup2 +samp = wrapMarkup2 Text.Blaze.XHtml1.Transitional.samp +script :: Markup2 +script = wrapMarkup2 Text.Blaze.XHtml1.Transitional.script +select :: Markup2 +select = wrapMarkup2 Text.Blaze.XHtml1.Transitional.select +small :: Markup2 +small = wrapMarkup2 Text.Blaze.XHtml1.Transitional.small +span :: Markup2 +span = wrapMarkup2 Text.Blaze.XHtml1.Transitional.span +strong :: Markup2 +strong = wrapMarkup2 Text.Blaze.XHtml1.Transitional.strong +style :: Markup2 +style = wrapMarkup2 Text.Blaze.XHtml1.Transitional.style +sub :: Markup2 +sub = wrapMarkup2 Text.Blaze.XHtml1.Transitional.sub +sup :: Markup2 +sup = wrapMarkup2 Text.Blaze.XHtml1.Transitional.sup +table :: Markup2 +table = wrapMarkup2 Text.Blaze.XHtml1.Transitional.table +tbody :: Markup2 +tbody = wrapMarkup2 Text.Blaze.XHtml1.Transitional.tbody +td :: Markup2 +td = wrapMarkup2 Text.Blaze.XHtml1.Transitional.td +textarea :: Markup2 +textarea = wrapMarkup2 Text.Blaze.XHtml1.Transitional.textarea +tfoot :: Markup2 +tfoot = wrapMarkup2 Text.Blaze.XHtml1.Transitional.tfoot +th :: Markup2 +th = wrapMarkup2 Text.Blaze.XHtml1.Transitional.th +thead :: Markup2 +thead = wrapMarkup2 Text.Blaze.XHtml1.Transitional.thead +title :: Markup2 +title = wrapMarkup2 Text.Blaze.XHtml1.Transitional.title +tr :: Markup2 +tr = wrapMarkup2 Text.Blaze.XHtml1.Transitional.tr +tt :: Markup2 +tt = wrapMarkup2 Text.Blaze.XHtml1.Transitional.tt +ul :: Markup2 +ul = wrapMarkup2 Text.Blaze.XHtml1.Transitional.ul +var :: Markup2 +var = wrapMarkup2 Text.Blaze.XHtml1.Transitional.var +applet :: Markup2 +applet = wrapMarkup2 Text.Blaze.XHtml1.Transitional.applet +center :: Markup2 +center = wrapMarkup2 Text.Blaze.XHtml1.Transitional.center +dir :: Markup2 +dir = wrapMarkup2 Text.Blaze.XHtml1.Transitional.dir +font :: Markup2 +font = wrapMarkup2 Text.Blaze.XHtml1.Transitional.font +iframe :: Markup2 +iframe = wrapMarkup2 Text.Blaze.XHtml1.Transitional.iframe +isindex :: Markup2 +isindex = wrapMarkup2 Text.Blaze.XHtml1.Transitional.isindex +menu :: Markup2 +menu = wrapMarkup2 Text.Blaze.XHtml1.Transitional.menu +noframes :: Markup2 +noframes = wrapMarkup2 Text.Blaze.XHtml1.Transitional.noframes +s :: Markup2 +s = wrapMarkup2 Text.Blaze.XHtml1.Transitional.s +u :: Markup2 +u = wrapMarkup2 Text.Blaze.XHtml1.Transitional.u +docType :: Markup +docType = wrapMarkup Text.Blaze.XHtml1.Transitional.docType +area :: Markup +area = wrapMarkup Text.Blaze.XHtml1.Transitional.area +br :: Markup +br = wrapMarkup Text.Blaze.XHtml1.Transitional.br +col :: Markup +col = wrapMarkup Text.Blaze.XHtml1.Transitional.col +hr :: Markup +hr = wrapMarkup Text.Blaze.XHtml1.Transitional.hr +link :: Markup +link = wrapMarkup Text.Blaze.XHtml1.Transitional.link +img :: Markup +img = wrapMarkup Text.Blaze.XHtml1.Transitional.img +input :: Markup +input = wrapMarkup Text.Blaze.XHtml1.Transitional.input +meta :: Markup +meta = wrapMarkup Text.Blaze.XHtml1.Transitional.meta +param :: Markup +param = wrapMarkup Text.Blaze.XHtml1.Transitional.param +basefont :: Markup +basefont = wrapMarkup Text.Blaze.XHtml1.Transitional.basefont + diff --git a/src/Text/BlazeT/XHtml1/Transitional/Attributes.hs b/src/Text/BlazeT/XHtml1/Transitional/Attributes.hs new file mode 100644 index 0000000..1881806 --- /dev/null +++ b/src/Text/BlazeT/XHtml1/Transitional/Attributes.hs @@ -0,0 +1,11 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module simply reexports the corresponding @blaze-html@ module. +-} +module Text.BlazeT.XHtml1.Transitional.Attributes + (module Text.Blaze.XHtml1.Transitional.Attributes + ) where +import Text.Blaze.XHtml1.Transitional.Attributes + diff --git a/src/Text/BlazeT/XHtml5.hs b/src/Text/BlazeT/XHtml5.hs new file mode 100644 index 0000000..102a993 --- /dev/null +++ b/src/Text/BlazeT/XHtml5.hs @@ -0,0 +1,234 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module wraps all exports of "Text.Blaze.XHtml5" using 'wrapMarkup' and 'wrapMarkup'. +-} +module Text.BlazeT.XHtml5 + (module Text.BlazeT.XHtml5 + ,module Text.BlazeT.Html + ) where +import qualified Text.Blaze.XHtml5 +import Text.BlazeT +import Text.BlazeT.Html +import Text.BlazeT.Internal + +docTypeHtml :: Markup2 +docTypeHtml = wrapMarkup2 Text.Blaze.XHtml5.docTypeHtml +a :: Markup2 +a = wrapMarkup2 Text.Blaze.XHtml5.a +abbr :: Markup2 +abbr = wrapMarkup2 Text.Blaze.XHtml5.abbr +address :: Markup2 +address = wrapMarkup2 Text.Blaze.XHtml5.address +article :: Markup2 +article = wrapMarkup2 Text.Blaze.XHtml5.article +aside :: Markup2 +aside = wrapMarkup2 Text.Blaze.XHtml5.aside +audio :: Markup2 +audio = wrapMarkup2 Text.Blaze.XHtml5.audio +b :: Markup2 +b = wrapMarkup2 Text.Blaze.XHtml5.b +bdo :: Markup2 +bdo = wrapMarkup2 Text.Blaze.XHtml5.bdo +blockquote :: Markup2 +blockquote = wrapMarkup2 Text.Blaze.XHtml5.blockquote +body :: Markup2 +body = wrapMarkup2 Text.Blaze.XHtml5.body +button :: Markup2 +button = wrapMarkup2 Text.Blaze.XHtml5.button +canvas :: Markup2 +canvas = wrapMarkup2 Text.Blaze.XHtml5.canvas +caption :: Markup2 +caption = wrapMarkup2 Text.Blaze.XHtml5.caption +cite :: Markup2 +cite = wrapMarkup2 Text.Blaze.XHtml5.cite +code :: Markup2 +code = wrapMarkup2 Text.Blaze.XHtml5.code +colgroup :: Markup2 +colgroup = wrapMarkup2 Text.Blaze.XHtml5.colgroup +command :: Markup2 +command = wrapMarkup2 Text.Blaze.XHtml5.command +datalist :: Markup2 +datalist = wrapMarkup2 Text.Blaze.XHtml5.datalist +dd :: Markup2 +dd = wrapMarkup2 Text.Blaze.XHtml5.dd +del :: Markup2 +del = wrapMarkup2 Text.Blaze.XHtml5.del +details :: Markup2 +details = wrapMarkup2 Text.Blaze.XHtml5.details +dfn :: Markup2 +dfn = wrapMarkup2 Text.Blaze.XHtml5.dfn +div :: Markup2 +div = wrapMarkup2 Text.Blaze.XHtml5.div +dl :: Markup2 +dl = wrapMarkup2 Text.Blaze.XHtml5.dl +dt :: Markup2 +dt = wrapMarkup2 Text.Blaze.XHtml5.dt +em :: Markup2 +em = wrapMarkup2 Text.Blaze.XHtml5.em +fieldset :: Markup2 +fieldset = wrapMarkup2 Text.Blaze.XHtml5.fieldset +figcaption :: Markup2 +figcaption = wrapMarkup2 Text.Blaze.XHtml5.figcaption +figure :: Markup2 +figure = wrapMarkup2 Text.Blaze.XHtml5.figure +footer :: Markup2 +footer = wrapMarkup2 Text.Blaze.XHtml5.footer +form :: Markup2 +form = wrapMarkup2 Text.Blaze.XHtml5.form +h1 :: Markup2 +h1 = wrapMarkup2 Text.Blaze.XHtml5.h1 +h2 :: Markup2 +h2 = wrapMarkup2 Text.Blaze.XHtml5.h2 +h3 :: Markup2 +h3 = wrapMarkup2 Text.Blaze.XHtml5.h3 +h4 :: Markup2 +h4 = wrapMarkup2 Text.Blaze.XHtml5.h4 +h5 :: Markup2 +h5 = wrapMarkup2 Text.Blaze.XHtml5.h5 +h6 :: Markup2 +h6 = wrapMarkup2 Text.Blaze.XHtml5.h6 +head :: Markup2 +head = wrapMarkup2 Text.Blaze.XHtml5.head +header :: Markup2 +header = wrapMarkup2 Text.Blaze.XHtml5.header +hgroup :: Markup2 +hgroup = wrapMarkup2 Text.Blaze.XHtml5.hgroup +html :: Markup2 +html = wrapMarkup2 Text.Blaze.XHtml5.html +i :: Markup2 +i = wrapMarkup2 Text.Blaze.XHtml5.i +iframe :: Markup2 +iframe = wrapMarkup2 Text.Blaze.XHtml5.iframe +ins :: Markup2 +ins = wrapMarkup2 Text.Blaze.XHtml5.ins +kbd :: Markup2 +kbd = wrapMarkup2 Text.Blaze.XHtml5.kbd +label :: Markup2 +label = wrapMarkup2 Text.Blaze.XHtml5.label +legend :: Markup2 +legend = wrapMarkup2 Text.Blaze.XHtml5.legend +li :: Markup2 +li = wrapMarkup2 Text.Blaze.XHtml5.li +main :: Markup2 +main = wrapMarkup2 Text.Blaze.XHtml5.main +map :: Markup2 +map = wrapMarkup2 Text.Blaze.XHtml5.map +mark :: Markup2 +mark = wrapMarkup2 Text.Blaze.XHtml5.mark +menu :: Markup2 +menu = wrapMarkup2 Text.Blaze.XHtml5.menu +meter :: Markup2 +meter = wrapMarkup2 Text.Blaze.XHtml5.meter +nav :: Markup2 +nav = wrapMarkup2 Text.Blaze.XHtml5.nav +noscript :: Markup2 +noscript = wrapMarkup2 Text.Blaze.XHtml5.noscript +object :: Markup2 +object = wrapMarkup2 Text.Blaze.XHtml5.object +ol :: Markup2 +ol = wrapMarkup2 Text.Blaze.XHtml5.ol +optgroup :: Markup2 +optgroup = wrapMarkup2 Text.Blaze.XHtml5.optgroup +option :: Markup2 +option = wrapMarkup2 Text.Blaze.XHtml5.option +output :: Markup2 +output = wrapMarkup2 Text.Blaze.XHtml5.output +p :: Markup2 +p = wrapMarkup2 Text.Blaze.XHtml5.p +pre :: Markup2 +pre = wrapMarkup2 Text.Blaze.XHtml5.pre +progress :: Markup2 +progress = wrapMarkup2 Text.Blaze.XHtml5.progress +q :: Markup2 +q = wrapMarkup2 Text.Blaze.XHtml5.q +rp :: Markup2 +rp = wrapMarkup2 Text.Blaze.XHtml5.rp +rt :: Markup2 +rt = wrapMarkup2 Text.Blaze.XHtml5.rt +ruby :: Markup2 +ruby = wrapMarkup2 Text.Blaze.XHtml5.ruby +samp :: Markup2 +samp = wrapMarkup2 Text.Blaze.XHtml5.samp +script :: Markup2 +script = wrapMarkup2 Text.Blaze.XHtml5.script +section :: Markup2 +section = wrapMarkup2 Text.Blaze.XHtml5.section +select :: Markup2 +select = wrapMarkup2 Text.Blaze.XHtml5.select +small :: Markup2 +small = wrapMarkup2 Text.Blaze.XHtml5.small +span :: Markup2 +span = wrapMarkup2 Text.Blaze.XHtml5.span +strong :: Markup2 +strong = wrapMarkup2 Text.Blaze.XHtml5.strong +style :: Markup2 +style = wrapMarkup2 Text.Blaze.XHtml5.style +sub :: Markup2 +sub = wrapMarkup2 Text.Blaze.XHtml5.sub +summary :: Markup2 +summary = wrapMarkup2 Text.Blaze.XHtml5.summary +sup :: Markup2 +sup = wrapMarkup2 Text.Blaze.XHtml5.sup +table :: Markup2 +table = wrapMarkup2 Text.Blaze.XHtml5.table +tbody :: Markup2 +tbody = wrapMarkup2 Text.Blaze.XHtml5.tbody +td :: Markup2 +td = wrapMarkup2 Text.Blaze.XHtml5.td +textarea :: Markup2 +textarea = wrapMarkup2 Text.Blaze.XHtml5.textarea +tfoot :: Markup2 +tfoot = wrapMarkup2 Text.Blaze.XHtml5.tfoot +th :: Markup2 +th = wrapMarkup2 Text.Blaze.XHtml5.th +thead :: Markup2 +thead = wrapMarkup2 Text.Blaze.XHtml5.thead +time :: Markup2 +time = wrapMarkup2 Text.Blaze.XHtml5.time +title :: Markup2 +title = wrapMarkup2 Text.Blaze.XHtml5.title +tr :: Markup2 +tr = wrapMarkup2 Text.Blaze.XHtml5.tr +ul :: Markup2 +ul = wrapMarkup2 Text.Blaze.XHtml5.ul +var :: Markup2 +var = wrapMarkup2 Text.Blaze.XHtml5.var +video :: Markup2 +video = wrapMarkup2 Text.Blaze.XHtml5.video +docType :: Markup +docType = wrapMarkup Text.Blaze.XHtml5.docType +area :: Markup +area = wrapMarkup Text.Blaze.XHtml5.area +base :: Markup +base = wrapMarkup Text.Blaze.XHtml5.base +br :: Markup +br = wrapMarkup Text.Blaze.XHtml5.br +col :: Markup +col = wrapMarkup Text.Blaze.XHtml5.col +embed :: Markup +embed = wrapMarkup Text.Blaze.XHtml5.embed +hr :: Markup +hr = wrapMarkup Text.Blaze.XHtml5.hr +img :: Markup +img = wrapMarkup Text.Blaze.XHtml5.img +input :: Markup +input = wrapMarkup Text.Blaze.XHtml5.input +keygen :: Markup +keygen = wrapMarkup Text.Blaze.XHtml5.keygen +link :: Markup +link = wrapMarkup Text.Blaze.XHtml5.link +menuitem :: Markup +menuitem = wrapMarkup Text.Blaze.XHtml5.menuitem +meta :: Markup +meta = wrapMarkup Text.Blaze.XHtml5.meta +param :: Markup +param = wrapMarkup Text.Blaze.XHtml5.param +source :: Markup +source = wrapMarkup Text.Blaze.XHtml5.source +track :: Markup +track = wrapMarkup Text.Blaze.XHtml5.track +wbr :: Markup +wbr = wrapMarkup Text.Blaze.XHtml5.wbr + diff --git a/src/Text/BlazeT/XHtml5/Attributes.hs b/src/Text/BlazeT/XHtml5/Attributes.hs new file mode 100644 index 0000000..e878108 --- /dev/null +++ b/src/Text/BlazeT/XHtml5/Attributes.hs @@ -0,0 +1,11 @@ +-- !! DO NOT EDIT +{-| +(Automatically generated by @src\/Util\/GenerateHtmlTCombinators.hs:49@) + +This module simply reexports the corresponding @blaze-html@ module. +-} +module Text.BlazeT.XHtml5.Attributes + (module Text.Blaze.XHtml5.Attributes + ) where +import Text.Blaze.XHtml5.Attributes + diff --git a/src/Util/GenerateHtmlCombinators.hs b/src/Util/GenerateHtmlCombinators.hs new file mode 100644 index 0000000..83da65b --- /dev/null +++ b/src/Util/GenerateHtmlCombinators.hs @@ -0,0 +1,519 @@ +-- taken from https://github.com/jaspervdj/blaze-html/blob/2c4513e30ce768517b8d7b7b154d438f55217006/src/Util/GenerateHtmlCombinators.hs + +-- Copyright Jasper Van der Jeugt 2010 + +-- All rights reserved. + +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are met: + +-- * Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. + +-- * Redistributions in binary form must reproduce the above +-- copyright notice, this list of conditions and the following +-- disclaimer in the documentation and/or other materials provided +-- with the distribution. + +-- * Neither the name of Jasper Van der Jeugt nor the names of other +-- contributors may be used to endorse or promote products derived +-- from this software without specific prior written permission. + +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +{-# LANGUAGE CPP #-} + +#define DO_NOT_EDIT (doNotEdit __FILE__ __LINE__) + +-- | Generates code for HTML tags. +-- +module Util.GenerateHtmlCombinators where + +import Control.Arrow ((&&&)) +import Data.List (sort, sortBy, intersperse, intercalate) +import Data.Ord (comparing) +import System.Directory (createDirectoryIfMissing) +import System.FilePath ((), (<.>)) +import Data.Map (Map) +import qualified Data.Map as M +import Data.Char (toLower) +import qualified Data.Set as S + +import Util.Sanitize (sanitize, prelude) + +-- | Datatype for an HTML variant. +-- +data HtmlVariant = HtmlVariant + { version :: [String] + , docType :: [String] + , parents :: [String] + , leafs :: [String] + , attributes :: [String] + , selfClosing :: Bool + } deriving (Eq) + +instance Show HtmlVariant where + show = map toLower . intercalate "-" . version + +-- | Get the full module name for an HTML variant. +-- +getModuleName :: HtmlVariant -> String +getModuleName = ("Text.Blaze." ++) . intercalate "." . version + +-- | Get the attribute module name for an HTML variant. +-- +getAttributeModuleName :: HtmlVariant -> String +getAttributeModuleName = (++ ".Attributes") . getModuleName + +-- | Check if a given name causes a name clash. +-- +isNameClash :: HtmlVariant -> String -> Bool +isNameClash v t + -- Both an element and an attribute + | (t `elem` parents v || t `elem` leafs v) && t `elem` attributes v = True + -- Already a prelude function + | sanitize t `S.member` prelude = True + | otherwise = False + +-- | Write an HTML variant. +-- +writeHtmlVariant :: HtmlVariant -> IO () +writeHtmlVariant htmlVariant = do + -- Make a directory. + createDirectoryIfMissing True basePath + + let tags = zip parents' (repeat makeParent) + ++ zip leafs' (repeat (makeLeaf $ selfClosing htmlVariant)) + sortedTags = sortBy (comparing fst) tags + appliedTags = map (\(x, f) -> f x) sortedTags + + -- Write the main module. + writeFile' (basePath <.> "hs") $ removeTrailingNewlines $ unlines + [ DO_NOT_EDIT + , "{-# LANGUAGE OverloadedStrings #-}" + , "-- | This module exports HTML combinators used to create documents." + , "--" + , exportList modulName $ "module Text.Blaze.Html" + : "docType" + : "docTypeHtml" + : map (sanitize . fst) sortedTags + , DO_NOT_EDIT + , "import Prelude ((>>), (.))" + , "" + , "import Text.Blaze" + , "import Text.Blaze.Internal" + , "import Text.Blaze.Html" + , "" + , makeDocType $ docType htmlVariant + , makeDocTypeHtml $ docType htmlVariant + , unlines appliedTags + ] + + let sortedAttributes = sort attributes' + + -- Write the attribute module. + writeFile' (basePath "Attributes.hs") $ removeTrailingNewlines $ unlines + [ DO_NOT_EDIT + , "-- | This module exports combinators that provide you with the" + , "-- ability to set attributes on HTML elements." + , "--" + , "{-# LANGUAGE OverloadedStrings #-}" + , exportList attributeModuleName $ map sanitize sortedAttributes + , DO_NOT_EDIT + , "import Prelude ()" + , "" + , "import Text.Blaze.Internal (Attribute, AttributeValue, attribute)" + , "" + , unlines (map makeAttribute sortedAttributes) + ] + where + basePath = "src" "Text" "Blaze" foldl1 () version' + modulName = getModuleName htmlVariant + attributeModuleName = getAttributeModuleName htmlVariant + attributes' = attributes htmlVariant + parents' = parents htmlVariant + leafs' = leafs htmlVariant + version' = version htmlVariant + removeTrailingNewlines = reverse . drop 2 . reverse + writeFile' file content = do + putStrLn ("Generating " ++ file) + writeFile file content + +-- | Create a string, consisting of @x@ spaces, where @x@ is the length of the +-- argument. +-- +spaces :: String -> String +spaces = flip replicate ' ' . length + +-- | Join blocks of code with a newline in between. +-- +unblocks :: [String] -> String +unblocks = unlines . intersperse "\n" + +-- | A warning to not edit the generated code. +-- +doNotEdit :: FilePath -> Int -> String +doNotEdit fileName lineNumber = init $ unlines + [ "-- WARNING: The next block of code was automatically generated by" + , "-- " ++ fileName ++ ":" ++ show lineNumber + , "--" + ] + +-- | Generate an export list for a Haskell module. +-- +exportList :: String -- ^ Module name. + -> [String] -- ^ List of functions. + -> String -- ^ Resulting string. +exportList _ [] = error "exportList without functions." +exportList name (f:functions) = unlines $ + [ "module " ++ name + , " ( " ++ f + ] ++ + map (" , " ++) functions ++ + [ " ) where"] + +-- | Generate a function for a doctype. +-- +makeDocType :: [String] -> String +makeDocType lines' = unlines + [ DO_NOT_EDIT + , "-- | Combinator for the document type. This should be placed at the top" + , "-- of every HTML page." + , "--" + , "-- Example:" + , "--" + , "-- > docType" + , "--" + , "-- Result:" + , "--" + , unlines (map ("-- > " ++) lines') ++ "--" + , "docType :: Html -- ^ The document type HTML." + , "docType = preEscapedText " ++ show (unlines lines') + , "{-# INLINE docType #-}" + ] + +-- | Generate a function for the HTML tag (including the doctype). +-- +makeDocTypeHtml :: [String] -- ^ The doctype. + -> String -- ^ Resulting combinator function. +makeDocTypeHtml lines' = unlines + [ DO_NOT_EDIT + , "-- | Combinator for the @\\@ element. This combinator will also" + , "-- insert the correct doctype." + , "--" + , "-- Example:" + , "--" + , "-- > docTypeHtml $ span $ toHtml \"foo\"" + , "--" + , "-- Result:" + , "--" + , unlines (map ("-- > " ++) lines') ++ "-- > foo" + , "--" + , "docTypeHtml :: Html -- ^ Inner HTML." + , " -> Html -- ^ Resulting HTML." + , "docTypeHtml inner = docType >> html inner" + , "{-# INLINE docTypeHtml #-}" + ] + +-- | Generate a function for an HTML tag that can be a parent. +-- +makeParent :: String -> String +makeParent tag = unlines + [ DO_NOT_EDIT + , "-- | Combinator for the @\\<" ++ tag ++ ">@ element." + , "--" + , "-- Example:" + , "--" + , "-- > " ++ function ++ " $ span $ toHtml \"foo\"" + , "--" + , "-- Result:" + , "--" + , "-- > <" ++ tag ++ ">foo" + , "--" + , function ++ " :: Html -- ^ Inner HTML." + , spaces function ++ " -> Html -- ^ Resulting HTML." + , function ++ " = Parent \"" ++ tag ++ "\" \"<" ++ tag + ++ "\" \"\"" ++ modifier + , "{-# INLINE " ++ function ++ " #-}" + ] + where + function = sanitize tag + modifier = if tag `elem` ["style", "script"] then " . external" else "" + +-- | Generate a function for an HTML tag that must be a leaf. +-- +makeLeaf :: Bool -- ^ Make leaf tags self-closing + -> String -- ^ Tag for the combinator + -> String -- ^ Combinator code +makeLeaf closing tag = unlines + [ DO_NOT_EDIT + , "-- | Combinator for the @\\<" ++ tag ++ " />@ element." + , "--" + , "-- Example:" + , "--" + , "-- > " ++ function + , "--" + , "-- Result:" + , "--" + , "-- > <" ++ tag ++ " />" + , "--" + , function ++ " :: Html -- ^ Resulting HTML." + , function ++ " = Leaf \"" ++ tag ++ "\" \"<" ++ tag ++ "\" " ++ "\"" + ++ (if closing then " /" else "") ++ ">\"" + , "{-# INLINE " ++ function ++ " #-}" + ] + where + function = sanitize tag + +-- | Generate a function for an HTML attribute. +-- +makeAttribute :: String -> String +makeAttribute name = unlines + [ DO_NOT_EDIT + , "-- | Combinator for the @" ++ name ++ "@ attribute." + , "--" + , "-- Example:" + , "--" + , "-- > div ! " ++ function ++ " \"bar\" $ \"Hello.\"" + , "--" + , "-- Result:" + , "--" + , "-- >
Hello.
" + , "--" + , function ++ " :: AttributeValue -- ^ Attribute value." + , spaces function ++ " -> Attribute -- ^ Resulting attribute." + , function ++ " = attribute \"" ++ name ++ "\" \" " + ++ name ++ "=\\\"\"" + , "{-# INLINE " ++ function ++ " #-}" + ] + where + function = sanitize name + +-- | HTML 4.01 Strict. +-- A good reference can be found here: http://www.w3schools.com/tags/default.asp +-- +html4Strict :: HtmlVariant +html4Strict = HtmlVariant + { version = ["Html4", "Strict"] + , docType = + [ "" + ] + , parents = + [ "a", "abbr", "acronym", "address", "b", "bdo", "big", "blockquote" + , "body" , "button", "caption", "cite", "code", "colgroup", "dd", "del" + , "dfn", "div" , "dl", "dt", "em", "fieldset", "form", "h1", "h2", "h3" + , "h4", "h5", "h6", "head", "html", "i", "ins" , "kbd", "label" + , "legend", "li", "map", "noscript", "object", "ol", "optgroup" + , "option", "p", "pre", "q", "samp", "script", "select", "small" + , "span", "strong", "style", "sub", "sup", "table", "tbody", "td" + , "textarea", "tfoot", "th", "thead", "title", "tr", "tt", "ul", "var" + ] + , leafs = + [ "area", "br", "col", "hr", "link", "img", "input", "meta", "param" + ] + , attributes = + [ "abbr", "accept", "accesskey", "action", "align", "alt", "archive" + , "axis", "border", "cellpadding", "cellspacing", "char", "charoff" + , "charset", "checked", "cite", "class", "classid", "codebase" + , "codetype", "cols", "colspan", "content", "coords", "data", "datetime" + , "declare", "defer", "dir", "disabled", "enctype", "for", "frame" + , "headers", "height", "href", "hreflang", "http-equiv", "id", "label" + , "lang", "maxlength", "media", "method", "multiple", "name", "nohref" + , "onabort", "onblur", "onchange", "onclick", "ondblclick", "onfocus" + , "onkeydown", "onkeypress", "onkeyup", "onload", "onmousedown" + , "onmousemove", "onmouseout", "onmouseover", "onmouseup", "onreset" + , "onselect", "onsubmit", "onunload", "profile", "readonly", "rel" + , "rev", "rows", "rowspan", "rules", "scheme", "scope", "selected" + , "shape", "size", "span", "src", "standby", "style", "summary" + , "tabindex", "title", "type", "usemap", "valign", "value", "valuetype" + , "width" + ] + , selfClosing = False + } + +-- | HTML 4.0 Transitional +-- +html4Transitional :: HtmlVariant +html4Transitional = HtmlVariant + { version = ["Html4", "Transitional"] + , docType = + [ "" + ] + , parents = parents html4Strict ++ + [ "applet", "center", "dir", "font", "iframe", "isindex", "menu" + , "noframes", "s", "u" + ] + , leafs = leafs html4Strict ++ ["basefont"] + , attributes = attributes html4Strict ++ + [ "background", "bgcolor", "clear", "compact", "hspace", "language" + , "noshade", "nowrap", "start", "target", "vspace" + ] + , selfClosing = False + } + +-- | HTML 4.0 FrameSet +-- +html4FrameSet :: HtmlVariant +html4FrameSet = HtmlVariant + { version = ["Html4", "FrameSet"] + , docType = + [ "" + ] + , parents = parents html4Transitional ++ ["frameset"] + , leafs = leafs html4Transitional ++ ["frame"] + , attributes = attributes html4Transitional ++ + [ "frameborder", "scrolling" + ] + , selfClosing = False + } + +-- | XHTML 1.0 Strict +-- +xhtml1Strict :: HtmlVariant +xhtml1Strict = HtmlVariant + { version = ["XHtml1", "Strict"] + , docType = + [ "" + ] + , parents = parents html4Strict + , leafs = leafs html4Strict + , attributes = attributes html4Strict + , selfClosing = True + } + +-- | XHTML 1.0 Transitional +-- +xhtml1Transitional :: HtmlVariant +xhtml1Transitional = HtmlVariant + { version = ["XHtml1", "Transitional"] + , docType = + [ "" + ] + , parents = parents html4Transitional + , leafs = leafs html4Transitional + , attributes = attributes html4Transitional + , selfClosing = True + } + +-- | XHTML 1.0 FrameSet +-- +xhtml1FrameSet :: HtmlVariant +xhtml1FrameSet = HtmlVariant + { version = ["XHtml1", "FrameSet"] + , docType = + [ "" + ] + , parents = parents html4FrameSet + , leafs = leafs html4FrameSet + , attributes = attributes html4FrameSet + , selfClosing = True + } + +-- | HTML 5.0 +-- A good reference can be found here: +-- http://www.w3schools.com/html5/html5_reference.asp +-- +html5 :: HtmlVariant +html5 = HtmlVariant + { version = ["Html5"] + , docType = [""] + , parents = + [ "a", "abbr", "address", "article", "aside", "audio", "b" + , "bdo", "blockquote", "body", "button", "canvas", "caption", "cite" + , "code", "colgroup", "command", "datalist", "dd", "del", "details" + , "dfn", "div", "dl", "dt", "em", "fieldset", "figcaption", "figure" + , "footer", "form", "h1", "h2", "h3", "h4", "h5", "h6", "head", "header" + , "hgroup", "html", "i", "iframe", "ins", "kbd", "label" + , "legend", "li", "main", "map", "mark", "menu", "meter", "nav" + , "noscript", "object", "ol", "optgroup", "option", "output", "p" + , "pre", "progress", "q", "rp", "rt", "ruby", "samp", "script" + , "section", "select", "small", "span", "strong", "style", "sub" + , "summary", "sup", "table", "tbody", "td", "textarea", "tfoot", "th" + , "thead", "time", "title", "tr", "ul", "var", "video" + ] + , leafs = + -- http://www.whatwg.org/specs/web-apps/current-work/multipage/syntax.html#void-elements + [ "area", "base", "br", "col", "embed", "hr", "img", "input", "keygen" + , "link", "menuitem", "meta", "param", "source", "track", "wbr" + ] + , attributes = + [ "accept", "accept-charset", "accesskey", "action", "alt", "async" + , "autocomplete", "autofocus", "autoplay", "challenge", "charset" + , "checked", "cite", "class", "cols", "colspan", "content" + , "contenteditable", "contextmenu", "controls", "coords", "data" + , "datetime", "defer", "dir", "disabled", "draggable", "enctype", "for" + , "form", "formaction", "formenctype", "formmethod", "formnovalidate" + , "formtarget", "headers", "height", "hidden", "high", "href" + , "hreflang", "http-equiv", "icon", "id", "ismap", "item", "itemprop" + , "itemscope", "itemtype" + , "keytype", "label", "lang", "list", "loop", "low", "manifest", "max" + , "maxlength", "media", "method", "min", "multiple", "name" + , "novalidate", "onbeforeonload", "onbeforeprint", "onblur", "oncanplay" + , "oncanplaythrough", "onchange", "oncontextmenu", "onclick" + , "ondblclick", "ondrag", "ondragend", "ondragenter", "ondragleave" + , "ondragover", "ondragstart", "ondrop", "ondurationchange", "onemptied" + , "onended", "onerror", "onfocus", "onformchange", "onforminput" + , "onhaschange", "oninput", "oninvalid", "onkeydown", "onkeyup" + , "onload", "onloadeddata", "onloadedmetadata", "onloadstart" + , "onmessage", "onmousedown", "onmousemove", "onmouseout", "onmouseover" + , "onmouseup", "onmousewheel", "ononline", "onpagehide", "onpageshow" + , "onpause", "onplay", "onplaying", "onprogress", "onpropstate" + , "onratechange", "onreadystatechange", "onredo", "onresize", "onscroll" + , "onseeked", "onseeking", "onselect", "onstalled", "onstorage" + , "onsubmit", "onsuspend", "ontimeupdate", "onundo", "onunload" + , "onvolumechange", "onwaiting", "open", "optimum", "pattern", "ping" + , "placeholder", "preload", "pubdate", "radiogroup", "readonly", "rel" + , "required", "reversed", "rows", "rowspan", "sandbox", "scope" + , "scoped", "seamless", "selected", "shape", "size", "sizes", "span" + , "spellcheck", "src", "srcdoc", "start", "step", "style", "subject" + , "summary", "tabindex", "target", "title", "type", "usemap", "value" + , "width", "wrap", "xmlns" + ] + , selfClosing = False + } + +-- | XHTML 5.0 +-- +xhtml5 :: HtmlVariant +xhtml5 = HtmlVariant + { version = ["XHtml5"] + , docType = [""] + , parents = parents html5 + , leafs = leafs html5 + , attributes = attributes html5 + , selfClosing = True + } + + +-- | A map of HTML variants, per version, lowercase. +-- +htmlVariants :: Map String HtmlVariant +htmlVariants = M.fromList $ map (show &&& id) + [ html4Strict + , html4Transitional + , html4FrameSet + , xhtml1Strict + , xhtml1Transitional + , xhtml1FrameSet + , html5 + , xhtml5 + ] + +main :: IO () +main = mapM_ (writeHtmlVariant . snd) $ M.toList htmlVariants diff --git a/src/Util/GenerateHtmlTCombinators.hs b/src/Util/GenerateHtmlTCombinators.hs new file mode 100755 index 0000000..0dd5444 --- /dev/null +++ b/src/Util/GenerateHtmlTCombinators.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE CPP #-} + +module Util.GenerateHtmlTCombinators where + +import Control.Applicative +import Data.List +import Language.Haskell.TH +import System.Directory +import System.FilePath +import Text.Printf +import Text.Regex +import Text.Regex.TDFA +import Util.GenerateHtmlCombinators hiding (getModuleName, main) + +declare :: HtmlVariant -> [Dec] +declare x = concatMap (\(w,ls) -> concatMap (g w) ls) + [(("wrapMarkup2","Markup2"),"docTypeHtml" : parents x) + ,(("wrapMarkup","Markup"), "docType" : leafs x)] + where g (w',t') l' = + [SigD l $ ConT t + ,ValD (VarP l) (NormalB (AppE (VarE w) + $ VarE $ mkName $ getModuleName "Blaze" x ++"."++l')) []] + where [w,t,l] = fmap mkName [w',t',l'] + + + +writeSource :: HtmlVariant -> IO () +writeSource v = mapM_ g [True, False] + where + g attr = do + let path = if attr then "Attributes" else "" + name = (if attr then "." else "") ++ path + [mT,m] = ((++ name) . flip getModuleName v) <$> + ["BlazeT","Blaze"] + exports = if attr then [m] else [mT, "Text.BlazeT.Html"] + f = (joinPath $ ["src","Text","BlazeT"] ++ version v + ++ [path]) <.> "hs" + body = if attr then "" else unlines $ + map (printf "import Text.BlazeT%s") ["", ".Html", ".Internal"] + ++ ["", show ( ppr_list $ declare v)] + quali = if attr then "" else "qualified " + docs True = "This module simply reexports the corresponding @blaze-html@ module." + docs False = printf "This module wraps all exports of \"%s\" using 'wrapMarkup' and 'wrapMarkup'." m + createDirectoryIfMissing True $ takeDirectory $ f + writeFile f $ unlines $ + ["-- !! DO NOT EDIT" + ,"{-|" + ,printf "(Automatically generated by @%s:%d@)\n" + (subRegex (mkRegex "/") __FILE__ "\\\\/") ( __LINE__ :: Int) + ,docs attr + ,"-}" + ,"module "++ mT + ," (" ++ intercalate "\n ," (map ("module "++) exports) + ," ) where" + ,"import "++ quali ++ m + , body] + +main = mapM_ writeSource htmlVariants + + +getModuleName :: String -> HtmlVariant -> String +getModuleName base = (("Text."++base++".")++) . intercalate "." . version diff --git a/src/Util/Sanitize.hs b/src/Util/Sanitize.hs new file mode 100644 index 0000000..112bae1 --- /dev/null +++ b/src/Util/Sanitize.hs @@ -0,0 +1,112 @@ +-- taken from https://github.com/jaspervdj/blaze-html/blob/2c4513e30ce768517b8d7b7b154d438f55217006/src/Util/Sanitize.hs + +-- Copyright Jasper Van der Jeugt 2010 + +-- All rights reserved. + +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are met: + +-- * Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. + +-- * Redistributions in binary form must reproduce the above +-- copyright notice, this list of conditions and the following +-- disclaimer in the documentation and/or other materials provided +-- with the distribution. + +-- * Neither the name of Jasper Van der Jeugt nor the names of other +-- contributors may be used to endorse or promote products derived +-- from this software without specific prior written permission. + +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-- | A program to sanitize an HTML tag to a Haskell function. +-- +module Util.Sanitize + ( sanitize + , keywords + , prelude + ) where + +import Data.Char (toLower, toUpper) +import Data.Set (Set) +import qualified Data.Set as S + +-- | Sanitize a tag. This function returns a name that can be used as +-- combinator in haskell source code. +-- +-- Examples: +-- +-- > sanitize "class" == "class_" +-- > sanitize "http-equiv" == "httpEquiv" +-- +sanitize :: String -> String +sanitize str + | lower == "doctypehtml" = "docTypeHtml" + | otherwise = appendUnderscore $ removeDash lower + where + lower = map toLower str + + -- Remove a dash, replacing it by camelcase notation + -- + -- Example: + -- + -- > removeDash "foo-bar" == "fooBar" + -- + removeDash ('-' : x : xs) = toUpper x : removeDash xs + removeDash (x : xs) = x : removeDash xs + removeDash [] = [] + + appendUnderscore t | t `S.member` keywords = t ++ "_" + | otherwise = t + +-- | A set of standard Haskell keywords, which cannot be used as combinators. +-- +keywords :: Set String +keywords = S.fromList + [ "case", "class", "data", "default", "deriving", "do", "else", "if" + , "import", "in", "infix", "infixl", "infixr", "instance" , "let", "module" + , "newtype", "of", "then", "type", "where" + ] + +-- | Set of functions from the Prelude, which we do not use as combinators. +-- +prelude :: Set String +prelude = S.fromList + [ "abs", "acos", "acosh", "all", "and", "any", "appendFile", "asTypeOf" + , "asin", "asinh", "atan", "atan2", "atanh", "break", "catch", "ceiling" + , "compare", "concat", "concatMap", "const", "cos", "cosh", "curry", "cycle" + , "decodeFloat", "div", "divMod", "drop", "dropWhile", "either", "elem" + , "encodeFloat", "enumFrom", "enumFromThen", "enumFromThenTo", "enumFromTo" + , "error", "even", "exp", "exponent", "fail", "filter", "flip" + , "floatDigits", "floatRadix", "floatRange", "floor", "fmap", "foldl" + , "foldl1", "foldr", "foldr1", "fromEnum", "fromInteger", "fromIntegral" + , "fromRational", "fst", "gcd", "getChar", "getContents", "getLine", "head" + , "id", "init", "interact", "ioError", "isDenormalized", "isIEEE" + , "isInfinite", "isNaN", "isNegativeZero", "iterate", "last", "lcm" + , "length", "lex", "lines", "log", "logBase", "lookup", "map", "mapM" + , "mapM_", "max", "maxBound", "maximum", "maybe", "min", "minBound" + , "minimum", "mod", "negate", "not", "notElem", "null", "odd", "or" + , "otherwise", "pi", "pred", "print", "product", "properFraction", "putChar" + , "putStr", "putStrLn", "quot", "quotRem", "read", "readFile", "readIO" + , "readList", "readLn", "readParen", "reads", "readsPrec", "realToFrac" + , "recip", "rem", "repeat", "replicate", "return", "reverse", "round" + , "scaleFloat", "scanl", "scanl1", "scanr", "scanr1", "seq", "sequence" + , "sequence_", "show", "showChar", "showList", "showParen", "showString" + , "shows", "showsPrec", "significand", "signum", "sin", "sinh", "snd" + , "span", "splitAt", "sqrt", "subtract", "succ", "sum", "tail", "take" + , "takeWhile", "tan", "tanh", "toEnum", "toInteger", "toRational" + , "truncate", "uncurry", "undefined", "unlines", "until", "unwords", "unzip" + , "unzip3", "userError", "words", "writeFile", "zip", "zip3", "zipWith" + , "zipWith3" + ] -- cgit v1.2.3