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

A simple DOM tree renderer, using Blaze.

Browse Source
This commit is contained in:
vi 2014-06-26 19:51:23 +08:00
parent 04ac52ebd0
commit edcf2b1433
4 changed files with 69 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Text/Taggy.hs
View File

@ -13,6 +13,7 @@ module Text.Taggy
, module Text.Taggy.Parser
, module Text.Taggy.DOM
, module Text.Taggy.Combinators
, module Text.Taggy.Renderer
) where
import Data.Text (Text)
@ -20,6 +21,7 @@ import Text.Taggy.Types
import Text.Taggy.Parser
import Text.Taggy.DOM
import Text.Taggy.Combinators
import Text.Taggy.Renderer
linksIn :: [Tag] -> [Text]
linksIn = map attrValue

46
src/Text/Taggy/Renderer.hs Normal file
View File

@ -0,0 +1,46 @@
{-# LANGUAGE LambdaCase, RecordWildCards, FlexibleInstances, UndecidableInstances, OverloadedStrings #-}
module Text.Taggy.Renderer (
Renderable(..)
) where
import Data.Foldable (Foldable(foldMap))
import Data.HashMap.Strict (HashMap, foldlWithKey')
import Data.Monoid ((<>))
import Data.Text (Text, unpack)
import Data.Text.Encoding (encodeUtf8)
import Text.Blaze (Markup)
import Text.Blaze.Renderer.Text (renderMarkup)
import Text.Taggy.DOM (Element(..), Node(..))
import qualified Data.Text.Lazy as Lazy (Text)
import Text.Blaze.Internal (ChoiceString(..), StaticString(..), MarkupM(..))
class AsMarkup a where
toMarkup :: a -> Markup
instance AsMarkup Node where
toMarkup = \case
NodeContent text -> Content $ Text text
NodeElement elmt -> toMarkup elmt
instance AsMarkup Element where
toMarkup Element{..} = eltAttrs `toAttribute` Parent tag begin end kids
where tag = toStatic eltName
begin = toStatic $ "<" <> eltName
end = toStatic $ "</" <> eltName <> ">"
kids = foldMap toMarkup eltChildren
class Renderable a where
render :: a -> Lazy.Text
instance AsMarkup a => Renderable a where
render = renderMarkup . toMarkup
------------------------------------------------------------------------
toAttribute :: HashMap Text Text -> (Markup -> Markup)
toAttribute = flip $ foldlWithKey' toAttribute'
where toAttribute' html attr value = AddCustomAttribute (Text attr) (Text value) html
toStatic :: Text -> StaticString
toStatic text = StaticString (unpack text ++) (encodeUtf8 text) text

4
taggy.cabal
View File

@ -22,6 +22,8 @@ library
Text.Taggy.Types
other-modules:
build-depends: base >=4.5 && <5,
blaze-html,
blaze-markup,
text >=1 && <1.2,
attoparsec >=0.11 && <0.13,
vector >=0.7,
@ -67,6 +69,8 @@ test-suite spec
Spec.hs
build-depends:
base == 4.*
, blaze-html
, blaze-markup
, text
, hspec
, hspec-attoparsec

17
tests/Text/Taggy/RendererSpec.hs Normal file
View File

@ -0,0 +1,17 @@
{-# LANGUAGE OverloadedStrings #-}
module Text.Taggy.RendererSpec where
import Test.Hspec
import Text.Taggy
spec :: Spec
spec = do
describe "render" $ do
let doc = "<html xmlns=\"http://www.w3.org/1999/xhtml\">foo<bar class=\"el\">baz</bar><qux class=\"el\"><quux></quux></qux></html>"
node = head . domify $ taggyWith False doc
elmt = (\(NodeElement e) -> e) $ node
it "Should render a given node." $ do
render node `shouldBe` doc
it "Should render a given element." $ do
render elmt `shouldBe` doc