{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Web.Internal.FormUrlEncoded where
import Control.Applicative (Const(Const))
import Control.Arrow ((***))
import Control.Monad ((<=<))
import Data.ByteString.Builder (shortByteString, toLazyByteString)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSL8
import Data.Coerce (coerce)
import qualified Data.Foldable as F
import Data.Functor.Identity (Identity(Identity))
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Int (Int16, Int32, Int64, Int8)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.List (intersperse, sortBy)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid (All (..), Any (..), Dual (..),
Product (..), Sum (..))
import Data.Ord (comparing)
import Data.Proxy (Proxy (..))
import Data.Semigroup (Semigroup (..))
import qualified Data.Semigroup as Semi
import Data.Tagged (Tagged (..))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.Lazy as Lazy
import Data.Time.Compat (Day, LocalTime, NominalDiffTime,
UTCTime, ZonedTime)
import Data.Time.Calendar.Month.Compat (Month)
import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
import Data.Void (Void)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Exts (Constraint, IsList (..))
import GHC.Generics
import GHC.TypeLits
import Network.HTTP.Types.URI (urlDecode, urlEncodeBuilder)
import Numeric.Natural (Natural)
import Web.Internal.HttpApiData
class ToFormKey k where
toFormKey :: k -> Text
instance ToFormKey () where toFormKey :: () -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Char where toFormKey :: Char -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Bool where toFormKey :: Bool -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Ordering where toFormKey :: Ordering -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Double where toFormKey :: Double -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Float where toFormKey :: Float -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Int where toFormKey :: Int -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Int8 where toFormKey :: Int8 -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Int16 where toFormKey :: Int16 -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Int32 where toFormKey :: Int32 -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Int64 where toFormKey :: Int64 -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Integer where toFormKey :: Integer -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Word where toFormKey :: Word -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Word8 where toFormKey :: Word8 -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Word16 where toFormKey :: Word16 -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Word32 where toFormKey :: Word32 -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Word64 where toFormKey :: Word64 -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Day where toFormKey :: Day -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey LocalTime where toFormKey :: LocalTime -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey ZonedTime where toFormKey :: ZonedTime -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey UTCTime where toFormKey :: UTCTime -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey NominalDiffTime where toFormKey :: NominalDiffTime -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Quarter where toFormKey :: Quarter -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey QuarterOfYear where toFormKey :: QuarterOfYear -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Month where toFormKey :: Month -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey String where toFormKey :: String -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Text where toFormKey :: Text -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Lazy.Text where toFormKey :: Text -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey All where toFormKey :: All -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Any where toFormKey :: Any -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey a => ToFormKey (Dual a) where toFormKey :: Dual a -> Text
toFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. ToFormKey k => k -> Text
toFormKey :: a -> Text)
instance ToFormKey a => ToFormKey (Sum a) where toFormKey :: Sum a -> Text
toFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. ToFormKey k => k -> Text
toFormKey :: a -> Text)
instance ToFormKey a => ToFormKey (Product a) where toFormKey :: Product a -> Text
toFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. ToFormKey k => k -> Text
toFormKey :: a -> Text)
instance ToFormKey a => ToFormKey (Semi.Min a) where toFormKey :: Min a -> Text
toFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. ToFormKey k => k -> Text
toFormKey :: a -> Text)
instance ToFormKey a => ToFormKey (Semi.Max a) where toFormKey :: Max a -> Text
toFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. ToFormKey k => k -> Text
toFormKey :: a -> Text)
instance ToFormKey a => ToFormKey (Semi.First a) where toFormKey :: First a -> Text
toFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. ToFormKey k => k -> Text
toFormKey :: a -> Text)
instance ToFormKey a => ToFormKey (Semi.Last a) where toFormKey :: Last a -> Text
toFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. ToFormKey k => k -> Text
toFormKey :: a -> Text)
instance ToFormKey a => ToFormKey (Tagged b a) where toFormKey :: Tagged b a -> Text
toFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. ToFormKey k => k -> Text
toFormKey :: a -> Text)
instance ToFormKey a => ToFormKey (Identity a) where toFormKey :: Identity a -> Text
toFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. ToFormKey k => k -> Text
toFormKey :: a -> Text)
instance ToFormKey a => ToFormKey (Const a b) where
toFormKey :: Const a b -> Text
toFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. ToFormKey k => k -> Text
toFormKey :: a -> Text)
instance ToFormKey Void where toFormKey :: Void -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
instance ToFormKey Natural where toFormKey :: Natural -> Text
toFormKey = forall a. ToHttpApiData a => a -> Text
toQueryParam
class FromFormKey k where
parseFormKey :: Text -> Either Text k
instance FromFormKey () where parseFormKey :: Text -> Either Text ()
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Char where parseFormKey :: Text -> Either Text Char
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Bool where parseFormKey :: Text -> Either Text Bool
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Ordering where parseFormKey :: Text -> Either Text Ordering
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Double where parseFormKey :: Text -> Either Text Double
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Float where parseFormKey :: Text -> Either Text Float
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Int where parseFormKey :: Text -> Either Text Int
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Int8 where parseFormKey :: Text -> Either Text Int8
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Int16 where parseFormKey :: Text -> Either Text Int16
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Int32 where parseFormKey :: Text -> Either Text Int32
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Int64 where parseFormKey :: Text -> Either Text Int64
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Integer where parseFormKey :: Text -> Either Text Integer
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Word where parseFormKey :: Text -> Either Text Word
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Word8 where parseFormKey :: Text -> Either Text Word8
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Word16 where parseFormKey :: Text -> Either Text Word16
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Word32 where parseFormKey :: Text -> Either Text Word32
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Word64 where parseFormKey :: Text -> Either Text Word64
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Day where parseFormKey :: Text -> Either Text Day
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey LocalTime where parseFormKey :: Text -> Either Text LocalTime
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey ZonedTime where parseFormKey :: Text -> Either Text ZonedTime
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey UTCTime where parseFormKey :: Text -> Either Text UTCTime
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey NominalDiffTime where parseFormKey :: Text -> Either Text NominalDiffTime
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Quarter where parseFormKey :: Text -> Either Text Quarter
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey QuarterOfYear where parseFormKey :: Text -> Either Text QuarterOfYear
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Month where parseFormKey :: Text -> Either Text Month
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey String where parseFormKey :: Text -> Either Text String
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Text where parseFormKey :: Text -> Either Text Text
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Lazy.Text where parseFormKey :: Text -> Either Text Text
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey All where parseFormKey :: Text -> Either Text All
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Any where parseFormKey :: Text -> Either Text Any
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey a => FromFormKey (Dual a) where parseFormKey :: Text -> Either Text (Dual a)
parseFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. FromFormKey k => Text -> Either Text k
parseFormKey :: Text -> Either Text a)
instance FromFormKey a => FromFormKey (Sum a) where parseFormKey :: Text -> Either Text (Sum a)
parseFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. FromFormKey k => Text -> Either Text k
parseFormKey :: Text -> Either Text a)
instance FromFormKey a => FromFormKey (Product a) where parseFormKey :: Text -> Either Text (Product a)
parseFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. FromFormKey k => Text -> Either Text k
parseFormKey :: Text -> Either Text a)
instance FromFormKey a => FromFormKey (Semi.Min a) where parseFormKey :: Text -> Either Text (Min a)
parseFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. FromFormKey k => Text -> Either Text k
parseFormKey :: Text -> Either Text a)
instance FromFormKey a => FromFormKey (Semi.Max a) where parseFormKey :: Text -> Either Text (Max a)
parseFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. FromFormKey k => Text -> Either Text k
parseFormKey :: Text -> Either Text a)
instance FromFormKey a => FromFormKey (Semi.First a) where parseFormKey :: Text -> Either Text (First a)
parseFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. FromFormKey k => Text -> Either Text k
parseFormKey :: Text -> Either Text a)
instance FromFormKey a => FromFormKey (Semi.Last a) where parseFormKey :: Text -> Either Text (Last a)
parseFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. FromFormKey k => Text -> Either Text k
parseFormKey :: Text -> Either Text a)
instance FromFormKey a => FromFormKey (Tagged b a) where parseFormKey :: Text -> Either Text (Tagged b a)
parseFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. FromFormKey k => Text -> Either Text k
parseFormKey :: Text -> Either Text a)
instance FromFormKey a => FromFormKey (Identity a) where parseFormKey :: Text -> Either Text (Identity a)
parseFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. FromFormKey k => Text -> Either Text k
parseFormKey :: Text -> Either Text a)
instance FromFormKey a => FromFormKey (Const a b) where
parseFormKey :: Text -> Either Text (Const a b)
parseFormKey = coerce :: forall a b. Coercible a b => a -> b
coerce (forall k. FromFormKey k => Text -> Either Text k
parseFormKey :: Text -> Either Text a)
instance FromFormKey Void where parseFormKey :: Text -> Either Text Void
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
instance FromFormKey Natural where parseFormKey :: Text -> Either Text Natural
parseFormKey = forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
newtype Form = Form { Form -> HashMap Text [Text]
unForm :: HashMap Text [Text] }
deriving (Form -> Form -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Form -> Form -> Bool
$c/= :: Form -> Form -> Bool
== :: Form -> Form -> Bool
$c== :: Form -> Form -> Bool
Eq, ReadPrec [Form]
ReadPrec Form
Int -> ReadS Form
ReadS [Form]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Form]
$creadListPrec :: ReadPrec [Form]
readPrec :: ReadPrec Form
$creadPrec :: ReadPrec Form
readList :: ReadS [Form]
$creadList :: ReadS [Form]
readsPrec :: Int -> ReadS Form
$creadsPrec :: Int -> ReadS Form
Read, forall x. Rep Form x -> Form
forall x. Form -> Rep Form x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Form x -> Form
$cfrom :: forall x. Form -> Rep Form x
Generic, NonEmpty Form -> Form
Form -> Form -> Form
forall b. Integral b => b -> Form -> Form
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Form -> Form
$cstimes :: forall b. Integral b => b -> Form -> Form
sconcat :: NonEmpty Form -> Form
$csconcat :: NonEmpty Form -> Form
<> :: Form -> Form -> Form
$c<> :: Form -> Form -> Form
Semigroup, Semigroup Form
Form
[Form] -> Form
Form -> Form -> Form
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Form] -> Form
$cmconcat :: [Form] -> Form
mappend :: Form -> Form -> Form
$cmappend :: Form -> Form -> Form
mempty :: Form
$cmempty :: Form
Monoid)
instance Show Form where
showsPrec :: Int -> Form -> ShowS
showsPrec Int
d Form
form = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (Form -> [(Text, Text)]
toListStable Form
form)
instance IsList Form where
type Item Form = (Text, Text)
fromList :: [Item Form] -> Form
fromList = HashMap Text [Text] -> Form
Form forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Semigroup a => a -> a -> a
(<>)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
k, Text
v) -> (Text
k, [Text
v]))
toList :: Form -> [Item Form]
toList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Text
k, [Text]
vs) -> forall a b. (a -> b) -> [a] -> [b]
map ((,) Text
k) [Text]
vs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HashMap.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> HashMap Text [Text]
unForm
toListStable :: Form -> [(Text, Text)]
toListStable :: Form -> [(Text, Text)]
toListStable = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
class ToForm a where
toForm :: a -> Form
default toForm :: (Generic a, GToForm a (Rep a)) => a -> Form
toForm = forall a.
(Generic a, GToForm a (Rep a)) =>
FormOptions -> a -> Form
genericToForm FormOptions
defaultFormOptions
instance ToForm Form where toForm :: Form -> Form
toForm = forall a. a -> a
id
instance (ToFormKey k, ToHttpApiData v) => ToForm [(k, v)] where
toForm :: [(k, v)] -> Form
toForm = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall k. ToFormKey k => k -> Text
toFormKey forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. ToHttpApiData a => a -> Text
toQueryParam)
instance (ToFormKey k, ToHttpApiData v) => ToForm (Map k [v]) where
toForm :: Map k [v] -> Form
toForm = forall k v. (ToFormKey k, ToHttpApiData v) => [(k, [v])] -> Form
fromEntriesByKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList
instance (ToFormKey k, ToHttpApiData v) => ToForm (HashMap k [v]) where
toForm :: HashMap k [v] -> Form
toForm = forall k v. (ToFormKey k, ToHttpApiData v) => [(k, [v])] -> Form
fromEntriesByKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HashMap.toList
instance ToHttpApiData v => ToForm (IntMap [v]) where
toForm :: IntMap [v] -> Form
toForm = forall k v. (ToFormKey k, ToHttpApiData v) => [(k, [v])] -> Form
fromEntriesByKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IntMap.toList
fromEntriesByKey :: (ToFormKey k, ToHttpApiData v) => [(k, [v])] -> Form
fromEntriesByKey :: forall k v. (ToFormKey k, ToHttpApiData v) => [(k, [v])] -> Form
fromEntriesByKey = HashMap Text [Text] -> Form
Form forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall k. ToFormKey k => k -> Text
toFormKey forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b. (a -> b) -> [a] -> [b]
map forall a. ToHttpApiData a => a -> Text
toQueryParam)
data Proxy3 a b c = Proxy3
type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where
NotSupported cls a reason = TypeError
( 'Text "Cannot derive a Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instance for " ':<>: 'ShowType a ':<>: 'Text "." ':$$:
'ShowType a ':<>: 'Text " " ':<>: 'Text reason ':<>: 'Text "," ':$$:
'Text "but Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instances can be derived only for records" ':$$:
'Text "(i.e. product types with named fields)." )
genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
genericToForm :: forall a.
(Generic a, GToForm a (Rep a)) =>
FormOptions -> a -> Form
genericToForm FormOptions
opts = forall {k} (t :: k) (f :: * -> *) x.
GToForm t f =>
Proxy t -> FormOptions -> f x -> Form
gToForm (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) FormOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from
class GToForm t (f :: * -> *) where
gToForm :: Proxy t -> FormOptions -> f x -> Form
instance (GToForm t f, GToForm t g) => GToForm t (f :*: g) where
gToForm :: forall x. Proxy t -> FormOptions -> (:*:) f g x -> Form
gToForm Proxy t
p FormOptions
opts (f x
a :*: g x
b) = forall {k} (t :: k) (f :: * -> *) x.
GToForm t f =>
Proxy t -> FormOptions -> f x -> Form
gToForm Proxy t
p FormOptions
opts f x
a forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k) (f :: * -> *) x.
GToForm t f =>
Proxy t -> FormOptions -> f x -> Form
gToForm Proxy t
p FormOptions
opts g x
b
instance (GToForm t f) => GToForm t (M1 D x f) where
gToForm :: forall x. Proxy t -> FormOptions -> M1 D x f x -> Form
gToForm Proxy t
p FormOptions
opts (M1 f x
a) = forall {k} (t :: k) (f :: * -> *) x.
GToForm t f =>
Proxy t -> FormOptions -> f x -> Form
gToForm Proxy t
p FormOptions
opts f x
a
instance (GToForm t f) => GToForm t (M1 C x f) where
gToForm :: forall x. Proxy t -> FormOptions -> M1 C x f x -> Form
gToForm Proxy t
p FormOptions
opts (M1 f x
a) = forall {k} (t :: k) (f :: * -> *) x.
GToForm t f =>
Proxy t -> FormOptions -> f x -> Form
gToForm Proxy t
p FormOptions
opts f x
a
instance {-# OVERLAPPABLE #-} (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where
gToForm :: forall x. Proxy t -> FormOptions -> M1 S s (K1 i c) x -> Form
gToForm Proxy t
_ FormOptions
opts (M1 (K1 c
c)) = forall l. IsList l => [Item l] -> l
fromList [(Text
key, forall a. ToHttpApiData a => a -> Text
toQueryParam c
c)]
where
key :: Text
key = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ FormOptions -> ShowS
fieldLabelModifier FormOptions
opts forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall {k} {k} {k} (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 s g p)
instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i (Maybe c))) where
gToForm :: forall x.
Proxy t -> FormOptions -> M1 S s (K1 i (Maybe c)) x -> Form
gToForm Proxy t
_ FormOptions
opts (M1 (K1 Maybe c
c)) =
case Maybe c
c of
Maybe c
Nothing -> forall a. Monoid a => a
mempty
Just c
x -> forall l. IsList l => [Item l] -> l
fromList [(Text
key, forall a. ToHttpApiData a => a -> Text
toQueryParam c
x)]
where
key :: Text
key = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ FormOptions -> ShowS
fieldLabelModifier FormOptions
opts forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall {k} {k} {k} (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 s g p)
instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i [c])) where
gToForm :: forall x. Proxy t -> FormOptions -> M1 S s (K1 i [c]) x -> Form
gToForm Proxy t
_ FormOptions
opts (M1 (K1 [c]
cs)) = forall l. IsList l => [Item l] -> l
fromList (forall a b. (a -> b) -> [a] -> [b]
map (\c
c -> (Text
key, forall a. ToHttpApiData a => a -> Text
toQueryParam c
c)) [c]
cs)
where
key :: Text
key = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ FormOptions -> ShowS
fieldLabelModifier FormOptions
opts forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall {k} {k} {k} (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 s g p)
instance {-# OVERLAPPING #-} (Selector s) => GToForm t (M1 S s (K1 i String)) where
gToForm :: forall x. Proxy t -> FormOptions -> M1 S s (K1 i String) x -> Form
gToForm Proxy t
_ FormOptions
opts (M1 (K1 String
c)) = forall l. IsList l => [Item l] -> l
fromList [(Text
key, forall a. ToHttpApiData a => a -> Text
toQueryParam String
c)]
where
key :: Text
key = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ FormOptions -> ShowS
fieldLabelModifier FormOptions
opts forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall {k} {k} {k} (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 s g p)
instance NotSupported ToForm t "is a sum type" => GToForm t (f :+: g) where gToForm :: forall x. Proxy t -> FormOptions -> (:+:) f g x -> Form
gToForm = forall a. HasCallStack => String -> a
error String
"impossible"
class FromForm a where
fromForm :: Form -> Either Text a
default fromForm :: (Generic a, GFromForm a (Rep a)) => Form -> Either Text a
fromForm = forall a.
(Generic a, GFromForm a (Rep a)) =>
FormOptions -> Form -> Either Text a
genericFromForm FormOptions
defaultFormOptions
instance FromForm Form where fromForm :: Form -> Either Text Form
fromForm = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
fromForm :: Form -> Either Text [(k, v)]
fromForm = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(k
k, [v]
vs) -> forall a b. (a -> b) -> [a] -> [b]
map ((,) k
k) [v]
vs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(FromFormKey k, FromHttpApiData v) =>
Form -> Either Text [(k, [v])]
toEntriesByKey
instance (Ord k, FromFormKey k, FromHttpApiData v) => FromForm (Map k [v]) where
fromForm :: Form -> Either Text (Map k [v])
fromForm = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(FromFormKey k, FromHttpApiData v) =>
Form -> Either Text [(k, [v])]
toEntriesByKey
instance (Eq k, Hashable k, FromFormKey k, FromHttpApiData v) => FromForm (HashMap k [v]) where
fromForm :: Form -> Either Text (HashMap k [v])
fromForm = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith forall a. Semigroup a => a -> a -> a
(<>)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(FromFormKey k, FromHttpApiData v) =>
Form -> Either Text [(k, [v])]
toEntriesByKey
instance FromHttpApiData v => FromForm (IntMap [v]) where
fromForm :: Form -> Either Text (IntMap [v])
fromForm = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith forall a. Semigroup a => a -> a -> a
(<>)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(FromFormKey k, FromHttpApiData v) =>
Form -> Either Text [(k, [v])]
toEntriesByKey
toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
toEntriesByKey :: forall k v.
(FromFormKey k, FromHttpApiData v) =>
Form -> Either Text [(k, [v])]
toEntriesByKey = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {a} {t :: * -> *} {b}.
(FromFormKey a, Traversable t, FromHttpApiData b) =>
(Text, t Text) -> Either Text (a, t b)
parseGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HashMap.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> HashMap Text [Text]
unForm
where
parseGroup :: (Text, t Text) -> Either Text (a, t b)
parseGroup (Text
k, t Text
vs) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k. FromFormKey k => Text -> Either Text k
parseFormKey Text
k forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam t Text
vs
toEntriesByKeyStable :: (Ord k, FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
toEntriesByKeyStable :: forall k v.
(Ord k, FromFormKey k, FromHttpApiData v) =>
Form -> Either Text [(k, [v])]
toEntriesByKeyStable = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(FromFormKey k, FromHttpApiData v) =>
Form -> Either Text [(k, [v])]
toEntriesByKey
genericFromForm :: forall a. (Generic a, GFromForm a (Rep a)) => FormOptions -> Form -> Either Text a
genericFromForm :: forall a.
(Generic a, GFromForm a (Rep a)) =>
FormOptions -> Form -> Either Text a
genericFromForm FormOptions
opts Form
f = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (t :: k) (f :: * -> *) x.
GFromForm t f =>
Proxy t -> FormOptions -> Form -> Either Text (f x)
gFromForm (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) FormOptions
opts Form
f
class GFromForm t (f :: * -> *) where
gFromForm :: Proxy t -> FormOptions -> Form -> Either Text (f x)
instance (GFromForm t f, GFromForm t g) => GFromForm t (f :*: g) where
gFromForm :: forall x.
Proxy t -> FormOptions -> Form -> Either Text ((:*:) f g x)
gFromForm Proxy t
p FormOptions
opts Form
f = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (t :: k) (f :: * -> *) x.
GFromForm t f =>
Proxy t -> FormOptions -> Form -> Either Text (f x)
gFromForm Proxy t
p FormOptions
opts Form
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (t :: k) (f :: * -> *) x.
GFromForm t f =>
Proxy t -> FormOptions -> Form -> Either Text (f x)
gFromForm Proxy t
p FormOptions
opts Form
f
instance GFromForm t f => GFromForm t (M1 D x f) where
gFromForm :: forall x.
Proxy t -> FormOptions -> Form -> Either Text (M1 D x f x)
gFromForm Proxy t
p FormOptions
opts Form
f = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (t :: k) (f :: * -> *) x.
GFromForm t f =>
Proxy t -> FormOptions -> Form -> Either Text (f x)
gFromForm Proxy t
p FormOptions
opts Form
f
instance GFromForm t f => GFromForm t (M1 C x f) where
gFromForm :: forall x.
Proxy t -> FormOptions -> Form -> Either Text (M1 C x f x)
gFromForm Proxy t
p FormOptions
opts Form
f = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (t :: k) (f :: * -> *) x.
GFromForm t f =>
Proxy t -> FormOptions -> Form -> Either Text (f x)
gFromForm Proxy t
p FormOptions
opts Form
f
instance {-# OVERLAPPABLE #-} (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i c)) where
gFromForm :: forall x.
Proxy t -> FormOptions -> Form -> Either Text (M1 S s (K1 i c) x)
gFromForm Proxy t
_ FormOptions
opts Form
form = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
key Form
form
where
key :: Text
key = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ FormOptions -> ShowS
fieldLabelModifier FormOptions
opts forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall {k} {k} {k} (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 s g p)
instance (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i (Maybe c))) where
gFromForm :: forall x.
Proxy t
-> FormOptions -> Form -> Either Text (M1 S s (K1 i (Maybe c)) x)
gFromForm Proxy t
_ FormOptions
opts Form
form = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v.
FromHttpApiData v =>
Text -> Form -> Either Text (Maybe v)
parseMaybe Text
key Form
form
where
key :: Text
key = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ FormOptions -> ShowS
fieldLabelModifier FormOptions
opts forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall {k} {k} {k} (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 s g p)
instance (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i [c])) where
gFromForm :: forall x.
Proxy t -> FormOptions -> Form -> Either Text (M1 S s (K1 i [c]) x)
gFromForm Proxy t
_ FormOptions
opts Form
form = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. FromHttpApiData v => Text -> Form -> Either Text [v]
parseAll Text
key Form
form
where
key :: Text
key = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ FormOptions -> ShowS
fieldLabelModifier FormOptions
opts forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall {k} {k} {k} (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 s g p)
instance {-# OVERLAPPING #-} (Selector s) => GFromForm t (M1 S s (K1 i String)) where
gFromForm :: forall x.
Proxy t
-> FormOptions -> Form -> Either Text (M1 S s (K1 i String) x)
gFromForm Proxy t
_ FormOptions
opts Form
form = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
key Form
form
where
key :: Text
key = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ FormOptions -> ShowS
fieldLabelModifier FormOptions
opts forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall {k} {k} {k} (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 s g p)
instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where gFromForm :: forall x.
Proxy t -> FormOptions -> Form -> Either Text ((:+:) f g x)
gFromForm = forall a. HasCallStack => String -> a
error String
"impossible"
urlEncodeForm :: Form -> BSL.ByteString
urlEncodeForm :: Form -> ByteString
urlEncodeForm = [(Text, Text)] -> ByteString
urlEncodeParams forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
urlEncodeFormStable :: Form -> BSL.ByteString
urlEncodeFormStable :: Form -> ByteString
urlEncodeFormStable = [(Text, Text)] -> ByteString
urlEncodeParams forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
urlEncodeParams :: [(Text, Text)] -> BSL.ByteString
urlEncodeParams :: [(Text, Text)] -> ByteString
urlEncodeParams = Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (ShortByteString -> Builder
shortByteString ShortByteString
"&") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Builder
encodePair
where
escape :: Text -> Builder
escape = Bool -> ByteString -> Builder
urlEncodeBuilder Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
encodePair :: (Text, Text) -> Builder
encodePair (Text
k, Text
"") = Text -> Builder
escape Text
k
encodePair (Text
k, Text
v) = Text -> Builder
escape Text
k forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
shortByteString ShortByteString
"=" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
escape Text
v
urlDecodeForm :: BSL.ByteString -> Either Text Form
urlDecodeForm :: ByteString -> Either Text Form
urlDecodeForm = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToForm a => a -> Form
toForm forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text [(Text, Text)]
urlDecodeParams
urlDecodeParams :: BSL.ByteString -> Either Text [(Text, Text)]
urlDecodeParams :: ByteString -> Either Text [(Text, Text)]
urlDecodeParams ByteString
bs = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [ByteString] -> Either Text (Text, Text)
parsePair [[ByteString]]
pairs
where
pairs :: [[ByteString]]
pairs = forall a b. (a -> b) -> [a] -> [b]
map (Char -> ByteString -> [ByteString]
BSL8.split Char
'=') (Char -> ByteString -> [ByteString]
BSL8.split Char
'&' ByteString
bs)
unescape :: ByteString -> Text
unescape = OnDecodeError -> ByteString -> Text
Text.decodeUtf8With OnDecodeError
lenientDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlDecode Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
parsePair :: [ByteString] -> Either Text (Text, Text)
parsePair [ByteString]
p =
case forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
unescape [ByteString]
p of
[Text
k, Text
v] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k, Text
v)
[Text
k] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k, Text
"")
[Text]
xs -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"not a valid pair: " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"=" [Text]
xs
urlDecodeAsForm :: FromForm a => BSL.ByteString -> Either Text a
urlDecodeAsForm :: forall a. FromForm a => ByteString -> Either Text a
urlDecodeAsForm = forall a. FromForm a => Form -> Either Text a
fromForm forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Either Text Form
urlDecodeForm
urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
urlEncodeAsForm :: forall a. ToForm a => a -> ByteString
urlEncodeAsForm = Form -> ByteString
urlEncodeForm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToForm a => a -> Form
toForm
urlEncodeAsFormStable :: ToForm a => a -> BSL.ByteString
urlEncodeAsFormStable :: forall a. ToForm a => a -> ByteString
urlEncodeAsFormStable = Form -> ByteString
urlEncodeFormStable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToForm a => a -> Form
toForm
lookupAll :: Text -> Form -> [Text]
lookupAll :: Text -> Form -> [Text]
lookupAll Text
key = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
F.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> HashMap Text [Text]
unForm
lookupMaybe :: Text -> Form -> Either Text (Maybe Text)
lookupMaybe :: Text -> Form -> Either Text (Maybe Text)
lookupMaybe Text
key Form
form =
case Text -> Form -> [Text]
lookupAll Text
key Form
form of
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
[Text
v] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Text
v)
[Text]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Duplicate key " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Text
key)
lookupUnique :: Text -> Form -> Either Text Text
lookupUnique :: Text -> Form -> Either Text Text
lookupUnique Text
key Form
form = do
Maybe Text
mv <- Text -> Form -> Either Text (Maybe Text)
lookupMaybe Text
key Form
form
case Maybe Text
mv of
Just Text
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v
Maybe Text
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Could not find key " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Text
key)
parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v]
parseAll :: forall v. FromHttpApiData v => Text -> Form -> Either Text [v]
parseAll Text
key = forall (t :: * -> *) a.
(Traversable t, FromHttpApiData a) =>
t Text -> Either Text (t a)
parseQueryParams forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Form -> [Text]
lookupAll Text
key
parseMaybe :: FromHttpApiData v => Text -> Form -> Either Text (Maybe v)
parseMaybe :: forall v.
FromHttpApiData v =>
Text -> Form -> Either Text (Maybe v)
parseMaybe Text
key = forall (t :: * -> *) a.
(Traversable t, FromHttpApiData a) =>
t Text -> Either Text (t a)
parseQueryParams forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Form -> Either Text (Maybe Text)
lookupMaybe Text
key
parseUnique :: FromHttpApiData v => Text -> Form -> Either Text v
parseUnique :: forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
key Form
form = Text -> Form -> Either Text Text
lookupUnique Text
key Form
form forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam
data FormOptions = FormOptions
{
FormOptions -> ShowS
fieldLabelModifier :: String -> String
}
defaultFormOptions :: FormOptions
defaultFormOptions :: FormOptions
defaultFormOptions = FormOptions
{ fieldLabelModifier :: ShowS
fieldLabelModifier = forall a. a -> a
id
}
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn :: forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn a -> b
f = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> b
f)