-singleton ∷ CIAscii → Ascii → Headers
-{-# INLINE singleton #-}
-singleton key val
- = Headers $ M.singleton key val
-
-toHeaders ∷ [(CIAscii, Ascii)] → Headers
-{-# INLINE toHeaders #-}
-toHeaders = flip mkHeaders (∅)
-
-mkHeaders ∷ [(CIAscii, Ascii)] → Headers → Headers
-mkHeaders [] (Headers m) = Headers m
-mkHeaders ((key, val):xs) (Headers m)
- = mkHeaders xs $ Headers $
- case M.lookup key m of
- Nothing → M.insert key val m
- Just old → M.insert key (merge old val) m
+C.derive [d| instance Foldable Headers (CIAscii, Ascii)
+ instance Collection Headers (CIAscii, Ascii)
+ instance Indexed Headers CIAscii Ascii
+ instance Map Headers CIAscii Ascii
+ instance SortingCollection Headers (CIAscii, Ascii)
+ |]
+
+-- |@'insert' (key, val)@ merges @val@ with an existing one if any.
+instance Unfoldable Headers (CIAscii, Ascii) where
+ {-# INLINE insert #-}
+ insert (key, val) (Headers m)
+ = Headers $ insertWith merge key val m
+ {-# INLINE empty #-}
+ empty = Headers empty
+ {-# INLINE singleton #-}
+ singleton = Headers ∘ singleton
+
+instance Monoid Headers where
+ {-# INLINE mempty #-}
+ mempty = empty
+ {-# INLINE mappend #-}
+ mappend = insertMany
+
+merge ∷ Ascii → Ascii → Ascii
+{-# INLINE merge #-}
+merge a b
+ | nullA a ∧ nullA b = (∅)
+ | nullA a = b
+ | nullA b = a
+ | otherwise = a ⊕ ", " ⊕ b