Hi Bjorn, hi list, the darcswatch instance I’m running is getting quite big, and it periodically slows down my server. I managed to get quite an improvement with this simple patch to my parsing: http://darcs.nomeata.de/cgi-bin/darcsweb.cgi?r=darcswatch;a=commitdiff;h=20090119181919-23c07-140f8deb91a52a423a2984dce2d22f4a48999aaf.gz
Since the new HTTP library, my code runs completely on ByteStrings, only
the xhtml library expects me to feed strings. I tried to fix this and
created a patch against xhtml-3000.2.0.1 to work internally with lazy
ByteStrings. It’s API-compatible to the normal xhtml library, it just
adds showHtml', renderHtml' and prettyHtml' that output lazy
ByteStrings, and that has Html instances for strict any lazy
ByteStrings.
There were some speed and space improvements, but none horrific (at
least for DarcsWatch, most of the time goes into parsing the
repositories and mails, and into sorting that data). Unfortunately, I
can’t use it in the live installation until I upgrade the machine from
Debian etch to lenny, as the bundled bytestring library in ghc-6.6’ base
is too old.
Nevertheless, I’m sharing my patch here, maybe it’s useful for some, or
maybe it can be the base for an official xhtml release with bytestrings
inside.
To speed things up even more one should probably create a type analogous
to ShowS, i.e. (L.ByteString -> L.ByteString), that allows you to
concatenate ByteString chunks cheaply.
I also noted that the current version of bytestring implements
"concatMap" in a way that is guaranteed to rip apart the string into
very small chunks, even if the mapped function returns the same
character most times (as it is the case for the Html escaping function).
Therefore, I wrote this function:
-- | More efficient variant of 'L.concatMap'
concatMapL' :: (Char -> String) -> L.ByteString -> L.ByteString
concatMapL' f s = go s
where go s = let (unmodified, modified) = L.span (\c -> f c == [c]) s
in case L.uncons modified of
Nothing -> unmodified
Just (c,rest) -> L.pack (f c) `L.append` go rest
Does this make sense? Should it maybe replace the function in the
library?
Greetings,
Joachim
[1] http://darcswatch.nomeata.de/
--
Joachim "nomeata" Breitner
mail: [email protected] | ICQ# 74513189 | GPG-Key: 4743206C
JID: [email protected] | http://www.joachim-breitner.de/
Debian Developer: [email protected]
Nur in xhtml-bytestring/: dist.
diff -aur xhtml-3000.2.0.1/Text/XHtml/Debug.hs xhtml-bytestring/Text/XHtml/Debug.hs
--- xhtml-3000.2.0.1/Text/XHtml/Debug.hs 2008-09-17 16:19:47.000000000 +0200
+++ xhtml-bytestring/Text/XHtml/Debug.hs 2009-01-19 22:04:32.000000000 +0100
@@ -7,6 +7,7 @@
import Text.XHtml.Table
import Text.XHtml.Strict.Elements
import Text.XHtml.Strict.Attributes
+import qualified Data.ByteString.Lazy.Char8 as L
--
-- * Tree Displaying Combinators
@@ -84,7 +85,7 @@
debug :: HtmlElement -> HtmlTree
debug (HtmlString str) = HtmlLeaf (spaceHtml +++
- linesToHtml (lines str))
+ linesToHtml (lines (L.unpack str)))
debug (HtmlTag {
markupTag = markupTag,
markupContent = markupContent,
diff -aur xhtml-3000.2.0.1/Text/XHtml/Extras.hs xhtml-bytestring/Text/XHtml/Extras.hs
--- xhtml-3000.2.0.1/Text/XHtml/Extras.hs 2008-09-17 16:19:47.000000000 +0200
+++ xhtml-bytestring/Text/XHtml/Extras.hs 2009-01-19 22:03:57.000000000 +0100
@@ -13,11 +13,11 @@
-- | Convert a 'String' to 'Html', converting
-- characters that need to be escaped to HTML entities.
stringToHtml :: String -> Html
-stringToHtml = primHtml . stringToHtmlString
+stringToHtml = primHtml' . stringToHtmlString
-- | This converts a string, but keeps spaces as non-line-breakable.
lineToHtml :: String -> Html
-lineToHtml = primHtml . concatMap htmlizeChar2 . stringToHtmlString
+lineToHtml = primHtml' . concatMapL' htmlizeChar2 . stringToHtmlString
where
htmlizeChar2 ' ' = " "
htmlizeChar2 c = [c]
diff -aur xhtml-3000.2.0.1/Text/XHtml/Frameset.hs xhtml-bytestring/Text/XHtml/Frameset.hs
--- xhtml-3000.2.0.1/Text/XHtml/Frameset.hs 2008-09-17 16:19:47.000000000 +0200
+++ xhtml-bytestring/Text/XHtml/Frameset.hs 2009-01-19 22:35:55.000000000 +0100
@@ -11,6 +11,7 @@
primHtml,
-- * Rendering
showHtml, renderHtml, prettyHtml,
+ showHtml', renderHtml', prettyHtml',
showHtmlFragment, renderHtmlFragment, prettyHtmlFragment,
module Text.XHtml.Strict.Elements,
module Text.XHtml.Frameset.Elements,
@@ -19,7 +20,7 @@
module Text.XHtml.Extras
) where
-import Text.XHtml.Internals
+import Text.XHtml.Internals hiding (showHtml', renderHtml', prettyHtml')
import Text.XHtml.Strict.Elements
import Text.XHtml.Frameset.Elements
@@ -28,7 +29,9 @@
import Text.XHtml.Extras
-docType =
+import qualified Data.ByteString.Lazy.Char8 as L
+
+docType = L.pack $
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\"" ++
" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\";>"
@@ -36,12 +39,16 @@
-- This should be the most time and space efficient way to
-- render HTML, though the ouput is quite unreadable.
showHtml :: HTML html => html -> String
-showHtml = showHtmlInternal docType
+showHtml = L.unpack . showHtml'
+showHtml' :: HTML html => html -> L.ByteString
+showHtml' = showHtmlInternal docType
-- | Outputs indented HTML. Because space matters in
-- HTML, the output is quite messy.
renderHtml :: HTML html => html -> String
-renderHtml = renderHtmlInternal docType
+renderHtml = L.unpack . renderHtml'
+renderHtml' :: HTML html => html -> L.ByteString
+renderHtml' = renderHtmlInternal docType
-- | Outputs indented HTML, with indentation inside elements.
-- This can change the meaning of the HTML document, and
@@ -49,4 +56,6 @@
-- The implementation is inefficient, and you are normally
-- better off using 'showHtml' or 'renderHtml'.
prettyHtml :: HTML html => html -> String
-prettyHtml = prettyHtmlInternal docType
\ Kein Zeilenumbruch am Dateiende.
+prettyHtml = L.unpack . prettyHtml'
+prettyHtml' :: HTML html => html -> L.ByteString
+prettyHtml' = prettyHtmlInternal docType
diff -aur xhtml-3000.2.0.1/Text/XHtml/Internals.hs xhtml-bytestring/Text/XHtml/Internals.hs
--- xhtml-3000.2.0.1/Text/XHtml/Internals.hs 2008-09-17 16:19:47.000000000 +0200
+++ xhtml-bytestring/Text/XHtml/Internals.hs 2009-01-19 22:24:53.000000000 +0100
@@ -18,6 +18,9 @@
import Data.Char
import Data.Monoid
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as L
+
infixr 2 +++ -- combining Html
infixr 7 << -- nesting Html
infixl 8 ! -- adding optional arguments
@@ -29,7 +32,7 @@
-- | A important property of Html is that all strings inside the
-- structure are already in Html friendly format.
data HtmlElement
- = HtmlString String
+ = HtmlString L.ByteString
-- ^ ..just..plain..normal..text... but using © and &amb;, etc.
| HtmlTag {
markupTag :: String,
@@ -39,7 +42,7 @@
-- ^ tag with internal markup
-- | Attributes with name and value.
-data HtmlAttr = HtmlAttr String String
+data HtmlAttr = HtmlAttr String L.ByteString
newtype Html = Html { getHtmlElements :: [HtmlElement] }
@@ -57,7 +60,7 @@
showsPrec _ (HtmlAttr str val) =
showString str .
showString "=" .
- shows val
+ showString (L.unpack val)
instance Monoid Html where
mempty = noHtml
@@ -76,9 +79,19 @@
toHtml a = a
instance HTML Char where
- toHtml a = toHtml [a]
+ toHtml a = toHtml [a]
toHtmlFromList [] = Html []
- toHtmlFromList str = Html [HtmlString (stringToHtmlString str)]
+ toHtmlFromList str = toHtml (stringToHtmlString str)
+
+instance HTML L.ByteString where
+ toHtml str = toHtml [str]
+ toHtmlFromList [] = Html []
+ toHtmlFromList strs = Html [HtmlString (encodeHtmlByteString (L.concat strs))]
+
+instance HTML B.ByteString where
+ toHtml str = toHtml (L.fromChunks [str])
+ toHtmlFromList [] = Html []
+ toHtmlFromList strs = Html [HtmlString (encodeHtmlByteString (L.fromChunks strs))]
instance (HTML a) => HTML [a] where
toHtml xs = toHtmlFromList xs
@@ -144,16 +157,16 @@
itag str = tag str noHtml
emptyAttr :: String -> HtmlAttr
-emptyAttr s = HtmlAttr s s
+emptyAttr s = HtmlAttr s (L.pack s)
intAttr :: String -> Int -> HtmlAttr
-intAttr s i = HtmlAttr s (show i)
+intAttr s i = HtmlAttr s (L.pack (show i))
strAttr :: String -> String -> HtmlAttr
strAttr s t = HtmlAttr s (stringToHtmlString t)
htmlAttr :: String -> Html -> HtmlAttr
-htmlAttr s t = HtmlAttr s (show t)
+htmlAttr s t = HtmlAttr s (L.pack (show t))
{-
@@ -168,16 +181,32 @@
-}
--- | Processing Strings into Html friendly things.
-stringToHtmlString :: String -> String
-stringToHtmlString = concatMap fixChar
- where
- fixChar '<' = "<"
- fixChar '>' = ">"
- fixChar '&' = "&"
- fixChar '"' = """
- fixChar c | ord c < 0x80 = [c]
- fixChar c = "&#" ++ show (ord c) ++ ";"
+-- | Processing ByteStrings into Html friendly things.
+-- High code points are not replaced, so make sure the string
+-- is in the encoding that the user agent expects
+encodeHtmlByteString :: L.ByteString -> L.ByteString
+encodeHtmlByteString = concatMapL' fixChar
+
+-- | More efficient variant of 'L.concatMap'
+concatMapL' :: (Char -> String) -> L.ByteString -> L.ByteString
+concatMapL' f s = go s
+ where go s = let (unmodified, modified) = L.span (\c -> f c == [c]) s
+ in case L.uncons modified of
+ Nothing -> unmodified
+ Just (c,rest) -> L.pack (f c) `L.append` go rest
+
+-- | Processing Strings into Html friendly things, including
+-- replacing high code points by unicode escapes.
+stringToHtmlString :: String -> L.ByteString
+stringToHtmlString = L.pack . concatMap fixChar
+
+fixChar :: Char -> String
+fixChar '<' = "<"
+fixChar '>' = ">"
+fixChar '&' = "&"
+fixChar '"' = """
+fixChar c | ord c < 0x80 = [c]
+fixChar c = "&#" ++ show (ord c) ++ ";"
-- | This is not processed for special chars.
@@ -185,8 +214,11 @@
-- because they understand special chars, like @'<'@.
primHtml :: String -> Html
primHtml x | null x = Html []
- | otherwise = Html [HtmlString x]
+ | otherwise = primHtml' (L.pack x)
+-- | Variant of 'primHtml' that takes a ByteString
+primHtml' :: L.ByteString -> Html
+primHtml' x = Html [HtmlString x]
--
@@ -200,18 +232,22 @@
-- This should be the most time and space efficient way to
-- render HTML, though the ouput is quite unreadable.
showHtmlInternal :: HTML html =>
- String -- ^ DOCTYPE declaration
- -> html -> String
+ L.ByteString -- ^ DOCTYPE declaration
+ -> html -> L.ByteString
showHtmlInternal docType theHtml =
- docType ++ showHtmlFragment (mkHtml theHtml)
+ docType `L.append` showHtmlFragment' (mkHtml theHtml)
+
+-- Used a few times
+nl = L.pack "\n"
-- | Outputs indented HTML. Because space matters in
-- HTML, the output is quite messy.
renderHtmlInternal :: HTML html =>
- String -- ^ DOCTYPE declaration
- -> html -> String
+ L.ByteString -- ^ DOCTYPE declaration
+ -> html -> L.ByteString
renderHtmlInternal docType theHtml =
- docType ++ "\n" ++ renderHtmlFragment (mkHtml theHtml) ++ "\n"
+ docType `L.append` nl `L.append`
+ renderHtmlFragment' (mkHtml theHtml) `L.append` nl
-- | Outputs indented HTML, with indentation inside elements.
-- This can change the meaning of the HTML document, and
@@ -219,23 +255,29 @@
-- The implementation is inefficient, and you are normally
-- better off using 'showHtml' or 'renderHtml'.
prettyHtmlInternal :: HTML html =>
- String -- ^ DOCTYPE declaration
- -> html -> String
+ L.ByteString -- ^ DOCTYPE declaration
+ -> html -> L.ByteString
prettyHtmlInternal docType theHtml =
- docType ++ "\n" ++ prettyHtmlFragment (mkHtml theHtml)
+ docType `L.append` nl `L.append` prettyHtmlFragment' (mkHtml theHtml)
-- | Render a piece of HTML without adding a DOCTYPE declaration
-- or root element. Does not add any extra whitespace.
+showHtmlFragment' :: HTML html => html -> L.ByteString
+showHtmlFragment' h = L.concat $ map showHtml' $ getHtmlElements $ toHtml h
+
+-- | Variant of 'showHtmlFragment'' for regular Strings
showHtmlFragment :: HTML html => html -> String
-showHtmlFragment h =
- (foldr (.) id $ map showHtml' $ getHtmlElements $ toHtml h) ""
+showHtmlFragment = L.unpack . showHtmlFragment'
-- | Render a piece of indented HTML without adding a DOCTYPE declaration
-- or root element. Only adds whitespace where it does not change
-- the meaning of the document.
+renderHtmlFragment' :: HTML html => html -> L.ByteString
+renderHtmlFragment' h = L.concat $ map (renderHtml' 0) $ getHtmlElements $ toHtml h
+
+-- | Variant of 'renderHtmlFragment'' for regular Strings
renderHtmlFragment :: HTML html => html -> String
-renderHtmlFragment h =
- (foldr (.) id $ map (renderHtml' 0) $ getHtmlElements $ toHtml h) ""
+renderHtmlFragment = L.unpack . renderHtmlFragment'
-- | Render a piece of indented HTML without adding a DOCTYPE declaration
-- or a root element.
@@ -244,39 +286,41 @@
-- is mostly useful for debugging the HTML output.
-- The implementation is inefficient, and you are normally
-- better off using 'showHtmlFragment' or 'renderHtmlFragment'.
+prettyHtmlFragment' :: HTML html => html -> L.ByteString
+prettyHtmlFragment' = L.unlines . concat . map prettyHtml' . getHtmlElements . toHtml
+
+-- | Variant of 'prettyHtmlFragment'' for regular Strings
prettyHtmlFragment :: HTML html => html -> String
-prettyHtmlFragment =
- unlines . concat . map prettyHtml' . getHtmlElements . toHtml
+prettyHtmlFragment = L.unpack . prettyHtmlFragment'
-- | Show a single HTML element, without adding whitespace.
-showHtml' :: HtmlElement -> ShowS
-showHtml' (HtmlString str) = (++) str
-showHtml'(HtmlTag { markupTag = name,
+showHtml' :: HtmlElement -> L.ByteString
+showHtml' (HtmlString str) = str
+showHtml' (HtmlTag { markupTag = name,
markupContent = html,
markupAttrs = markupAttrs })
= if isNoHtml html && elem name validHtmlITags
- then renderTag True name markupAttrs ""
- else (renderTag False name markupAttrs ""
- . foldr (.) id (map showHtml' (getHtmlElements html))
- . renderEndTag name "")
+ then renderTag True name markupAttrs L.empty
+ else renderTag False name markupAttrs L.empty `L.append`
+ L.concat (map showHtml' (getHtmlElements html)) `L.append`
+ renderEndTag name L.empty
-renderHtml' :: Int -> HtmlElement -> ShowS
-renderHtml' _ (HtmlString str) = (++) str
+renderHtml' :: Int -> HtmlElement -> L.ByteString
+renderHtml' _ (HtmlString str) = str
renderHtml' n (HtmlTag
{ markupTag = name,
markupContent = html,
markupAttrs = markupAttrs })
= if isNoHtml html && elem name validHtmlITags
then renderTag True name markupAttrs (nl n)
- else (renderTag False name markupAttrs (nl n)
- . foldr (.) id (map (renderHtml' (n+2)) (getHtmlElements html))
- . renderEndTag name (nl n))
+ else renderTag False name markupAttrs (nl n) `L.append`
+ L.concat (map (renderHtml' (n+2)) (getHtmlElements html)) `L.append`
+ renderEndTag name (nl n)
where
- nl n = "\n" ++ replicate (n `div` 8) '\t'
- ++ replicate (n `mod` 8) ' '
+ nl n = L.pack $ "\n" ++ replicate (n `div` 8) '\t' ++ replicate (n `mod` 8) ' '
-prettyHtml' :: HtmlElement -> [String]
+prettyHtml' :: HtmlElement -> [L.ByteString]
prettyHtml' (HtmlString str) = [str]
prettyHtml' (HtmlTag
{ markupTag = name,
@@ -284,38 +328,38 @@
markupAttrs = markupAttrs })
= if isNoHtml html && elem name validHtmlITags
then
- [rmNL (renderTag True name markupAttrs "" "")]
+ [rmNL (renderTag True name markupAttrs L.empty)]
else
- [rmNL (renderTag False name markupAttrs "" "")] ++
+ [rmNL (renderTag False name markupAttrs L.empty)] ++
shift (concat (map prettyHtml' (getHtmlElements html))) ++
- [rmNL (renderEndTag name "" "")]
+ [rmNL (renderEndTag name L.empty)]
where
- shift = map (\x -> " " ++ x)
- rmNL = filter (/= '\n')
+ shift = map (\x -> L.pack " " `L.append` x)
+ rmNL = L.filter (/= '\n')
-- | Show a start tag
renderTag :: Bool -- ^ 'True' if the empty tag shorthand should be used
-> String -- ^ Tag name
-> [HtmlAttr] -- ^ Attributes
- -> String -- ^ Whitespace to add after attributes
- -> ShowS
-renderTag empty name attrs nl r
- = "<" ++ name ++ showAttrs attrs ++ nl ++ close ++ r
+ -> L.ByteString -- ^ Whitespace to add after attributes
+ -> L.ByteString
+renderTag empty name attrs nl
+ = L.pack ("<" ++ name) `L.append` showAttrs attrs `L.append` nl `L.append` close
where
- close = if empty then " />" else ">"
+ close = if empty then L.pack " />" else L.singleton '>'
- showAttrs attrs = concat [' ':showPair attr | attr <- attrs ]
+ showAttrs attrs = L.concat [' ' `L.cons` showPair attr | attr <- attrs ]
- showPair :: HtmlAttr -> String
+ showPair :: HtmlAttr -> L.ByteString
showPair (HtmlAttr tag val)
- = tag ++ "=\"" ++ val ++ "\""
+ = L.pack (tag ++ "=\"") `L.append` val `L.append` (L.singleton '\"')
-- | Show an end tag
renderEndTag :: String -- ^ Tag name
- -> String -- ^ Whitespace to add after tag name
- -> ShowS
-renderEndTag name nl r = "</" ++ name ++ nl ++ ">" ++ r
+ -> L.ByteString -- ^ Whitespace to add after tag name
+ -> L.ByteString
+renderEndTag name nl = L.pack ("</" ++ name) `L.append` nl `L.append` L.singleton '>'
-- | The names of all elements which can represented using the empty tag
diff -aur xhtml-3000.2.0.1/Text/XHtml/Strict.hs xhtml-bytestring/Text/XHtml/Strict.hs
--- xhtml-3000.2.0.1/Text/XHtml/Strict.hs 2008-09-17 16:19:47.000000000 +0200
+++ xhtml-bytestring/Text/XHtml/Strict.hs 2009-01-19 22:36:16.000000000 +0100
@@ -12,31 +12,39 @@
docType,
-- * Rendering
showHtml, renderHtml, renderHtmlWithLanguage, prettyHtml,
+ showHtml', renderHtml', renderHtmlWithLanguage', prettyHtml',
showHtmlFragment, renderHtmlFragment, prettyHtmlFragment,
module Text.XHtml.Strict.Elements,
module Text.XHtml.Strict.Attributes,
module Text.XHtml.Extras
) where
-import Text.XHtml.Internals
+import Text.XHtml.Internals hiding (showHtml', renderHtml', prettyHtml')
import Text.XHtml.Strict.Elements
import Text.XHtml.Strict.Attributes
import Text.XHtml.Extras
+import qualified Data.ByteString.Lazy.Char8 as L
+
-- | The @DOCTYPE@ for XHTML 1.0 Strict.
-docType = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\""
+docType = L.pack $
+ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\""
++ " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\";>"
-- | Output the HTML without adding newlines or spaces within the markup.
-- This should be the most time and space efficient way to
-- render HTML, though the ouput is quite unreadable.
showHtml :: HTML html => html -> String
-showHtml = showHtmlInternal docType
+showHtml = L.unpack . showHtml'
+showHtml' :: HTML html => html -> L.ByteString
+showHtml' = showHtmlInternal docType
-- | Outputs indented HTML. Because space matters in
-- HTML, the output is quite messy.
renderHtml :: HTML html => html -> String
-renderHtml = renderHtmlInternal docType
+renderHtml = L.unpack . renderHtml'
+renderHtml' :: HTML html => html -> L.ByteString
+renderHtml' = renderHtmlInternal docType
-- | Outputs indented XHTML. Because space matters in
-- HTML, the output is quite messy.
@@ -44,8 +52,14 @@
=> String -- ^ The code of the "dominant" language of the webpage.
-> html -- ^ All the 'Html', including a header.
-> String
-renderHtmlWithLanguage l theHtml =
- docType ++ "\n" ++ renderHtmlFragment code ++ "\n"
+renderHtmlWithLanguage l = L.unpack . renderHtmlWithLanguage' l
+renderHtmlWithLanguage' :: HTML html
+ => String -- ^ The code of the "dominant" language of the webpage.
+ -> html -- ^ All the 'Html', including a header.
+ -> L.ByteString
+renderHtmlWithLanguage' l theHtml =
+ docType `L.append` L.singleton '\n' `L.append`
+ renderHtmlFragment' code `L.append` L.singleton '\n'
where
code = tag "html" ! [ strAttr "xmlns" "http://www.w3.org/1999/xhtml";
, strAttr "lang" l
@@ -58,4 +72,6 @@
-- The implementation is inefficient, and you are normally
-- better off using 'showHtml' or 'renderHtml'.
prettyHtml :: HTML html => html -> String
-prettyHtml = prettyHtmlInternal docType
+prettyHtml = L.unpack . prettyHtml'
+prettyHtml' :: HTML html => html -> L.ByteString
+prettyHtml' = prettyHtmlInternal docType
diff -aur xhtml-3000.2.0.1/Text/XHtml/Transitional.hs xhtml-bytestring/Text/XHtml/Transitional.hs
--- xhtml-3000.2.0.1/Text/XHtml/Transitional.hs 2008-09-17 16:19:47.000000000 +0200
+++ xhtml-bytestring/Text/XHtml/Transitional.hs 2009-01-19 22:36:06.000000000 +0100
@@ -11,6 +11,7 @@
primHtml,
-- * Rendering
showHtml, renderHtml, prettyHtml,
+ showHtml', renderHtml', prettyHtml',
showHtmlFragment, renderHtmlFragment, prettyHtmlFragment,
module Text.XHtml.Strict.Elements,
module Text.XHtml.Frameset.Elements,
@@ -21,7 +22,7 @@
module Text.XHtml.Extras
) where
-import Text.XHtml.Internals
+import Text.XHtml.Internals hiding (showHtml', renderHtml', prettyHtml')
import Text.XHtml.Strict.Elements
import Text.XHtml.Frameset.Elements
@@ -33,8 +34,10 @@
import Text.XHtml.Extras
+import qualified Data.ByteString.Lazy.Char8 as L
-docType =
+
+docType = L.pack $
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"" ++
" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\";>"
@@ -42,12 +45,17 @@
-- This should be the most time and space efficient way to
-- render HTML, though the ouput is quite unreadable.
showHtml :: HTML html => html -> String
-showHtml = showHtmlInternal docType
+showHtml = L.unpack . showHtml'
+
+showHtml' :: HTML html => html -> L.ByteString
+showHtml' = showHtmlInternal docType
-- | Outputs indented HTML. Because space matters in
-- HTML, the output is quite messy.
renderHtml :: HTML html => html -> String
-renderHtml = renderHtmlInternal docType
+renderHtml = L.unpack . renderHtml'
+renderHtml' :: HTML html => html -> L.ByteString
+renderHtml' = renderHtmlInternal docType
-- | Outputs indented HTML, with indentation inside elements.
-- This can change the meaning of the HTML document, and
@@ -55,4 +63,6 @@
-- The implementation is inefficient, and you are normally
-- better off using 'showHtml' or 'renderHtml'.
prettyHtml :: HTML html => html -> String
-prettyHtml = prettyHtmlInternal docType
+prettyHtml = L.unpack . prettyHtml'
+prettyHtml' :: HTML html => html -> L.ByteString
+prettyHtml' = prettyHtmlInternal docType
diff -aur xhtml-3000.2.0.1/xhtml.cabal xhtml-bytestring/xhtml.cabal
--- xhtml-3000.2.0.1/xhtml.cabal 2008-09-17 16:19:47.000000000 +0200
+++ xhtml-bytestring/xhtml.cabal 2009-01-19 22:43:48.000000000 +0100
@@ -1,17 +1,19 @@
-Name: xhtml
+Name: xhtml-bytestring
Version: 3000.2.0.1
Copyright: Bjorn Bringert 2004-2006, Andy Gill, and the Oregon Graduate
- Institute of Science and Technology, 1999-2001
-Maintainer: [email protected]
-Author: Bjorn Bringert
+ Institute of Science and Technology, 1999-2001, Joachim Breitner, 2009
+Maintainer: [email protected]
+Author: Joachim Breitner
License: BSD3
License-file: LICENSE
-build-depends: base
+build-depends: base, bytestring
Extensions:
Synopsis: An XHTML combinator library
Description:
This package provides combinators for producing
XHTML 1.0, including the Strict, Transitional and Frameset variants.
+ It uses ByteString internally and allows the user to input and output
+ Bytestrings as well.
Build-Type: Simple
Exposed-Modules:
Text.XHtml,
signature.asc
Description: Dies ist ein digital signierter Nachrichtenteil
_______________________________________________ Haskell-Cafe mailing list [email protected] http://www.haskell.org/mailman/listinfo/haskell-cafe
