diff --git a/src/Text/Taggy/DOM.hs b/src/Text/Taggy/DOM.hs index 12240e0..8deb6e9 100644 --- a/src/Text/Taggy/DOM.hs +++ b/src/Text/Taggy/DOM.hs @@ -17,7 +17,8 @@ module Text.Taggy.DOM where import Data.HashMap.Strict (HashMap) -import Data.Monoid ((<>)) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Semigroup ((<>)) import Data.Text (Text) import Text.Taggy.Parser (taggyWith) import Text.Taggy.Types @@ -36,7 +37,7 @@ type AttrValue = Text -- \"raw\" content. data Element = Element { eltName :: !Text -- ^ name of the element. e.g "a" for - , eltAttrs :: !(HashMap AttrName [AttrValue]) -- ^ a (hash)map from attribute names to attribute values + , eltAttrs :: !(HashMap AttrName (NonEmpty AttrValue)) -- ^ a (hash)map from attribute names to attribute values , eltChildren :: [Node] -- ^ children 'Node's } deriving (Eq, Show) @@ -79,7 +80,7 @@ domify (TagOpen name attribs True : tags) where as = HM.fromListWith (\v1 v2 -> v1 <> v2) . map attrToPair $ attribs - attrToPair (Attribute k v) = (k, [v]) + attrToPair (Attribute k v) = (k, singleton v) domify (TagText txt : tags) = NodeContent txt : domify tags @@ -91,7 +92,7 @@ domify (TagOpen name attribs False : tags) as = HM.fromListWith (\v1 v2 -> v1 <> v2) . map attrToPair $ attribs - attrToPair (Attribute k v) = (k, [v]) + attrToPair (Attribute k v) = (k, singleton v) domify (TagClose _ : tags) = domify tags domify (TagComment _ : tags) = domify tags @@ -127,7 +128,7 @@ untilClosed name (cousins, TagOpen n as True : ts) where as' = HM.fromListWith (\v1 v2 -> v1 <> v2) . map attrToPair $ as - attrToPair (Attribute k v) = (k, [v]) + attrToPair (Attribute k v) = (k, singleton v) untilClosed name (cousins, TagOpen n as False : ts) = let (insideNew, ts') = untilClosed n ([], ts) @@ -139,7 +140,7 @@ untilClosed name (cousins, TagOpen n as False : ts) where as' = HM.fromListWith (\v1 v2 -> v1 <> v2) . map attrToPair $ as - attrToPair (Attribute k v) = (k, [v]) + attrToPair (Attribute k v) = (k, singleton v) untilClosed name (cousins, TagScript tago scr _ : ts) = let (TagOpen n at _) = tago @@ -151,7 +152,7 @@ untilClosed name (cousins, TagScript tago scr _ : ts) where at' at = HM.fromListWith (\v1 v2 -> v1 <> v2) . map attrToPair $ at - attrToPair (Attribute k v) = (k, [v]) + attrToPair (Attribute k v) = (k, singleton v) untilClosed name (cousins, TagStyle tago sty _ : ts) = let (TagOpen n at _) = tago @@ -163,9 +164,12 @@ untilClosed name (cousins, TagStyle tago sty _ : ts) where at' at = HM.fromListWith (\v1 v2 -> v1 <> v2) . map attrToPair $ at - attrToPair (Attribute k v) = (k, [v]) + attrToPair (Attribute k v) = (k, singleton v) untilClosed _ (cs, []) = (cs, []) convertText :: Text -> Node convertText t = NodeContent t + +singleton :: a -> NonEmpty a +singleton a = a :| [] diff --git a/src/Text/Taggy/Renderer.hs b/src/Text/Taggy/Renderer.hs index 7379f30..2b5a08c 100644 --- a/src/Text/Taggy/Renderer.hs +++ b/src/Text/Taggy/Renderer.hs @@ -17,6 +17,7 @@ module Text.Taggy.Renderer where import Data.Foldable (foldMap) import Data.HashMap.Strict (HashMap, foldlWithKey') import Data.List (foldl') +import Data.List.NonEmpty (NonEmpty) import Data.Monoid ((<>)) import Data.Text (Text, unpack) import Data.Text.Encoding (encodeUtf8) @@ -60,7 +61,7 @@ class Renderable a where instance AsMarkup a => Renderable a where renderWith = fmap renderMarkup . toMarkup -toAttribute :: HashMap Text [Text] -> (Markup -> Markup) +toAttribute :: HashMap Text (NonEmpty Text) -> (Markup -> Markup) toAttribute = flip $ foldlWithKey' toAttribute' where toAttribute' html attr value = foldl' (\html' v -> AddCustomAttribute (Text attr) (Text v) html') html value diff --git a/taggy.cabal b/taggy.cabal index eba6f51..d371b51 100644 --- a/taggy.cabal +++ b/taggy.cabal @@ -1,7 +1,7 @@ name: taggy version: 0.2.0 synopsis: Efficient and simple HTML/XML parsing library -description: +description: /taggy/ is a simple package for parsing HTML (and should work with XML) written on top of the library, which makes it one of the most efficient (space and time consumption wise) @@ -54,10 +54,11 @@ library Text.Taggy.Parser, Text.Taggy.Renderer Text.Taggy.Types - other-modules: + other-modules: build-depends: base >=4.6 && <5, blaze-html >= 0.7, blaze-markup >= 0.6, + semigroups >= 0.18.1, text >= 1, attoparsec >=0.11, vector >=0.7, @@ -108,6 +109,7 @@ test-suite unit , text , hspec , hspec-attoparsec + , semigroups , vector , attoparsec , unordered-containers @@ -128,6 +130,7 @@ test-suite integration , blaze-html , blaze-markup , directory + , semigroups , text , hspec >= 1.11 , hspec-attoparsec