{-# LANGUAGE CPP #-}

-- |
-- Module      : Amazonka.Data.JSON
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Data.JSON
  ( -- * FromJSON
    Aeson.FromJSON (..),
    Aeson.FromJSONKey (..),
    parseJSONText,
    Aeson.eitherDecode,
    Aeson.eitherDecode',

    -- ** Parser a
    Aeson.withObject,
    (Aeson..:),
    (Aeson..:?),
    (Aeson..!=),

    -- ** Either String a
    eitherParseJSON,
    (.:>),
    (.?>),

    -- * ToJSON
    Aeson.ToJSON (..),
    Aeson.ToJSONKey (..),
    toJSONText,
    Aeson.Value (Object),
    Aeson.object,
    (Aeson..=),
  )
where

import Amazonka.Data.Text
import Amazonka.Prelude
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson.Types

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.Key (Key)
#else
import qualified Data.HashMap.Strict as KM
type Key = Text
#endif

parseJSONText :: FromText a => String -> Aeson.Value -> Aeson.Types.Parser a
parseJSONText :: forall a. FromText a => String -> Value -> Parser a
parseJSONText String
n = forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
n (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromText a => Text -> Either String a
fromText)

toJSONText :: ToText a => a -> Aeson.Value
toJSONText :: forall a. ToText a => a -> Value
toJSONText = Text -> Value
Aeson.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText

eitherParseJSON :: Aeson.FromJSON a => Aeson.Object -> Either String a
eitherParseJSON :: forall a. FromJSON a => Object -> Either String a
eitherParseJSON = forall a b. (a -> Parser b) -> a -> Either String b
Aeson.Types.parseEither forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
Aeson.Object

(.:>) :: Aeson.FromJSON a => Aeson.Object -> Key -> Either String a
.:> :: forall a. FromJSON a => Object -> Key -> Either String a
(.:>) Object
o Key
k =
  case forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
k Object
o of
    Maybe Value
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"key " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Key
k forall a. [a] -> [a] -> [a]
++ String
" not present"
    Just Value
v -> forall a b. (a -> Parser b) -> a -> Either String b
Aeson.Types.parseEither forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v

(.?>) :: Aeson.FromJSON a => Aeson.Object -> Key -> Either String (Maybe a)
.?> :: forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
(.?>) Object
o Key
k =
  case forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
k Object
o of
    Maybe Value
Nothing -> forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
    Just Value
v -> forall a b. (a -> Parser b) -> a -> Either String b
Aeson.Types.parseEither forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v