{-# language LambdaCase #-}
module Http.Header
( Header(..)
, decodeMany
, parser
, parserSmallArray
, builder
, builderSmallArray
) where
import Control.Monad (when)
import Data.Bytes (Bytes)
import Data.Bytes.Parser (Parser)
import Data.Bytes.Types (Bytes(Bytes))
import Data.Primitive (SmallArray,SmallMutableArray,ByteArray(ByteArray))
import Data.Word (Word8,Word16)
import Data.Text (Text)
import Data.Bytes.Builder (Builder)
import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Text.Utf8 as Utf8
import qualified Data.Bytes.Builder as Builder
import qualified Data.Text.Internal as Text
import qualified Data.Text.Array
import qualified Data.Bytes.Parser as Parser
import qualified Data.Bytes.Parser.Latin as Latin
import qualified Data.Primitive as PM
data =
{ Header -> Text
name :: {-# UNPACK #-} !Text
, Header -> Text
value :: {-# UNPACK #-} !Text
} deriving (Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show)
uninitializedHeader :: Header
{-# noinline uninitializedHeader #-}
= forall a. String -> a
errorWithoutStackTrace String
"parserHeaders: uninitialized header"
decodeMany :: Int -> Bytes -> Maybe (SmallArray Header)
decodeMany :: Int -> Bytes -> Maybe (SmallArray Header)
decodeMany !Int
n !Bytes
b = forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
Parser.parseBytesMaybe (forall s. Int -> Parser () s (SmallArray Header)
parserSmallArray Int
n forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s. e -> Parser e s ()
Parser.endOfInput ()) Bytes
b
parserSmallArray ::
Int
-> Parser () s (SmallArray Header)
parserSmallArray :: forall s. Int -> Parser () s (SmallArray Header)
parserSmallArray !Int
n = do
SmallMutableArray s Header
dst <- forall s a e. ST s a -> Parser e s a
Parser.effect (forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
PM.newSmallArray Int
n Header
uninitializedHeader)
forall s.
Int
-> Int
-> SmallMutableArray s Header
-> Parser () s (SmallArray Header)
parserHeaderStep Int
0 Int
n SmallMutableArray s Header
dst
parserHeaderStep ::
Int
-> Int
-> SmallMutableArray s Header
-> Parser () s (SmallArray Header)
!Int
ix !Int
n !SmallMutableArray s Header
dst = forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (forall a. Eq a => a -> a -> Bool
== Char
'\r') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'\n'
forall s a e. ST s a -> Parser e s a
Parser.effect forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m ()
PM.shrinkSmallMutableArray SmallMutableArray s Header
dst Int
ix
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
PM.unsafeFreezeSmallArray SmallMutableArray s Header
dst
Bool
False -> if Int
n forall a. Ord a => a -> a -> Bool
> Int
0
then do
Header
header <- forall s. Parser () s Header
parser
forall s a e. ST s a -> Parser e s a
Parser.effect (forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
PM.writeSmallArray SmallMutableArray s Header
dst Int
ix Header
header)
forall s.
Int
-> Int
-> SmallMutableArray s Header
-> Parser () s (SmallArray Header)
parserHeaderStep (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (Int
n forall a. Num a => a -> a -> a
- Int
1) SmallMutableArray s Header
dst
else forall e s a. e -> Parser e s a
Parser.fail ()
parser :: Parser () s Header
parser :: forall s. Parser () s Header
parser = do
!Bytes
name <- forall e s. (Word8 -> Bool) -> Parser e s Bytes
Parser.takeWhile forall a b. (a -> b) -> a -> b
$ \Word8
c ->
(Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
0x41 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
0x5A)
Bool -> Bool -> Bool
||
(Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
0x61 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
0x7A)
Bool -> Bool -> Bool
||
(Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
0x30 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
0x39)
Bool -> Bool -> Bool
||
Word8
c forall a. Eq a => a -> a -> Bool
== Word8
0x2D
Bool -> Bool -> Bool
||
Word8
c forall a. Eq a => a -> a -> Bool
== Word8
0x5F
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
forall e s. (Char -> Bool) -> Parser e s ()
Latin.skipWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t')
Bytes
value0 <- forall e s. (Word8 -> Bool) -> Parser e s Bytes
Parser.takeWhile forall a b. (a -> b) -> a -> b
$ \Word8
c ->
(Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
0x20 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
0x7e)
Bool -> Bool -> Bool
||
(Word8
c forall a. Eq a => a -> a -> Bool
== Word8
0x09)
forall e s. e -> Char -> Char -> Parser e s ()
Latin.char2 () Char
'\r' Char
'\n'
let !value :: Bytes
value = (Word8 -> Bool) -> Bytes -> Bytes
Bytes.dropWhileEnd (\Word8
c -> Word8
c forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
c forall a. Eq a => a -> a -> Bool
== Word8
0x09) Bytes
value0
forall (f :: * -> *) a. Applicative f => a -> f a
pure Header{name :: Text
name=Bytes -> Text
unsafeBytesToText Bytes
name,value :: Text
value=Bytes -> Text
unsafeBytesToText Bytes
value}
unsafeBytesToText :: Bytes -> Text
{-# inline unsafeBytesToText #-}
unsafeBytesToText :: Bytes -> Text
unsafeBytesToText (Bytes (ByteArray ByteArray#
arr) Int
off Int
len) =
Array -> Int -> Int -> Text
Text.Text (ByteArray# -> Array
Data.Text.Array.ByteArray ByteArray#
arr) Int
off Int
len
builder :: Header -> Builder
builder :: Header -> Builder
builder Header{Text
name :: Text
name :: Header -> Text
name,Text
value :: Text
value :: Header -> Text
value} =
Bytes -> Builder
Builder.copy (Text -> Bytes
Utf8.fromText Text
name)
forall a. Semigroup a => a -> a -> a
<>
Char -> Char -> Builder
Builder.ascii2 Char
':' Char
' '
forall a. Semigroup a => a -> a -> a
<>
Bytes -> Builder
Builder.copy (Text -> Bytes
Utf8.fromText Text
value)
forall a. Semigroup a => a -> a -> a
<>
Char -> Char -> Builder
Builder.ascii2 Char
'\r' Char
'\n'
builderSmallArray :: SmallArray Header -> Builder
builderSmallArray :: SmallArray Header -> Builder
builderSmallArray = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Header -> Builder
builder