Split 'go' into with/without attrs code paths

.gitignore

@@ -9,6 +9,7 @@ local
 cabal.sandbox.config
 cabal.config
 
+report.html
 TestSuite.tix
 .hpc
 hpc

src/Text/Blaze/Renderer/Pretty.hs

@@ -13,32 +13,57 @@ import Text.Blaze.Renderer.String (fromChoiceString)
 renderString :: Markup  -- ^ Markup to render
              -> String  -- ^ String to append
              -> String  -- ^ Resulting String
-renderString = go 0 id
+renderString = go 0
   where
-    go :: Int -> (String -> String) -> MarkupM b -> String -> String
-    go i attrs (Parent _ open close content) =
-        ind i . getString open . attrs . (">\n" ++) . go (inc i) id content
+    go :: Int -> MarkupM b -> String -> String
+    go i (Parent _ open close content) =
+        ind i . getString open . (">\n" ++) . go (inc i) content
               . ind i . getString close .  ('\n' :)
-    go i attrs (CustomParent tag content) =
+    go i (CustomParent tag content) =
+        ind i . ('<' :) . fromChoiceString tag . (">\n" ++) .
+        go (inc i) content . ind i . ("</" ++) . fromChoiceString tag .
+        (">\n" ++)
+    go i (Leaf _ begin end) =
+        ind i . getString begin . getString end . ('\n' :)
+    go i (CustomLeaf tag close) =
+        ind i . ('<' :) . fromChoiceString tag .
+        ((if close then " />\n" else ">\n") ++)
+    go i (AddAttribute _ key value h) = flip (go_attrs i) h $
+        getString key . fromChoiceString value . ('"' :)
+    go i (AddCustomAttribute key value h) = flip (go_attrs i) h $
+        (' ' : ) . fromChoiceString key . ("=\"" ++) . fromChoiceString value .
+        ('"' :)
+    go i (Content content) = ind i . fromChoiceString content . ('\n' :)
+    go i (Comment comment) = ind i .
+        ("<!-- " ++) . fromChoiceString comment . (" -->\n" ++)
+    go i (Append h1 h2) = go i h1 . go i h2
+    go _ Empty = id
+    {-# NOINLINE go #-}
+
+    go_attrs :: Int -> (String -> String) -> MarkupM b -> String -> String
+    go_attrs i attrs (Parent _ open close content) =
+        ind i . getString open . attrs . (">\n" ++) . go (inc i) content
+              . ind i . getString close .  ('\n' :)
+    go_attrs i attrs (CustomParent tag content) =
         ind i . ('<' :) . fromChoiceString tag . attrs . (">\n" ++) .
-        go (inc i) id content . ind i . ("</" ++) . fromChoiceString tag .
+        go (inc i) content . ind i . ("</" ++) . fromChoiceString tag .
         (">\n" ++)
-    go i attrs (Leaf _ begin end) =
+    go_attrs i attrs (Leaf _ begin end) =
         ind i . getString begin . attrs . getString end . ('\n' :)
-    go i attrs (CustomLeaf tag close) =
+    go_attrs i attrs (CustomLeaf tag close) =
         ind i . ('<' :) . fromChoiceString tag . attrs .
         ((if close then " />\n" else ">\n") ++)
-    go i attrs (AddAttribute _ key value h) = flip (go i) h $
+    go_attrs i attrs (AddAttribute _ key value h) = flip (go_attrs i) h $
         getString key . fromChoiceString value . ('"' :) . attrs
-    go i attrs (AddCustomAttribute key value h) = flip (go i) h $
+    go_attrs i attrs (AddCustomAttribute key value h) = flip (go_attrs i) h $
         (' ' : ) . fromChoiceString key . ("=\"" ++) . fromChoiceString value .
         ('"' :) .  attrs
-    go i _ (Content content) = ind i . fromChoiceString content . ('\n' :)
-    go i _ (Comment comment) = ind i .
+    go_attrs i _ (Content content) = ind i . fromChoiceString content . ('\n' :)
+    go_attrs i _ (Comment comment) = ind i .
         ("<!-- " ++) . fromChoiceString comment . (" -->\n" ++)
-    go i attrs (Append h1 h2) = go i attrs h1 . go i attrs h2
-    go _ _ Empty = id
-    {-# NOINLINE go #-}
+    go_attrs i attrs (Append h1 h2) = go_attrs i attrs h1 . go_attrs i attrs h2
+    go_attrs _ _ Empty = id
+    {-# NOINLINE go_attrs #-}
 
     -- Increase the indentation
     inc = (+) 4

src/Text/Blaze/Renderer/String.hs

@@ -59,29 +59,52 @@ fromChoiceString EmptyChoiceString = id
 renderString :: Markup    -- ^ Markup to render
              -> String  -- ^ String to append
              -> String  -- ^ Resulting String
-renderString = go id
+renderString = go
   where
-    go :: (String -> String) -> MarkupM b -> String -> String
-    go attrs (Parent _ open close content) =
-        getString open . attrs . ('>' :) . go id content . getString close
-    go attrs (CustomParent tag content) =
-        ('<' :) . fromChoiceString tag . attrs . ('>' :) .  go id content .
+    go :: MarkupM b -> String -> String
+    go (Parent _ open close content) =
+        getString open . ('>' :) . go content . getString close
+    go (CustomParent tag content) =
+        ('<' :) . fromChoiceString tag . ('>' :) .  go content .
         ("</" ++) . fromChoiceString tag . ('>' :)
-    go attrs (Leaf _ begin end) = getString begin . attrs . getString end
-    go attrs (CustomLeaf tag close) =
+    go (Leaf _ begin end) = getString begin . getString end
+    go (CustomLeaf tag close) =
+        ('<' :) . fromChoiceString tag .
+        (if close then (" />" ++) else ('>' :))
+    go (AddAttribute _ key value h) = flip go_attrs h $
+        getString key . fromChoiceString value . ('"' :)
+    go (AddCustomAttribute key value h) = flip go_attrs h $
+        (' ' :) . fromChoiceString key . ("=\"" ++) . fromChoiceString value .
+        ('"' :)
+    go (Content content) = fromChoiceString content
+    go (Comment comment) =
+        ("<!-- " ++) . fromChoiceString comment . (" -->" ++)
+    go (Append h1 h2) = go h1 . go h2
+    go Empty = id
+    {-# NOINLINE go #-}
+
+    go_attrs :: (String -> String) -> MarkupM b -> String -> String
+    go_attrs attrs (Parent _ open close content) =
+        getString open . attrs . ('>' :) . go content . getString close
+    go_attrs attrs (CustomParent tag content) =
+        ('<' :) . fromChoiceString tag . attrs . ('>' :) .  go content .
+        ("</" ++) . fromChoiceString tag . ('>' :)
+    go_attrs attrs (Leaf _ begin end) = getString begin . attrs . getString end
+    go_attrs attrs (CustomLeaf tag close) =
         ('<' :) . fromChoiceString tag . attrs .
         (if close then (" />" ++) else ('>' :))
-    go attrs (AddAttribute _ key value h) = flip go h $
+    go_attrs attrs (AddAttribute _ key value h) = flip go_attrs h $
         getString key . fromChoiceString value . ('"' :) . attrs
-    go attrs (AddCustomAttribute key value h) = flip go h $
+    go_attrs attrs (AddCustomAttribute key value h) = flip go_attrs h $
         (' ' :) . fromChoiceString key . ("=\"" ++) . fromChoiceString value .
         ('"' :) .  attrs
-    go _ (Content content) = fromChoiceString content
-    go _ (Comment comment) =
+    go_attrs _ (Content content) = fromChoiceString content
+    go_attrs _ (Comment comment) =
         ("<!-- " ++) . fromChoiceString comment . (" -->" ++)
-    go attrs (Append h1 h2) = go attrs h1 . go attrs h2
-    go _ Empty = id
-    {-# NOINLINE go #-}
+    go_attrs attrs (Append h1 h2) = go_attrs attrs h1 . go_attrs attrs h2
+    go_attrs _ Empty = id
+    {-# NOINLINE go_attrs #-}
+
 {-# INLINE renderString #-}
 
 -- | Render markup to a lazy 'String'.

src/Text/Blaze/Renderer/Text.hs

@@ -81,53 +81,93 @@ renderHtmlBuilder = renderMarkupBuilder
 renderMarkupBuilderWith :: (ByteString -> Text)  -- ^ Decoder for bytestrings
                         -> Markup                -- ^ Markup to render
                         -> Builder               -- ^ Resulting builder
-renderMarkupBuilderWith d = go mempty
+renderMarkupBuilderWith d = go
   where
-    go :: Builder -> MarkupM b -> Builder
-    go attrs (Parent _ open close content) =
+    go :: MarkupM b -> Builder
+    go (Parent _ open close content) =
+        B.fromText (getText open)
+            `mappend` B.singleton '>'
+            `mappend` go content
+            `mappend` B.fromText (getText close)
+    go (CustomParent tag content) =
+        B.singleton '<'
+            `mappend` fromChoiceString d tag
+            `mappend` B.singleton '>'
+            `mappend` go content
+            `mappend` B.fromText "</"
+            `mappend` fromChoiceString d tag
+            `mappend` B.singleton '>'
+    go (Leaf _ begin end) =
+        B.fromText (getText begin)
+            `mappend` B.fromText (getText end)
+    go (CustomLeaf tag close) =
+        B.singleton '<'
+            `mappend` fromChoiceString d tag
+            `mappend` (if close then B.fromText " />" else B.singleton '>')
+    go (AddAttribute _ key value h) =
+        go_attrs (B.fromText (getText key)
+                 `mappend` fromChoiceString d value
+                 `mappend` B.singleton '"') h
+    go (AddCustomAttribute key value h) =
+        go_attrs (B.singleton ' '
+                 `mappend` fromChoiceString d key
+                 `mappend` B.fromText "=\""
+                 `mappend` fromChoiceString d value
+                 `mappend` B.singleton '"') h
+    go (Content content)  = fromChoiceString d content
+    go (Comment comment)  =
+        B.fromText "<!-- "
+            `mappend` fromChoiceString d comment
+            `mappend` " -->"
+    go (Append h1 h2) = go h1 `mappend` go h2
+    go Empty              = mempty
+    {-# NOINLINE go #-}
+
+    go_attrs :: Builder -> MarkupM b -> Builder
+    go_attrs attrs (Parent _ open close content) =
         B.fromText (getText open)
             `mappend` attrs
             `mappend` B.singleton '>'
-            `mappend` go mempty content
+            `mappend` go content
             `mappend` B.fromText (getText close)
-    go attrs (CustomParent tag content) =
+    go_attrs attrs (CustomParent tag content) =
         B.singleton '<'
             `mappend` fromChoiceString d tag
             `mappend` attrs
             `mappend` B.singleton '>'
-            `mappend` go mempty content
+            `mappend` go content
             `mappend` B.fromText "</"
             `mappend` fromChoiceString d tag
             `mappend` B.singleton '>'
-    go attrs (Leaf _ begin end) =
+    go_attrs attrs (Leaf _ begin end) =
         B.fromText (getText begin)
             `mappend` attrs
             `mappend` B.fromText (getText end)
-    go attrs (CustomLeaf tag close) =
+    go_attrs attrs (CustomLeaf tag close) =
         B.singleton '<'
             `mappend` fromChoiceString d tag
             `mappend` attrs
             `mappend` (if close then B.fromText " />" else B.singleton '>')
-    go attrs (AddAttribute _ key value h) =
-        go (B.fromText (getText key)
+    go_attrs attrs (AddAttribute _ key value h) =
+        go_attrs (B.fromText (getText key)
             `mappend` fromChoiceString d value
             `mappend` B.singleton '"'
             `mappend` attrs) h
-    go attrs (AddCustomAttribute key value h) =
-        go (B.singleton ' '
+    go_attrs attrs (AddCustomAttribute key value h) =
+        go_attrs (B.singleton ' '
             `mappend` fromChoiceString d key
             `mappend` B.fromText "=\""
             `mappend` fromChoiceString d value
             `mappend` B.singleton '"'
             `mappend` attrs) h
-    go _ (Content content)  = fromChoiceString d content
-    go _ (Comment comment)  =
+    go_attrs _ (Content content)  = fromChoiceString d content
+    go_attrs _ (Comment comment)  =
         B.fromText "<!-- "
             `mappend` fromChoiceString d comment
             `mappend` " -->"
-    go attrs (Append h1 h2) = go attrs h1 `mappend` go attrs h2
-    go _ Empty              = mempty
-    {-# NOINLINE go #-}
+    go_attrs attrs (Append h1 h2) = go_attrs attrs h1 `mappend` go_attrs attrs h2
+    go_attrs _ Empty              = mempty
+    {-# NOINLINE go_attrs #-}
 {-# INLINE renderMarkupBuilderWith #-}
 
 renderHtmlBuilderWith :: (ByteString -> Text)  -- ^ Decoder for bytestrings

src/Text/Blaze/Renderer/Utf8.hs

@@ -47,53 +47,93 @@ fromChoiceString EmptyChoiceString = mempty
 --
 renderMarkupBuilder, renderHtmlBuilder :: Markup     -- ^ Markup to render
                   -> Builder  -- ^ Resulting builder
-renderMarkupBuilder = go mempty
+renderMarkupBuilder = go
   where
-    go :: Builder -> MarkupM b -> Builder
-    go attrs (Parent _ open close content) =
+    go :: MarkupM b -> Builder
+    go (Parent _ open close content) =
+        B.copyByteString (getUtf8ByteString open)
+            `mappend` B.fromChar '>'
+            `mappend` go content
+            `mappend` B.copyByteString (getUtf8ByteString close)
+    go (CustomParent tag content) =
+        B.fromChar '<'
+            `mappend` fromChoiceString tag
+            `mappend` B.fromChar '>'
+            `mappend` go content
+            `mappend` B.fromByteString "</"
+            `mappend` fromChoiceString tag
+            `mappend` B.fromChar '>'
+    go (Leaf _ begin end) =
+        B.copyByteString (getUtf8ByteString begin)
+            `mappend` B.copyByteString (getUtf8ByteString end)
+    go (CustomLeaf tag close) =
+        B.fromChar '<'
+            `mappend` fromChoiceString tag
+            `mappend` (if close then B.fromByteString " />" else B.fromChar '>')
+    go (AddAttribute _ key value h) =
+        go_attrs (B.copyByteString (getUtf8ByteString key)
+                 `mappend` fromChoiceString value
+                 `mappend` B.fromChar '"') h
+    go (AddCustomAttribute key value h) =
+        go_attrs (B.fromChar ' '
+                 `mappend` fromChoiceString key
+                 `mappend` B.fromByteString "=\""
+                 `mappend` fromChoiceString value
+                 `mappend` B.fromChar '"') h
+    go (Content content)  = fromChoiceString content
+    go (Comment comment)  =
+        B.fromByteString "<!-- "
+            `mappend` fromChoiceString comment
+            `mappend` B.fromByteString " -->"
+    go (Append h1 h2) = go h1 `mappend` go h2
+    go Empty              = mempty
+    {-# NOINLINE go #-}
+
+    go_attrs :: Builder -> MarkupM b -> Builder
+    go_attrs attrs (Parent _ open close content) =
         B.copyByteString (getUtf8ByteString open)
             `mappend` attrs
             `mappend` B.fromChar '>'
-            `mappend` go mempty content
+            `mappend` go content
             `mappend` B.copyByteString (getUtf8ByteString close)
-    go attrs (CustomParent tag content) =
+    go_attrs attrs (CustomParent tag content) =
         B.fromChar '<'
             `mappend` fromChoiceString tag
             `mappend` attrs
             `mappend` B.fromChar '>'
-            `mappend` go mempty content
+            `mappend` go content
             `mappend` B.fromByteString "</"
             `mappend` fromChoiceString tag
             `mappend` B.fromChar '>'
-    go attrs (Leaf _ begin end) =
+    go_attrs attrs (Leaf _ begin end) =
         B.copyByteString (getUtf8ByteString begin)
             `mappend` attrs
             `mappend` B.copyByteString (getUtf8ByteString end)
-    go attrs (CustomLeaf tag close) =
+    go_attrs attrs (CustomLeaf tag close) =
         B.fromChar '<'
             `mappend` fromChoiceString tag
             `mappend` attrs
             `mappend` (if close then B.fromByteString " />" else B.fromChar '>')
-    go attrs (AddAttribute _ key value h) =
-        go (B.copyByteString (getUtf8ByteString key)
+    go_attrs attrs (AddAttribute _ key value h) =
+        go_attrs (B.copyByteString (getUtf8ByteString key)
             `mappend` fromChoiceString value
             `mappend` B.fromChar '"'
             `mappend` attrs) h
-    go attrs (AddCustomAttribute key value h) =
-        go (B.fromChar ' '
+    go_attrs attrs (AddCustomAttribute key value h) =
+        go_attrs (B.fromChar ' '
             `mappend` fromChoiceString key
             `mappend` B.fromByteString "=\""
             `mappend` fromChoiceString value
             `mappend` B.fromChar '"'
             `mappend` attrs) h
-    go _ (Content content)  = fromChoiceString content
-    go _ (Comment comment)  =
+    go_attrs _ (Content content)  = fromChoiceString content
+    go_attrs _ (Comment comment)  =
         B.fromByteString "<!-- "
             `mappend` fromChoiceString comment
             `mappend` B.fromByteString " -->"
-    go attrs (Append h1 h2) = go attrs h1 `mappend` go attrs h2
-    go _ Empty              = mempty
-    {-# NOINLINE go #-}
+    go_attrs attrs (Append h1 h2) = go_attrs attrs h1 `mappend` go_attrs attrs h2
+    go_attrs _ Empty              = mempty
+    {-# NOINLINE go_attrs #-}
 {-# INLINE renderMarkupBuilder #-}
 
 renderHtmlBuilder = renderMarkupBuilder