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

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index 2ee9cbb..e413eb2 100644
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -23,13 +23,13 @@ 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, foldr, lookup, null)
+import Prelude hiding (filter, foldl, foldl1, foldr, foldr1, lookup, null)
 import Prelude.Unicode
 
 newtype Headers
@@ -74,26 +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 v
-        = Headers $ singleton v
-    {-# 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 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
@@ -101,20 +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: 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
@@ -134,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
@@ -187,11 +229,11 @@ headers = do xs ← P.many header
       joinValues = A.fromAsciiBuilder
                    ∘ mconcat
                    ∘ intersperse (A.toAsciiBuilder "\x20")
-                   ∘ map A.toAsciiBuilder
+                   ∘ (A.toAsciiBuilder <$>)
 
 printHeaders ∷ Headers → AsciiBuilder
 printHeaders (Headers m)
-    = mconcat (map printHeader (fromFoldable m)) ⊕
+    = mconcat (printHeader <$> fromFoldable m) ⊕
       A.toAsciiBuilder "\x0D\x0A"
     where
       printHeader ∷ (CIAscii, Ascii) → AsciiBuilder