{-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.PQTypes.JSON
  ( JSON(..)
  , JSONB(..)
  , aesonFromSQL
  , aesonToSQL
  ) where

import Data.Aeson
import Foreign.Ptr
import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL

import Database.PostgreSQL.PQTypes.Format
import Database.PostgreSQL.PQTypes.FromSQL
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.ToSQL

-- | Wrapper for (de)serializing underlying type as 'json'.
newtype JSON json = JSON { forall json. JSON json -> json
unJSON :: json }
  deriving (JSON json -> JSON json -> Bool
forall json. Eq json => JSON json -> JSON json -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSON json -> JSON json -> Bool
$c/= :: forall json. Eq json => JSON json -> JSON json -> Bool
== :: JSON json -> JSON json -> Bool
$c== :: forall json. Eq json => JSON json -> JSON json -> Bool
Eq, forall a b. a -> JSON b -> JSON a
forall a b. (a -> b) -> JSON a -> JSON b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> JSON b -> JSON a
$c<$ :: forall a b. a -> JSON b -> JSON a
fmap :: forall a b. (a -> b) -> JSON a -> JSON b
$cfmap :: forall a b. (a -> b) -> JSON a -> JSON b
Functor, JSON json -> JSON json -> Bool
JSON json -> JSON json -> Ordering
JSON json -> JSON json -> JSON json
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 {json}. Ord json => Eq (JSON json)
forall json. Ord json => JSON json -> JSON json -> Bool
forall json. Ord json => JSON json -> JSON json -> Ordering
forall json. Ord json => JSON json -> JSON json -> JSON json
min :: JSON json -> JSON json -> JSON json
$cmin :: forall json. Ord json => JSON json -> JSON json -> JSON json
max :: JSON json -> JSON json -> JSON json
$cmax :: forall json. Ord json => JSON json -> JSON json -> JSON json
>= :: JSON json -> JSON json -> Bool
$c>= :: forall json. Ord json => JSON json -> JSON json -> Bool
> :: JSON json -> JSON json -> Bool
$c> :: forall json. Ord json => JSON json -> JSON json -> Bool
<= :: JSON json -> JSON json -> Bool
$c<= :: forall json. Ord json => JSON json -> JSON json -> Bool
< :: JSON json -> JSON json -> Bool
$c< :: forall json. Ord json => JSON json -> JSON json -> Bool
compare :: JSON json -> JSON json -> Ordering
$ccompare :: forall json. Ord json => JSON json -> JSON json -> Ordering
Ord, Int -> JSON json -> ShowS
forall json. Show json => Int -> JSON json -> ShowS
forall json. Show json => [JSON json] -> ShowS
forall json. Show json => JSON json -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSON json] -> ShowS
$cshowList :: forall json. Show json => [JSON json] -> ShowS
show :: JSON json -> String
$cshow :: forall json. Show json => JSON json -> String
showsPrec :: Int -> JSON json -> ShowS
$cshowsPrec :: forall json. Show json => Int -> JSON json -> ShowS
Show)

instance PQFormat (JSON json) where
  pqFormat :: ByteString
pqFormat = String -> ByteString
BS.pack String
"%json"

instance FromSQL (JSON BS.ByteString) where
  type PQBase (JSON BS.ByteString) = PGbytea
  fromSQL :: Maybe (PQBase (JSON ByteString)) -> IO (JSON ByteString)
fromSQL = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall json. json -> JSON json
JSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL

instance FromSQL (JSON BSL.ByteString) where
  type PQBase (JSON BSL.ByteString) = PGbytea
  fromSQL :: Maybe (PQBase (JSON ByteString)) -> IO (JSON ByteString)
fromSQL = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall json. json -> JSON json
JSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL

instance ToSQL (JSON BS.ByteString) where
  type PQDest (JSON BS.ByteString) = PGbytea
  toSQL :: forall r.
JSON ByteString
-> ParamAllocator
-> (Ptr (PQDest (JSON ByteString)) -> IO r)
-> IO r
toSQL = forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall json. JSON json -> json
unJSON

instance ToSQL (JSON BSL.ByteString) where
  type PQDest (JSON BSL.ByteString) = PGbytea
  toSQL :: forall r.
JSON ByteString
-> ParamAllocator
-> (Ptr (PQDest (JSON ByteString)) -> IO r)
-> IO r
toSQL = forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall json. JSON json -> json
unJSON

instance FromSQL (JSON Value) where
  type PQBase (JSON Value) = PGbytea
  fromSQL :: Maybe (PQBase (JSON Value)) -> IO (JSON Value)
fromSQL = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall json. json -> JSON json
JSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FromJSON t => Maybe PGbytea -> IO t
aesonFromSQL

instance ToSQL (JSON Value) where
  type PQDest (JSON Value) = PGbytea
  toSQL :: forall r.
JSON Value
-> ParamAllocator -> (Ptr (PQDest (JSON Value)) -> IO r) -> IO r
toSQL = forall t r.
ToJSON t =>
t -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
aesonToSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall json. JSON json -> json
unJSON

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

-- | Wrapper for (de)serializing underlying type as 'jsonb'.
newtype JSONB jsonb = JSONB { forall jsonb. JSONB jsonb -> jsonb
unJSONB :: jsonb }
  deriving (JSONB jsonb -> JSONB jsonb -> Bool
forall jsonb. Eq jsonb => JSONB jsonb -> JSONB jsonb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONB jsonb -> JSONB jsonb -> Bool
$c/= :: forall jsonb. Eq jsonb => JSONB jsonb -> JSONB jsonb -> Bool
== :: JSONB jsonb -> JSONB jsonb -> Bool
$c== :: forall jsonb. Eq jsonb => JSONB jsonb -> JSONB jsonb -> Bool
Eq, forall a b. a -> JSONB b -> JSONB a
forall a b. (a -> b) -> JSONB a -> JSONB b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> JSONB b -> JSONB a
$c<$ :: forall a b. a -> JSONB b -> JSONB a
fmap :: forall a b. (a -> b) -> JSONB a -> JSONB b
$cfmap :: forall a b. (a -> b) -> JSONB a -> JSONB b
Functor, JSONB jsonb -> JSONB jsonb -> Bool
JSONB jsonb -> JSONB jsonb -> Ordering
JSONB jsonb -> JSONB jsonb -> JSONB jsonb
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 {jsonb}. Ord jsonb => Eq (JSONB jsonb)
forall jsonb. Ord jsonb => JSONB jsonb -> JSONB jsonb -> Bool
forall jsonb. Ord jsonb => JSONB jsonb -> JSONB jsonb -> Ordering
forall jsonb.
Ord jsonb =>
JSONB jsonb -> JSONB jsonb -> JSONB jsonb
min :: JSONB jsonb -> JSONB jsonb -> JSONB jsonb
$cmin :: forall jsonb.
Ord jsonb =>
JSONB jsonb -> JSONB jsonb -> JSONB jsonb
max :: JSONB jsonb -> JSONB jsonb -> JSONB jsonb
$cmax :: forall jsonb.
Ord jsonb =>
JSONB jsonb -> JSONB jsonb -> JSONB jsonb
>= :: JSONB jsonb -> JSONB jsonb -> Bool
$c>= :: forall jsonb. Ord jsonb => JSONB jsonb -> JSONB jsonb -> Bool
> :: JSONB jsonb -> JSONB jsonb -> Bool
$c> :: forall jsonb. Ord jsonb => JSONB jsonb -> JSONB jsonb -> Bool
<= :: JSONB jsonb -> JSONB jsonb -> Bool
$c<= :: forall jsonb. Ord jsonb => JSONB jsonb -> JSONB jsonb -> Bool
< :: JSONB jsonb -> JSONB jsonb -> Bool
$c< :: forall jsonb. Ord jsonb => JSONB jsonb -> JSONB jsonb -> Bool
compare :: JSONB jsonb -> JSONB jsonb -> Ordering
$ccompare :: forall jsonb. Ord jsonb => JSONB jsonb -> JSONB jsonb -> Ordering
Ord, Int -> JSONB jsonb -> ShowS
forall jsonb. Show jsonb => Int -> JSONB jsonb -> ShowS
forall jsonb. Show jsonb => [JSONB jsonb] -> ShowS
forall jsonb. Show jsonb => JSONB jsonb -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONB jsonb] -> ShowS
$cshowList :: forall jsonb. Show jsonb => [JSONB jsonb] -> ShowS
show :: JSONB jsonb -> String
$cshow :: forall jsonb. Show jsonb => JSONB jsonb -> String
showsPrec :: Int -> JSONB jsonb -> ShowS
$cshowsPrec :: forall jsonb. Show jsonb => Int -> JSONB jsonb -> ShowS
Show)

instance PQFormat (JSONB jsonb) where
  pqFormat :: ByteString
pqFormat = String -> ByteString
BS.pack String
"%jsonb"

instance FromSQL (JSONB BS.ByteString) where
  type PQBase (JSONB BS.ByteString) = PGbytea
  fromSQL :: Maybe (PQBase (JSONB ByteString)) -> IO (JSONB ByteString)
fromSQL = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall jsonb. jsonb -> JSONB jsonb
JSONB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL

instance FromSQL (JSONB BSL.ByteString) where
  type PQBase (JSONB BSL.ByteString) = PGbytea
  fromSQL :: Maybe (PQBase (JSONB ByteString)) -> IO (JSONB ByteString)
fromSQL = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall jsonb. jsonb -> JSONB jsonb
JSONB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL

instance ToSQL (JSONB BS.ByteString) where
  type PQDest (JSONB BS.ByteString) = PGbytea
  toSQL :: forall r.
JSONB ByteString
-> ParamAllocator
-> (Ptr (PQDest (JSONB ByteString)) -> IO r)
-> IO r
toSQL = forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall jsonb. JSONB jsonb -> jsonb
unJSONB

instance ToSQL (JSONB BSL.ByteString) where
  type PQDest (JSONB BSL.ByteString) = PGbytea
  toSQL :: forall r.
JSONB ByteString
-> ParamAllocator
-> (Ptr (PQDest (JSONB ByteString)) -> IO r)
-> IO r
toSQL = forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall jsonb. JSONB jsonb -> jsonb
unJSONB

instance FromSQL (JSONB Value) where
  type PQBase (JSONB Value) = PGbytea
  fromSQL :: Maybe (PQBase (JSONB Value)) -> IO (JSONB Value)
fromSQL = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall jsonb. jsonb -> JSONB jsonb
JSONB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FromJSON t => Maybe PGbytea -> IO t
aesonFromSQL

instance ToSQL (JSONB Value) where
  type PQDest (JSONB Value) = PGbytea
  toSQL :: forall r.
JSONB Value
-> ParamAllocator -> (Ptr (PQDest (JSONB Value)) -> IO r) -> IO r
toSQL = forall t r.
ToJSON t =>
t -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
aesonToSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall jsonb. JSONB jsonb -> jsonb
unJSONB

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

-- | Helper for defining 'FromSQL' instance for a type with 'FromJSON' instance.
--
-- @since 1.9.1.0
aesonFromSQL :: FromJSON t => Maybe PGbytea -> IO t
aesonFromSQL :: forall t. FromJSON t => Maybe PGbytea -> IO t
aesonFromSQL Maybe PGbytea
mbase = do
  Either String t
evalue <- forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL Maybe PGbytea
mbase
  case Either String t
evalue of
    Left String
err -> forall e a. Exception e => e -> IO a
E.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorCall
E.ErrorCall forall a b. (a -> b) -> a -> b
$ String
"aesonFromSQL: " forall a. [a] -> [a] -> [a]
++ String
err
    Right t
value -> forall (m :: * -> *) a. Monad m => a -> m a
return t
value

-- | Helper for defining 'ToSQL' instance for a type with 'ToJSON' instance.
--
-- @since 1.9.1.0
aesonToSQL
  :: ToJSON t
  => t
  -> ParamAllocator
  -> (Ptr PGbytea -> IO r)
  -> IO r
aesonToSQL :: forall t r.
ToJSON t =>
t -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
aesonToSQL = forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode