packages feed

xhtml 3000.2.2.1 → 3000.4.1.0

raw patch · 15 files changed

Files

ChangeLog.md view
@@ -1,3 +1,17 @@+## 3000.4.1.0++- Fix Inconsistent single quote escaping between String and Text HTML instances [#24](github.com/haskell/xhtml/pull/24)++## 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+  `Data.ByteString.Builder` and difference lists.+  [#19](https://github.com/haskell/xhtml/pull/19)+ ## 3000.2.2.1  - Special release which supports *only* `base >= 4.11`
Text/XHtml/BlockTable.hs view
@@ -10,7 +10,7 @@ -- -- An XHTML combinator library ----- These combinators can be used to build formated 2D tables.+-- These combinators can be used to build formatted 2D tables. -- The specific target usage is for HTML table generation. ----------------------------------------------------------------------------- @@ -67,7 +67,7 @@ module Text.XHtml.BlockTable (       -- * Datatypes       BlockTable,-      -- * Contruction Functions+      -- * Construction Functions       single,       above,       beside,@@ -114,7 +114,7 @@     let       -- Note this depends on the fact that       -- that the result has the same number-      -- of lines as the y dimention; one list+      -- of lines as the y dimension; one list       -- per line. This is not true in general       -- but is always true for these combinators.       -- I should assert this!
Text/XHtml/Debug.hs view
@@ -1,5 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} +{-# language OverloadedStrings #-}+ -- | This module contains functions for displaying --   HTML as a pretty tree. module Text.XHtml.Debug ( HtmlTree(..), treeHtml, treeColors, debugHtml ) where@@ -9,7 +11,10 @@ import Text.XHtml.Table import Text.XHtml.Strict.Elements import Text.XHtml.Strict.Attributes+import qualified Data.Text.Lazy as LText +import Data.List (uncons)+ -- -- * Tree Displaying Combinators --@@ -21,51 +26,47 @@       = HtmlLeaf Html       | HtmlNode Html [HtmlTree] Html -treeHtml :: [String] -> HtmlTree -> Html-treeHtml colors h = table ! [-                    border 0,-                    cellpadding 0,-                    cellspacing 2] << treeHtml' colors h-     where-      manycolors = scanr (:) []+treeHtml :: [LText.Text] -> HtmlTree -> Html+treeHtml colors h =+    table !+      [ border 0,+        cellpadding 0,+        cellspacing 2+      ]+      << treeHtml' colors h+  where+    manycolors = scanr (:) [] -      treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable-      treeHtmls c ts = aboves (zipWith treeHtml' c ts)+    treeHtmls :: [[LText.Text]] -> [HtmlTree] -> HtmlTable+    treeHtmls c ts = aboves (zipWith treeHtml' c ts) -      treeHtml' :: [String] -> HtmlTree -> HtmlTable-      treeHtml' _ (HtmlLeaf leaf) = cell-                                         (td ! [width "100%"] -                                            << bold  -                                               << leaf)-      treeHtml' (c:cs@(c2:_)) (HtmlNode hopen ts hclose) =-          if null ts && isNoHtml hclose-          then-              cell hd -          else if null ts-          then-              hd </> bar `beside` (td ! [bgcolor' c2] << spaceHtml)-                 </> tl-          else-              hd </> (bar `beside` treeHtmls morecolors ts)-                 </> tl-        where-              -- This stops a column of colors being the same-              -- color as the immeduately outside nesting bar.-              morecolors = filter ((/= c).head) (manycolors cs)-              bar = td ! [bgcolor' c,width "10"] << spaceHtml-              hd = td ! [bgcolor' c] << hopen-              tl = td ! [bgcolor' c] << hclose-      treeHtml' _ _ = error "The imposible happens"+    treeHtml' :: [LText.Text] -> HtmlTree -> HtmlTable+    treeHtml' _ (HtmlLeaf leaf) = cell+                                        (td ! [width "100%"]+                                          << bold+                                              << leaf)+    treeHtml' (c:cs@(c2:_)) (HtmlNode hopen ts hclose)+        | null ts && isNoHtml hclose = cell hd+        | null ts = hd </> bar `beside` (td ! [bgcolor' c2] << spaceHtml) </> tl+        | otherwise = hd </> (bar `beside` treeHtmls morecolors ts) </> tl+      where+        -- This stops a column of colors being the same+        -- color as the immediately outside nesting bar.+        morecolors = filter (maybe True ((/= c) . fst) . uncons) (manycolors cs)+        bar = td ! [bgcolor' c,width "10"] << spaceHtml+        hd = td ! [bgcolor' c] << hopen+        tl = td ! [bgcolor' c] << hclose+    treeHtml' _ _ = error "The imposible happens"  instance HTML HtmlTree where-      toHtml x = treeHtml treeColors x+      toHtml = treeHtml treeColors  -- type "length treeColors" to see how many colors are here.-treeColors :: [String]+treeColors :: [LText.Text] treeColors = ["#88ccff","#ffffaa","#ffaaff","#ccffff"] ++ treeColors  --- +-- -- * Html Debugging Combinators -- @@ -73,40 +74,41 @@ -- Html as a tree structure, allowing debugging of what is -- actually getting produced. debugHtml :: (HTML a) => a -> Html-debugHtml obj = table ! [border 0] << +debugHtml obj = table ! [border 0] <<                   ( th ! [bgcolor' "#008888"]                      << underline'-                       << "Debugging Output"-               </>  td << (toHtml (debug' (toHtml obj)))+                       << ("Debugging Output" :: String)+               </>  td << toHtml (debug' (toHtml obj))               )   where        debug' :: Html -> [HtmlTree]-      debug' (Html markups) = map debug markups+      debug' (Html markups) = map debug (markups [])        debug :: HtmlElement -> HtmlTree       debug (HtmlString str) = HtmlLeaf (spaceHtml +++-                                              linesToHtml (lines str))+                                              linesToHtml (lines (builderToString str)))       debug (HtmlTag {               markupTag = tag',               markupContent = content',-              markupAttrs  = attrs+              markupAttrs  = mkAttrs               }) =-              case content' of-                Html [] -> HtmlNode hd [] noHtml-                Html xs -> HtmlNode hd (map debug xs) tl+              if isNoHtml content'+                then HtmlNode hd [] noHtml+                else HtmlNode hd (map debug (getHtmlElements content')) tl         where+              attrs = mkAttrs []               args = if null attrs                      then ""-                     else "  " ++ unwords (map show attrs)-              hd = xsmallFont << ("<" ++ tag' ++ args ++ ">")-              tl = xsmallFont << ("</" ++ tag' ++ ">")+                     else "  " <> unwords (map show attrs)+              hd = xsmallFont << ("<" <> lazyByteStringToString tag' <> args <> ">")+              tl = xsmallFont << ("</" <> lazyByteStringToString tag' <> ">") -bgcolor' :: String -> HtmlAttr-bgcolor' c = thestyle ("background-color:" ++ c)+bgcolor' :: LText.Text -> HtmlAttr+bgcolor' c = thestyle ("background-color:" <> c)  underline' :: Html -> Html-underline' = thespan ! [thestyle ("text-decoration:underline")]+underline' = thespan ! [thestyle "text-decoration:underline"]  xsmallFont :: Html -> Html-xsmallFont  = thespan ! [thestyle ("font-size:x-small")]+xsmallFont  = thespan ! [thestyle "font-size:x-small"]
Text/XHtml/Extras.hs view
@@ -1,5 +1,9 @@+{-# language OverloadedStrings #-}+ module Text.XHtml.Extras where +import qualified Data.Text.Lazy as LText+ import Text.XHtml.Internals import Text.XHtml.Strict.Elements import Text.XHtml.Strict.Attributes@@ -11,22 +15,29 @@ -- | Convert a 'String' to 'Html', converting --   characters that need to be escaped to HTML entities. stringToHtml :: String -> Html-stringToHtml = primHtml . stringToHtmlString +stringToHtml = primHtml . builderToString . stringToHtmlString +{-# INLINE stringToHtml #-}+ -- | This converts a string, but keeps spaces as non-line-breakable. lineToHtml :: String -> Html-lineToHtml = primHtml . concatMap htmlizeChar2 . stringToHtmlString -   where -      htmlizeChar2 ' ' = "&nbsp;"-      htmlizeChar2 c   = [c]+lineToHtml =+    primHtmlNonEmptyBuilder . stringToHtmlString . foldMap htmlizeChar2+  where+    htmlizeChar2 ' ' = "&nbsp;"+    htmlizeChar2 c   = [c] +{-# INLINE lineToHtml #-}+ -- | This converts a string, but keeps spaces as non-line-breakable, --   and adds line breaks between each of the strings in the input list. linesToHtml :: [String] -> Html linesToHtml []     = noHtml-linesToHtml (x:[]) = lineToHtml x+linesToHtml [x]    = lineToHtml x linesToHtml (x:xs) = lineToHtml x +++ br +++ linesToHtml xs +{-# INLINE linesToHtml #-}+ -- -- * Html abbreviations --@@ -41,10 +52,10 @@ bullet        :: Html  -primHtmlChar  = \ x -> primHtml ("&" ++ x ++ ";")-copyright     = primHtmlChar "copy"-spaceHtml     = primHtmlChar "nbsp"-bullet        = primHtmlChar "#149"+primHtmlChar x = primHtml ("&" ++ x ++ ";")+copyright      = primHtmlChar "copy"+spaceHtml      = primHtmlChar "nbsp"+bullet         = primHtmlChar "#149"  -- | Same as 'paragraph'. p :: Html -> Html@@ -54,7 +65,7 @@ -- * Hotlinks -- -type URL = String+type URL = LText.Text  data HotLink = HotLink {       hotLinkURL        :: URL,@@ -76,7 +87,7 @@       hotLinkAttributes = [] }  --- +-- -- * Lists -- @@ -96,19 +107,19 @@ -- * Forms -- -widget :: String -> String -> [HtmlAttr] -> Html+widget :: LText.Text -> LText.Text -> [HtmlAttr] -> Html widget w n attrs = input ! ([thetype w] ++ ns ++ attrs)-  where ns = if null n then [] else [name n,identifier n]+  where ns = if LText.null n then [] else [name n,identifier n] -checkbox :: String -> String -> Html-hidden   :: String -> String -> Html-radio    :: String -> String -> Html-reset    :: String -> String -> Html-submit   :: String -> String -> Html-password :: String           -> Html-textfield :: String          -> Html-afile    :: String           -> Html-clickmap :: String           -> Html+checkbox :: LText.Text -> LText.Text -> Html+hidden   :: LText.Text -> LText.Text -> Html+radio    :: LText.Text -> LText.Text -> Html+reset    :: LText.Text -> LText.Text -> Html+submit   :: LText.Text -> LText.Text -> Html+password :: LText.Text           -> Html+textfield :: LText.Text          -> Html+afile    :: LText.Text           -> Html+clickmap :: LText.Text           -> Html  checkbox n v = widget "checkbox" n [value v] hidden   n v = widget "hidden"   n [value v]@@ -121,9 +132,9 @@ clickmap n   = widget "image"    n []  {-# DEPRECATED menu "menu generates strange XHTML, and is not flexible enough. Roll your own that suits your needs." #-}-menu :: String -> [Html] -> Html+menu :: LText.Text -> [Html] -> Html menu n choices    = select ! [name n] << [ option << p << choice | choice <- choices ] -gui :: String -> Html -> Html+gui :: LText.Text -> Html -> Html gui act = form ! [action act,method "post"]
Text/XHtml/Frameset.hs view
@@ -1,3 +1,5 @@+{-# language OverloadedStrings #-}+ -- | Produces XHTML 1.0 Frameset. module Text.XHtml.Frameset (      -- * Data types@@ -5,12 +7,12 @@      -- * Classes      HTML(..), ADDATTRS(..), CHANGEATTRS(..),      -- * Primitives and basic combinators-     (<<), concatHtml, (+++), +     (<<), concatHtml, (+++),      noHtml, isNoHtml, tag, itag,      htmlAttrPair, emptyAttr, intAttr, strAttr, htmlAttr,-     primHtml, +     primHtml,      -- * Rendering-     showHtml, renderHtml, prettyHtml, +     showHtml, renderHtml, prettyHtml,      showHtmlFragment, renderHtmlFragment, prettyHtmlFragment,      module Text.XHtml.Strict.Elements,      module Text.XHtml.Frameset.Elements,@@ -28,26 +30,26 @@  import Text.XHtml.Extras -docType :: String+docType :: Builder docType =-      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\"" +++      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\"" <>      " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.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+--   render HTML, though the output is quite unreadable.+showHtml :: HTML html => html -> Builder showHtml = showHtmlInternal docType  -- | Outputs indented HTML. Because space matters in --   HTML, the output is quite messy.-renderHtml :: HTML html => html -> String+renderHtml :: HTML html => html -> Builder renderHtml = renderHtmlInternal docType  -- | Outputs indented HTML, with indentation inside elements.---   This can change the meaning of the HTML document, and +--   This can change the meaning of the HTML document, and --   is mostly useful for debugging the HTML output. --   The implementation is inefficient, and you are normally --   better off using 'showHtml' or 'renderHtml'. prettyHtml :: HTML html => html -> String-prettyHtml = prettyHtmlInternal docType+prettyHtml = prettyHtmlInternal (builderToString docType)
Text/XHtml/Frameset/Attributes.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE OverloadedStrings #-}  module Text.XHtml.Frameset.Attributes where @@ -18,5 +19,5 @@ noresize            ::           HtmlAttr noresize            = emptyAttr "noresize" -scrolling           :: String -> HtmlAttr+scrolling           :: LText -> HtmlAttr scrolling           =   strAttr "scrolling"
Text/XHtml/Frameset/Elements.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE OverloadedStrings #-}  module Text.XHtml.Frameset.Elements where
Text/XHtml/Internals.hs view
@@ -1,5 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE OverloadedStrings, FlexibleInstances, BangPatterns, RecordWildCards #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Text.XHtml.internals@@ -13,12 +15,29 @@ -- -- Internals of the XHTML combinator library. ------------------------------------------------------------------------------module Text.XHtml.Internals where+module Text.XHtml.Internals+    ( module Text.XHtml.Internals+    , Builder+    ) where -import Data.Char+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+import Data.ByteString.Builder.Prim hiding (intDec, charUtf8)+import Data.ByteString.Internal (c2w) import qualified Data.Semigroup as Sem import qualified Data.Monoid as Mon+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Text (Text)+import Data.Word (Word8) +type LText = LText.Text+ infixr 2 +++  -- combining Html infixr 7 <<   -- nesting Html infixl 8 !    -- adding optional arguments@@ -30,47 +49,59 @@ -- | A important property of Html is that all strings inside the -- structure are already in Html friendly format. data HtmlElement-      = HtmlString String+      = HtmlString !Builder         -- ^ ..just..plain..normal..text... but using &copy; and &amb;, etc.       | HtmlTag {-              markupTag      :: String,-              markupAttrs    :: [HtmlAttr],-              markupContent  :: Html+              markupTag      :: !BSL.ByteString,+              markupAttrs    :: [HtmlAttr] -> [HtmlAttr],+              markupContent  :: !Html               }         -- ^ tag with internal markup  -- | Attributes with name and value.-data HtmlAttr = HtmlAttr String String+data HtmlAttr = HtmlAttr !Builder !Builder  -htmlAttrPair :: HtmlAttr -> (String,String)+htmlAttrPair :: HtmlAttr -> (Builder,Builder) htmlAttrPair (HtmlAttr n v) = (n,v)  -newtype Html = Html { getHtmlElements :: [HtmlElement] }+newtype Html = Html { unHtml :: [HtmlElement] -> [HtmlElement] } +getHtmlElements :: Html -> [HtmlElement]+getHtmlElements html = unHtml html [] +builderToString :: Builder -> String+builderToString =+    LText.unpack . LText.decodeUtf8 . toLazyByteString++lazyByteStringToString :: BSL.ByteString -> String+lazyByteStringToString =+    LText.unpack . LText.decodeUtf8+ -- -- * Classes --  instance Show Html where-      showsPrec _ html = showString (renderHtmlFragment html)-      showList htmls   = foldr (.) id (map shows htmls)+      showsPrec _ html = showString (builderToString (renderHtmlFragment html))+      showList = foldr ((.) . shows) id  instance Show HtmlAttr where       showsPrec _ (HtmlAttr str val) =-              showString str .+              showString (builderToString str) .               showString "=" .-              shows val+              shows (builderToString val)  -- | @since 3000.2.2 instance Sem.Semigroup Html where     (<>) = (+++)+    {-# INLINE (<>) #-}  instance Mon.Monoid Html where     mempty = noHtml     mappend = (Sem.<>)+    {-# INLINE mappend #-}  -- | HTML is the class of things that can be validly put -- inside an HTML tag. So this can be one or more 'Html' elements,@@ -79,47 +110,87 @@       toHtml     :: a -> Html       toHtmlFromList :: [a] -> Html -      toHtmlFromList xs = Html (concat [ x | (Html x) <- map toHtml xs])+      toHtmlFromList xs = Html (foldr (\x acc -> unHtml (toHtml x) . acc) id xs)  instance HTML Html where       toHtml a    = a+      {-# INLINE toHtml #-}+      toHtmlFromList htmls = Html (foldr (\x acc -> unHtml x . acc) id htmls)+      {-# INLINE toHtmlFromList #-}  instance HTML Char where       toHtml       a = toHtml [a]-      toHtmlFromList []  = Html []-      toHtmlFromList str = Html [HtmlString (stringToHtmlString str)]+      {-# INLINE toHtml #-}+      toHtmlFromList []  = Html id+      toHtmlFromList str = Html (HtmlString (stringToHtmlString str) :)+      {-# INLINE toHtmlFromList #-}  instance (HTML a) => HTML [a] where-      toHtml xs = toHtmlFromList xs+      toHtml = toHtmlFromList+      {-# 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 #-}++instance HTML LText.Text where+    toHtml "" = Html id+    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 #-}+ class ADDATTRS a where       (!) :: a -> [HtmlAttr] -> a  -- | CHANGEATTRS is a more expressive alternative to ADDATTRS class CHANGEATTRS a where-      changeAttrs :: a -> ([HtmlAttr]->[HtmlAttr]) -> a+      changeAttrs :: a -> ([HtmlAttr] -> [HtmlAttr]) -> a  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+      changeAttrs fn f arg = changeAttrs (fn arg) f  instance ADDATTRS Html where-      (Html htmls) ! attr = Html (map addAttrs htmls)-        where-              addAttrs (html@(HtmlTag { markupAttrs = attrs }) )-                            = html { markupAttrs = attrs ++ attr }-              addAttrs html = html+    (Html htmls) ! attr = Html (mapDlist addAttrs htmls)+      where+        addAttrs html =+            case html of+                HtmlTag { markupAttrs = attrs, .. } ->+                    HtmlTag+                        { markupAttrs = attrs . (attr ++)+                        , ..+                        }+                _ ->+                    html+    {-# INLINE (!) #-} + instance CHANGEATTRS Html where-      changeAttrs (Html htmls) f = Html (map addAttrs htmls)+      changeAttrs (Html htmls) f = Html (mapDlist addAttrs htmls)         where-              addAttrs (html@(HtmlTag { markupAttrs = attrs }) )-                            = html { markupAttrs = f attrs }+              addAttrs html@(HtmlTag { markupAttrs = attrs })+                            = html { markupAttrs = f . attrs }               addAttrs html = html  @@ -134,50 +205,71 @@      -> b fn << arg = fn (toHtml arg) +{-# SPECIALIZE (<<) :: (Html -> b) -> String -> b #-}+{-# SPECIALIZE (<<) :: (Html -> b) -> Text -> b #-}+{-# SPECIALIZE (<<) :: (Html -> b) -> LText -> b #-}+{-# SPECIALIZE (<<) :: (Html -> b) -> Html -> b #-}+{-# SPECIALIZE (<<) :: (Html -> b) -> [Html] -> b #-}+{-# INLINABLE (<<) #-}  concatHtml :: (HTML a) => [a] -> Html-concatHtml as = Html (concat (map (getHtmlElements.toHtml) as))+concatHtml = Html . foldr ((.) . unHtml . toHtml) id +{-# SPECIALIZE concatHtml :: [Html] -> Html #-}+{-# INLINABLE concatHtml #-}+ -- | Create a piece of HTML which is the concatenation --   of two things which can be made into HTML.-(+++) :: (HTML a,HTML b) => a -> b -> Html-a +++ b = Html (getHtmlElements (toHtml a) ++ getHtmlElements (toHtml b))+(+++) :: (HTML a, HTML b) => a -> b -> Html+a +++ b = Html (unHtml (toHtml a) . unHtml (toHtml b)) +{-# SPECIALIZE (+++) :: Html -> Html -> Html #-}+{-# INLINABLE (+++) #-}+ -- | An empty piece of HTML. noHtml :: Html-noHtml = Html []+noHtml = Html id --- | Checks whether the given piece of HTML is empty.+{-# INLINE noHtml #-}++-- | Checks whether the given piece of HTML is empty. This materializes the+-- list, so it's not great to do this a bunch. isNoHtml :: Html -> Bool-isNoHtml (Html xs) = null xs+isNoHtml (Html xs) = null (xs [])  -- | Constructs an element with a custom name.-tag :: String -- ^ Element name+tag :: BSL.ByteString -- ^ Element name     -> Html -- ^ Element contents     -> Html-tag str       htmls = Html [-      HtmlTag {-              markupTag = str,-              markupAttrs = [],-              markupContent = htmls }]+tag str htmls =+    Html+        (+        HtmlTag+            { markupTag = str+            , markupAttrs = id+            , markupContent = htmls+            }+        :+        )  -- | Constructs an element with a custom name, and --   without any children.-itag :: String -> Html+itag :: BSL.ByteString -> Html itag str = tag str noHtml -emptyAttr :: String -> HtmlAttr+emptyAttr :: Builder -> HtmlAttr emptyAttr s = HtmlAttr s s -intAttr :: String -> Int -> HtmlAttr-intAttr s i = HtmlAttr s (show i)--strAttr :: String -> String -> HtmlAttr-strAttr s t = HtmlAttr s (stringToHtmlString t)+intAttr :: Builder -> Int -> HtmlAttr+intAttr s = HtmlAttr s . intDec+{-# INLINE intAttr #-} -htmlAttr :: String -> Html -> HtmlAttr-htmlAttr s t = HtmlAttr s (show t)+strAttr :: Builder -> LText.Text -> HtmlAttr+strAttr s = HtmlAttr s . lazyTextToHtmlString+{-# INLINE strAttr #-} +htmlAttr :: Builder -> Html -> HtmlAttr+htmlAttr s t = HtmlAttr s (renderHtmlFragment t)  {- foldHtml :: (String -> [HtmlAttr] -> [a] -> a)@@ -192,26 +284,77 @@ -}  -- | Processing Strings into Html friendly things.-stringToHtmlString :: String -> String-stringToHtmlString = concatMap fixChar-    where-      fixChar '<' = "&lt;"-      fixChar '>' = "&gt;"-      fixChar '&' = "&amp;"-      fixChar '"' = "&quot;"-      fixChar c | ord c < 0x80 = [c]-      fixChar c = "&#" ++ show (ord c) ++ ";"+stringToHtmlString :: String -> Builder+stringToHtmlString = primMapListBounded charUtf8HtmlEscaped+{-# INLINE stringToHtmlString #-} +-- | Copied from @blaze-builder@+{-# INLINE charUtf8HtmlEscaped #-}+charUtf8HtmlEscaped :: BoundedPrim Char+charUtf8HtmlEscaped =+    condB (>  '>' ) P.charUtf8 $+    condB (== '<' ) (fixed4 ('&',('l',('t',';')))) $              -- &lt;+    condB (== '>' ) (fixed4 ('&',('g',('t',';')))) $              -- &gt;+    condB (== '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $        -- &amp;+    condB (== '"' ) (fixed6 ('&',('q',('u',('o',('t',';')))))) $  -- &quot;+    liftFixedToBounded P.char7 -- fallback for Chars smaller than '>'+  where+    {-# INLINE fixed4 #-}+    fixed4 x = liftFixedToBounded $ const x >$<+      char7 >*< char7 >*< char7 >*< char7 +    {-# INLINE fixed5 #-}+    fixed5 x = liftFixedToBounded $ const x >$<+      char7 >*< char7 >*< char7 >*< char7 >*< char7++    {-# INLINE fixed6 #-}+    fixed6 x = liftFixedToBounded $ const x >$<+      char7 >*< char7 >*< char7 >*< char7 >*< char7 >*< char7++textToHtmlString :: Text -> Builder+textToHtmlString = Text.encodeUtf8BuilderEscaped wordHtmlEscaped+{-# INLINE textToHtmlString #-}++lazyTextToHtmlString :: LText.Text -> Builder+lazyTextToHtmlString = LText.encodeUtf8BuilderEscaped wordHtmlEscaped++-- | Copied from @blaze-builder@+{-# INLINE wordHtmlEscaped #-}+wordHtmlEscaped :: P.BoundedPrim Word8+wordHtmlEscaped =+  P.condB (>  c2w '>' ) (P.condB (== c2w '\DEL') P.emptyB $ P.liftFixedToBounded P.word8) $+  P.condB (== c2w '<' ) (fixed4 ('&',('l',('t',';')))) $                  -- &lt;+  P.condB (== c2w '>' ) (fixed4 ('&',('g',('t',';')))) $                  -- &gt;+  P.condB (== c2w '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $            -- &amp;+  P.condB (== c2w '"' ) (fixed6 ('&',('q',('u',('o',('t',';')))))) $      -- &quot;+  P.condB (\c -> c >= c2w ' ' || c == c2w '\t' || c == c2w '\n' || c == c2w '\r')+        (P.liftFixedToBounded P.word8) P.emptyB+  where+  {-# INLINE fixed4 #-}+  fixed4 x = P.liftFixedToBounded $ const x P.>$<+    P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8+  {-# INLINE fixed5 #-}+  fixed5 x = P.liftFixedToBounded $ const x P.>$<+    P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8+  {-# INLINE fixed6 #-}+  fixed6 x = P.liftFixedToBounded $ const x P.>$<+    P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8+ -- | This is not processed for special chars. -- use stringToHtml or lineToHtml instead, for user strings, -- because they understand special chars, like @'<'@. primHtml :: String -> Html-primHtml x | null x    = Html []-           | otherwise = Html [HtmlString x]+primHtml x | null x    = Html id+           | otherwise = Html (HtmlString (stringUtf8 x) :) +{-# INLINE primHtml #-} +-- | Does not process special characters, or check to see if it is empty.+primHtmlNonEmptyBuilder :: Builder -> Html+primHtmlNonEmptyBuilder x = Html (HtmlString x :) +{-# INLINE primHtmlNonEmptyBuilder #-}+ -- -- * Html Rendering --@@ -219,23 +362,33 @@ mkHtml :: HTML html => html -> Html mkHtml = (tag "html" ! [strAttr "xmlns" "http://www.w3.org/1999/xhtml"] <<) +{-# SPECIALIZE mkHtml :: Html -> Html #-}+{-# INLINABLE mkHtml #-}+ -- | 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.+--   render HTML, though the output is quite unreadable. showHtmlInternal :: HTML html =>-                    String -- ^ DOCTYPE declaration-                 -> html -> String+                    Builder -- ^ DOCTYPE declaration+                 -> html -> Builder showHtmlInternal docType theHtml =-    docType ++ showHtmlFragment (mkHtml theHtml)+    docType <> showHtmlFragment (mkHtml theHtml) +{-# SPECIALIZE showHtmlInternal :: Builder -> Html -> Builder #-}+{-# INLINABLE showHtmlInternal #-}++ -- | Outputs indented HTML. Because space matters in --   HTML, the output is quite messy. renderHtmlInternal :: HTML html =>-                      String  -- ^ DOCTYPE declaration-                   -> html -> String+                      Builder  -- ^ DOCTYPE declaration+                   -> html -> Builder renderHtmlInternal docType theHtml =-      docType ++ "\n" ++ renderHtmlFragment (mkHtml theHtml) ++ "\n"+      docType <> "\n" <> renderHtmlFragment (mkHtml theHtml) <> "\n" +{-# SPECIALIZE renderHtmlInternal :: Builder -> Html -> Builder #-}+{-# INLINABLE renderHtmlInternal #-}+ -- | Outputs indented HTML, with indentation inside elements. --   This can change the meaning of the HTML document, and --   is mostly useful for debugging the HTML output.@@ -249,17 +402,29 @@  -- | Render a piece of HTML without adding a DOCTYPE declaration --   or root element. Does not add any extra whitespace.-showHtmlFragment :: HTML html => html -> String+showHtmlFragment :: HTML html => html -> Builder showHtmlFragment h =-    (foldr (.) id $ map showHtml' $ getHtmlElements $ toHtml h) ""+    go $ getHtmlElements $ toHtml h+  where+    go [] = mempty+    go (x : xs) = showHtml' x <> go xs +{-# SPECIALIZE showHtmlFragment :: Html -> Builder #-}+{-# INLINABLE 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 -> String+renderHtmlFragment :: HTML html => html -> Builder renderHtmlFragment h =-    (foldr (.) id $ map (renderHtml' 0) $ getHtmlElements $ toHtml h) ""+    go $ getHtmlElements $ toHtml h+  where+    go [] = mempty+    go (x:xs) = renderHtml' 0 x <> go xs +{-# SPECIALIZE renderHtmlFragment :: Html -> Builder #-}+{-# INLINABLE renderHtmlFragment #-}+ -- | Render a piece of indented HTML without adding a DOCTYPE declaration --   or a root element. --   The indentation is done inside elements.@@ -269,82 +434,108 @@ --   better off using 'showHtmlFragment' or 'renderHtmlFragment'. prettyHtmlFragment :: HTML html => html -> String prettyHtmlFragment =-    unlines . concat . map prettyHtml' . getHtmlElements . toHtml+    unlines . concatMap prettyHtml' . getHtmlElements . toHtml  -- | Show a single HTML element, without adding whitespace.-showHtml' :: HtmlElement -> ShowS-showHtml' (HtmlString str) = (++) str+showHtml' :: HtmlElement -> Builder+showHtml' (HtmlString str) = str showHtml'(HtmlTag { markupTag = name,                     markupContent = html,                     markupAttrs = attrs })-    = if isNoHtml html && elem name validHtmlITags-      then renderTag True name attrs ""-      else (renderTag False name attrs ""-            . foldr (.) id (map showHtml' (getHtmlElements html))-            . renderEndTag name "")+    = if isValidHtmlITag name && isNoHtml html+      then renderTag True nameBuilder (attrs []) ""+      else renderTag False nameBuilder (attrs []) ""+        <> go (getHtmlElements html)+        <> renderEndTag nameBuilder ""+  where+    go [] = mempty+    go (x:xs) = showHtml' x <> go xs -renderHtml' :: Int -> HtmlElement -> ShowS-renderHtml' _ (HtmlString str) = (++) str+    nameBuilder :: Builder+    nameBuilder = lazyByteString name++renderHtml' :: Int -> HtmlElement -> Builder+renderHtml' _ (HtmlString str) = str renderHtml' n (HtmlTag               { markupTag = name,                 markupContent = html,                 markupAttrs = attrs })-      = if isNoHtml html && elem name validHtmlITags-        then renderTag True name attrs (nl n)-        else (renderTag False name attrs (nl n)-             . foldr (.) id (map (renderHtml' (n+2)) (getHtmlElements html))-             . renderEndTag name (nl n))+      = if isValidHtmlITag name && isNoHtml html+        then renderTag True nameBuilder (attrs []) nl+        else renderTag False nameBuilder (attrs []) nl+          <> foldMap (renderHtml' (n+2)) (getHtmlElements html)+          <> renderEndTag nameBuilder nl     where-      nl n' = "\n" ++ replicate (n' `div` 8) '\t'-              ++ replicate (n' `mod` 8) ' '+      nl :: Builder+      nl = charUtf8 '\n' <> tabs <> spaces +      tabs :: Builder+      tabs =+        case n `div` 8 of+          m | m <= 0 -> mempty+          m          -> Sem.stimes m (charUtf8 '\t') +      spaces :: Builder+      spaces =+        case n `mod` 8 of+          m | m <= 0 -> mempty+          m          -> Sem.stimes m (charUtf8 ' ')++      nameBuilder :: Builder+      nameBuilder = lazyByteString name++ prettyHtml' :: HtmlElement -> [String]-prettyHtml' (HtmlString str) = [str]+prettyHtml' (HtmlString str) = [builderToString str] prettyHtml' (HtmlTag               { markupTag = name,                 markupContent = html,                 markupAttrs = attrs })-      = if isNoHtml html && elem name validHtmlITags+      = if isValidHtmlITag name && isNoHtml html         then-         [rmNL (renderTag True name attrs "" "")]+         [rmNL (renderTag True nameBuilder (attrs []) "")]         else-         [rmNL (renderTag False name attrs "" "")] ++-          shift (concat (map prettyHtml' (getHtmlElements html))) ++-         [rmNL (renderEndTag name "" "")]+         [rmNL (renderTag False nameBuilder (attrs []) "")] +++          shift (concatMap prettyHtml' (getHtmlElements html)) +++         [rmNL (renderEndTag nameBuilder "")]   where-      shift = map (\x -> "   " ++ x)-      rmNL = filter (/= '\n')+      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-          -> String     -- ^ Tag name+          -> Builder    -- ^ Tag name           -> [HtmlAttr] -- ^ Attributes-          -> String     -- ^ Whitespace to add after attributes-          -> ShowS-renderTag empty name attrs nl r-      = "<" ++ name ++ shownAttrs ++ nl ++ close ++ r+          -> Builder    -- ^ Whitespace to add after attributes+          -> Builder+renderTag empty name attrs nl+      = "<" <> name <> shownAttrs <> nl <> close   where       close = if empty then " />" else ">" -      shownAttrs = concat [' ':showPair attr | attr <- attrs ]+      shownAttrs = foldr (\attr acc -> charUtf8 ' ' <> showPair attr <> acc) mempty attrs -      showPair :: HtmlAttr -> String+      showPair :: HtmlAttr -> Builder       showPair (HtmlAttr key val)-              = key ++ "=\"" ++ val  ++ "\""+              = key <> "=\"" <> val  <> "\""  -- | Show an end tag-renderEndTag :: String -- ^ Tag name-             -> String -- ^ Whitespace to add after tag name-             -> ShowS-renderEndTag name nl r = "</" ++ name ++ nl ++ ">" ++ r+renderEndTag :: Builder -- ^ Tag name+             -> Builder -- ^ Whitespace to add after tag name+             -> Builder+renderEndTag name nl = "</" <> name <> nl <> ">" +isValidHtmlITag :: BSL.ByteString -> Bool+isValidHtmlITag bs = bs `Set.member` validHtmlITags --- | The names of all elements which can represented using the empty tag+-- | The names of all elements which can be represented using the empty tag --   short-hand.-validHtmlITags :: [String]-validHtmlITags = [+validHtmlITags :: Set BSL.ByteString+validHtmlITags = Set.fromList [                   "area",                   "base",                   "basefont",
Text/XHtml/Strict.hs view
@@ -1,3 +1,5 @@+{-# language OverloadedStrings #-}+ -- | Produces XHTML 1.0 Strict. module Text.XHtml.Strict (      -- * Data types@@ -5,7 +7,7 @@      -- * Classes      HTML(..), ADDATTRS(..), CHANGEATTRS(..),      -- * Primitives and basic combinators-     (<<), concatHtml, (+++), +     (<<), concatHtml, (+++),      noHtml, isNoHtml, tag, itag,      htmlAttrPair, emptyAttr, intAttr, strAttr, htmlAttr,      primHtml, stringToHtmlString,@@ -18,45 +20,53 @@      module Text.XHtml.Extras   ) where +import qualified Data.Text.Lazy as LText+ import Text.XHtml.Internals import Text.XHtml.Strict.Elements import Text.XHtml.Strict.Attributes import Text.XHtml.Extras  -- | The @DOCTYPE@ for XHTML 1.0 Strict.-docType :: String+docType :: Builder docType = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\""-          ++ " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"+          <> " \"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+--   render HTML, though the output is quite unreadable.+showHtml :: HTML html => html -> Builder showHtml = showHtmlInternal docType +{-# SPECIALIZE showHtml :: Html -> Builder #-}+{-# INLINABLE showHtml #-}+ -- | Outputs indented HTML. Because space matters in --   HTML, the output is quite messy.-renderHtml :: HTML html => html -> String+renderHtml :: HTML html => html -> Builder renderHtml = renderHtmlInternal docType +{-# SPECIALIZE renderHtml :: Html -> Builder #-}+{-# INLINABLE renderHtml #-}+ -- | Outputs indented XHTML. Because space matters in --   HTML, the output is quite messy. renderHtmlWithLanguage :: HTML html-                       => String -- ^ The code of the "dominant" language of the webpage.+                       => LText.Text -- ^ The code of the "dominant" language of the webpage.                        -> html -- ^ All the 'Html', including a header.-                       -> String+                       -> Builder renderHtmlWithLanguage l theHtml =-    docType ++ "\n" ++ renderHtmlFragment code  ++ "\n"+    docType <> "\n" <> renderHtmlFragment code  <> "\n"   where     code = tag "html" ! [ strAttr "xmlns" "http://www.w3.org/1999/xhtml"-                           , strAttr "lang" l-                           , strAttr "xml:lang" l-                           ] << theHtml+                        , strAttr "lang" l+                        , strAttr "xml:lang" l+                        ] << theHtml  -- | Outputs indented HTML, with indentation inside elements.---   This can change the meaning of the HTML document, and +--   This can change the meaning of the HTML document, and --   is mostly useful for debugging the HTML output. --   The implementation is inefficient, and you are normally --   better off using 'showHtml' or 'renderHtml'. prettyHtml :: HTML html => html -> String-prettyHtml = prettyHtmlInternal docType+prettyHtml = prettyHtmlInternal (builderToString docType)
Text/XHtml/Strict/Attributes.hs view
@@ -1,60 +1,62 @@ {-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE OverloadedStrings #-}+ module Text.XHtml.Strict.Attributes where  import Text.XHtml.Internals+import qualified Data.Text.Lazy as LText  -- * Attributes in XHTML Strict -action              :: String -> HtmlAttr-align               :: String -> HtmlAttr--alt                 :: String -> HtmlAttr-altcode             :: String -> HtmlAttr-archive             :: String -> HtmlAttr-base                :: String -> HtmlAttr+action              :: LText.Text -> HtmlAttr+align               :: LText.Text -> HtmlAttr+alt                 :: LText.Text -> HtmlAttr+altcode             :: LText.Text -> HtmlAttr+archive             :: LText.Text -> HtmlAttr+base                :: LText.Text -> HtmlAttr border              :: Int    -> HtmlAttr-bordercolor         :: String -> HtmlAttr+bordercolor         :: LText.Text -> HtmlAttr cellpadding         :: Int    -> HtmlAttr cellspacing         :: Int    -> HtmlAttr checked             ::           HtmlAttr-codebase            :: String -> HtmlAttr-cols                :: String -> HtmlAttr+codebase            :: LText.Text -> HtmlAttr+cols                :: LText.Text -> HtmlAttr colspan             :: Int    -> HtmlAttr-content             :: String -> HtmlAttr-coords              :: String -> HtmlAttr+content             :: LText.Text -> HtmlAttr+coords              :: LText.Text -> HtmlAttr disabled            ::           HtmlAttr-enctype             :: String -> HtmlAttr-height              :: String -> HtmlAttr-href                :: String -> HtmlAttr-hreflang            :: String -> HtmlAttr-httpequiv           :: String -> HtmlAttr-identifier          :: String -> HtmlAttr+enctype             :: LText.Text -> HtmlAttr+height              :: LText.Text -> HtmlAttr+href                :: LText.Text -> HtmlAttr+hreflang            :: LText.Text -> HtmlAttr+httpequiv           :: LText.Text -> HtmlAttr+identifier          :: LText.Text -> HtmlAttr ismap               ::           HtmlAttr-lang                :: String -> HtmlAttr+lang                :: LText.Text -> HtmlAttr maxlength           :: Int    -> HtmlAttr-method              :: String -> HtmlAttr+method              :: LText.Text -> HtmlAttr multiple            ::           HtmlAttr-name                :: String -> HtmlAttr+name                :: LText.Text -> HtmlAttr nohref              ::           HtmlAttr-rel                 :: String -> HtmlAttr-rev                 :: String -> HtmlAttr-rows                :: String -> HtmlAttr+rel                 :: LText.Text -> HtmlAttr+rev                 :: LText.Text -> HtmlAttr+rows                :: LText.Text -> HtmlAttr rowspan             :: Int    -> HtmlAttr-rules               :: String -> HtmlAttr+rules               :: LText.Text -> HtmlAttr selected            ::           HtmlAttr-shape               :: String -> HtmlAttr-size                :: String -> HtmlAttr-src                 :: String -> HtmlAttr-theclass            :: String -> HtmlAttr-thefor              :: String -> HtmlAttr-thestyle            :: String -> HtmlAttr-thetype             :: String -> HtmlAttr-title               :: String -> HtmlAttr-usemap              :: String -> HtmlAttr-valign              :: String -> HtmlAttr-value               :: String -> HtmlAttr-width               :: String -> HtmlAttr+shape               :: LText.Text -> HtmlAttr+size                :: LText.Text -> HtmlAttr+src                 :: LText.Text -> HtmlAttr+theclass            :: LText.Text -> HtmlAttr+thefor              :: LText.Text -> HtmlAttr+thestyle            :: LText.Text -> HtmlAttr+thetype             :: LText.Text -> HtmlAttr+title               :: LText.Text -> HtmlAttr+usemap              :: LText.Text -> HtmlAttr+valign              :: LText.Text -> HtmlAttr+value               :: LText.Text -> HtmlAttr+width               :: LText.Text -> HtmlAttr  action              =   strAttr "action" align               =   strAttr "align"@@ -105,4 +107,52 @@ value               =   strAttr "value" width               =   strAttr "width" +{-# INLINE action      #-}+{-# INLINE align       #-}+{-# INLINE alt         #-}+{-# INLINE altcode     #-}+{-# INLINE archive     #-}+{-# INLINE base        #-}+{-# INLINE border      #-}+{-# INLINE bordercolor #-}+{-# INLINE cellpadding #-}+{-# INLINE cellspacing #-}+{-# INLINE checked     #-}+{-# INLINE codebase    #-}+{-# INLINE cols        #-}+{-# INLINE colspan     #-}+{-# INLINE content     #-}+{-# INLINE coords      #-}+{-# INLINE disabled    #-}+{-# INLINE enctype     #-}+{-# INLINE height      #-}+{-# INLINE href        #-}+{-# INLINE hreflang    #-}+{-# INLINE httpequiv   #-}+{-# INLINE identifier  #-}+{-# INLINE ismap       #-}+{-# INLINE lang        #-}+{-# INLINE maxlength   #-}+{-# INLINE method      #-}+{-# INLINE multiple    #-}+{-# INLINE name        #-}+{-# INLINE nohref      #-}+{-# INLINE rel         #-}+{-# INLINE rev         #-}+{-# INLINE rows        #-}+{-# INLINE rowspan     #-}+{-# INLINE rules       #-}+{-# INLINE selected    #-}+{-# INLINE shape       #-}+{-# INLINE size        #-}+{-# INLINE src         #-}+{-# INLINE theclass    #-}+{-# INLINE thefor      #-}+{-# INLINE thestyle    #-}+{-# INLINE thetype     #-}+{-# INLINE title       #-}+{-# INLINE usemap      #-}+{-# INLINE valign      #-}+{-# INLINE value       #-}+{-# INLINE width       #-}
Text/XHtml/Strict/Elements.hs view
@@ -1,5 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE OverloadedStrings #-}+ module Text.XHtml.Strict.Elements where  import Text.XHtml.Internals@@ -161,3 +163,81 @@ tt                  =  tag "tt" ulist               =  tag "ul" variable            =  tag "var"++{-# INLINE abbr       #-}+{-# INLINE acronym    #-}+{-# INLINE address    #-}+{-# INLINE anchor     #-}+{-# INLINE area       #-}+{-# INLINE bdo        #-}+{-# INLINE big        #-}+{-# INLINE blockquote #-}+{-# INLINE body       #-}+{-# INLINE bold       #-}+{-# INLINE button     #-}+{-# INLINE br         #-}+{-# INLINE caption    #-}+{-# INLINE cite       #-}+{-# INLINE col        #-}+{-# INLINE colgroup   #-}+{-# INLINE ddef       #-}+{-# INLINE define     #-}+{-# INLINE del        #-}+{-# INLINE dlist      #-}+{-# INLINE dterm      #-}+{-# INLINE emphasize  #-}+{-# INLINE fieldset   #-}+{-# INLINE form       #-}+{-# INLINE h1         #-}+{-# INLINE h2         #-}+{-# INLINE h3         #-}+{-# INLINE h4         #-}+{-# INLINE h5         #-}+{-# INLINE h6         #-}+{-# INLINE header     #-}+{-# INLINE hr         #-}+{-# INLINE image      #-}+{-# INLINE input      #-}+{-# INLINE ins        #-}+{-# INLINE italics    #-}+{-# INLINE keyboard   #-}+{-# INLINE label      #-}+{-# INLINE legend     #-}+{-# INLINE li         #-}+{-# INLINE meta       #-}+{-# INLINE noscript   #-}+{-# INLINE object     #-}+{-# INLINE olist      #-}+{-# INLINE optgroup   #-}+{-# INLINE option     #-}+{-# INLINE paragraph  #-}+{-# INLINE param      #-}+{-# INLINE pre        #-}+{-# INLINE quote      #-}+{-# INLINE sample     #-}+{-# INLINE script     #-}+{-# INLINE select     #-}+{-# INLINE small      #-}+{-# INLINE strong     #-}+{-# INLINE style      #-}+{-# INLINE sub        #-}+{-# INLINE sup        #-}+{-# INLINE table      #-}+{-# INLINE tbody      #-}+{-# INLINE td         #-}+{-# INLINE textarea   #-}+{-# INLINE tfoot      #-}+{-# INLINE th         #-}+{-# INLINE thead      #-}+{-# INLINE thebase    #-}+{-# INLINE thecode    #-}+{-# INLINE thediv     #-}+{-# INLINE thehtml    #-}+{-# INLINE thelink    #-}+{-# INLINE themap     #-}+{-# INLINE thespan    #-}+{-# INLINE thetitle   #-}+{-# INLINE tr         #-}+{-# INLINE tt         #-}+{-# INLINE ulist      #-}+{-# INLINE variable   #-}
Text/XHtml/Transitional.hs view
@@ -1,3 +1,5 @@+{-# language OverloadedStrings #-}+ -- | Produces XHTML 1.0 Transitional. module Text.XHtml.Transitional (      -- * Data types@@ -5,13 +7,16 @@      -- * Classes      HTML(..), ADDATTRS(..), CHANGEATTRS(..),      -- * Primitives and basic combinators-     (<<), concatHtml, (+++), +     (<<), concatHtml, (+++),      noHtml, isNoHtml, tag, itag,      htmlAttrPair, emptyAttr, intAttr, strAttr, htmlAttr,-     primHtml, +     primHtml,      -- * Rendering-     showHtml, renderHtml, prettyHtml, +     showHtml, renderHtml, prettyHtml,      showHtmlFragment, renderHtmlFragment, prettyHtmlFragment,+     -- * Re-exports+     LText,+     Builder,      module Text.XHtml.Strict.Elements,      module Text.XHtml.Frameset.Elements,      module Text.XHtml.Transitional.Elements,@@ -34,26 +39,26 @@ import Text.XHtml.Extras  -docType :: String+docType :: Builder docType =-      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"" +++      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"" <>      " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.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+--   render HTML, though the output is quite unreadable.+showHtml :: HTML html => html -> Builder showHtml = showHtmlInternal docType  -- | Outputs indented HTML. Because space matters in --   HTML, the output is quite messy.-renderHtml :: HTML html => html -> String+renderHtml :: HTML html => html -> Builder renderHtml = renderHtmlInternal docType  -- | Outputs indented HTML, with indentation inside elements.---   This can change the meaning of the HTML document, and +--   This can change the meaning of the HTML document, and --   is mostly useful for debugging the HTML output. --   The implementation is inefficient, and you are normally --   better off using 'showHtml' or 'renderHtml'. prettyHtml :: HTML html => html -> String-prettyHtml = prettyHtmlInternal docType+prettyHtml = prettyHtmlInternal (builderToString docType)
Text/XHtml/Transitional/Attributes.hs view
@@ -1,5 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE OverloadedStrings #-}+ module Text.XHtml.Transitional.Attributes where  import Text.XHtml.Internals@@ -7,27 +9,27 @@ -- * Extra attributes in XHTML Transitional  {-# DEPRECATED alink "This attribute is deprecated in XHTML 1.0" #-}-alink               :: String -> HtmlAttr+alink               :: LText -> HtmlAttr alink               =   strAttr "alink"  {-# DEPRECATED background "This attribute is deprecated in XHTML 1.0" #-}-background          :: String -> HtmlAttr+background          :: LText -> HtmlAttr background          =   strAttr "background"  {-# DEPRECATED bgcolor "This attribute is deprecated in XHTML 1.0" #-}-bgcolor             :: String -> HtmlAttr+bgcolor             :: LText -> HtmlAttr bgcolor             =   strAttr "bgcolor"  {-# DEPRECATED clear "This attribute is deprecated in XHTML 1.0" #-}-clear               :: String -> HtmlAttr+clear               :: LText -> HtmlAttr clear               =   strAttr "clear"  {-# DEPRECATED code "This attribute is deprecated in XHTML 1.0" #-}-code                :: String -> HtmlAttr+code                :: LText -> HtmlAttr code                =   strAttr "code"  {-# DEPRECATED color "This attribute is deprecated in XHTML 1.0" #-}-color               :: String -> HtmlAttr+color               :: LText -> HtmlAttr color               =   strAttr "color"  {-# DEPRECATED compact "This attribute is deprecated in XHTML 1.0" #-}@@ -35,7 +37,7 @@ compact             = emptyAttr "compact"  {-# DEPRECATED face "This attribute is deprecated in XHTML 1.0" #-}-face                :: String -> HtmlAttr+face                :: LText -> HtmlAttr face                =   strAttr "face"  {-# DEPRECATED hspace "This attribute is deprecated in XHTML 1.0" #-}@@ -43,7 +45,7 @@ hspace              =   intAttr "hspace"  {-# DEPRECATED link "This attribute is deprecated in XHTML 1.0" #-}-link                :: String -> HtmlAttr+link                :: LText -> HtmlAttr link                =   strAttr "link"  {-# DEPRECATED noshade "This attribute is deprecated in XHTML 1.0" #-}@@ -58,19 +60,19 @@ start               :: Int    -> HtmlAttr start               =   intAttr "start" -target              :: String -> HtmlAttr+target              :: LText -> HtmlAttr target              =   strAttr "target"  {-# DEPRECATED text "This attribute is deprecated in XHTML 1.0" #-}-text                :: String -> HtmlAttr+text                :: LText -> HtmlAttr text                =   strAttr "text"  {-# DEPRECATED version "This attribute is deprecated in XHTML 1.0" #-}-version             :: String -> HtmlAttr+version             :: LText -> HtmlAttr version             =   strAttr "version"  {-# DEPRECATED vlink "This attribute is deprecated in XHTML 1.0" #-}-vlink               :: String -> HtmlAttr+vlink               :: LText -> HtmlAttr vlink               =   strAttr "vlink"  {-# DEPRECATED vspace "This attribute is deprecated in XHTML 1.0" #-}@@ -84,22 +86,22 @@ --  {-# DEPRECATED aqua,black,blue,fuchsia,gray,green,lime,maroon,navy,olive,purple,red,silver,teal,yellow,white "The use of color attibutes is deprecated in XHTML 1.0" #-}-aqua          :: String-black         :: String-blue          :: String-fuchsia       :: String-gray          :: String-green         :: String-lime          :: String-maroon        :: String-navy          :: String-olive         :: String-purple        :: String-red           :: String-silver        :: String-teal          :: String-yellow        :: String-white         :: String+aqua          :: LText+black         :: LText+blue          :: LText+fuchsia       :: LText+gray          :: LText+green         :: LText+lime          :: LText+maroon        :: LText+navy          :: LText+olive         :: LText+purple        :: LText+red           :: LText+silver        :: LText+teal          :: LText+yellow        :: LText+white         :: LText  aqua          = "aqua" black         = "black"
Text/XHtml/Transitional/Elements.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE OverloadedStrings #-}  module Text.XHtml.Transitional.Elements where
xhtml.cabal view
@@ -1,9 +1,9 @@-Cabal-version:      2.0+Cabal-version:      >= 1.10 Name:               xhtml-Version:            3000.2.2.1+Version:            3000.4.1.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>+Maintainer:         hecate@glitchbra.in Author:             Bjorn Bringert License:            BSD3 License-file:       LICENSE@@ -24,21 +24,17 @@  library     Default-Language: Haskell2010-    if impl(ghc >= 7.2)-        Default-Extensions: Safe+    build-depends:+        bytestring+      , containers+      , text -    -- We intentionally try to enlarge the configuration space only as little-    -- as needed, thus we partition the space for the cabal solver into-    ---    --  - xhtml-3000.2.2   supports base  < 4.11 & cabal-version: 1.10-    --  - xhtml-3000.2.2.1 supports base >= 4.11 & cabal-version: 2.0-    ---    -- as xhtml-3000.2.2 and xhtml-3000.2.2.1 are not distinguishable except-    -- for their version number.-    Build-depends: base >= 4.11 && < 5+    Build-depends: base >= 4 && < 5     if impl(ghc >= 8.0)         -- Enable warnings about potential future incompatibilities-        ghc-options: -Wcompat -Wnoncanonical-monadfail-instances -Wnoncanonical-monad-instances+        ghc-options:+          -Wcompat+          -Wnoncanonical-monad-instances     else         -- This provides compatibility with versions prior to GHC 8.0 / base-4.9, when `Data.Semigroup`         -- still lived in `semigroups`.