Safe Haskell | None |
---|---|
Language | Haskell2010 |
An opaque data type for HTTP headers. Intended to be imported qualified, i.e:
import Snap.Types.Headers (Headers) import qualified Snap.Types.Headers as H foo :: Headers foo = H.empty
Synopsis
- data Headers
- empty :: Headers
- null :: Headers -> Bool
- member :: CI ByteString -> Headers -> Bool
- lookup :: CI ByteString -> Headers -> Maybe ByteString
- lookupWithDefault :: ByteString -> CI ByteString -> Headers -> ByteString
- insert :: CI ByteString -> ByteString -> Headers -> Headers
- unsafeInsert :: ByteString -> ByteString -> Headers -> Headers
- set :: CI ByteString -> ByteString -> Headers -> Headers
- delete :: CI ByteString -> Headers -> Headers
- foldl' :: (a -> CI ByteString -> ByteString -> a) -> a -> Headers -> a
- foldr :: (CI ByteString -> ByteString -> a -> a) -> a -> Headers -> a
- foldedFoldl' :: (a -> ByteString -> ByteString -> a) -> a -> Headers -> a
- foldedFoldr :: (ByteString -> ByteString -> a -> a) -> a -> Headers -> a
- toList :: Headers -> [(CI ByteString, ByteString)]
- fromList :: [(CI ByteString, ByteString)] -> Headers
- unsafeFromCaseFoldedList :: [(ByteString, ByteString)] -> Headers
- unsafeToCaseFoldedList :: Headers -> [(ByteString, ByteString)]
Headers type
A key-value map that represents a collection of HTTP header fields. Keys are case-insensitive.
Headers creation
Predicates
Lookup
lookup :: CI ByteString -> Headers -> Maybe ByteString Source #
lookupWithDefault :: ByteString -> CI ByteString -> Headers -> ByteString Source #
Look up the value of a given HTTP header field or return the provided default value when that header field is not present.
Example:
ghci> :set -XOverloadedStrings ghci> let hdrs = H.fromList
[("Host", "localhost")] ghci> H.lookupWithDefault
"host" "127.0.0.1" $ hdrs "localhost" ghci> H.lookupWithDefault
"Accept" "text/plain" $ hdrs "text/plain"
Adding/setting headers
insert :: CI ByteString -> ByteString -> Headers -> Headers Source #
Insert a key-value pair into the headers map. If the key already exists in the map, the values are catenated with ", ".
Example:
ghci> :set -XOverloadedStrings ghci> let hdrs = H.insert
"Accept" "text/plain" $ H.empty
ghci> hdrs H {unH = [("accept","text/plain")]} ghci> H.insert
"Accept" "text/html" $ hdrs H {unH = [("accept","text/plain,text/html")]}
unsafeInsert :: ByteString -> ByteString -> Headers -> Headers Source #
Insert a key-value pair into the headers map, without checking whether the header already exists. The key must be already case-folded, or none of the lookups will work!
Example:
ghci> :set -XOverloadedStrings ghci> let hdrs = H.unsafeInsert
"accept" "text/plain" $ H.empty
ghci> hdrs H {unH = [("accept","text/plain")]} ghci> let hdrs' = H.unsafeInsert
"accept" "text/html" $ hdrs ghci> hdrs' H {unH = [("accept","text/html"), ("accept","text/plain")]} ghci> H.lookup
"accept" hdrs' Just "text/html"
set :: CI ByteString -> ByteString -> Headers -> Headers Source #
Set the value of a HTTP header field to a given value, replacing the old value.
Example:
ghci> :set -XOverloadedStrings ghci> H.set
"accept" "text/plain" $ H.empty
H {unH = [("accept","text/plain")]} ghci> H.set
"accept" "text/html" $ H.fromList
[("Accept", "text/plain")] H {unH = [("accept","text/html")]}
Deleting
Traversal
foldl' :: (a -> CI ByteString -> ByteString -> a) -> a -> Headers -> a Source #
Strict left fold over all key-value pairs in the headers map.
Example:
ghci> :set -XOverloadedStrings ghci> import Data.Monoid ghci> let hdrs = H.fromList
[("Accept", "text/plain"), ("Accept", "text/html")] ghci> let f (cntr, acc) _ val = (cntr+1, val <> ";" <> acc) ghci> H.foldl'
f (0, "") hdrs (2,"text/html;text/plain;")
foldr :: (CI ByteString -> ByteString -> a -> a) -> a -> Headers -> a Source #
Right fold over all key-value pairs in the headers map.
Example:
ghci> :set -XOverloadedStrings ghci> import Data.Monoid ghci> let hdrs = H.fromList
[("Accept", "text/plain"), ("Accept", "text/html")] ghci> let f _ val (cntr, acc) = (cntr+1, val <> ";" <> acc) ghci> H.foldr
f (0, "") hdrs (2,"text/plain;text/html;")
foldedFoldl' :: (a -> ByteString -> ByteString -> a) -> a -> Headers -> a Source #
Same as foldl'
, but the key parameter is of type ByteString
instead of
CI
ByteString
. The key is case-folded (lowercase).
foldedFoldr :: (ByteString -> ByteString -> a -> a) -> a -> Headers -> a Source #
Same as foldr
, but the key parameter is of type ByteString
instead of
CI
ByteString
. The key is case-folded (lowercase).
Lists
toList :: Headers -> [(CI ByteString, ByteString)] Source #
fromList :: [(CI ByteString, ByteString)] -> Headers Source #
unsafeFromCaseFoldedList :: [(ByteString, ByteString)] -> Headers Source #
Like fromList
, but the keys are assumed to be already case-folded (in
lowercase).
unsafeToCaseFoldedList :: Headers -> [(ByteString, ByteString)] Source #
Like toList
, but does not convert the keys to CI
ByteString
, so key
comparisons will be case-sensitive.