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

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

import Data.Aeson
import qualified Data.Aeson as Aeson
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
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 @jsonb@ 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@ and an Aeson 'Value'
newtype Json = Json Value

-- | Newtype for 'Hasql.Interpolate.Decoder.DecodeValue' /
-- 'Hasql.Interpolate.Encoder.EncodeValue' instances that converts
-- between a postgres @jsonb@ and a 'ByteString'
newtype JsonbBytes = JsonbBytes ByteString

-- | Newtype for 'Hasql.Interpolate.Decoder.DecodeValue' /
-- 'Hasql.Interpolate.Encoder.EncodeValue' instances that converts
-- between a postgres @json@ and a 'ByteString'
newtype JsonBytes = JsonBytes ByteString

-- | Newtype for 'Hasql.Interpolate.Decoder.DecodeValue' /
-- 'Hasql.Interpolate.Encoder.EncodeValue' instances that converts
-- between a postgres @json@ 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@ 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
forall a b. Coercible a b => a -> b
coerce Value Value
D.jsonb

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

-- | Parse a postgres @jsonb@ using 'D.jsonbBytes'
instance DecodeValue JsonbBytes where
  decodeValue :: Value JsonbBytes
decodeValue = Value ByteString -> Value JsonbBytes
forall a b. Coercible a b => a -> b
coerce ((ByteString -> Either Text ByteString) -> Value ByteString
forall a. (ByteString -> Either Text a) -> Value a
D.jsonbBytes ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right)

-- | Parse a postgres @json@ using 'D.jsonBytes'
instance DecodeValue JsonBytes where
  decodeValue :: Value JsonBytes
decodeValue = Value ByteString -> Value JsonBytes
forall a b. Coercible a b => a -> b
coerce ((ByteString -> Either Text ByteString) -> Value ByteString
forall a. (ByteString -> Either Text a) -> Value a
D.jsonBytes ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right)

-- | 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 a b c. (a -> b) -> Either a c -> Either b c
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 a b c. (a -> b) -> Either a c -> Either b c
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
forall a b. Coercible a b => a -> b
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
forall a b. Coercible a b => a -> b
coerce Value Value
E.jsonb

-- | Encode a 'ByteString' to a postgres @json@ using 'E.jsonBytes'
instance EncodeValue JsonBytes where
  encodeValue :: Value JsonBytes
encodeValue = Value ByteString -> Value JsonBytes
forall a b. Coercible a b => a -> b
coerce Value ByteString
E.jsonbBytes

-- | Encode a 'ByteString' to a postgres @jsonb@ using 'E.jsonbBytes'
instance EncodeValue JsonbBytes where
  encodeValue :: Value JsonbBytes
encodeValue = Value ByteString -> Value JsonbBytes
forall a b. Coercible a b => a -> b
coerce Value ByteString
E.jsonbBytes

-- | 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 = LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (AsJson a -> LazyByteString) -> AsJson a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
Aeson.encode (a -> LazyByteString)
-> (AsJson a -> a) -> AsJson a -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
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 = LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (AsJsonb a -> LazyByteString) -> AsJsonb a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
Aeson.encode (a -> LazyByteString)
-> (AsJsonb a -> a) -> AsJsonb a -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
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