X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHeaders.hs;h=2ee9cbb8ce60e39311b496aa2b8ebfe7666e9cbc;hp=8219624df47b052df0be224e37dbda10957927bc;hb=19763f7de78daf2d4c794f4010039f70c7f73994;hpb=09fe5429b2a1bcea6d6e57ab1c4a5178807cbacd

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index 8219624..2ee9cbb 100644
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -15,7 +15,7 @@ module Network.HTTP.Lucu.Headers
     , printHeaders
     )
     where
-import Control.Applicative
+import Control.Applicative hiding (empty)
 import Control.Applicative.Unicode hiding ((∅))
 import Control.Arrow
 import Control.Monad
@@ -29,12 +29,12 @@ import Data.Collections.BaseInstances ()
 import Data.Monoid
 import Data.Monoid.Unicode
 import Network.HTTP.Lucu.Parser.Http
-import Prelude hiding (filter, lookup, null)
+import Prelude hiding (filter, foldr, lookup, null)
 import Prelude.Unicode
 
 newtype Headers
     = Headers (M.Map CIAscii Ascii)
-      deriving (Eq, Monoid, Show)
+      deriving (Eq, Show)
 
 class HasHeaders a where
     getHeaders ∷ a → Headers
@@ -73,10 +73,22 @@ 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 v
+        = Headers $ singleton v
+    {-# INLINE insertMany #-}
+    insertMany f (Headers m)
+        = Headers $ insertMany f m
+    {-# INLINE insertManySorted #-}
+    insertManySorted f (Headers m)
+        = Headers $ insertManySorted f m
 
 instance Foldable Headers (CIAscii, Ascii) where
-    {-# INLINE foldMap #-}
-    foldMap f (Headers m) = foldMap f m
+    {-# INLINE foldr #-}
+    foldr f b (Headers m) = foldr f b m
 
 instance Collection Headers (CIAscii, Ascii) where
     {-# INLINE filter #-}
@@ -90,6 +102,13 @@ instance Indexed Headers CIAscii Ascii where
     {-# INLINE inDomain #-}
     inDomain k (Headers m) = inDomain k m
 
+instance Monoid Headers where
+    {-# INLINE mempty #-}
+    mempty = empty
+    {-# INLINE mappend #-}
+    mappend (Headers α) (Headers β)
+        = Headers $ insertManySorted β α
+
 instance Map Headers CIAscii Ascii where
     {-# INLINE lookup #-}
     lookup k (Headers m) = lookup k m