blaze-markup 0.5.0.0 → 0.5.1.0

raw patch · 8 files changed

+162/−36 lines, 8 filesnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• blaze-markup.cabal +1/−1
• src/Text/Blaze.hs +28/−7
• src/Text/Blaze/Internal.hs +43/−6
• src/Text/Blaze/Renderer/Pretty.hs +12/−3
• src/Text/Blaze/Renderer/String.hs +11/−4
• src/Text/Blaze/Renderer/Text.hs +26/−6
• src/Text/Blaze/Renderer/Utf8.hs +24/−5
• tests/Text/Blaze/Tests.hs +17/−4

@@ -1,5 +1,5 @@ Name:         blaze-markup-Version:      0.5.0.0+Version:      0.5.1.0 Homepage:     http://jaspervdj.be/blaze Bug-Reports:  http://github.com/jaspervdj/blaze-markup/issues License:      BSD3

@@ -44,11 +44,8 @@     , dataAttribute     , customAttribute -      -- * Converting values to HTML.+      -- * Converting values to Markup.     , ToMarkup (..)-    , preEscapedText-    , preEscapedLazyText-    , preEscapedString     , unsafeByteString     , unsafeLazyByteString @@ -58,14 +55,14 @@        -- * Converting values to attribute values.     , ToValue (..)-    , preEscapedTextValue-    , preEscapedLazyTextValue-    , preEscapedStringValue     , unsafeByteStringValue     , unsafeLazyByteStringValue        -- * Setting attributes     , (!)++      -- * Modifiying Markup trees+    , contents     ) where  import Data.Monoid (mconcat)@@ -82,6 +79,12 @@     --     toMarkup :: a -> Markup +    -- | Convert a value to Markup without escaping+    --+    preEscapedToMarkup :: a -> Markup+    preEscapedToMarkup = toMarkup+    {-# INLINE preEscapedToMarkup #-}+ instance ToMarkup Markup where     toMarkup = id     {-# INLINE toMarkup #-}@@ -93,14 +96,20 @@ instance ToMarkup Text where     toMarkup = text     {-# INLINE toMarkup #-}+    preEscapedToMarkup = preEscapedText+    {-# INLINE preEscapedToMarkup #-}  instance ToMarkup LT.Text where     toMarkup = lazyText     {-# INLINE toMarkup #-}+    preEscapedToMarkup = preEscapedLazyText+    {-# INLINE preEscapedToMarkup #-}  instance ToMarkup String where     toMarkup = string     {-# INLINE toMarkup #-}+    preEscapedToMarkup = preEscapedString+    {-# INLINE preEscapedToMarkup #-}  instance ToMarkup Int where     toMarkup = string . show@@ -133,6 +142,12 @@     --     toValue :: a -> AttributeValue +    -- | Convert a value to an attribute value without escaping+    --+    preEscapedToValue :: a -> AttributeValue+    preEscapedToValue = toValue+    {-# INLINE preEscapedToValue #-}+ instance ToValue AttributeValue where     toValue = id     {-# INLINE toValue #-}@@ -140,14 +155,20 @@ instance ToValue Text where     toValue = textValue     {-# INLINE toValue #-}+    preEscapedToValue = preEscapedTextValue+    {-# INLINE preEscapedToValue #-}  instance ToValue LT.Text where     toValue = lazyTextValue     {-# INLINE toValue #-}+    preEscapedToValue = preEscapedLazyTextValue+    {-# INLINE preEscapedToValue #-}  instance ToValue String where     toValue = stringValue     {-# INLINE toValue #-}+    preEscapedToValue = preEscapedStringValue+    {-# INLINE preEscapedToValue #-}  instance ToValue Int where     toValue = stringValue . show

@@ -20,11 +20,13 @@     , AttributeValue        -- * Creating custom tags and attributes.+    , customParent+    , customLeaf     , attribute     , dataAttribute     , customAttribute -      -- * Converting values to HTML.+      -- * Converting values to Markup.     , text     , preEscapedText     , lazyText@@ -52,7 +54,8 @@     , Attributable     , (!) -      -- * Modifying HTML elements+      -- * Modifying Markup elements+    , contents     , external     ) where @@ -119,8 +122,12 @@ data MarkupM a     -- | Tag, open tag, end tag, content     = forall b. Parent StaticString StaticString StaticString (MarkupM b)+    -- | Custom parent+    | forall b. CustomParent ChoiceString (MarkupM b)     -- | Tag, open tag, end tag     | Leaf StaticString StaticString StaticString+    -- | Custom leaf+    | CustomLeaf ChoiceString Bool     -- | HTML content     | Content ChoiceString     -- | Concatenation of two HTML pieces@@ -129,7 +136,7 @@     -- receive the attribute.     | AddAttribute StaticString StaticString ChoiceString (MarkupM a)     -- | Add a custom attribute to the inner HTML.-    | AddCustomAttribute ChoiceString ChoiceString ChoiceString (MarkupM a)+    | AddCustomAttribute ChoiceString ChoiceString (MarkupM a)     -- | Empty HTML.     | Empty     deriving (Typeable)@@ -182,6 +189,18 @@ newtype AttributeValue = AttributeValue { unAttributeValue :: ChoiceString }     deriving (IsString, Monoid) +-- | Create a custom parent element+customParent :: Tag     -- ^ Element tag+             -> Markup  -- ^ Content+             -> Markup  -- ^ Resulting markup+customParent tag = CustomParent (Static $ unTag tag)++-- | Create a custom leaf element+customLeaf :: Tag     -- ^ Element tag+           -> Bool    -- ^ Close the leaf?+           -> Markup  -- ^ Resulting markup+customLeaf tag = CustomLeaf (Static $ unTag tag)+ -- | Create an HTML attribute that can be applied to an HTML element later using -- the '!' operator. --@@ -209,7 +228,6 @@               -> Attribute       -- ^ Resulting HTML attribute. dataAttribute tag value = Attribute $ AddCustomAttribute     (Static "data-" `mappend` Static (unTag tag))-    (Static " data-" `mappend` Static (unTag tag) `mappend` Static "=\"")     (unAttributeValue value) {-# INLINE dataAttribute #-} @@ -229,7 +247,6 @@                 -> Attribute       -- ^ Resulting HTML attribtue customAttribute tag value = Attribute $ AddCustomAttribute     (Static $ unTag tag)-    (Static " " `mappend` Static (unTag tag) `mappend` Static "=\"")     (unAttributeValue value) {-# INLINE customAttribute #-} @@ -408,7 +425,27 @@ external (Content x) = Content $ External x external (Append x y) = Append (external x) (external y) external (Parent x y z i) = Parent x y z $ external i+external (CustomParent x i) = CustomParent x $ external i external (AddAttribute x y z i) = AddAttribute x y z $ external i-external (AddCustomAttribute x y z i) = AddCustomAttribute x y z $ external i+external (AddCustomAttribute x y i) = AddCustomAttribute x y $ external i external x = x {-# INLINE external #-}++-- | Take only the text content of an HTML tree.+--+-- > contents $ do+-- >     p ! $ "Hello "+-- >     p ! $ "Word!"+--+-- Result:+--+-- > Hello World!+--+contents :: MarkupM a -> MarkupM b+contents (Parent _ _ _ c)           = contents c+contents (CustomParent _ c)         = contents c+contents (Content c)                = Content c+contents (Append c1 c2)             = Append (contents c1) (contents c2)+contents (AddAttribute _ _ _ c)     = contents c+contents (AddCustomAttribute _ _ c) = contents c+contents _                          = Empty

@@ -19,12 +19,20 @@     go i attrs (Parent _ open close content) =         ind i . getString open . attrs . (">\n" ++) . go (inc i) id content               . ind i . getString close .  ('\n' :)+    go i attrs (CustomParent tag content) =+        ind i . ('<' :) . fromChoiceString tag . attrs . (">\n" ++) .+        go (inc i) id content . ind i . ("</" ++) . fromChoiceString tag .+        (">\n" ++)     go i attrs (Leaf _ begin end) =         ind i . getString begin . attrs . getString end . ('\n' :)+    go 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 $         getString key . fromChoiceString value . ('"' :) . attrs-    go i attrs (AddCustomAttribute _ key value h) = flip (go i) h $-        fromChoiceString key . fromChoiceString value . ('"' :) . attrs+    go i attrs (AddCustomAttribute key value h) = flip (go i) h $+        (' ' : ) . fromChoiceString key . ("=\"" ++) . fromChoiceString value .+        ('"' :) .  attrs     go i _ (Content content) = ind i . fromChoiceString content . ('\n' :)     go i attrs (Append h1 h2) = go i attrs h1 . go i attrs h2     go _ _ Empty = id@@ -45,5 +53,6 @@  renderHtml :: Markup -> String renderHtml = renderMarkup-{-# DEPRECATED renderHtml "Use renderMarkup instead" #-} {-# INLINE renderHtml #-}+{-# DEPRECATED renderHtml+    "Use renderHtml from Text.Blaze.Html.Renderer.Pretty instead" #-}

@@ -64,11 +64,18 @@     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 .+        ("</" ++) . fromChoiceString tag . ('>' :)     go attrs (Leaf _ begin end) = getString begin . attrs . getString end+    go attrs (CustomLeaf tag close) =+        ('<' :) . fromChoiceString tag . attrs .+        (if close then (" />" ++) else ('>' :))     go attrs (AddAttribute _ key value h) = flip go h $         getString key . fromChoiceString value . ('"' :) . attrs-    go attrs (AddCustomAttribute _ key value h) = flip go h $-        fromChoiceString key . fromChoiceString value . ('"' :) . attrs+    go attrs (AddCustomAttribute key value h) = flip go h $+        (' ' :) . fromChoiceString key . ("=\"" ++) . fromChoiceString value .+        ('"' :) .  attrs     go _ (Content content) = fromChoiceString content     go attrs (Append h1 h2) = go attrs h1 . go attrs h2     go _ Empty = id@@ -83,6 +90,6 @@  renderHtml :: Markup -> String renderHtml = renderMarkup-{-# DEPRECATED renderHtml "Use renderMarkup instead" #-} {-# INLINE renderHtml #-}-+{-# DEPRECATED renderHtml+    "Use renderHtml from Text.Blaze.Html.Renderer.String instead" #-}

@@ -72,8 +72,9 @@  renderHtmlBuilder :: Markup -> Builder renderHtmlBuilder = renderMarkupBuilder-{-# DEPRECATED renderHtmlBuilder "Use renderMarkupBuilder instead" #-} {-# INLINE renderHtmlBuilder #-}+{-# DEPRECATED renderHtmlBuilder+    "Use renderHtmlBuilder from Text.Blaze.Html.Renderer.Text instead" #-}  -- | Render some 'Markup' to a Text 'Builder'. --@@ -89,17 +90,33 @@             `mappend` B.singleton '>'             `mappend` go mempty content             `mappend` B.fromText (getText close)+    go attrs (CustomParent tag content) =+        B.singleton '<'+            `mappend` fromChoiceString d tag+            `mappend` attrs+            `mappend` B.singleton '>'+            `mappend` go mempty content+            `mappend` B.fromText "</"+            `mappend` fromChoiceString d tag+            `mappend` B.singleton '>'     go attrs (Leaf _ begin end) =         B.fromText (getText begin)             `mappend` attrs             `mappend` B.fromText (getText end)+    go 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)             `mappend` fromChoiceString d value             `mappend` B.singleton '"'             `mappend` attrs) h-    go attrs (AddCustomAttribute _ key value h) =-        go (fromChoiceString d key+    go attrs (AddCustomAttribute key value h) =+        go (B.singleton ' '+            `mappend` fromChoiceString d key+            `mappend` B.fromText "=\""             `mappend` fromChoiceString d value             `mappend` B.singleton '"'             `mappend` attrs) h@@ -113,8 +130,9 @@                       -> Markup                -- ^ Markup to render                       -> Builder               -- ^ Resulting builder renderHtmlBuilderWith = renderMarkupBuilderWith-{-# DEPRECATED renderHtmlBuilderWith "Use renderMarkupBuilderWith instead" #-} {-# INLINE renderHtmlBuilderWith #-}+{-# DEPRECATED renderHtmlBuilderWith+    "Use renderHtmlBuilderWith from Text.Blaze.Html.Renderer.Text instead" #-}  -- | Render markup to a lazy Text value. If there are any ByteString's in the -- input markup, this function will consider them as UTF-8 encoded values and@@ -126,8 +144,9 @@  renderHtml :: Markup -> L.Text renderHtml = renderMarkup-{-# DEPRECATED renderHtml "Use renderMarkup instead" #-} {-# INLINE renderHtml #-}+{-# DEPRECATED renderHtml+    "Use renderHtml from Text.Blaze.Html.Renderer.Text instead" #-}  -- | Render markup to a lazy Text value. This function allows you to specify what -- should happen with ByteString's in the input HTML. You can decode them or@@ -142,4 +161,5 @@                -> Markup                -- ^ Markup to render                -> L.Text                -- ^ Resulting lazy text renderHtmlWith = renderMarkupWith-{-# DEPRECATED renderHtmlWith "Use renderMarkupWith instead" #-}+{-# DEPRECATED renderHtmlWith+    "Use renderHtmlWith from Text.Blaze.Html.Renderer.Text instead" #-}

@@ -56,17 +56,33 @@             `mappend` B.fromChar '>'             `mappend` go mempty content             `mappend` B.copyByteString (getUtf8ByteString close)+    go attrs (CustomParent tag content) =+        B.fromChar '<'+            `mappend` fromChoiceString tag+            `mappend` attrs+            `mappend` B.fromChar '>'+            `mappend` go mempty content+            `mappend` B.fromByteString "</"+            `mappend` fromChoiceString tag+            `mappend` B.fromChar '>'     go attrs (Leaf _ begin end) =         B.copyByteString (getUtf8ByteString begin)             `mappend` attrs             `mappend` B.copyByteString (getUtf8ByteString end)+    go 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)             `mappend` fromChoiceString value             `mappend` B.fromChar '"'             `mappend` attrs) h-    go attrs (AddCustomAttribute _ key value h) =-        go (fromChoiceString key+    go attrs (AddCustomAttribute key value h) =+        go (B.fromChar ' '+            `mappend` fromChoiceString key+            `mappend` B.fromByteString "=\""             `mappend` fromChoiceString value             `mappend` B.fromChar '"'             `mappend` attrs) h@@ -77,8 +93,9 @@ {-# INLINE renderMarkupBuilder #-}  renderHtmlBuilder = renderMarkupBuilder-{-# DEPRECATED renderHtmlBuilder "Use renderMarkupBuilder instead" #-} {-# INLINE renderHtmlBuilder #-}+{-# DEPRECATED renderHtmlBuilder+    "Use renderHtmlBuilder from Text.Blaze.Html.Renderer.Utf8 instead" #-}  -- | Render HTML to a lazy UTF-8 encoded 'L.ByteString.' --@@ -88,8 +105,9 @@ {-# INLINE renderMarkup #-}  renderHtml = renderMarkup-{-# DEPRECATED renderHtml "Use renderMarkup instead" #-} {-# INLINE renderHtml #-}+{-# DEPRECATED renderHtml+    "Use renderHtml from Text.Blaze.Html.Renderer.Utf8 instead" #-}   -- | Repeatedly render HTML to a buffer and process this buffer using the given@@ -103,5 +121,6 @@ {-# INLINE renderMarkupToByteStringIO #-}  renderHtmlToByteStringIO = renderMarkupToByteStringIO-{-# DEPRECATED renderHtmlToByteStringIO "Use renderMarkupToByteStringIO instead" #-} {-# INLINE renderHtmlToByteStringIO #-}+{-# DEPRECATED renderHtmlToByteStringIO+    "Use renderMarkupToByteStringIO from Text.Blaze.Html.Renderer.Utf8 instead" #-}

@@ -12,12 +12,14 @@ import Data.Char (ord) import Data.List (isInfixOf) +import Test.Framework (Test)+import Test.HUnit (Assertion, (@=?))+import Test.Framework.Providers.HUnit (testCase)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck import qualified Data.ByteString as SB-import qualified Data.ByteString.Lazy.Char8 as LBC import qualified Data.ByteString.Lazy as LB-import Test.Framework-import Test.Framework.Providers.QuickCheck2-import Test.QuickCheck+import qualified Data.ByteString.Lazy.Char8 as LBC  import Text.Blaze.Internal import Text.Blaze.Tests.Util@@ -32,6 +34,8 @@         , testProperty "external </ sequence"      externalEndSequence         , testProperty "well nested <>"            wellNestedBrackets         , testProperty "unsafeByteString id"       unsafeByteStringId++        , testCase     "contents 1"                contents1         ]  -- | The left identity Monoid law.@@ -109,6 +113,15 @@         '<' -> if isOpen then False else wellNested True xs         '>' -> if isOpen then wellNested False xs else False         _   -> wellNested isOpen xs++contents1 :: Assertion+contents1 = "Hello World!" @=? renderUsingUtf8 (contents html)+  where+    html :: Markup+    html = div $ do+        p ! id "para" $ "Hello "+        img ! name "An image"+        p "World!"  -- Show instance for the HTML type, so we can debug. --