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

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index 8219624..e413eb2 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
@@ -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, foldl, foldl1, foldr, foldr1, 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,15 +73,38 @@ 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
 
+-- 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
@@ -89,13 +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
+    {-# INLINE mappend #-}
+    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
@@ -115,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
@@ -168,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