module Data.Aeson.Extended
  ( FromJSONKeyValue (..),
    ToJSONKeyValue (..),
    FromJSONWithContext (..),
    mapWithJSONPath,
    encodeToStrictText,
    (.=?),

    -- * Re-exports
    module Data.Aeson,
  )
where

-------------------------------------------------------------------------------

import Data.Aeson
import Data.Aeson.Text (encodeToTextBuilder)
import Data.Aeson.Types (JSONPathElement (..), Parser)
import Data.Functor.Const (getConst)
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Hasura.Prelude

-------------------------------------------------------------------------------

class ToJSONKeyValue a where
  toJSONKeyValue :: a -> (Key, Value)

class FromJSONKeyValue a where
  parseJSONKeyValue :: (Key, Value) -> Parser a

instance ToJSONKeyValue Void where
  toJSONKeyValue :: Void -> (Key, Value)
toJSONKeyValue = Void -> (Key, Value)
forall a. Void -> a
absurd

instance ToJSONKeyValue a => ToJSONKeyValue (Const a b) where
  toJSONKeyValue :: Const a b -> (Key, Value)
toJSONKeyValue = a -> (Key, Value)
forall a. ToJSONKeyValue a => a -> (Key, Value)
toJSONKeyValue (a -> (Key, Value))
-> (Const a b -> a) -> Const a b -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const a b -> a
forall a k (b :: k). Const a b -> a
getConst

-- | Similar to 'FromJSON', except the parser can also source data with which
-- to construct 'a' from a context 'ctx'.
--
-- This can be useful if the 'a' value contains some data that is not from the
-- current piece of JSON (the 'Value'). For example, some data from higher
-- up in the overall JSON graph, or from some system context.
class FromJSONWithContext ctx a | a -> ctx where
  parseJSONWithContext :: ctx -> Value -> Parser a

-------------------------------------------------------------------------------

-- | An optional key-value pair for encoding a JSON object.
--
-- @
-- object $ ["foo" .= 0] <> catMaybes [ "bar" .=? Nothing, "baz" .=? 2 ]
-- @
(.=?) :: (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.=? :: Key -> Maybe v -> Maybe kv
(.=?) Key
k = (v -> kv) -> Maybe v -> Maybe kv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
k Key -> v -> kv
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
{-# INLINE (.=?) #-}

infixr 8 .=?

-- | Map a 'Parser' over a list, keeping the JSONPath context
mapWithJSONPath :: (a -> Parser b) -> [a] -> Parser [b]
mapWithJSONPath :: (a -> Parser b) -> [a] -> Parser [b]
mapWithJSONPath a -> Parser b
parser [a]
xs =
  ((Int, a) -> Parser b) -> [(Int, a)] -> Parser [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Int
idx, a
item) -> a -> Parser b
parser a
item Parser b -> JSONPathElement -> Parser b
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
idx) ([(Int, a)] -> Parser [b]) -> [(Int, a)] -> Parser [b]
forall a b. (a -> b) -> a -> b
$ [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [a]
xs

encodeToStrictText :: ToJSON a => a -> Text
encodeToStrictText :: a -> Text
encodeToStrictText = Text -> Text
toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. ToJSON a => a -> Builder
encodeToTextBuilder