{-# 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

-- $setup
-- >>> :set -XDeriveGeneric -XOverloadedLists -XOverloadedStrings -XFlexibleContexts -XScopedTypeVariables -XTypeFamilies
-- >>> import GHC.Generics (Generic)
-- >>> import Data.Char (toLower)
-- >>> import Data.Text (Text)
-- >>> import Data.Word (Word8)
--
-- >>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic)
-- >>> instance ToForm Person
-- >>> instance FromForm Person
--
-- >>> data Post = Post { title :: String, subtitle :: Maybe String, comments :: [String]} deriving (Generic, Show)
-- >>> instance ToForm Post
-- >>> instance FromForm Post
--
-- >>> data Project = Project { projectName :: String, projectSize :: Int } deriving (Generic, Show)
-- >>> let myOptions = FormOptions { fieldLabelModifier = map toLower . drop (length ("project" :: String)) }
-- >>> instance ToForm Project where toForm = genericToForm myOptions
-- >>> instance FromForm Project where fromForm = genericFromForm myOptions

-- | Typeclass for types that can be used as keys in a 'Form'-like container (like 'Map').
class ToFormKey k where
  -- | Render a key for a 'Form'.
  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)

-- | @since 0.4.2
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)

-- | @since 0.4.2
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

-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
class FromFormKey k where
  -- | Parse a key of a 'Form'.
  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)

-- | @since 0.4.2
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)

-- | @since 0.4.2
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

-- | The contents of a form, not yet URL-encoded.
--
-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.
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)

-- | _NOTE:_ 'toList' is unstable and may result in different key order (but not values).
-- For a stable conversion use 'toListStable'.
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

-- | A stable version of 'toList'.
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

-- | Convert a value into 'Form'.
--
-- An example type and instance:
--
-- @
-- {-\# LANGUAGE OverloadedLists \#-}
--
-- data Person = Person
--   { name :: String
--   , age  :: Int }
--
-- instance 'ToForm' Person where
--   'toForm' person =
--     [ (\"name\", 'toQueryParam' (name person))
--     , (\"age\", 'toQueryParam' (age person)) ]
-- @
--
-- Instead of manually writing @'ToForm'@ instances you can
-- use a default generic implementation of @'toForm'@.
--
-- To do that, simply add @deriving 'Generic'@ clause to your datatype
-- and declare a 'ToForm' instance for your datatype without
-- giving definition for 'toForm'.
--
-- For instance, the previous example can be simplified into this:
--
-- @
-- data Person = Person
--   { name :: String
--   , age  :: Int
--   } deriving ('Generic')
--
-- instance 'ToForm' Person
-- @
--
-- The default implementation of 'toForm' is 'genericToForm'.
class ToForm a where
  -- | Convert a value into 'Form'.
  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

-- | Convert a list of entries groupped by key into a 'Form'.
--
-- >>> fromEntriesByKey [("name",["Nick"]),("color",["red","blue"])]
-- fromList [("color","red"),("color","blue"),("name","Nick")]
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)." )

-- | A 'Generic'-based implementation of 'toForm'.
-- This is used as a default implementation in 'ToForm'.
--
-- Note that this only works for records (i.e. product data types with named fields):
--
-- @
-- data Person = Person
--   { name :: String
--   , age  :: Int
--   } deriving ('Generic')
-- @
--
-- In this implementation each field's value gets encoded using `toQueryParam`.
-- Two field types are exceptions:
--
--    - for values of type @'Maybe' a@ an entry is added to the 'Form' only when it is @'Just' x@
--      and the encoded value is @'toQueryParam' x@; 'Nothing' values are omitted from the 'Form';
--
--    - for values of type @[a]@ (except @['Char']@) an entry is added for every item in the list;
--      if the list is empty no entries are added to the 'Form';
--
-- Here's an example:
--
-- @
-- data Post = Post
--   { title    :: String
--   , subtitle :: Maybe String
--   , comments :: [String]
--   } deriving ('Generic', 'Show')
--
-- instance 'ToForm' Post
-- @
--
-- >>> urlEncodeAsFormStable Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }
-- "comments=Nice%20post%21&comments=%2B1&title=Test"
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"

-- | Parse 'Form' into a value.
--
-- An example type and instance:
--
-- @
-- data Person = Person
--   { name :: String
--   , age  :: Int }
--
-- instance 'FromForm' Person where
--   'fromForm' f = Person
--     '<$>' 'parseUnique' "name" f
--     '<*>' 'parseUnique' "age"  f
-- @
--
-- Instead of manually writing @'FromForm'@ instances you can
-- use a default generic implementation of @'fromForm'@.
--
-- To do that, simply add @deriving 'Generic'@ clause to your datatype
-- and declare a 'FromForm' instance for your datatype without
-- giving definition for 'fromForm'.
--
-- For instance, the previous example can be simplified into this:
--
-- @
-- data Person = Person
--   { name :: String
--   , age  :: Int
--   } deriving ('Generic')
--
-- instance 'FromForm' Person
-- @
--
-- The default implementation of 'fromForm' is 'genericFromForm'.
-- It only works for records and it will use 'parseQueryParam' for each field's value.
class FromForm a where
  -- | Parse 'Form' into a value.
  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

-- | _NOTE:_ this conversion is unstable and may result in different key order (but not values).
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

-- | Parse a 'Form' into a list of entries groupped by key.
--
-- _NOTE:_ this conversion is unstable and may result in different key order
-- (but not values). For a stable encoding see 'toEntriesByKeyStable'.
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

-- | Parse a 'Form' into a list of entries groupped by key.
--
-- >>> toEntriesByKeyStable [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
-- Right [("color",["red","white"]),("name",["Nick"])]
--
-- For an unstable (but faster) conversion see 'toEntriesByKey'.
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

-- | A 'Generic'-based implementation of 'fromForm'.
-- This is used as a default implementation in 'FromForm'.
--
-- Note that this only works for records (i.e. product data types with named fields):
--
-- @
-- data Person = Person
--   { name :: String
--   , age  :: Int
--   } deriving ('Generic')
-- @
--
-- In this implementation each field's value gets decoded using `parseQueryParam`.
-- Two field types are exceptions:
--
--    - for values of type @'Maybe' a@ an entry is parsed if present in the 'Form'
--      and the is decoded with 'parseQueryParam'; if no entry is present result is 'Nothing';
--
--    - for values of type @[a]@ (except @['Char']@) all entries are parsed to produce a list of parsed values;
--
-- Here's an example:
--
-- @
-- data Post = Post
--   { title    :: String
--   , subtitle :: Maybe String
--   , comments :: [String]
--   } deriving ('Generic', 'Show')
--
-- instance 'FromForm' Post
-- @
--
-- >>> urlDecodeAsForm "comments=Nice%20post%21&comments=%2B1&title=Test" :: Either Text Post
-- Right (Post {title = "Test", subtitle = Nothing, comments = ["Nice post!","+1"]})
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"

-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
--
-- _NOTE:_ this encoding is unstable and may result in different key order
-- (but not values). For a stable encoding see 'urlEncodeFormStable'.
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

-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
--
-- For an unstable (but faster) encoding see 'urlEncodeForm'.
--
-- Key-value pairs get encoded to @key=value@ and separated by @&@:
--
-- >>> urlEncodeFormStable [("name", "Julian"), ("lastname", "Arni")]
-- "lastname=Arni&name=Julian"
--
-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
--
-- >>> urlEncodeFormStable [("is_test", "")]
-- "is_test"
--
-- Empty keys are allowed too:
--
-- >>> urlEncodeFormStable [("", "foobar")]
-- "=foobar"
--
-- However, if both key and value are empty, the key-value pair is ignored.
-- (This prevents @'urlDecodeForm' . 'urlEncodeFormStable'@ from being a true isomorphism).
--
-- >>> urlEncodeFormStable [("", "")]
-- ""
--
-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
--
-- >>> urlEncodeFormStable [("fullname", "Andres Löh")]
-- "fullname=Andres%20L%C3%B6h"
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

-- | Encode a list of key-value pairs to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
--
-- See also 'urlEncodeFormStable'.
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

-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
--
-- Key-value pairs get decoded normally:
--
-- >>> urlDecodeForm "name=Greg&lastname=Weber"
-- Right (fromList [("lastname","Weber"),("name","Greg")])
--
-- Keys with no values get decoded to pairs with empty values.
--
-- >>> urlDecodeForm "is_test"
-- Right (fromList [("is_test","")])
--
-- Empty keys are allowed:
--
-- >>> urlDecodeForm "=foobar"
-- Right (fromList [("","foobar")])
--
-- The empty string gets decoded into an empty 'Form':
--
-- >>> urlDecodeForm ""
-- Right (fromList [])
--
-- Everything is un-escaped with 'unEscapeString':
--
-- >>> urlDecodeForm "fullname=Andres%20L%C3%B6h"
-- Right (fromList [("fullname","Andres L\246h")])
--
-- Improperly formed strings result in an error:
--
-- >>> urlDecodeForm "this=has=too=many=equals"
-- Left "not a valid pair: this=has=too=many=equals"
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

-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a list of key-value pairs.
--
-- See also 'urlDecodeForm'.
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


-- | This is a convenience function for decoding a
-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
-- that has an instance of 'FromForm'.
--
-- This is effectively @'fromForm' '<=<' 'urlDecodeForm'@.
--
-- >>> urlDecodeAsForm "name=Dennis&age=22" :: Either Text Person
-- Right (Person {name = "Dennis", age = 22})
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

-- | This is a convenience function for encoding a datatype that has instance
-- of 'ToForm' directly to a @application/x-www-form-urlencoded@
-- 'BSL.ByteString'.
--
-- This is effectively @'urlEncodeForm' . 'toForm'@.
--
-- _NOTE:_ this encoding is unstable and may result in different key order
-- (but not values). For a stable encoding see 'urlEncodeAsFormStable'.
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

-- | This is a convenience function for encoding a datatype that has instance
-- of 'ToForm' directly to a @application/x-www-form-urlencoded@
-- 'BSL.ByteString'.
--
-- This is effectively @'urlEncodeFormStable' . 'toForm'@.
--
-- >>> urlEncodeAsFormStable Person {name = "Dennis", age = 22}
-- "age=22&name=Dennis"
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

-- | Find all values corresponding to a given key in a 'Form'.
--
-- >>> lookupAll "name" []
-- []
-- >>> lookupAll "name" [("name", "Oleg")]
-- ["Oleg"]
-- >>> lookupAll "name" [("name", "Oleg"), ("name", "David")]
-- ["Oleg","David"]
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

-- | Lookup an optional value for a key.
-- Fail if there is more than one value.
--
-- >>> lookupMaybe "name" []
-- Right Nothing
-- >>> lookupMaybe "name" [("name", "Oleg")]
-- Right (Just "Oleg")
-- >>> lookupMaybe "name" [("name", "Oleg"), ("name", "David")]
-- Left "Duplicate key \"name\""
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)

-- | Lookup a unique value for a key.
-- Fail if there is zero or more than one value.
--
-- >>> lookupUnique "name" []
-- Left "Could not find key \"name\""
-- >>> lookupUnique "name" [("name", "Oleg")]
-- Right "Oleg"
-- >>> lookupUnique "name" [("name", "Oleg"), ("name", "David")]
-- Left "Duplicate key \"name\""
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)

-- | Lookup all values for a given key in a 'Form' and parse them with 'parseQueryParams'.
--
-- >>> parseAll "age" [] :: Either Text [Word8]
-- Right []
-- >>> parseAll "age" [("age", "8"), ("age", "seven")] :: Either Text [Word8]
-- Left "could not parse: `seven' (input does not start with a digit)"
-- >>> parseAll "age" [("age", "8"), ("age", "777")] :: Either Text [Word8]
-- Left "out of bounds: `777' (should be between 0 and 255)"
-- >>> parseAll "age" [("age", "12"), ("age", "25")] :: Either Text [Word8]
-- Right [12,25]
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

-- | Lookup an optional value for a given key and parse it with 'parseQueryParam'.
-- Fail if there is more than one value for the key.
--
-- >>> parseMaybe "age" [] :: Either Text (Maybe Word8)
-- Right Nothing
-- >>> parseMaybe "age" [("age", "12"), ("age", "25")] :: Either Text (Maybe Word8)
-- Left "Duplicate key \"age\""
-- >>> parseMaybe "age" [("age", "seven")] :: Either Text (Maybe Word8)
-- Left "could not parse: `seven' (input does not start with a digit)"
-- >>> parseMaybe "age" [("age", "777")] :: Either Text (Maybe Word8)
-- Left "out of bounds: `777' (should be between 0 and 255)"
-- >>> parseMaybe "age" [("age", "7")] :: Either Text (Maybe Word8)
-- Right (Just 7)
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

-- | Lookup a unique value for a given key and parse it with 'parseQueryParam'.
-- Fail if there is zero or more than one value for the key.
--
-- >>> parseUnique "age" [] :: Either Text Word8
-- Left "Could not find key \"age\""
-- >>> parseUnique "age" [("age", "12"), ("age", "25")] :: Either Text Word8
-- Left "Duplicate key \"age\""
-- >>> parseUnique "age" [("age", "seven")] :: Either Text Word8
-- Left "could not parse: `seven' (input does not start with a digit)"
-- >>> parseUnique "age" [("age", "777")] :: Either Text Word8
-- Left "out of bounds: `777' (should be between 0 and 255)"
-- >>> parseUnique "age" [("age", "7")] :: Either Text Word8
-- Right 7
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

-- | 'Generic'-based deriving options for 'ToForm' and 'FromForm'.
--
-- A common use case for non-default 'FormOptions'
-- is to strip a prefix off of field labels:
--
-- @
-- data Project = Project
--   { projectName :: String
--   , projectSize :: Int
--   } deriving ('Generic', 'Show')
--
-- myOptions :: 'FormOptions'
-- myOptions = 'FormOptions'
--  { 'fieldLabelModifier' = 'map' 'toLower' . 'drop' ('length' \"project\") }
--
-- instance 'ToForm' Project where
--   'toForm' = 'genericToForm' myOptions
--
-- instance 'FromForm' Project where
--   'fromForm' = 'genericFromForm' myOptions
-- @
--
-- >>> urlEncodeAsFormStable Project { projectName = "http-api-data", projectSize = 172 }
-- "name=http-api-data&size=172"
-- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project
-- Right (Project {projectName = "http-api-data", projectSize = 172})
data FormOptions = FormOptions
  { -- | Function applied to field labels. Handy for removing common record prefixes for example.
    FormOptions -> ShowS
fieldLabelModifier :: String -> String
  }

-- | Default encoding 'FormOptions'.
--
-- @
-- 'FormOptions'
-- { 'fieldLabelModifier' = id
-- }
-- @
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)