{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Data.MIME.Parameter
(
Parameters(..)
, parameterList
, parameter
, rawParameter
, newParameter
, ParameterValue(..)
, EncodedParameterValue
, DecodedParameterValue
, value
, HasParameters(..)
) where
import Control.Applicative ((<|>), optional)
import Data.Foldable (fold)
import Data.Functor (($>))
import Data.Semigroup (Sum(..), Max(..))
import Data.String (IsString(..))
import Data.Word (Word8)
import Data.Void (Void)
import Foreign (withForeignPtr, plusPtr, minusPtr, peek, peekByteOff, poke)
import GHC.Generics (Generic)
import System.IO.Unsafe (unsafeDupablePerformIO)
import Control.DeepSeq (NFData)
import Control.Lens
import Control.Lens.Cons.Extras (recons)
import Data.Attoparsec.ByteString.Char8 hiding (take)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Char8 as C
import Data.CaseInsensitive (CI, foldedCase, mk, original)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.MIME.Charset
import Data.MIME.Internal
import Data.IMF.Syntax (ci, isQtext, isVchar)
type RawParameters = [(CI B.ByteString, B.ByteString)]
newtype Parameters = Parameters [(CI B.ByteString, B.ByteString)]
deriving (Parameters -> Parameters -> Bool
(Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool) -> Eq Parameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameters -> Parameters -> Bool
$c/= :: Parameters -> Parameters -> Bool
== :: Parameters -> Parameters -> Bool
$c== :: Parameters -> Parameters -> Bool
Eq, Int -> Parameters -> ShowS
[Parameters] -> ShowS
Parameters -> String
(Int -> Parameters -> ShowS)
-> (Parameters -> String)
-> ([Parameters] -> ShowS)
-> Show Parameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameters] -> ShowS
$cshowList :: [Parameters] -> ShowS
show :: Parameters -> String
$cshow :: Parameters -> String
showsPrec :: Int -> Parameters -> ShowS
$cshowsPrec :: Int -> Parameters -> ShowS
Show, (forall x. Parameters -> Rep Parameters x)
-> (forall x. Rep Parameters x -> Parameters) -> Generic Parameters
forall x. Rep Parameters x -> Parameters
forall x. Parameters -> Rep Parameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Parameters x -> Parameters
$cfrom :: forall x. Parameters -> Rep Parameters x
Generic, Parameters -> ()
(Parameters -> ()) -> NFData Parameters
forall a. (a -> ()) -> NFData a
rnf :: Parameters -> ()
$crnf :: Parameters -> ()
NFData)
instance Semigroup Parameters where
Parameters [(CI ByteString, ByteString)]
a <> :: Parameters -> Parameters -> Parameters
<> Parameters [(CI ByteString, ByteString)]
b = [(CI ByteString, ByteString)] -> Parameters
Parameters ([(CI ByteString, ByteString)]
a [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<> [(CI ByteString, ByteString)]
b)
instance Monoid Parameters where
mempty :: Parameters
mempty = [(CI ByteString, ByteString)] -> Parameters
Parameters []
type instance Index Parameters = CI B.ByteString
type instance IxValue Parameters = EncodedParameterValue
paramiso :: Iso' Parameters [(CI B.ByteString, B.ByteString)]
paramiso :: p [(CI ByteString, ByteString)] (f [(CI ByteString, ByteString)])
-> p Parameters (f Parameters)
paramiso = (Parameters -> [(CI ByteString, ByteString)])
-> ([(CI ByteString, ByteString)] -> Parameters)
-> Iso
Parameters
Parameters
[(CI ByteString, ByteString)]
[(CI ByteString, ByteString)]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Parameters [(CI ByteString, ByteString)]
raw) -> [(CI ByteString, ByteString)]
raw) [(CI ByteString, ByteString)] -> Parameters
Parameters
instance Ixed Parameters where
ix :: Index Parameters -> Traversal' Parameters (IxValue Parameters)
ix Index Parameters
k = ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters
Iso
Parameters
Parameters
[(CI ByteString, ByteString)]
[(CI ByteString, ByteString)]
paramiso (([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters)
-> ((EncodedParameterValue -> f EncodedParameterValue)
-> [(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> (EncodedParameterValue -> f EncodedParameterValue)
-> Parameters
-> f Parameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EncodedParameterValue -> f EncodedParameterValue)
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
l
where
l :: (EncodedParameterValue -> f EncodedParameterValue)
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
l EncodedParameterValue -> f EncodedParameterValue
f [(CI ByteString, ByteString)]
kv = case CI ByteString
-> [(CI ByteString, ByteString)] -> Maybe EncodedParameterValue
getParameter CI ByteString
Index Parameters
k [(CI ByteString, ByteString)]
kv of
Maybe EncodedParameterValue
Nothing -> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(CI ByteString, ByteString)]
kv
Just EncodedParameterValue
v -> (\EncodedParameterValue
v' -> CI ByteString
-> EncodedParameterValue
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
setParam CI ByteString
Index Parameters
k EncodedParameterValue
v' [(CI ByteString, ByteString)]
kv) (EncodedParameterValue -> [(CI ByteString, ByteString)])
-> f EncodedParameterValue -> f [(CI ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncodedParameterValue -> f EncodedParameterValue
f EncodedParameterValue
v
setParam :: CI B.ByteString -> EncodedParameterValue -> RawParameters -> RawParameters
setParam :: CI ByteString
-> EncodedParameterValue
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
setParam CI ByteString
k EncodedParameterValue
v = (CI ByteString
-> EncodedParameterValue -> [(CI ByteString, ByteString)]
renderParam CI ByteString
k EncodedParameterValue
v [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<>) ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)])
-> ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)])
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam CI ByteString
k
renderParam :: CI B.ByteString -> EncodedParameterValue -> [(CI B.ByteString, B.ByteString)]
renderParam :: CI ByteString
-> EncodedParameterValue -> [(CI ByteString, ByteString)]
renderParam CI ByteString
k EncodedParameterValue
pv = case EncodedParameterValue
pv of
ParameterValue Maybe (CI ByteString)
Nothing Maybe (CI ByteString)
Nothing ByteString
v -> case ParameterEncoding -> ByteString -> (ParameterEncoding, ByteString)
extEncode ParameterEncoding
forall a. Bounded a => a
minBound ByteString
v of
(ParameterEncoding
Plain, ByteString
v') -> [(CI ByteString
k, ByteString
v')]
(ParameterEncoding
Quoted, ByteString
v') -> [(CI ByteString
k, ByteString
"\"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
v' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\"")]
(ParameterEncoding
Extended, ByteString
v') -> [(CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*", ByteString
"''" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
v')]
ParameterValue Maybe (CI ByteString)
cs Maybe (CI ByteString)
lang ByteString
v ->
[(CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*", Maybe (CI ByteString) -> ByteString
f Maybe (CI ByteString)
cs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Maybe (CI ByteString) -> ByteString
f Maybe (CI ByteString)
lang ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ParameterEncoding, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (ParameterEncoding -> ByteString -> (ParameterEncoding, ByteString)
extEncode ParameterEncoding
Extended ByteString
v))]
where
f :: Maybe (CI ByteString) -> ByteString
f = ByteString
-> (CI ByteString -> ByteString)
-> Maybe (CI ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" CI ByteString -> ByteString
forall s. CI s -> s
original
deleteParam :: CI B.ByteString -> RawParameters -> RawParameters
deleteParam :: CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam CI ByteString
k = ((CI ByteString, ByteString) -> Bool)
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((CI ByteString, ByteString) -> Bool)
-> (CI ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> Bool
test (CI ByteString -> Bool)
-> ((CI ByteString, ByteString) -> CI ByteString)
-> (CI ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI ByteString, ByteString) -> CI ByteString
forall a b. (a, b) -> a
fst)
where
test :: CI ByteString -> Bool
test CI ByteString
x =
CI ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
k
Bool -> Bool -> Bool
|| (CI ByteString -> ByteString
forall s. CI s -> s
foldedCase CI ByteString
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"*") ByteString -> ByteString -> Bool
`B.isPrefixOf` CI ByteString -> ByteString
forall s. CI s -> s
foldedCase CI ByteString
x
instance At Parameters where
at :: Index Parameters -> Lens' Parameters (Maybe (IxValue Parameters))
at Index Parameters
k = ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters
Iso
Parameters
Parameters
[(CI ByteString, ByteString)]
[(CI ByteString, ByteString)]
paramiso (([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters)
-> ((Maybe EncodedParameterValue
-> f (Maybe EncodedParameterValue))
-> [(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> (Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> Parameters
-> f Parameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
Lens' [(CI ByteString, ByteString)] (Maybe EncodedParameterValue)
l
where
l :: Lens' RawParameters (Maybe EncodedParameterValue)
l :: (Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
l Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue)
f [(CI ByteString, ByteString)]
kv =
let
g :: Maybe EncodedParameterValue -> [(CI ByteString, ByteString)]
g Maybe EncodedParameterValue
Nothing = CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam CI ByteString
Index Parameters
k [(CI ByteString, ByteString)]
kv
g (Just EncodedParameterValue
v) = (CI ByteString
-> EncodedParameterValue
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
setParam CI ByteString
Index Parameters
k EncodedParameterValue
v ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)])
-> ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)])
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam CI ByteString
Index Parameters
k) [(CI ByteString, ByteString)]
kv
in
Maybe EncodedParameterValue -> [(CI ByteString, ByteString)]
g (Maybe EncodedParameterValue -> [(CI ByteString, ByteString)])
-> f (Maybe EncodedParameterValue)
-> f [(CI ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue)
f (CI ByteString
-> [(CI ByteString, ByteString)] -> Maybe EncodedParameterValue
getParameter CI ByteString
Index Parameters
k [(CI ByteString, ByteString)]
kv)
data Continued = Continued | NotContinued
deriving (Int -> Continued -> ShowS
[Continued] -> ShowS
Continued -> String
(Int -> Continued -> ShowS)
-> (Continued -> String)
-> ([Continued] -> ShowS)
-> Show Continued
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Continued] -> ShowS
$cshowList :: [Continued] -> ShowS
show :: Continued -> String
$cshow :: Continued -> String
showsPrec :: Int -> Continued -> ShowS
$cshowsPrec :: Int -> Continued -> ShowS
Show)
data Encoded = Encoded | NotEncoded
deriving (Int -> Encoded -> ShowS
[Encoded] -> ShowS
Encoded -> String
(Int -> Encoded -> ShowS)
-> (Encoded -> String) -> ([Encoded] -> ShowS) -> Show Encoded
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Encoded] -> ShowS
$cshowList :: [Encoded] -> ShowS
show :: Encoded -> String
$cshow :: Encoded -> String
showsPrec :: Int -> Encoded -> ShowS
$cshowsPrec :: Int -> Encoded -> ShowS
Show)
data InitialSection = InitialSection Continued Encoded B.ByteString
deriving (Int -> InitialSection -> ShowS
[InitialSection] -> ShowS
InitialSection -> String
(Int -> InitialSection -> ShowS)
-> (InitialSection -> String)
-> ([InitialSection] -> ShowS)
-> Show InitialSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitialSection] -> ShowS
$cshowList :: [InitialSection] -> ShowS
show :: InitialSection -> String
$cshow :: InitialSection -> String
showsPrec :: Int -> InitialSection -> ShowS
$cshowsPrec :: Int -> InitialSection -> ShowS
Show)
data OtherSection = OtherSection Encoded B.ByteString
deriving (Int -> OtherSection -> ShowS
[OtherSection] -> ShowS
OtherSection -> String
(Int -> OtherSection -> ShowS)
-> (OtherSection -> String)
-> ([OtherSection] -> ShowS)
-> Show OtherSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherSection] -> ShowS
$cshowList :: [OtherSection] -> ShowS
show :: OtherSection -> String
$cshow :: OtherSection -> String
showsPrec :: Int -> OtherSection -> ShowS
$cshowsPrec :: Int -> OtherSection -> ShowS
Show)
initialSection
:: CI B.ByteString
-> RawParameters
-> Maybe InitialSection
initialSection :: CI ByteString
-> [(CI ByteString, ByteString)] -> Maybe InitialSection
initialSection CI ByteString
k [(CI ByteString, ByteString)]
m =
Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
NotContinued Encoded
NotEncoded (ByteString -> InitialSection)
-> Maybe ByteString -> Maybe InitialSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
k [(CI ByteString, ByteString)]
m
Maybe InitialSection
-> Maybe InitialSection -> Maybe InitialSection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
Continued Encoded
NotEncoded (ByteString -> InitialSection)
-> Maybe ByteString -> Maybe InitialSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*0") [(CI ByteString, ByteString)]
m
Maybe InitialSection
-> Maybe InitialSection -> Maybe InitialSection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
NotContinued Encoded
Encoded (ByteString -> InitialSection)
-> Maybe ByteString -> Maybe InitialSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*") [(CI ByteString, ByteString)]
m
Maybe InitialSection
-> Maybe InitialSection -> Maybe InitialSection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
Continued Encoded
Encoded (ByteString -> InitialSection)
-> Maybe ByteString -> Maybe InitialSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*0*") [(CI ByteString, ByteString)]
m
otherSection
:: CI B.ByteString
-> Int
-> RawParameters
-> Maybe OtherSection
otherSection :: CI ByteString
-> Int -> [(CI ByteString, ByteString)] -> Maybe OtherSection
otherSection CI ByteString
k Int
i [(CI ByteString, ByteString)]
m =
Encoded -> ByteString -> OtherSection
OtherSection Encoded
NotEncoded (ByteString -> OtherSection)
-> Maybe ByteString -> Maybe OtherSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*" CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
i') [(CI ByteString, ByteString)]
m
Maybe OtherSection -> Maybe OtherSection -> Maybe OtherSection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Encoded -> ByteString -> OtherSection
OtherSection Encoded
Encoded (ByteString -> OtherSection)
-> Maybe ByteString -> Maybe OtherSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*" CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
i' CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*") [(CI ByteString, ByteString)]
m
where
i' :: CI ByteString
i' = ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C.pack (Int -> String
forall a. Show a => a -> String
show Int
i)
data ParameterValue cs a = ParameterValue
(Maybe cs)
(Maybe (CI B.ByteString))
a
deriving (ParameterValue cs a -> ParameterValue cs a -> Bool
(ParameterValue cs a -> ParameterValue cs a -> Bool)
-> (ParameterValue cs a -> ParameterValue cs a -> Bool)
-> Eq (ParameterValue cs a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall cs a.
(Eq cs, Eq a) =>
ParameterValue cs a -> ParameterValue cs a -> Bool
/= :: ParameterValue cs a -> ParameterValue cs a -> Bool
$c/= :: forall cs a.
(Eq cs, Eq a) =>
ParameterValue cs a -> ParameterValue cs a -> Bool
== :: ParameterValue cs a -> ParameterValue cs a -> Bool
$c== :: forall cs a.
(Eq cs, Eq a) =>
ParameterValue cs a -> ParameterValue cs a -> Bool
Eq, Int -> ParameterValue cs a -> ShowS
[ParameterValue cs a] -> ShowS
ParameterValue cs a -> String
(Int -> ParameterValue cs a -> ShowS)
-> (ParameterValue cs a -> String)
-> ([ParameterValue cs a] -> ShowS)
-> Show (ParameterValue cs a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall cs a.
(Show cs, Show a) =>
Int -> ParameterValue cs a -> ShowS
forall cs a. (Show cs, Show a) => [ParameterValue cs a] -> ShowS
forall cs a. (Show cs, Show a) => ParameterValue cs a -> String
showList :: [ParameterValue cs a] -> ShowS
$cshowList :: forall cs a. (Show cs, Show a) => [ParameterValue cs a] -> ShowS
show :: ParameterValue cs a -> String
$cshow :: forall cs a. (Show cs, Show a) => ParameterValue cs a -> String
showsPrec :: Int -> ParameterValue cs a -> ShowS
$cshowsPrec :: forall cs a.
(Show cs, Show a) =>
Int -> ParameterValue cs a -> ShowS
Show, (forall x. ParameterValue cs a -> Rep (ParameterValue cs a) x)
-> (forall x. Rep (ParameterValue cs a) x -> ParameterValue cs a)
-> Generic (ParameterValue cs a)
forall x. Rep (ParameterValue cs a) x -> ParameterValue cs a
forall x. ParameterValue cs a -> Rep (ParameterValue cs a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall cs a x. Rep (ParameterValue cs a) x -> ParameterValue cs a
forall cs a x. ParameterValue cs a -> Rep (ParameterValue cs a) x
$cto :: forall cs a x. Rep (ParameterValue cs a) x -> ParameterValue cs a
$cfrom :: forall cs a x. ParameterValue cs a -> Rep (ParameterValue cs a) x
Generic, ParameterValue cs a -> ()
(ParameterValue cs a -> ()) -> NFData (ParameterValue cs a)
forall a. (a -> ()) -> NFData a
forall cs a. (NFData cs, NFData a) => ParameterValue cs a -> ()
rnf :: ParameterValue cs a -> ()
$crnf :: forall cs a. (NFData cs, NFData a) => ParameterValue cs a -> ()
NFData)
type EncodedParameterValue = ParameterValue CharsetName B.ByteString
type DecodedParameterValue = ParameterValue Void T.Text
instance IsString DecodedParameterValue where
fromString :: String -> DecodedParameterValue
fromString = Maybe Void
-> Maybe (CI ByteString) -> Text -> DecodedParameterValue
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe Void
forall a. Maybe a
Nothing Maybe (CI ByteString)
forall a. Maybe a
Nothing (Text -> DecodedParameterValue)
-> (String -> Text) -> String -> DecodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance IsString EncodedParameterValue where
fromString :: String -> EncodedParameterValue
fromString = DecodedParameterValue -> EncodedParameterValue
forall a. HasCharset a => Decoded a -> a
charsetEncode (DecodedParameterValue -> EncodedParameterValue)
-> (String -> DecodedParameterValue)
-> String
-> EncodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DecodedParameterValue
forall a. IsString a => String -> a
fromString
value :: Lens (ParameterValue cs a) (ParameterValue cs b) a b
value :: (a -> f b) -> ParameterValue cs a -> f (ParameterValue cs b)
value a -> f b
f (ParameterValue Maybe cs
a Maybe (CI ByteString)
b a
c) = Maybe cs -> Maybe (CI ByteString) -> b -> ParameterValue cs b
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe cs
a Maybe (CI ByteString)
b (b -> ParameterValue cs b) -> f b -> f (ParameterValue cs b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
c
charset :: Lens (ParameterValue cs a) (ParameterValue cs' a) (Maybe cs) (Maybe cs')
charset :: (Maybe cs -> f (Maybe cs'))
-> ParameterValue cs a -> f (ParameterValue cs' a)
charset Maybe cs -> f (Maybe cs')
f (ParameterValue Maybe cs
a Maybe (CI ByteString)
b a
c) = (\Maybe cs'
a' -> Maybe cs' -> Maybe (CI ByteString) -> a -> ParameterValue cs' a
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe cs'
a' Maybe (CI ByteString)
b a
c) (Maybe cs' -> ParameterValue cs' a)
-> f (Maybe cs') -> f (ParameterValue cs' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe cs -> f (Maybe cs')
f Maybe cs
a
newParameter :: Cons s s Char Char => s -> EncodedParameterValue
newParameter :: s -> EncodedParameterValue
newParameter = DecodedParameterValue -> EncodedParameterValue
forall a. HasCharset a => Decoded a -> a
charsetEncode (DecodedParameterValue -> EncodedParameterValue)
-> (s -> DecodedParameterValue) -> s -> EncodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Void
-> Maybe (CI ByteString) -> Text -> DecodedParameterValue
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe Void
forall a. Maybe a
Nothing Maybe (CI ByteString)
forall a. Maybe a
Nothing (Text -> DecodedParameterValue)
-> (s -> Text) -> s -> DecodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text s Text -> s -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text s Text
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons
instance HasCharset EncodedParameterValue where
type Decoded EncodedParameterValue = DecodedParameterValue
charsetName :: (Maybe (CI ByteString) -> f (Maybe (CI ByteString)))
-> EncodedParameterValue -> f EncodedParameterValue
charsetName = (EncodedParameterValue -> Maybe (CI ByteString))
-> (Maybe (CI ByteString) -> f (Maybe (CI ByteString)))
-> EncodedParameterValue
-> f EncodedParameterValue
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((EncodedParameterValue -> Maybe (CI ByteString))
-> (Maybe (CI ByteString) -> f (Maybe (CI ByteString)))
-> EncodedParameterValue
-> f EncodedParameterValue)
-> (EncodedParameterValue -> Maybe (CI ByteString))
-> (Maybe (CI ByteString) -> f (Maybe (CI ByteString)))
-> EncodedParameterValue
-> f EncodedParameterValue
forall a b. (a -> b) -> a -> b
$ \(ParameterValue Maybe (CI ByteString)
name Maybe (CI ByteString)
_ ByteString
_) -> Maybe (CI ByteString)
name Maybe (CI ByteString)
-> Maybe (CI ByteString) -> Maybe (CI ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CI ByteString -> Maybe (CI ByteString)
forall a. a -> Maybe a
Just CI ByteString
"us-ascii"
charsetData :: (ByteString -> f ByteString)
-> EncodedParameterValue -> f EncodedParameterValue
charsetData = (ByteString -> f ByteString)
-> EncodedParameterValue -> f EncodedParameterValue
forall cs a b. Lens (ParameterValue cs a) (ParameterValue cs b) a b
value
charsetDecoded :: CharsetLookup
-> forall (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Contravariant f) =>
Optic'
p
f
EncodedParameterValue
(Either e (Decoded EncodedParameterValue))
charsetDecoded CharsetLookup
m = (EncodedParameterValue -> Either e DecodedParameterValue)
-> Optic'
p f EncodedParameterValue (Either e DecodedParameterValue)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((EncodedParameterValue -> Either e DecodedParameterValue)
-> Optic'
p f EncodedParameterValue (Either e DecodedParameterValue))
-> (EncodedParameterValue -> Either e DecodedParameterValue)
-> Optic'
p f EncodedParameterValue (Either e DecodedParameterValue)
forall a b. (a -> b) -> a -> b
$ \EncodedParameterValue
a -> (\Text
t -> (ASetter
(ParameterValue (CI ByteString) Text)
DecodedParameterValue
(Maybe (CI ByteString))
(Maybe Void)
-> Maybe Void
-> ParameterValue (CI ByteString) Text
-> DecodedParameterValue
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(ParameterValue (CI ByteString) Text)
DecodedParameterValue
(Maybe (CI ByteString))
(Maybe Void)
forall cs a cs'.
Lens
(ParameterValue cs a) (ParameterValue cs' a) (Maybe cs) (Maybe cs')
charset Maybe Void
forall a. Maybe a
Nothing (ParameterValue (CI ByteString) Text -> DecodedParameterValue)
-> (EncodedParameterValue -> ParameterValue (CI ByteString) Text)
-> EncodedParameterValue
-> DecodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
EncodedParameterValue
(ParameterValue (CI ByteString) Text)
ByteString
Text
-> Text
-> EncodedParameterValue
-> ParameterValue (CI ByteString) Text
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
EncodedParameterValue
(ParameterValue (CI ByteString) Text)
ByteString
Text
forall cs a b. Lens (ParameterValue cs a) (ParameterValue cs b) a b
value Text
t) EncodedParameterValue
a) (Text -> DecodedParameterValue)
-> Either e Text -> Either e DecodedParameterValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Either e Text) EncodedParameterValue (Either e Text)
-> EncodedParameterValue -> Either e Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CharsetLookup
-> Getting (Either e Text) EncodedParameterValue (Either e Text)
forall a e (p :: * -> * -> *) (f :: * -> *).
(HasCharset a, AsCharsetError e, Profunctor p, Contravariant f) =>
CharsetLookup -> Optic' p f a (Either e Text)
charsetText CharsetLookup
m) EncodedParameterValue
a
charsetEncode :: Decoded EncodedParameterValue -> EncodedParameterValue
charsetEncode (ParameterValue _ lang s) =
let
bs :: ByteString
bs = Text -> ByteString
T.encodeUtf8 Text
s
cs :: Maybe (CI ByteString)
cs = if (Word8 -> Bool) -> ByteString -> Bool
B.all (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80) ByteString
bs then Maybe (CI ByteString)
forall a. Maybe a
Nothing else CI ByteString -> Maybe (CI ByteString)
forall a. a -> Maybe a
Just CI ByteString
"utf-8"
in Maybe (CI ByteString)
-> Maybe (CI ByteString) -> ByteString -> EncodedParameterValue
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe (CI ByteString)
cs Maybe (CI ByteString)
lang ByteString
bs
getParameter :: CI B.ByteString -> RawParameters -> Maybe EncodedParameterValue
getParameter :: CI ByteString
-> [(CI ByteString, ByteString)] -> Maybe EncodedParameterValue
getParameter CI ByteString
k [(CI ByteString, ByteString)]
m = do
InitialSection Continued
cont Encoded
enc ByteString
s <- CI ByteString
-> [(CI ByteString, ByteString)] -> Maybe InitialSection
initialSection CI ByteString
k [(CI ByteString, ByteString)]
m
(Maybe (CI ByteString)
cs, Maybe (CI ByteString)
lang, ByteString
v0) <-
(String
-> Maybe
(Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> ((Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> Maybe
(Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Either
String (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> String
-> Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a b. a -> b -> a
const Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a. Maybe a
Nothing) (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a. a -> Maybe a
Just (Either
String (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> Maybe
(Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Either
String (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a b. (a -> b) -> a -> b
$ Parser (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> ByteString
-> Either
String (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a. Parser a -> ByteString -> Either String a
parseOnly (Encoded
-> Parser
(Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
parseInitialValue Encoded
enc) ByteString
s
let
sect0 :: OtherSection
sect0 = Encoded -> ByteString -> OtherSection
OtherSection Encoded
enc ByteString
v0
otherSects :: Int -> [OtherSection]
otherSects Int
i = [OtherSection]
-> (OtherSection -> [OtherSection])
-> Maybe OtherSection
-> [OtherSection]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (OtherSection -> [OtherSection] -> [OtherSection]
forall a. a -> [a] -> [a]
: Int -> [OtherSection]
otherSects (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (CI ByteString
-> Int -> [(CI ByteString, ByteString)] -> Maybe OtherSection
otherSection CI ByteString
k Int
i [(CI ByteString, ByteString)]
m)
sects :: [OtherSection]
sects = case Continued
cont of
Continued
NotContinued -> [OtherSection
sect0]
Continued
Continued -> OtherSection
sect0 OtherSection -> [OtherSection] -> [OtherSection]
forall a. a -> [a] -> [a]
: Int -> [OtherSection]
otherSects Int
1
Maybe (CI ByteString)
-> Maybe (CI ByteString) -> ByteString -> EncodedParameterValue
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe (CI ByteString)
cs Maybe (CI ByteString)
lang (ByteString -> EncodedParameterValue)
-> ([ByteString] -> ByteString)
-> [ByteString]
-> EncodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([ByteString] -> EncodedParameterValue)
-> Maybe [ByteString] -> Maybe EncodedParameterValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OtherSection -> Maybe ByteString)
-> [OtherSection] -> Maybe [ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse OtherSection -> Maybe ByteString
decode [OtherSection]
sects
where
parseInitialValue :: Encoded
-> Parser
(Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
parseInitialValue Encoded
NotEncoded =
(Maybe (CI ByteString)
forall a. Maybe a
Nothing, Maybe (CI ByteString)
forall a. Maybe a
Nothing, ) (ByteString
-> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Parser ByteString ByteString
-> Parser
(Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
takeByteString
parseInitialValue Encoded
Encoded =
(,,) (Maybe (CI ByteString)
-> Maybe (CI ByteString)
-> ByteString
-> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Parser ByteString (Maybe (CI ByteString))
-> Parser
ByteString
(Maybe (CI ByteString)
-> ByteString
-> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe (CI ByteString))
charsetOrLang Parser
ByteString
(Maybe (CI ByteString)
-> ByteString
-> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Parser ByteString (Maybe (CI ByteString))
-> Parser
ByteString
(ByteString
-> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe (CI ByteString))
charsetOrLang Parser
ByteString
(ByteString
-> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Parser ByteString ByteString
-> Parser
(Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
takeByteString
charsetOrLang :: Parser ByteString (Maybe (CI ByteString))
charsetOrLang = Parser ByteString (CI ByteString)
-> Parser ByteString (Maybe (CI ByteString))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString -> Parser ByteString (CI ByteString)
forall s. FoldCase s => Parser s -> Parser (CI s)
ci ((Char -> Bool) -> Parser ByteString ByteString
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\''))) Parser ByteString (Maybe (CI ByteString))
-> Parser ByteString Word8
-> Parser ByteString (Maybe (CI ByteString))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Word8
char8 Char
'\''
decode :: OtherSection -> Maybe ByteString
decode (OtherSection Encoded
enc ByteString
s) = case Encoded
enc of
Encoded
NotEncoded -> ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
Encoded
Encoded -> ByteString -> Maybe ByteString
decodePercent ByteString
s
decodePercent :: B.ByteString -> Maybe B.ByteString
decodePercent :: ByteString -> Maybe ByteString
decodePercent (B.PS ForeignPtr Word8
sfp Int
soff Int
slen) = IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe ByteString) -> Maybe ByteString)
-> IO (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
slen
Maybe Int
result <- ForeignPtr Word8 -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
ForeignPtr Word8 -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
let
slimit :: Ptr Word8
slimit = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen)
fill :: Ptr Word8 -> Ptr Word8 -> IO (Maybe Int)
fill !Ptr Word8
dp !Ptr Word8
sp
| Ptr Word8
sp Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
slimit = Maybe Int -> IO (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Ptr Word8
dp Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr)
| Bool
otherwise = do
Word8
c <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
sp
case (Word8
c :: Word8) of
Word8
37
| Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
slimit -> Maybe Int -> IO (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise -> do
Word8
c1 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
sp Int
1
Word8
c2 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
sp Int
2
IO (Maybe Int)
-> ((Word8, Word8) -> IO (Maybe Int))
-> Maybe (Word8, Word8)
-> IO (Maybe Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Maybe Int -> IO (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing)
(\(Word8
hi,Word8
lo) -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp (Word8
hi Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
16 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
lo)
Ptr Word8 -> Ptr Word8 -> IO (Maybe Int)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) )
((,) (Word8 -> Word8 -> (Word8, Word8))
-> Maybe Word8 -> Maybe (Word8 -> (Word8, Word8))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Maybe Word8
parseHex Word8
c1 Maybe (Word8 -> (Word8, Word8))
-> Maybe Word8 -> Maybe (Word8, Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> Maybe Word8
parseHex Word8
c2)
Word8
_ ->
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp Word8
c IO () -> IO (Maybe Int) -> IO (Maybe Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Ptr Word8 -> IO (Maybe Int)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Ptr Word8 -> Ptr Word8 -> IO (Maybe Int)
fill Ptr Word8
dptr (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff)
Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dfp Int
0 (Int -> ByteString) -> Maybe Int -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
result
data ParameterEncoding = Plain | Quoted | Extended
deriving (ParameterEncoding -> ParameterEncoding -> Bool
(ParameterEncoding -> ParameterEncoding -> Bool)
-> (ParameterEncoding -> ParameterEncoding -> Bool)
-> Eq ParameterEncoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterEncoding -> ParameterEncoding -> Bool
$c/= :: ParameterEncoding -> ParameterEncoding -> Bool
== :: ParameterEncoding -> ParameterEncoding -> Bool
$c== :: ParameterEncoding -> ParameterEncoding -> Bool
Eq, Eq ParameterEncoding
Eq ParameterEncoding
-> (ParameterEncoding -> ParameterEncoding -> Ordering)
-> (ParameterEncoding -> ParameterEncoding -> Bool)
-> (ParameterEncoding -> ParameterEncoding -> Bool)
-> (ParameterEncoding -> ParameterEncoding -> Bool)
-> (ParameterEncoding -> ParameterEncoding -> Bool)
-> (ParameterEncoding -> ParameterEncoding -> ParameterEncoding)
-> (ParameterEncoding -> ParameterEncoding -> ParameterEncoding)
-> Ord ParameterEncoding
ParameterEncoding -> ParameterEncoding -> Bool
ParameterEncoding -> ParameterEncoding -> Ordering
ParameterEncoding -> ParameterEncoding -> ParameterEncoding
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParameterEncoding -> ParameterEncoding -> ParameterEncoding
$cmin :: ParameterEncoding -> ParameterEncoding -> ParameterEncoding
max :: ParameterEncoding -> ParameterEncoding -> ParameterEncoding
$cmax :: ParameterEncoding -> ParameterEncoding -> ParameterEncoding
>= :: ParameterEncoding -> ParameterEncoding -> Bool
$c>= :: ParameterEncoding -> ParameterEncoding -> Bool
> :: ParameterEncoding -> ParameterEncoding -> Bool
$c> :: ParameterEncoding -> ParameterEncoding -> Bool
<= :: ParameterEncoding -> ParameterEncoding -> Bool
$c<= :: ParameterEncoding -> ParameterEncoding -> Bool
< :: ParameterEncoding -> ParameterEncoding -> Bool
$c< :: ParameterEncoding -> ParameterEncoding -> Bool
compare :: ParameterEncoding -> ParameterEncoding -> Ordering
$ccompare :: ParameterEncoding -> ParameterEncoding -> Ordering
$cp1Ord :: Eq ParameterEncoding
Ord, ParameterEncoding
ParameterEncoding -> ParameterEncoding -> Bounded ParameterEncoding
forall a. a -> a -> Bounded a
maxBound :: ParameterEncoding
$cmaxBound :: ParameterEncoding
minBound :: ParameterEncoding
$cminBound :: ParameterEncoding
Bounded)
extEncode :: ParameterEncoding -> B.ByteString -> (ParameterEncoding, B.ByteString)
extEncode :: ParameterEncoding -> ByteString -> (ParameterEncoding, ByteString)
extEncode ParameterEncoding
encReq s :: ByteString
s@(B.PS ForeignPtr Word8
sfp Int
soff Int
slen) = (ParameterEncoding
enc, ByteString
d)
where
isTspecial :: Word8 -> Bool
isTspecial = (Word8 -> ByteString -> Bool
`B.elem` ByteString
"()<>@,;:\\\"/[]?=")
isAttrChar :: Word8 -> Bool
isAttrChar Word8
c = Word8 -> Bool
forall c. IsChar c => c -> Bool
isVchar Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> ByteString -> Bool
`B.notElem` ByteString
"*'%" Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8 -> Bool
isTspecial Word8
c)
numEncChars :: Word8 -> p
numEncChars Word8
c = if Word8 -> Bool
isAttrChar Word8
c then p
1 else p
3
charEncoding :: Word8 -> ParameterEncoding
charEncoding Word8
c
| Word8 -> Bool
isAttrChar Word8
c = ParameterEncoding
Plain
| Word8 -> Bool
forall c. IsChar c => c -> Bool
isVchar Word8
c Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09 = ParameterEncoding
Quoted
| Bool
otherwise = ParameterEncoding
Extended
charInfo :: Word8 -> (Sum a, Max ParameterEncoding)
charInfo Word8
c = (a -> Sum a
forall a. a -> Sum a
Sum (Word8 -> a
forall p. Num p => Word8 -> p
numEncChars Word8
c), ParameterEncoding -> Max ParameterEncoding
forall a. a -> Max a
Max (Word8 -> ParameterEncoding
charEncoding Word8
c))
(Sum Int
dlenMax, Max ParameterEncoding
encCap) = (Word8 -> (Sum Int, Max ParameterEncoding))
-> [Word8] -> (Sum Int, Max ParameterEncoding)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> (Sum Int, Max ParameterEncoding)
forall a. Num a => Word8 -> (Sum a, Max ParameterEncoding)
charInfo ([Word8] -> (Sum Int, Max ParameterEncoding))
-> [Word8] -> (Sum Int, Max ParameterEncoding)
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
s
enc :: ParameterEncoding
enc
| ByteString -> Bool
B.null ByteString
s = ParameterEncoding
Quoted
| Bool
otherwise = Max ParameterEncoding -> ParameterEncoding
forall a. Max a -> a
getMax (ParameterEncoding -> Max ParameterEncoding
forall a. a -> Max a
Max ParameterEncoding
encReq Max ParameterEncoding
-> Max ParameterEncoding -> Max ParameterEncoding
forall a. Semigroup a => a -> a -> a
<> Max ParameterEncoding
encCap)
poke' :: Ptr Word8 -> Word8 -> IO (Ptr Word8)
poke' Ptr Word8
ptr Word8
c = case ParameterEncoding
enc of
ParameterEncoding
Plain -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
c IO () -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
ParameterEncoding
Quoted
| Word8 -> Bool
forall c. IsChar c => c -> Bool
isQtext Word8
c -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
c IO () -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
| Bool
otherwise -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
0x5c
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
c
Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
ParameterEncoding
Extended
| Word8 -> Bool
isAttrChar Word8
c -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
c IO () -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
| Bool
otherwise -> do
let (Word8
hi, Word8
lo) = Word8 -> (Word8, Word8)
hexEncode Word8
c
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
37
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
hi
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) Word8
lo
Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
d :: ByteString
d = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
dlenMax
Int
dlen <- ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
let
slimit :: Ptr Word8
slimit = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen)
fill :: Ptr Word8 -> Ptr Word8 -> IO Int
fill !Ptr Word8
sp !Ptr Word8
dp
| Ptr Word8
sp Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
slimit = Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8
dp Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr)
| Bool
otherwise = Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
sp IO Word8 -> (Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> Word8 -> IO (Ptr Word8)
poke' Ptr Word8
dp IO (Ptr Word8) -> (Ptr Word8 -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> Ptr Word8 -> IO Int
fill (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Ptr Word8 -> Ptr Word8 -> IO Int
fill Ptr Word8
sptr Ptr Word8
dptr
ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dfp Int
0 Int
dlen
class HasParameters a where
parameters :: Lens' a Parameters
instance HasParameters Parameters where
parameters :: (Parameters -> f Parameters) -> Parameters -> f Parameters
parameters = (Parameters -> f Parameters) -> Parameters -> f Parameters
forall a. a -> a
id
parameterList :: HasParameters a => Lens' a RawParameters
parameterList :: Lens' a [(CI ByteString, ByteString)]
parameterList = (Parameters -> f Parameters) -> a -> f a
forall a. HasParameters a => Lens' a Parameters
parameters ((Parameters -> f Parameters) -> a -> f a)
-> (([(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters)
-> ([(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced
parameter
:: HasParameters a
=> CI B.ByteString -> Lens' a (Maybe EncodedParameterValue)
parameter :: CI ByteString -> Lens' a (Maybe EncodedParameterValue)
parameter CI ByteString
k = (Parameters -> f Parameters) -> a -> f a
forall a. HasParameters a => Lens' a Parameters
parameters ((Parameters -> f Parameters) -> a -> f a)
-> ((Maybe EncodedParameterValue
-> f (Maybe EncodedParameterValue))
-> Parameters -> f Parameters)
-> (Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Parameters -> Lens' Parameters (Maybe (IxValue Parameters))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
Index Parameters
k
rawParameter :: HasParameters a => CI B.ByteString -> Traversal' a B.ByteString
rawParameter :: CI ByteString -> Traversal' a ByteString
rawParameter CI ByteString
k = (Parameters -> f Parameters) -> a -> f a
forall a. HasParameters a => Lens' a Parameters
parameters ((Parameters -> f Parameters) -> a -> f a)
-> ((ByteString -> f ByteString) -> Parameters -> f Parameters)
-> (ByteString -> f ByteString)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters
Iso
Parameters
Parameters
[(CI ByteString, ByteString)]
[(CI ByteString, ByteString)]
paramiso (([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters)
-> ((ByteString -> f ByteString)
-> [(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> (ByteString -> f ByteString)
-> Parameters
-> f Parameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed (((CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> [(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> ((ByteString -> f ByteString)
-> (CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> (ByteString -> f ByteString)
-> [(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI ByteString, ByteString) -> Bool)
-> Optic'
(->) f (CI ByteString, ByteString) (CI ByteString, ByteString)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((CI ByteString
k CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==) (CI ByteString -> Bool)
-> ((CI ByteString, ByteString) -> CI ByteString)
-> (CI ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI ByteString, ByteString) -> CI ByteString
forall a b. (a, b) -> a
fst) Optic'
(->) f (CI ByteString, ByteString) (CI ByteString, ByteString)
-> ((ByteString -> f ByteString)
-> (CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> (ByteString -> f ByteString)
-> (CI ByteString, ByteString)
-> f (CI ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> f ByteString)
-> (CI ByteString, ByteString) -> f (CI ByteString, ByteString)
forall s t a b. Field2 s t a b => Lens s t a b
_2