Browse files

Add a `contents` function to extract text content

  • Loading branch information...
1 parent 7124af8 commit 0eafa8d012bd06fb18b128073852e18ad91de699 @jaspervdj committed Apr 21, 2012
Showing with 43 additions and 7 deletions.
  1. +4 −1 src/Text/Blaze.hs
  2. +22 −2 src/Text/Blaze/Internal.hs
  3. +17 −4 tests/Text/Blaze/Tests.hs
View
5 src/Text/Blaze.hs
@@ -44,7 +44,7 @@ module Text.Blaze
, dataAttribute
, customAttribute
- -- * Converting values to HTML.
+ -- * Converting values to Markup.
, ToMarkup (..)
, unsafeByteString
, unsafeLazyByteString
@@ -60,6 +60,9 @@ module Text.Blaze
-- * Setting attributes
, (!)
+
+ -- * Modifiying Markup trees
+ , contents
) where
import Data.Monoid (mconcat)
View
24 src/Text/Blaze/Internal.hs
@@ -26,7 +26,7 @@ module Text.Blaze.Internal
, dataAttribute
, customAttribute
- -- * Converting values to HTML.
+ -- * Converting values to Markup.
, text
, preEscapedText
, lazyText
@@ -54,7 +54,8 @@ module Text.Blaze.Internal
, Attributable
, (!)
- -- * Modifying HTML elements
+ -- * Modifying Markup elements
+ , contents
, external
) where
@@ -429,3 +430,22 @@ external (AddAttribute x y z i) = AddAttribute 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
View
21 tests/Text/Blaze/Tests.hs
@@ -12,12 +12,14 @@ import Data.Word (Word8)
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 @@ tests = [ testProperty "left identity Monoid law" monoidLeftIdentity
, testProperty "external </ sequence" externalEndSequence
, testProperty "well nested <>" wellNestedBrackets
, testProperty "unsafeByteString id" unsafeByteStringId
+
+ , testCase "contents 1" contents1
]
-- | The left identity Monoid law.
@@ -110,6 +114,15 @@ wellNestedBrackets = wellNested False . LBC.unpack . renderUsingUtf8
'>' -> 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.
--
instance Show Markup where

0 comments on commit 0eafa8d

Please sign in to comment.