- getHeaders :: a -> Headers
- setHeaders :: a -> Headers -> a
-
- getHeader :: Strict.ByteString -> a -> Maybe Strict.ByteString
- getHeader key a
- = key `seq` a `seq`
- M.lookup (toNCBS key) (getHeaders a)
-
- deleteHeader :: Strict.ByteString -> a -> a
- deleteHeader key a
- = key `seq` a `seq`
- setHeaders a $ M.delete (toNCBS key) (getHeaders a)
-
- setHeader :: Strict.ByteString -> Strict.ByteString -> a -> a
- setHeader key val a
- = key `seq` val `seq` a `seq`
- setHeaders a $ M.insert (toNCBS key) val (getHeaders a)
-
-
-emptyHeaders :: Headers
-emptyHeaders = M.empty
-
-
-toHeaders :: [(Strict.ByteString, Strict.ByteString)] -> Headers
-toHeaders xs = mkHeaders xs M.empty
-
-
-mkHeaders :: [(Strict.ByteString, Strict.ByteString)] -> Headers -> Headers
-mkHeaders [] m = m
-mkHeaders ((key, val):xs) m = mkHeaders xs $
- case M.lookup (toNCBS key) m of
- Nothing -> M.insert (toNCBS key) val m
- Just old -> M.insert (toNCBS key) (merge old val) m
+ getHeaders ∷ a → Headers
+ setHeaders ∷ a → Headers → a
+
+ modifyHeaders ∷ (Headers → Headers) → a → a
+ {-# INLINE modifyHeaders #-}
+ modifyHeaders = (setHeaders ⊛) ∘ (∘ getHeaders)
+
+ getHeader ∷ CIAscii → a → Maybe Ascii
+ {-# INLINE getHeader #-}
+ getHeader = (∘ getHeaders) ∘ lookup
+
+ hasHeader ∷ CIAscii → a → Bool
+ {-# INLINE hasHeader #-}
+ hasHeader = (∘ getHeaders) ∘ member
+
+ getCIHeader ∷ CIAscii → a → Maybe CIAscii
+ {-# INLINE getCIHeader #-}
+ getCIHeader = ((A.toCIAscii <$>) ∘) ∘ getHeader
+
+ deleteHeader ∷ CIAscii → a → a
+ {-# INLINE deleteHeader #-}
+ deleteHeader = modifyHeaders ∘ delete
+
+ setHeader ∷ CIAscii → Ascii → a → a
+ {-# INLINE setHeader #-}
+ setHeader = (modifyHeaders ∘) ∘ insertWith const
+
+instance HasHeaders Headers where
+ getHeaders = id
+ setHeaders _ = id
+
+-- |@'insert' (key, val)@ merges @val@ with an existing one if any.
+instance Unfoldable Headers (CIAscii, Ascii) where
+ {-# INLINE insert #-}
+ insert (key, val) (Headers m)
+ = Headers $ insertWith merge key val m
+
+instance Foldable Headers (CIAscii, Ascii) where
+ {-# INLINE foldMap #-}
+ foldMap f (Headers m) = foldMap f m
+
+instance Collection Headers (CIAscii, Ascii) where
+ {-# INLINE filter #-}
+ filter f (Headers m) = Headers $ filter f m
+
+instance Indexed Headers CIAscii Ascii where
+ {-# INLINE index #-}
+ index k (Headers m) = index k m
+ {-# INLINE adjust #-}
+ adjust f k (Headers m) = Headers $ adjust f k m
+ {-# INLINE inDomain #-}
+ inDomain k (Headers m) = inDomain k m
+
+instance Map Headers CIAscii Ascii where
+ {-# INLINE lookup #-}
+ lookup k (Headers m) = lookup k m
+ {-# INLINE insertWith #-}
+ insertWith f k v (Headers m)
+ = Headers $ insertWith f k v m
+ {-# INLINE mapWithKey #-}
+ mapWithKey f (Headers m)
+ = Headers $ mapWithKey f m
+ {-# INLINE unionWith #-}
+ unionWith f (Headers α) (Headers β)
+ = Headers $ unionWith f α β
+ {-# INLINE intersectionWith #-}
+ intersectionWith f (Headers α) (Headers β)
+ = Headers $ intersectionWith f α β
+ {-# INLINE differenceWith #-}
+ differenceWith f (Headers α) (Headers β)
+ = Headers $ differenceWith f α β
+ {-# INLINE isSubmapBy #-}
+ isSubmapBy f (Headers α) (Headers β)
+ = isSubmapBy f α β
+ {-# INLINE isProperSubmapBy #-}
+ isProperSubmapBy f (Headers α) (Headers β)
+ = isProperSubmapBy f α β
+
+instance SortingCollection Headers (CIAscii, Ascii) where
+ {-# INLINE minView #-}
+ minView (Headers m) = second Headers <$> minView m
+
+merge ∷ Ascii → Ascii → Ascii
+{-# INLINE merge #-}
+merge a b
+ | nullA a ∧ nullA b = (∅)
+ | nullA a = b
+ | nullA b = a
+ | otherwise = a ⊕ ", " ⊕ b