{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Http.Headers
(
Headers
, LookupException (..)
, fromArray
, fromList
, cons
, snoc
, toArray
, lookup
, lookupFirst
, lookupAll
, lookupLocation
, 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 Data.List qualified as List
import Data.Primitive qualified as PM
import Data.Primitive.Contiguous qualified as C
import Data.Text qualified as T
import GHC.Exts qualified as Exts
import Http.Header qualified
newtype = (SmallArray Header)
deriving newtype (Headers -> Headers -> Bool
(Headers -> Headers -> Bool)
-> (Headers -> Headers -> Bool) -> Eq Headers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Headers -> Headers -> Bool
== :: Headers -> Headers -> Bool
$c/= :: Headers -> Headers -> Bool
/= :: Headers -> Headers -> Bool
Eq, Int -> Headers -> ShowS
[Headers] -> ShowS
Headers -> String
(Int -> Headers -> ShowS)
-> (Headers -> String) -> ([Headers] -> ShowS) -> Show Headers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Headers -> ShowS
showsPrec :: Int -> Headers -> ShowS
$cshow :: Headers -> String
show :: Headers -> String
$cshowList :: [Headers] -> ShowS
showList :: [Headers] -> ShowS
Show, NonEmpty Headers -> Headers
Headers -> Headers -> Headers
(Headers -> Headers -> Headers)
-> (NonEmpty Headers -> Headers)
-> (forall b. Integral b => b -> Headers -> Headers)
-> Semigroup 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
$c<> :: Headers -> Headers -> Headers
<> :: Headers -> Headers -> Headers
$csconcat :: NonEmpty Headers -> Headers
sconcat :: NonEmpty Headers -> Headers
$cstimes :: forall b. Integral b => b -> Headers -> Headers
stimes :: forall b. Integral b => b -> Headers -> Headers
Semigroup, Semigroup Headers
Headers
Semigroup Headers =>
Headers
-> (Headers -> Headers -> Headers)
-> ([Headers] -> Headers)
-> Monoid Headers
[Headers] -> Headers
Headers -> Headers -> Headers
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Headers
mempty :: Headers
$cmappend :: Headers -> Headers -> Headers
mappend :: Headers -> Headers -> Headers
$cmconcat :: [Headers] -> Headers
mconcat :: [Headers] -> Headers
Monoid)
data LookupException
= Duplicate
| Missing
deriving (LookupException -> LookupException -> Bool
(LookupException -> LookupException -> Bool)
-> (LookupException -> LookupException -> Bool)
-> Eq LookupException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LookupException -> LookupException -> Bool
== :: LookupException -> LookupException -> Bool
$c/= :: LookupException -> LookupException -> Bool
/= :: LookupException -> LookupException -> Bool
Eq, Int -> LookupException -> ShowS
[LookupException] -> ShowS
LookupException -> String
(Int -> LookupException -> ShowS)
-> (LookupException -> String)
-> ([LookupException] -> ShowS)
-> Show LookupException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LookupException -> ShowS
showsPrec :: Int -> LookupException -> ShowS
$cshow :: LookupException -> String
show :: LookupException -> String
$cshowList :: [LookupException] -> ShowS
showList :: [LookupException] -> ShowS
Show)
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 (SmallArray Header -> Int -> Header -> SmallArray Header
forall b.
Element SmallArray b =>
SmallArray b -> Int -> b -> SmallArray b
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 (SmallArray Header -> Int -> Header -> SmallArray Header
forall b.
Element SmallArray b =>
SmallArray b -> Int -> b -> SmallArray b
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b -> arr b
C.insertAt SmallArray Header
hdrs (SmallArray Header -> Int
forall a. SmallArray a -> Int
PM.sizeofSmallArray SmallArray Header
hdrs) Header
hdr)
fromList :: [Header] -> Headers
fromList :: [Header] -> Headers
fromList = SmallArray Header -> Headers
Headers (SmallArray Header -> Headers)
-> ([Header] -> SmallArray Header) -> [Header] -> Headers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (SmallArray Header)] -> SmallArray Header
[Header] -> SmallArray Header
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) =
(Header -> Bool) -> SmallArray Header -> Maybe Header
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\Header {Text
name :: Text
name :: Header -> 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 -> LookupException -> Either LookupException Header
forall a b. a -> Either a b
Left LookupException
Missing
Just Header
hdr ->
let count :: Int
count =
(Int -> Header -> Int) -> Int -> SmallArray Header -> Int
forall b a. (b -> a -> b) -> b -> SmallArray a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
( \Int
acc Header {Text
name :: Header -> Text
name :: Text
name} ->
if Text -> Text -> Bool
caseInsensitiveEq Text
needle Text
name
then Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
else Int
acc
)
(Int
0 :: Int)
SmallArray Header
xs
in if Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then LookupException -> Either LookupException Header
forall a b. a -> Either a b
Left LookupException
Duplicate else Header -> Either LookupException Header
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) =
(Header -> Bool) -> SmallArray Header -> SmallArray Header
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
(a -> Bool) -> arr a -> arr a
C.filter (\Header {Text
name :: Header -> Text
name :: 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 Text -> Text -> Bool
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"
lookupLocation :: Headers -> Either LookupException Header
lookupLocation :: Headers -> Either LookupException Header
lookupLocation = Text -> Headers -> Either LookupException Header
lookup Text
"location"
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 =
Maybe Header -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> Headers -> Maybe Header
lookupFirst Text
"content-length" Headers
hdrs)
Bool -> Bool -> Bool
&& Maybe Header -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> Headers -> Maybe Header
lookupFirst Text
"transfer-encoding" Headers
hdrs)