{-# language DuplicateRecordFields #-}
{-# language DerivingStrategies #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language OverloadedStrings #-}
module Http.Headers
(
Headers
, LookupException(..)
, fromArray
, fromList
, cons
, snoc
, toArray
, lookup
, lookupFirst
, lookupAll
, lookupContentType
, lookupContentLength
, lookupTransferEncoding
, lookupHost
, lookupAccept
, lookupDate
, snocContentLength
, lacksContentLengthAndTransferEncoding
) where
import Prelude hiding (lookup)
import Data.Foldable (foldl')
import Data.Maybe (isNothing)
import Data.Primitive (SmallArray)
import Data.Text (Text)
import Http.Header (Header(Header))
import qualified Data.List as List
import qualified Data.Primitive as PM
import qualified Data.Primitive.Contiguous as C
import qualified Data.Text as T
import qualified GHC.Exts as Exts
import qualified Http.Header
newtype = (SmallArray Header)
deriving newtype (Int -> Headers -> ShowS
[Headers] -> ShowS
Headers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Headers] -> ShowS
$cshowList :: [Headers] -> ShowS
show :: Headers -> String
$cshow :: Headers -> String
showsPrec :: Int -> Headers -> ShowS
$cshowsPrec :: Int -> Headers -> ShowS
Show,NonEmpty Headers -> Headers
Headers -> Headers -> Headers
forall b. Integral b => b -> Headers -> Headers
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Headers -> Headers
$cstimes :: forall b. Integral b => b -> Headers -> Headers
sconcat :: NonEmpty Headers -> Headers
$csconcat :: NonEmpty Headers -> Headers
<> :: Headers -> Headers -> Headers
$c<> :: Headers -> Headers -> Headers
Semigroup,Semigroup Headers
Headers
[Headers] -> Headers
Headers -> Headers -> Headers
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Headers] -> Headers
$cmconcat :: [Headers] -> Headers
mappend :: Headers -> Headers -> Headers
$cmappend :: Headers -> Headers -> Headers
mempty :: Headers
$cmempty :: Headers
Monoid)
data LookupException
= Duplicate
| Missing
fromArray :: SmallArray Header -> Headers
fromArray :: SmallArray Header -> Headers
fromArray = SmallArray Header -> Headers
Headers
cons :: Header -> Headers -> Headers
cons :: Header -> Headers -> Headers
cons Header
hdr (Headers SmallArray Header
hdrs) = SmallArray Header -> Headers
Headers (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b -> arr b
C.insertAt SmallArray Header
hdrs Int
0 Header
hdr)
snoc :: Headers -> Header -> Headers
snoc :: Headers -> Header -> Headers
snoc (Headers SmallArray Header
hdrs) Header
hdr = SmallArray Header -> Headers
Headers (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b -> arr b
C.insertAt SmallArray Header
hdrs (forall a. SmallArray a -> Int
PM.sizeofSmallArray SmallArray Header
hdrs) Header
hdr)
fromList :: [Header] -> Headers
fromList :: [Header] -> Headers
fromList = SmallArray Header -> Headers
Headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
Exts.fromList
toArray :: Headers -> SmallArray Header
toArray :: Headers -> SmallArray Header
toArray (Headers SmallArray Header
xs) = SmallArray Header
xs
lookupFirst ::
Text
-> Headers
-> Maybe Header
lookupFirst :: Text -> Headers -> Maybe Header
lookupFirst Text
needle (Headers SmallArray Header
hdrs) =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\Header{Text
name :: Header -> Text
name :: Text
name} -> Text -> Text -> Bool
caseInsensitiveEq Text
needle Text
name) SmallArray Header
hdrs
lookup ::
Text
-> Headers
-> Either LookupException Header
lookup :: Text -> Headers -> Either LookupException Header
lookup Text
needle hdrs :: Headers
hdrs@(Headers SmallArray Header
xs) = case Text -> Headers -> Maybe Header
lookupFirst Text
needle Headers
hdrs of
Maybe Header
Nothing -> forall a b. a -> Either a b
Left LookupException
Missing
Just Header
hdr ->
let count :: Int
count = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
(\Int
acc Header{Text
name :: Text
name :: Header -> Text
name} -> if Text -> Text -> Bool
caseInsensitiveEq Text
needle Text
name
then Int
acc forall a. Num a => a -> a -> a
+ Int
1
else Int
acc
) (Int
0 :: Int) SmallArray Header
xs
in if Int
count forall a. Ord a => a -> a -> Bool
> Int
1 then forall a b. a -> Either a b
Left LookupException
Duplicate else forall a b. b -> Either a b
Right Header
hdr
lookupAll ::
Text
-> Headers
-> SmallArray Header
lookupAll :: Text -> Headers -> SmallArray Header
lookupAll Text
needle (Headers SmallArray Header
hdrs) =
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
(a -> Bool) -> arr a -> arr a
C.filter (\Header{Text
name :: Text
name :: Header -> Text
name} -> Text -> Text -> Bool
caseInsensitiveEq Text
needle Text
name) SmallArray Header
hdrs
caseInsensitiveEq :: Text -> Text -> Bool
caseInsensitiveEq :: Text -> Text -> Bool
caseInsensitiveEq Text
a Text
b = Text -> Text
T.toLower Text
a forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toLower Text
b
lookupTransferEncoding :: Headers -> Either LookupException Header
lookupTransferEncoding :: Headers -> Either LookupException Header
lookupTransferEncoding = Text -> Headers -> Either LookupException Header
lookup Text
"transfer-encoding"
lookupContentType :: Headers -> Either LookupException Header
lookupContentType :: Headers -> Either LookupException Header
lookupContentType = Text -> Headers -> Either LookupException Header
lookup Text
"content-type"
lookupContentLength :: Headers -> Either LookupException Header
lookupContentLength :: Headers -> Either LookupException Header
lookupContentLength = Text -> Headers -> Either LookupException Header
lookup Text
"content-length"
lookupHost :: Headers -> Either LookupException Header
lookupHost :: Headers -> Either LookupException Header
lookupHost = Text -> Headers -> Either LookupException Header
lookup Text
"host"
lookupAccept :: Headers -> Either LookupException Header
lookupAccept :: Headers -> Either LookupException Header
lookupAccept = Text -> Headers -> Either LookupException Header
lookup Text
"accept"
lookupDate :: Headers -> Either LookupException Header
lookupDate :: Headers -> Either LookupException Header
lookupDate = Text -> Headers -> Either LookupException Header
lookup Text
"date"
snocContentLength :: Headers -> Text -> Headers
snocContentLength :: Headers -> Text -> Headers
snocContentLength Headers
hdrs Text
val = Headers -> Header -> Headers
snoc Headers
hdrs (Text -> Text -> Header
Header Text
"Content-Length" Text
val)
lacksContentLengthAndTransferEncoding :: Headers -> Bool
lacksContentLengthAndTransferEncoding :: Headers -> Bool
lacksContentLengthAndTransferEncoding Headers
hdrs =
forall a. Maybe a -> Bool
isNothing (Text -> Headers -> Maybe Header
lookupFirst Text
"content-length" Headers
hdrs)
Bool -> Bool -> Bool
&&
forall a. Maybe a -> Bool
isNothing (Text -> Headers -> Maybe Header
lookupFirst Text
"transfer-encoding" Headers
hdrs)