diff --git a/Text/XHtml/Internals.hs b/Text/XHtml/Internals.hs
index cc89b31..514766d 100644
--- a/Text/XHtml/Internals.hs
+++ b/Text/XHtml/Internals.hs
@@ -101,21 +101,27 @@ class HTML a where
instance HTML Html where
toHtml a = a
+ {-# INLINE toHtml #-}
instance HTML Char where
toHtml a = toHtml [a]
+ {-# INLINE toHtml #-}
toHtmlFromList [] = Html id
toHtmlFromList str = Html (HtmlString (stringToHtmlString str) :)
+ {-# INLINE toHtmlFromList #-}
instance (HTML a) => HTML [a] where
toHtml xs = toHtmlFromList xs
+ {-# INLINE toHtml #-}
instance HTML a => HTML (Maybe a) where
toHtml = maybe noHtml toHtml
+ {-# INLINE toHtml #-}
instance HTML Text where
toHtml "" = Html id
toHtml xs = Html (HtmlString (textToHtmlString xs) :)
+ {-# INLINE toHtml #-}
mapDlist :: (a -> b) -> ([a] -> [a]) -> [b] -> [b]
mapDlist f as = (map f (as []) ++)
@@ -130,11 +136,14 @@ class CHANGEATTRS a where
instance (ADDATTRS b) => ADDATTRS (a -> b) where
fn ! attr = \ arg -> fn arg ! attr
+ {-# INLINE (!) #-}
instance (CHANGEATTRS b) => CHANGEATTRS (a -> b) where
changeAttrs fn f = \ arg -> changeAttrs (fn arg) f
+ {-# INLINE changeAttrs #-}
instance ADDATTRS Html where
+ {-# INLINE (!) #-}
(Html htmls) ! attr = Html (mapDlist addAttrs htmls)
where
addAttrs html =
@@ -149,6 +158,7 @@ instance ADDATTRS Html where
instance CHANGEATTRS Html where
+ {-# INLINE changeAttrs #-}
changeAttrs (Html htmls) f = Html (mapDlist addAttrs htmls)
where
addAttrs (html@(HtmlTag { markupAttrs = attrs }) )
@@ -167,6 +177,12 @@ instance CHANGEATTRS Html where
-> b
fn << arg = fn (toHtml arg)
+{-# SPECIALIZE (<<) :: (Html -> b) -> Html -> b #-}
+{-# SPECIALIZE (<<) :: (Html -> b) -> [Html] -> b #-}
+{-# SPECIALIZE (<<) :: (Html -> b) -> [Html] -> b #-}
+
+{-# INLINABLE (<<) #-}
+
concatHtml :: (HTML a) => [a] -> Html
concatHtml = Html . foldr (.) id . map (unHtml . toHtml)