FlexibleInstances
, GeneralizedNewtypeDeriving
, MultiParamTypeClasses
+ , TemplateHaskell
, TypeSynonymInstances
, OverloadedStrings
, UnicodeSyntax
#-}
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
-- |An internal module for HTTP headers.
module Network.HTTP.Lucu.Headers
( Headers
where
import Control.Applicative hiding (empty)
import Control.Applicative.Unicode hiding ((∅))
-import Control.Arrow
import Control.Monad
import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
import qualified Data.Ascii as A
import Data.Attoparsec.Char8 as P
+import qualified Data.Collections.Newtype.TH as C
import Data.List (intersperse)
import qualified Data.Map as M (Map)
import Data.Collections
import Data.Monoid
import Data.Monoid.Unicode
import Network.HTTP.Lucu.Parser.Http
-import Prelude hiding (filter, foldl, foldl1, foldr, foldr1, lookup, null)
+import Prelude hiding (lookup, null)
import Prelude.Unicode
newtype Headers
getHeaders = id
setHeaders _ = id
+C.derive [d| instance Foldable Headers (CIAscii, Ascii)
+ instance Collection Headers (CIAscii, Ascii)
+ instance Indexed Headers CIAscii Ascii
+ instance Map Headers CIAscii Ascii
+ instance SortingCollection Headers (CIAscii, Ascii)
+ |]
+
-- |@'insert' (key, val)@ merges @val@ with an existing one if any.
instance Unfoldable Headers (CIAscii, Ascii) where
{-# INLINE insert #-}
{-# 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
- {-# INLINE adjust #-}
- 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
- {-# 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 α β
-
--- FIXME: auto-derive
-instance SortingCollection Headers (CIAscii, Ascii) where
- {-# INLINE minView #-}
- minView (Headers m) = second Headers <$> minView m
-
merge ∷ Ascii → Ascii → Ascii
{-# INLINE merge #-}
merge a b