Fixed lots of bugs

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

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index e83aa34fdc181022584693abf28578a91b9360b9..0d53d3186c154c5c716c6fdc5fb1380d18852615 100644 (file)
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -29,7 +29,7 @@ import Data.Collections.BaseInstances ()
 import Data.Monoid
 import Data.Monoid.Unicode
 import Network.HTTP.Lucu.Parser.Http
-import Prelude hiding (filter, foldr, lookup, null)
+import Prelude hiding (filter, foldl, foldl1, foldr, foldr1, lookup, null)
 import Prelude.Unicode
 
 newtype Headers
@@ -74,30 +74,37 @@ instance Unfoldable Headers (CIAscii, Ascii) where
     insert (key, val) (Headers m)
         = Headers $ insertWith merge key val m
     {-# INLINE empty #-}
-    empty
-        = Headers 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
+    singleton = Headers ∘ singleton
 
+-- FIXME: auto-derive
 instance Foldable Headers (CIAscii, Ascii) where
+    {-# INLINE fold #-}
+    fold (Headers m) = fold m
+    {-# INLINE foldMap #-}
+    foldMap f (Headers m) = foldMap f m
+    {-# INLINE foldr #-}
+    foldr f b (Headers m) = foldr f b m
+    {-# INLINE foldl #-}
+    foldl f b (Headers m) = foldl f b m
+    {-# INLINE foldr1 #-}
+    foldr1 f (Headers m) = foldr1 f m
+    {-# INLINE foldl1 #-}
+    foldl1 f (Headers m) = foldl1 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
+    {-# INLINE isSingleton #-}
+    isSingleton (Headers m) = isSingleton m
 
+-- FIXME: auto-derive
 instance Collection Headers (CIAscii, Ascii) where
     {-# INLINE filter #-}
     filter f (Headers m) = Headers $ filter f m
 
+-- FIXME: auto-derive
 instance Indexed Headers CIAscii Ascii where
     {-# INLINE index #-}
     index k (Headers m) = index k m
@@ -105,21 +112,50 @@ instance Indexed Headers CIAscii Ascii where
     adjust f k (Headers m) = Headers $ adjust f k m
     {-# INLINE inDomain #-}
     inDomain k (Headers m) = inDomain k m
+    {-# INLINE (//) #-}
+    Headers m // l = Headers $ m // l
+    {-# INLINE accum #-}
+    accum f (Headers m) l = Headers $ accum f m l
 
 instance Monoid Headers where
     {-# INLINE mempty #-}
-    mempty = empty
+    mempty  = empty
     {-# INLINE mappend #-}
-    mappend (Headers α) (Headers β)
-        = Headers $ insertManySorted β α
+    mappend = insertMany
 
--- FIXME: override every methods
+-- FIXME: auto-derive
 instance Map Headers CIAscii Ascii where
+    {-# INLINE delete #-}
+    delete k (Headers m) = Headers $ delete k m
+    {-# INLINE member #-}
+    member k (Headers m) = member k m
+    {-# INLINE union #-}
+    union (Headers α) (Headers β)
+        = Headers $ union α β
+    {-# INLINE intersection #-}
+    intersection (Headers α) (Headers β)
+        = Headers $ intersection α β
+    {-# INLINE difference #-}
+    difference (Headers α) (Headers β)
+        = Headers $ difference α β
+    {-# INLINE isSubset #-}
+    isSubset (Headers α) (Headers β)
+        = isSubset α β
+    {-# INLINE isProperSubset #-}
+    isProperSubset (Headers α) (Headers β)
+        = isProperSubset α β
     {-# INLINE lookup #-}
     lookup k (Headers m) = lookup k m
+    {-# INLINE alter #-}
+    alter f k (Headers m)
+        = Headers $ alter f k m
     {-# INLINE insertWith #-}
     insertWith f k v (Headers m)
         = Headers $ insertWith f k v m
+    {-# INLINE fromFoldableWith #-}
+    fromFoldableWith = (Headers ∘) ∘ fromFoldableWith
+    {-# INLINE foldGroups #-}
+    foldGroups = ((Headers ∘) ∘) ∘ foldGroups
     {-# INLINE mapWithKey #-}
     mapWithKey f (Headers m)
         = Headers $ mapWithKey f m
@@ -139,6 +175,7 @@ instance Map Headers CIAscii Ascii where
     isProperSubmapBy f (Headers α) (Headers β)
         = isProperSubmapBy f α β
 
+-- FIXME: auto-derive
 instance SortingCollection Headers (CIAscii, Ascii) where
     {-# INLINE minView #-}
     minView (Headers m) = second Headers <$> minView m