{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Gogol.Data.JSON
-- Copyright   : (c) 2015-2022 Brendan Hay <brendan.g.hay@gmail.com>
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Gogol.Data.JSON
  ( Value,
    AsText (..),
    parseJSONObject,
    parseJSONText,
    toJSONText,

    -- * Re-exports
    FromJSON (..),
    FromJSONKey (..),
    ToJSON (..),
    ToJSONKey (..),
    withObject,
    emptyObject,
    object,
    (.=),
    (.:),
    (.:?),
    (.!=),
  )
where

import Data.Aeson
import Data.Aeson.Types
import Data.Text qualified as Text
import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))

#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (KeyMap)
#else
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
#endif

newtype AsText a = AsText {forall a. AsText a -> a
fromAsText :: a}
  deriving (AsText a -> AsText a -> Bool
(AsText a -> AsText a -> Bool)
-> (AsText a -> AsText a -> Bool) -> Eq (AsText a)
forall a. Eq a => AsText a -> AsText a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => AsText a -> AsText a -> Bool
== :: AsText a -> AsText a -> Bool
$c/= :: forall a. Eq a => AsText a -> AsText a -> Bool
/= :: AsText a -> AsText a -> Bool
Eq, Eq (AsText a)
Eq (AsText a) =>
(AsText a -> AsText a -> Ordering)
-> (AsText a -> AsText a -> Bool)
-> (AsText a -> AsText a -> Bool)
-> (AsText a -> AsText a -> Bool)
-> (AsText a -> AsText a -> Bool)
-> (AsText a -> AsText a -> AsText a)
-> (AsText a -> AsText a -> AsText a)
-> Ord (AsText a)
AsText a -> AsText a -> Bool
AsText a -> AsText a -> Ordering
AsText a -> AsText a -> AsText a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (AsText a)
forall a. Ord a => AsText a -> AsText a -> Bool
forall a. Ord a => AsText a -> AsText a -> Ordering
forall a. Ord a => AsText a -> AsText a -> AsText a
$ccompare :: forall a. Ord a => AsText a -> AsText a -> Ordering
compare :: AsText a -> AsText a -> Ordering
$c< :: forall a. Ord a => AsText a -> AsText a -> Bool
< :: AsText a -> AsText a -> Bool
$c<= :: forall a. Ord a => AsText a -> AsText a -> Bool
<= :: AsText a -> AsText a -> Bool
$c> :: forall a. Ord a => AsText a -> AsText a -> Bool
> :: AsText a -> AsText a -> Bool
$c>= :: forall a. Ord a => AsText a -> AsText a -> Bool
>= :: AsText a -> AsText a -> Bool
$cmax :: forall a. Ord a => AsText a -> AsText a -> AsText a
max :: AsText a -> AsText a -> AsText a
$cmin :: forall a. Ord a => AsText a -> AsText a -> AsText a
min :: AsText a -> AsText a -> AsText a
Ord, ReadPrec [AsText a]
ReadPrec (AsText a)
Int -> ReadS (AsText a)
ReadS [AsText a]
(Int -> ReadS (AsText a))
-> ReadS [AsText a]
-> ReadPrec (AsText a)
-> ReadPrec [AsText a]
-> Read (AsText a)
forall a. Read a => ReadPrec [AsText a]
forall a. Read a => ReadPrec (AsText a)
forall a. Read a => Int -> ReadS (AsText a)
forall a. Read a => ReadS [AsText a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (AsText a)
readsPrec :: Int -> ReadS (AsText a)
$creadList :: forall a. Read a => ReadS [AsText a]
readList :: ReadS [AsText a]
$creadPrec :: forall a. Read a => ReadPrec (AsText a)
readPrec :: ReadPrec (AsText a)
$creadListPrec :: forall a. Read a => ReadPrec [AsText a]
readListPrec :: ReadPrec [AsText a]
Read, Int -> AsText a -> ShowS
[AsText a] -> ShowS
AsText a -> String
(Int -> AsText a -> ShowS)
-> (AsText a -> String) -> ([AsText a] -> ShowS) -> Show (AsText a)
forall a. Show a => Int -> AsText a -> ShowS
forall a. Show a => [AsText a] -> ShowS
forall a. Show a => AsText a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AsText a -> ShowS
showsPrec :: Int -> AsText a -> ShowS
$cshow :: forall a. Show a => AsText a -> String
show :: AsText a -> String
$cshowList :: forall a. Show a => [AsText a] -> ShowS
showList :: [AsText a] -> ShowS
Show, Integer -> AsText a
AsText a -> AsText a
AsText a -> AsText a -> AsText a
(AsText a -> AsText a -> AsText a)
-> (AsText a -> AsText a -> AsText a)
-> (AsText a -> AsText a -> AsText a)
-> (AsText a -> AsText a)
-> (AsText a -> AsText a)
-> (AsText a -> AsText a)
-> (Integer -> AsText a)
-> Num (AsText a)
forall a. Num a => Integer -> AsText a
forall a. Num a => AsText a -> AsText a
forall a. Num a => AsText a -> AsText a -> AsText a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: forall a. Num a => AsText a -> AsText a -> AsText a
+ :: AsText a -> AsText a -> AsText a
$c- :: forall a. Num a => AsText a -> AsText a -> AsText a
- :: AsText a -> AsText a -> AsText a
$c* :: forall a. Num a => AsText a -> AsText a -> AsText a
* :: AsText a -> AsText a -> AsText a
$cnegate :: forall a. Num a => AsText a -> AsText a
negate :: AsText a -> AsText a
$cabs :: forall a. Num a => AsText a -> AsText a
abs :: AsText a -> AsText a
$csignum :: forall a. Num a => AsText a -> AsText a
signum :: AsText a -> AsText a
$cfromInteger :: forall a. Num a => Integer -> AsText a
fromInteger :: Integer -> AsText a
Num, Num (AsText a)
Num (AsText a) =>
(AsText a -> AsText a -> AsText a)
-> (AsText a -> AsText a)
-> (Rational -> AsText a)
-> Fractional (AsText a)
Rational -> AsText a
AsText a -> AsText a
AsText a -> AsText a -> AsText a
forall a. Fractional a => Num (AsText a)
forall a. Fractional a => Rational -> AsText a
forall a. Fractional a => AsText a -> AsText a
forall a. Fractional a => AsText a -> AsText a -> AsText a
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: forall a. Fractional a => AsText a -> AsText a -> AsText a
/ :: AsText a -> AsText a -> AsText a
$crecip :: forall a. Fractional a => AsText a -> AsText a
recip :: AsText a -> AsText a
$cfromRational :: forall a. Fractional a => Rational -> AsText a
fromRational :: Rational -> AsText a
Fractional, AsText a -> Text
AsText a -> ByteString
AsText a -> Builder
(AsText a -> Text)
-> (AsText a -> Builder)
-> (AsText a -> ByteString)
-> (AsText a -> Text)
-> (AsText a -> Builder)
-> ToHttpApiData (AsText a)
forall a. ToHttpApiData a => AsText a -> Text
forall a. ToHttpApiData a => AsText a -> ByteString
forall a. ToHttpApiData a => AsText a -> Builder
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: forall a. ToHttpApiData a => AsText a -> Text
toUrlPiece :: AsText a -> Text
$ctoEncodedUrlPiece :: forall a. ToHttpApiData a => AsText a -> Builder
toEncodedUrlPiece :: AsText a -> Builder
$ctoHeader :: forall a. ToHttpApiData a => AsText a -> ByteString
toHeader :: AsText a -> ByteString
$ctoQueryParam :: forall a. ToHttpApiData a => AsText a -> Text
toQueryParam :: AsText a -> Text
$ctoEncodedQueryParam :: forall a. ToHttpApiData a => AsText a -> Builder
toEncodedQueryParam :: AsText a -> Builder
ToHttpApiData, Text -> Either Text (AsText a)
ByteString -> Either Text (AsText a)
(Text -> Either Text (AsText a))
-> (ByteString -> Either Text (AsText a))
-> (Text -> Either Text (AsText a))
-> FromHttpApiData (AsText a)
forall a. FromHttpApiData a => Text -> Either Text (AsText a)
forall a. FromHttpApiData a => ByteString -> Either Text (AsText a)
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: forall a. FromHttpApiData a => Text -> Either Text (AsText a)
parseUrlPiece :: Text -> Either Text (AsText a)
$cparseHeader :: forall a. FromHttpApiData a => ByteString -> Either Text (AsText a)
parseHeader :: ByteString -> Either Text (AsText a)
$cparseQueryParam :: forall a. FromHttpApiData a => Text -> Either Text (AsText a)
parseQueryParam :: Text -> Either Text (AsText a)
FromHttpApiData)

instance (FromJSON a, FromHttpApiData a) => FromJSON (AsText a) where
  parseJSON :: Value -> Parser (AsText a)
parseJSON (String Text
s) = (Text -> Parser (AsText a))
-> (a -> Parser (AsText a)) -> Either Text a -> Parser (AsText a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser (AsText a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (AsText a))
-> (Text -> String) -> Text -> Parser (AsText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) (AsText a -> Parser (AsText a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AsText a -> Parser (AsText a))
-> (a -> AsText a) -> a -> Parser (AsText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> AsText a
forall a. a -> AsText a
AsText) (Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
s)
  parseJSON Value
o = a -> AsText a
forall a. a -> AsText a
AsText (a -> AsText a) -> Parser a -> Parser (AsText a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
o

instance (ToHttpApiData a) => ToJSON (AsText a) where
  toJSON :: AsText a -> Value
toJSON (AsText a
x) = Text -> Value
String (a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
x)

#if MIN_VERSION_aeson(2,0,0)
parseJSONObject :: FromJSON a => KeyMap Value -> Parser a
#else
parseJSONObject :: FromJSON a => HashMap Text Value -> Parser a
#endif
parseJSONObject :: forall a. FromJSON a => KeyMap Value -> Parser a
parseJSONObject = Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser a)
-> (KeyMap Value -> Value) -> KeyMap Value -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap Value -> Value
forall a. ToJSON a => a -> Value
toJSON

parseJSONText :: (FromHttpApiData a) => String -> Value -> Parser a
parseJSONText :: forall a. FromHttpApiData a => String -> Value -> Parser a
parseJSONText String
n = String -> (Text -> Parser a) -> Value -> Parser a
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
n ((Text -> Parser a) -> (a -> Parser a) -> Either Text a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> (Text -> String) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
f) a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text a -> Parser a)
-> (Text -> Either Text a) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam)
  where
    f :: Text -> String
f Text
x = String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
x

toJSONText :: (ToHttpApiData a) => a -> Value
toJSONText :: forall a. ToHttpApiData a => a -> Value
toJSONText = Text -> Value
String (Text -> Value) -> (a -> Text) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam