From a4e6b9466a5b3c19cb8fa0a66351682b49dfb04c Mon Sep 17 00:00:00 2001 From: vi Date: Mon, 23 Jun 2014 16:13:42 +0800 Subject: [PATCH] Two new combinators: hasName and (/&). --- src/Text/Taggy/Combinators.hs | 12 +++++++++++- tests/Text/Taggy/CombinatorsSpec.hs | 14 +++++++++++--- 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/src/Text/Taggy/Combinators.hs b/src/Text/Taggy/Combinators.hs index 47b9cee..f5c8f0f 100644 --- a/src/Text/Taggy/Combinators.hs +++ b/src/Text/Taggy/Combinators.hs @@ -1,4 +1,4 @@ -module Text.Taggy.Combinators (hasAttr, getAttr, innerText, (//)) where +module Text.Taggy.Combinators (hasName, hasAttr, getAttr, innerText, (//), (/&)) where import Prelude hiding (lookup) import Data.Monoid (mconcat) @@ -6,6 +6,9 @@ import Data.Text (Text) import Text.Taggy.DOM (Element(..), Node(..), AttrName, AttrValue) import Data.HashMap.Strict (lookup, keys) +hasName :: Element -> Text -> Bool +hasName = (==) . eltName + hasAttr :: Element -> AttrName -> Bool hasAttr = flip elem . keys . eltAttrs @@ -22,3 +25,10 @@ innerText = mconcat . map decons . eltChildren where expand = concat . map decons . eltChildren decons (NodeElement e) = e : expand e decons _ = [] + +(/&) :: Element -> [(Element -> Bool)] -> [Element] +(/&) element [] = [element] +(/&) element (x:xs) = concat . map (/& xs) . filter x . immediateChildren $ eltChildren element + where immediateChildren = map (\(NodeElement e) -> e) . filter isElement + isElement (NodeElement _) = True + isElement _ = False diff --git a/tests/Text/Taggy/CombinatorsSpec.hs b/tests/Text/Taggy/CombinatorsSpec.hs index 43a2088..cb441ce 100644 --- a/tests/Text/Taggy/CombinatorsSpec.hs +++ b/tests/Text/Taggy/CombinatorsSpec.hs @@ -2,6 +2,7 @@ module Text.Taggy.CombinatorsSpec where +import Data.Monoid import Text.Taggy.Combinators import Test.Hspec import Text.Taggy @@ -9,7 +10,10 @@ import Text.Taggy spec :: Spec spec = do let element = (\(NodeElement e) -> e) . head . domify . taggyWith False $ - "foobaz" + "foobaz" + describe "hasName" $ do + it "Test whether an element has a given name." $ do + (element `hasName` "html") `shouldBe` True describe "hasAttr" $ do it "Tests whether an attribute is present." $ do (element `hasAttr` "xmlns") `shouldBe` True @@ -20,7 +24,7 @@ spec = do it "Nothing's missing attributes." $ (element `getAttr` "style") `shouldBe` Nothing describe "innerText" $ do - it "Should concatenate the NodeContent of the target element and all its children." $ + it "Should concatenate the NodeContent of the target element and all its children." $ innerText element `shouldBe` "foobaz" describe "(//)" $ do it "Should return all children satisfying the predicate." $ do @@ -28,4 +32,8 @@ spec = do result = element // predicate result `shouldSatisfy` not . null result `shouldSatisfy` all predicate - + describe "(/&)" $ do + it "Should traverse an element's children, selecting only those matching provided predicates at each point." $ do + element /& [] `shouldBe` [element] + element /& [const False] `shouldBe` [] + element /& [flip hasAttr "class", flip hasName "quux"] `shouldBe` [Element "quux" mempty mempty]