{-# LANGUAGE OverloadedStrings #-}

-- | A module defining the KeyValuePairs type. This type may be used to
-- represent a structure in a specification that is a collection of
-- key-vaue pairs. For example query parameters and URLEncoded request
-- bodies.
--
-- The module provides FromJSON and ToJSON instances for KeyValuePairs.
-- Valid KeyValuePairs JSON is a single JSON object where all values
-- are either String, Scienfific or Bool.

module Testing.CurlRunnings.Internal.KeyValuePairs
  ( KeyValuePairs (..)
  , KeyValuePair (..)
  ) where

import           Data.Aeson
import           Data.Aeson.Types
import qualified Data.ByteString.Lazy as LBS
import           Data.HashMap.Strict  as H
import qualified Data.Text            as T
import           Data.Text.Encoding   as T

-- | A container for a list of key-value pairs
newtype KeyValuePairs = KeyValuePairs [KeyValuePair] deriving Int -> KeyValuePairs -> ShowS
[KeyValuePairs] -> ShowS
KeyValuePairs -> String
(Int -> KeyValuePairs -> ShowS)
-> (KeyValuePairs -> String)
-> ([KeyValuePairs] -> ShowS)
-> Show KeyValuePairs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyValuePairs] -> ShowS
$cshowList :: [KeyValuePairs] -> ShowS
show :: KeyValuePairs -> String
$cshow :: KeyValuePairs -> String
showsPrec :: Int -> KeyValuePairs -> ShowS
$cshowsPrec :: Int -> KeyValuePairs -> ShowS
Show

-- | A representation of a single key-value pair
data KeyValuePair = KeyValuePair T.Text T.Text deriving Int -> KeyValuePair -> ShowS
[KeyValuePair] -> ShowS
KeyValuePair -> String
(Int -> KeyValuePair -> ShowS)
-> (KeyValuePair -> String)
-> ([KeyValuePair] -> ShowS)
-> Show KeyValuePair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyValuePair] -> ShowS
$cshowList :: [KeyValuePair] -> ShowS
show :: KeyValuePair -> String
$cshow :: KeyValuePair -> String
showsPrec :: Int -> KeyValuePair -> ShowS
$cshowsPrec :: Int -> KeyValuePair -> ShowS
Show

instance ToJSON KeyValuePairs where
  toJSON :: KeyValuePairs -> Value
toJSON (KeyValuePairs [KeyValuePair]
qs) =
    [Pair] -> Value
object ((KeyValuePair -> Pair) -> [KeyValuePair] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(KeyValuePair Text
k Text
v) -> Text
k Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
v) [KeyValuePair]
qs)

instance FromJSON KeyValuePairs where
  parseJSON :: Value -> Parser KeyValuePairs
parseJSON = String
-> (Object -> Parser KeyValuePairs)
-> Value
-> Parser KeyValuePairs
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"keyValuePairs" Object -> Parser KeyValuePairs
parseKeyValuePairs where
    parseKeyValuePairs :: Object -> Parser KeyValuePairs
parseKeyValuePairs Object
o = [KeyValuePair] -> KeyValuePairs
KeyValuePairs ([KeyValuePair] -> KeyValuePairs)
-> Parser [KeyValuePair] -> Parser KeyValuePairs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pair -> Parser KeyValuePair) -> [Pair] -> Parser [KeyValuePair]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Pair -> Parser KeyValuePair
parseKeyValuePair (Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
H.toList Object
o)
    parseKeyValuePair :: Pair -> Parser KeyValuePair
parseKeyValuePair (Text
t, Value
v) = Text -> Text -> KeyValuePair
KeyValuePair Text
t (Text -> KeyValuePair) -> Parser Text -> Parser KeyValuePair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
parseSingleValueType Value
v

parseSingleValueType :: Value -> Parser T.Text
parseSingleValueType :: Value -> Parser Text
parseSingleValueType (Bool Bool
b)   = Bool -> Parser Text
forall a. ToJSON a => a -> Parser Text
parseToText Bool
b
parseSingleValueType (String Text
t) = Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
parseSingleValueType (Number Scientific
n) = Scientific -> Parser Text
forall a. ToJSON a => a -> Parser Text
parseToText Scientific
n
parseSingleValueType Value
invalid    = String -> Value -> Parser Text
forall a. String -> Value -> Parser a
typeMismatch String
"KeyValuePairs" Value
invalid

parseToText :: (ToJSON a) => a -> Parser T.Text
parseToText :: a -> Parser Text
parseToText = Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> (a -> Text) -> a -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode