Network/HTTP/Lucu/Headers.hs

   1 module Network.HTTP.Lucu.Headers
   2     ( Headers
   3     , HasHeaders(..)
   4     , emptyHeaders   -- Headers
   5     )
   6     where
   7
   8 import qualified Data.ByteString.Lazy.Char8 as B
   9 import           Data.ByteString.Lazy.Char8 (ByteString)
  10 import           Data.Char
  11 import           Data.List
  12
  13 type Headers = [ (ByteString, ByteString) ]
  14
  15 class HasHeaders a where
  16     getHeaders :: a -> Headers
  17     setHeaders :: a -> Headers -> a
  18
  19     getHeader :: a -> ByteString -> Maybe ByteString
  20     getHeader a key
  21         = fmap snd $ find (noCaseEq key . fst) (getHeaders a)
  22
  23     deleteHeader :: a -> ByteString -> a
  24     deleteHeader a key
  25         = setHeaders a $ filter (not . noCaseEq key . fst) (getHeaders a)
  26
  27     addHeader :: a -> ByteString -> ByteString -> a
  28     addHeader a key val
  29         = setHeaders a $ (getHeaders a) ++ [(key, val)]
  30
  31     setHeader :: a -> ByteString -> ByteString -> a
  32     setHeader a key val
  33         = let list    = getHeaders a
  34               deleted = filter (not . noCaseEq key . fst) list
  35               added   = deleted ++ [(key, val)]
  36           in
  37             setHeaders a added
  38
  39 noCaseEq :: ByteString -> ByteString -> Bool
  40 noCaseEq a b
  41     = (B.map toLower a) == (B.map toLower b)
  42
  43
  44 emptyHeaders :: Headers
  45 emptyHeaders = []