use semigroups rather than possibly-empty lists

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 <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 :| []

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
 

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 <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