mirror of
https://github.com/alpmestan/taggy.git
synced 2024-08-17 10:50:22 +03:00
use semigroups rather than possibly-empty lists
This commit is contained in:
parent
e98c0032e6
commit
159d1525a7
@ -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 <a>
|
||||
, 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 :| []
|
||||
|
@ -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
|
||||
|
||||
|
@ -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 <http://hackage.haskell.org/package/attoparsec attoparsec>
|
||||
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
|
||||
|
Loading…
Reference in New Issue
Block a user