{-# LANGUAGE OverloadedStrings #-}
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
newtype KeyValuePairs = KeyValuePairs [KeyValuePair] deriving Show
data KeyValuePair = KeyValuePair T.Text T.Text deriving Show
instance ToJSON KeyValuePairs where
toJSON (KeyValuePairs qs) =
object (fmap (\(KeyValuePair k v) -> k .= toJSON v) qs)
instance FromJSON KeyValuePairs where
parseJSON = withObject "keyValuePairs" parseKeyValuePairs where
parseKeyValuePairs o = KeyValuePairs <$> traverse parseKeyValuePair (H.toList o)
parseKeyValuePair (t, v) = KeyValuePair t <$> parseSingleValueType v
parseSingleValueType :: Value -> Parser T.Text
parseSingleValueType (Bool b) = parseToText b
parseSingleValueType (String t) = return t
parseSingleValueType (Number n) = parseToText n
parseSingleValueType invalid = typeMismatch "KeyValuePairs" invalid
parseToText :: (ToJSON a) => a -> Parser T.Text
parseToText = return . T.decodeUtf8 . LBS.toStrict . encode