MIMEParams is now an instance of collections-api's type classes.

[Lucu.git] / Network / HTTP / Lucu / Headers.hs

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index 8219624df47b052df0be224e37dbda10957927bc..97a7603611937c3b16109c4332f743823bf7281c 100644 (file)
--- 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
@@ -23,18 +23,18 @@ import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
 import qualified Data.Ascii as A
 import Data.Attoparsec.Char8 as P
 import Data.List (intersperse)
-import qualified Data.Map as M
+import qualified Data.Map as M (Map)
 import Data.Collections
 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,26 @@ 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 p
+        = Headers $ singleton p
+    {-# 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 null #-}
+    null (Headers m) = null m
+    {-# INLINE size #-}
+    size (Headers m) = size m
+    {-# INLINE foldr #-}
+    foldr f b (Headers m) = foldr f b m
 
 instance Collection Headers (CIAscii, Ascii) where
     {-# INLINE filter #-}
@@ -90,6 +106,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