alpmestan/taggy
1
1
Fork 0
mirror of https://github.com/alpmestan/taggy.git synced 2024-08-16 10:20:30 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #3 from fmapfmapfmap/combinators

Browse Source 
Some simple combinators on DOM-style documents.
This commit is contained in:
Alp Mestanogullari 2014-06-23 09:55:47 +02:00
commit 7b26531fe3
3 changed files with 58 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.ghci Normal file
View File

@ -0,0 +1,3 @@
:set -isrc
:set -itests
:set -XOverloadedStrings

24
src/Text/Taggy/Combinators.hs Normal file
View File

@ -0,0 +1,24 @@
module Text.Taggy.Combinators (hasAttr, getAttr, innerText, (//)) where
import Prelude hiding (lookup)
import Data.Monoid (mconcat)
import Data.Text (Text)
import Text.Taggy.DOM (Element(..), Node(..), AttrName, AttrValue)
import Data.HashMap.Strict (lookup, keys)
hasAttr :: Element -> AttrName -> Bool
hasAttr = flip elem . keys . eltAttrs
getAttr :: Element -> AttrName -> Maybe AttrValue
getAttr = flip lookup . eltAttrs
innerText :: Element -> Text
innerText = mconcat . map decons . eltChildren
where decons (NodeElement e) = innerText e
decons (NodeContent x) = x
(//) :: Element -> (Element -> Bool) -> [Element]
(//) = flip filter . expand
where expand = concat . map decons . eltChildren
decons (NodeElement e) = e : expand e
decons _ = []

31
tests/Text/Taggy/CombinatorsSpec.hs Normal file
View File

@ -0,0 +1,31 @@
{-# LANGUAGE OverloadedStrings #-}
module Text.Taggy.CombinatorsSpec where
import Text.Taggy.Combinators
import Test.Hspec
import Text.Taggy
spec :: Spec
spec = do
let element = (\(NodeElement e) -> e) . head . domify . taggyWith False $
"<html xmlns=\"http://www.w3.org/1999/xhtml\">foo<bar class=\"el\">baz</bar><qux class=\"el\"></qux></html>"
describe "hasAttr" $ do
it "Tests whether an attribute is present." $ do
(element `hasAttr` "xmlns") `shouldBe` True
(element `hasAttr` "href") `shouldBe` False
describe "getAttr" $ do
it "Retrieves present attributes." $
(element `getAttr` "xmlns") `shouldBe` Just "http://www.w3.org/1999/xhtml"
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." $
innerText element `shouldBe` "foobaz"
describe "(//)" $ do
it "Should return all children satisfying the predicate." $ do
let predicate = (==Just "el") . flip getAttr "class"
result = element // predicate
result `shouldSatisfy` not . null
result `shouldSatisfy` all predicate