xhtml 3000.3.0.0 → 3000.4.0.0
raw patch · 4 files changed
+47/−19 lines, 4 filesnew-uploader
Files
- ChangeLog.md +4/−0
- Text/XHtml/Debug.hs +2/−2
- Text/XHtml/Internals.hs +40/−16
- xhtml.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,7 @@+## 3000.4.0.0++- Memory allocation improvements [#20](https://github.com/haskell/xhtml/pull/20)+ ## 3000.3.0.0 - The internal representation has changed from `String` and `[String]` to a
Text/XHtml/Debug.hs view
@@ -101,8 +101,8 @@ args = if null attrs then "" else " " <> unwords (map show attrs)- hd = xsmallFont << ("<" <> builderToString tag' <> args <> ">")- tl = xsmallFont << ("</" <> builderToString tag' <> ">")+ hd = xsmallFont << ("<" <> lazyByteStringToString tag' <> args <> ">")+ tl = xsmallFont << ("</" <> lazyByteStringToString tag' <> ">") bgcolor' :: LText.Text -> HtmlAttr bgcolor' c = thestyle ("background-color:" <> c)
Text/XHtml/Internals.hs view
@@ -23,6 +23,7 @@ import qualified Data.Text.Lazy as LText import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy.Encoding as LText+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Data.ByteString.Builder hiding (char7) import qualified Data.ByteString.Builder.Prim as P@@ -51,7 +52,7 @@ = HtmlString !Builder -- ^ ..just..plain..normal..text... but using © and &amb;, etc. | HtmlTag {- markupTag :: !Builder,+ markupTag :: !BSL.ByteString, markupAttrs :: [HtmlAttr] -> [HtmlAttr], markupContent :: !Html }@@ -74,6 +75,10 @@ builderToString = LText.unpack . LText.decodeUtf8 . toLazyByteString +lazyByteStringToString :: BSL.ByteString -> String+lazyByteStringToString =+ LText.unpack . LText.decodeUtf8+ -- -- * Classes --@@ -138,6 +143,16 @@ toHtml xs = Html (HtmlString (lazyTextToHtmlString xs) : ) {-# INLINE toHtml #-} +instance HTML BSL.ByteString where+ toHtml "" = Html id+ toHtml xs = Html (HtmlString (lazyByteString xs) : )+ {-# INLINE toHtml #-}++instance HTML BS.ByteString where+ toHtml "" = Html id+ toHtml xs = Html (HtmlString (byteString xs) : )+ {-# INLINE toHtml #-}+ mapDlist :: (a -> b) -> ([a] -> [a]) -> [b] -> [b] mapDlist f as = (map f (as []) ++) {-# INLINE mapDlist #-}@@ -223,7 +238,7 @@ isNoHtml (Html xs) = null (xs []) -- | Constructs an element with a custom name.-tag :: Builder -- ^ Element name+tag :: BSL.ByteString -- ^ Element name -> Html -- ^ Element contents -> Html tag str htmls =@@ -239,7 +254,7 @@ -- | Constructs an element with a custom name, and -- without any children.-itag :: Builder -> Html+itag :: BSL.ByteString -> Html itag str = tag str noHtml emptyAttr :: Builder -> HtmlAttr@@ -429,14 +444,17 @@ markupContent = html, markupAttrs = attrs }) = if isValidHtmlITag name && isNoHtml html- then renderTag True name (attrs []) ""- else renderTag False name (attrs []) ""+ then renderTag True nameBuilder (attrs []) ""+ else renderTag False nameBuilder (attrs []) "" <> go (getHtmlElements html)- <> renderEndTag name ""+ <> renderEndTag nameBuilder "" where go [] = mempty go (x:xs) = showHtml' x <> go xs + nameBuilder :: Builder+ nameBuilder = lazyByteString name+ renderHtml' :: Int -> HtmlElement -> Builder renderHtml' _ (HtmlString str) = str renderHtml' n (HtmlTag@@ -444,10 +462,10 @@ markupContent = html, markupAttrs = attrs }) = if isValidHtmlITag name && isNoHtml html- then renderTag True name (attrs []) nl- else renderTag False name (attrs []) nl+ then renderTag True nameBuilder (attrs []) nl+ else renderTag False nameBuilder (attrs []) nl <> foldMap (renderHtml' (n+2)) (getHtmlElements html)- <> renderEndTag name nl+ <> renderEndTag nameBuilder nl where nl :: Builder nl = charUtf8 '\n' <> tabs <> spaces@@ -464,7 +482,10 @@ m | m <= 0 -> mempty m -> Sem.stimes m (charUtf8 ' ') + nameBuilder :: Builder+ nameBuilder = lazyByteString name + prettyHtml' :: HtmlElement -> [String] prettyHtml' (HtmlString str) = [builderToString str] prettyHtml' (HtmlTag@@ -473,21 +494,24 @@ markupAttrs = attrs }) = if isValidHtmlITag name && isNoHtml html then- [rmNL (renderTag True name (attrs []) "")]+ [rmNL (renderTag True nameBuilder (attrs []) "")] else- [rmNL (renderTag False name (attrs []) "")] +++ [rmNL (renderTag False nameBuilder (attrs []) "")] ++ shift (concatMap prettyHtml' (getHtmlElements html)) ++- [rmNL (renderEndTag name "")]+ [rmNL (renderEndTag nameBuilder "")] where shift = map (" " ++) rmNL = filter (/= '\n') . builderToString + nameBuilder :: Builder+ nameBuilder = lazyByteString name + -- | Show a start tag renderTag :: Bool -- ^ 'True' if the empty tag shorthand should be used- -> Builder -- ^ Tag name+ -> Builder -- ^ Tag name -> [HtmlAttr] -- ^ Attributes- -> Builder -- ^ Whitespace to add after attributes+ -> Builder -- ^ Whitespace to add after attributes -> Builder renderTag empty name attrs nl = "<" <> name <> shownAttrs <> nl <> close@@ -506,8 +530,8 @@ -> Builder renderEndTag name nl = "</" <> name <> nl <> ">" -isValidHtmlITag :: Builder -> Bool-isValidHtmlITag bldr = toLazyByteString bldr `Set.member` validHtmlITags+isValidHtmlITag :: BSL.ByteString -> Bool+isValidHtmlITag bs = bs `Set.member` validHtmlITags -- | The names of all elements which can be represented using the empty tag -- short-hand.
xhtml.cabal view
@@ -1,6 +1,6 @@ Cabal-version: >= 1.10 Name: xhtml-Version: 3000.3.0.0+Version: 3000.4.0.0 Copyright: Bjorn Bringert 2004-2006, Andy Gill and the Oregon Graduate Institute of Science and Technology, 1999-2001 Maintainer: Chris Dornan <chris@chrisdornan.com>