{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Testing.CurlRunnings.Internal.Payload
( Payload (..)
) where
import Data.Aeson
import qualified Data.Char as C
import qualified Data.Text as T
import GHC.Generics
import qualified Testing.CurlRunnings.Internal.Aeson as A
import Testing.CurlRunnings.Internal.KeyValuePairs
data Payload = JSON Value | URLEncoded KeyValuePairs deriving (forall x. Payload -> Rep Payload x)
-> (forall x. Rep Payload x -> Payload) -> Generic Payload
forall x. Rep Payload x -> Payload
forall x. Payload -> Rep Payload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Payload x -> Payload
$cfrom :: forall x. Payload -> Rep Payload x
Generic
instance Show Payload where
show :: Payload -> String
show (JSON Value
v) = Value -> String
forall a. Show a => a -> String
show Value
v
show (URLEncoded (KeyValuePairs [KeyValuePair]
xs)) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"&" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (KeyValuePair -> Text) -> [KeyValuePair] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(KeyValuePair KeyType
k Text
v) -> KeyType -> Text
A.toText KeyType
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v) [KeyValuePair]
xs
payloadTagFieldName :: A.KeyType
payloadTagFieldName :: KeyType
payloadTagFieldName = KeyType
"bodyType"
payloadContentsFieldName :: A.KeyType
payloadContentsFieldName :: KeyType
payloadContentsFieldName = KeyType
"content"
instance FromJSON Payload where
parseJSON :: Value -> Parser Payload
parseJSON Value
v = String -> (Object -> Parser Payload) -> Value -> Parser Payload
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"payload" Object -> Parser Payload
forall a. KeyMap a -> Parser Payload
parsePayload Value
v where
parsePayload :: KeyMap a -> Parser Payload
parsePayload KeyMap a
o = if Bool -> Bool
not (KeyType -> KeyMap a -> Bool
forall a. KeyType -> KeyMap a -> Bool
A.member KeyType
payloadTagFieldName KeyMap a
o) then Payload -> Parser Payload
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Payload
JSON Value
v) else Options -> Value -> Parser Payload
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
payloadOptions Value
v
payloadOptions :: Options
payloadOptions = Options
defaultOptions { sumEncoding :: SumEncoding
sumEncoding = TaggedObject :: String -> String -> SumEncoding
TaggedObject { tagFieldName :: String
tagFieldName = Text -> String
T.unpack (Text -> String) -> (KeyType -> Text) -> KeyType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyType -> Text
A.toText (KeyType -> String) -> KeyType -> String
forall a b. (a -> b) -> a -> b
$ KeyType
payloadTagFieldName
, contentsFieldName :: String
contentsFieldName = Text -> String
T.unpack (Text -> String) -> (KeyType -> Text) -> KeyType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyType -> Text
A.toText (KeyType -> String) -> KeyType -> String
forall a b. (a -> b) -> a -> b
$ KeyType
payloadContentsFieldName
}
, constructorTagModifier :: ShowS
constructorTagModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
C.toLower
}
instance ToJSON Payload where
toJSON :: Payload -> Value
toJSON (JSON Value
v) = [Pair] -> Value
object [(KeyType
payloadTagFieldName, Value
"json"), (KeyType
payloadContentsFieldName, Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
v)]
toJSON (URLEncoded KeyValuePairs
xs) = [Pair] -> Value
object [(KeyType
payloadTagFieldName, Value
"urlencoded"), (KeyType
payloadContentsFieldName, KeyValuePairs -> Value
forall a. ToJSON a => a -> Value
toJSON KeyValuePairs
xs)]