{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Hasql.Interpolate.Internal.Json
  ( Json (..),
    Jsonb (..),
    AsJson (..),
    AsJsonb (..),
  )
where

import Data.Aeson
import qualified Data.Aeson as Aeson
import Data.Bifunctor (first)
import qualified Data.ByteString.Lazy as BL
import Data.Coerce
import Data.Functor.Contravariant
import qualified Data.Text as T
import qualified Hasql.Decoders as D
import qualified Hasql.Encoders as E
import Hasql.Interpolate.Internal.Decoder
import Hasql.Interpolate.Internal.Encoder

-- | Newtype for 'Hasql.Interpolate.Decoder.DecodeValue' /
-- 'Hasql.Interpolate.Encoder.EncodeValue' instances that converts
-- between a postgres json type and an Aeson 'Value'
newtype Jsonb = Jsonb Value

-- | Newtype for 'Hasql.Interpolate.Decoder.DecodeValue' /
-- 'Hasql.Interpolate.Encoder.EncodeValue' instances that converts
-- between a postgres json type and an Aeson 'Value'
newtype Json = Json Value

-- | Newtype for 'Hasql.Interpolate.Decoder.DecodeValue' /
-- 'Hasql.Interpolate.Encoder.EncodeValue' instances that converts
-- between a postgres json type and anything that is an instance of
-- 'FromJSON' / 'ToJSON'
newtype AsJson a = AsJson a

-- | Newtype for 'Hasql.Interpolate.Decoder.DecodeValue' /
-- 'Hasql.Interpolate.Encoder.EncodeValue' instances that converts
-- between a postgres jsonb type and anything that is an instance of
-- 'FromJSON' / 'ToJSON'
newtype AsJsonb a = AsJsonb a

-- | Parse a postgres @jsonb@ using 'D.jsonb'
instance DecodeValue Jsonb where
  decodeValue :: Value Jsonb
decodeValue = Value Value -> Value Jsonb
coerce Value Value
D.jsonb

-- | Parse a postgres @json@ using 'D.json'
instance DecodeValue Json where
  decodeValue :: Value Json
decodeValue = Value Value -> Value Json
coerce Value Value
D.json

-- | Parse a postgres @json@ to anything that is an instance of
-- 'Aeson.FromJSON'
instance Aeson.FromJSON a => DecodeValue (AsJson a) where
  decodeValue :: Value (AsJson a)
decodeValue = a -> AsJson a
forall a. a -> AsJson a
AsJson (a -> AsJson a) -> Value a -> Value (AsJson a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Either Text a) -> Value a
forall a. (ByteString -> Either Text a) -> Value a
D.jsonBytes ((String -> Text) -> Either String a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String a -> Either Text a)
-> (ByteString -> Either String a) -> ByteString -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict)

-- | Parse a postgres @jsonb@ to anything that is an instance of
-- 'Aeson.FromJSON'
instance Aeson.FromJSON a => DecodeValue (AsJsonb a) where
  decodeValue :: Value (AsJsonb a)
decodeValue = a -> AsJsonb a
forall a. a -> AsJsonb a
AsJsonb (a -> AsJsonb a) -> Value a -> Value (AsJsonb a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Either Text a) -> Value a
forall a. (ByteString -> Either Text a) -> Value a
D.jsonbBytes ((String -> Text) -> Either String a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String a -> Either Text a)
-> (ByteString -> Either String a) -> ByteString -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict)

-- | Encode an Aeson 'Aeson.Value' to a postgres @json@ using 'E.json'
instance EncodeValue Json where
  encodeValue :: Value Json
encodeValue = Value Value -> Value Json
coerce Value Value
E.json

-- | Encode an Aeson 'Aeson.Value' to a postgres @jsonb@ using 'E.jsonb'
instance EncodeValue Jsonb where
  encodeValue :: Value Jsonb
encodeValue = Value Value -> Value Jsonb
coerce Value Value
E.jsonb

-- | Encode anything that is an instance of 'Aeson.ToJSON' to a postgres @json@
instance Aeson.ToJSON a => EncodeValue (AsJson a) where
  encodeValue :: Value (AsJson a)
encodeValue = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (AsJson a -> ByteString) -> AsJson a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (a -> ByteString) -> (AsJson a -> a) -> AsJson a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible (AsJson a) a => AsJson a -> a
coerce @_ @a (AsJson a -> ByteString) -> Value ByteString -> Value (AsJson a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Value ByteString
E.jsonBytes

-- | Encode anything that is an instance of 'Aeson.ToJSON' to a postgres @jsonb@
instance Aeson.ToJSON a => EncodeValue (AsJsonb a) where
  encodeValue :: Value (AsJsonb a)
encodeValue = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (AsJsonb a -> ByteString) -> AsJsonb a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (a -> ByteString) -> (AsJsonb a -> a) -> AsJsonb a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible (AsJsonb a) a => AsJsonb a -> a
coerce @_ @a (AsJsonb a -> ByteString) -> Value ByteString -> Value (AsJsonb a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Value ByteString
E.jsonbBytes