X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=Network%2FHTTP%2FLucu%2FHeaders.hs;h=97a7603611937c3b16109c4332f743823bf7281c;hb=bb121f1189d01b5089aa5c29f0d390fad36ade48;hp=8219624df47b052df0be224e37dbda10957927bc;hpb=09fe5429b2a1bcea6d6e57ab1c4a5178807cbacd;p=Lucu.git diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index 8219624..97a7603 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, 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