{-# 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 { JSON json -> json
unJSON :: json }
  deriving (JSON json -> JSON json -> Bool
(JSON json -> JSON json -> Bool)
-> (JSON json -> JSON json -> Bool) -> Eq (JSON json)
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, a -> JSON b -> JSON a
(a -> b) -> JSON a -> JSON b
(forall a b. (a -> b) -> JSON a -> JSON b)
-> (forall a b. a -> JSON b -> JSON a) -> Functor JSON
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
<$ :: a -> JSON b -> JSON a
$c<$ :: forall a b. a -> JSON b -> JSON a
fmap :: (a -> b) -> JSON a -> JSON b
$cfmap :: forall a b. (a -> b) -> JSON a -> JSON b
Functor, Eq (JSON json)
Eq (JSON json)
-> (JSON json -> JSON json -> Ordering)
-> (JSON json -> JSON json -> Bool)
-> (JSON json -> JSON json -> Bool)
-> (JSON json -> JSON json -> Bool)
-> (JSON json -> JSON json -> Bool)
-> (JSON json -> JSON json -> JSON json)
-> (JSON json -> JSON json -> JSON json)
-> Ord (JSON json)
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
$cp1Ord :: forall json. Ord json => Eq (JSON json)
Ord, Int -> JSON json -> ShowS
[JSON json] -> ShowS
JSON json -> String
(Int -> JSON json -> ShowS)
-> (JSON json -> String)
-> ([JSON json] -> ShowS)
-> Show (JSON json)
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 = (ByteString -> JSON ByteString)
-> IO ByteString -> IO (JSON ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> JSON ByteString
forall json. json -> JSON json
JSON (IO ByteString -> IO (JSON ByteString))
-> (Maybe PGbytea -> IO ByteString)
-> Maybe PGbytea
-> IO (JSON ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PGbytea -> IO ByteString
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 = (ByteString -> JSON ByteString)
-> IO ByteString -> IO (JSON ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> JSON ByteString
forall json. json -> JSON json
JSON (IO ByteString -> IO (JSON ByteString))
-> (Maybe PGbytea -> IO ByteString)
-> Maybe PGbytea
-> IO (JSON ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PGbytea -> IO ByteString
forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL

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

instance ToSQL (JSON BSL.ByteString) where
  type PQDest (JSON BSL.ByteString) = PGbytea
  toSQL :: JSON ByteString
-> ParamAllocator
-> (Ptr (PQDest (JSON ByteString)) -> IO r)
-> IO r
toSQL = ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL (ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r)
-> (JSON ByteString -> ByteString)
-> JSON ByteString
-> ParamAllocator
-> (Ptr PGbytea -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSON ByteString -> ByteString
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 = (Value -> JSON Value) -> IO Value -> IO (JSON Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> JSON Value
forall json. json -> JSON json
JSON (IO Value -> IO (JSON Value))
-> (Maybe PGbytea -> IO Value) -> Maybe PGbytea -> IO (JSON Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PGbytea -> IO Value
forall t. FromJSON t => Maybe PGbytea -> IO t
aesonFromSQL

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

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

-- | Wrapper for (de)serializing underlying type as 'jsonb'.
newtype JSONB jsonb = JSONB { JSONB jsonb -> jsonb
unJSONB :: jsonb }
  deriving (JSONB jsonb -> JSONB jsonb -> Bool
(JSONB jsonb -> JSONB jsonb -> Bool)
-> (JSONB jsonb -> JSONB jsonb -> Bool) -> Eq (JSONB jsonb)
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, a -> JSONB b -> JSONB a
(a -> b) -> JSONB a -> JSONB b
(forall a b. (a -> b) -> JSONB a -> JSONB b)
-> (forall a b. a -> JSONB b -> JSONB a) -> Functor JSONB
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
<$ :: a -> JSONB b -> JSONB a
$c<$ :: forall a b. a -> JSONB b -> JSONB a
fmap :: (a -> b) -> JSONB a -> JSONB b
$cfmap :: forall a b. (a -> b) -> JSONB a -> JSONB b
Functor, Eq (JSONB jsonb)
Eq (JSONB jsonb)
-> (JSONB jsonb -> JSONB jsonb -> Ordering)
-> (JSONB jsonb -> JSONB jsonb -> Bool)
-> (JSONB jsonb -> JSONB jsonb -> Bool)
-> (JSONB jsonb -> JSONB jsonb -> Bool)
-> (JSONB jsonb -> JSONB jsonb -> Bool)
-> (JSONB jsonb -> JSONB jsonb -> JSONB jsonb)
-> (JSONB jsonb -> JSONB jsonb -> JSONB jsonb)
-> Ord (JSONB jsonb)
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
$cp1Ord :: forall jsonb. Ord jsonb => Eq (JSONB jsonb)
Ord, Int -> JSONB jsonb -> ShowS
[JSONB jsonb] -> ShowS
JSONB jsonb -> String
(Int -> JSONB jsonb -> ShowS)
-> (JSONB jsonb -> String)
-> ([JSONB jsonb] -> ShowS)
-> Show (JSONB jsonb)
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 = (ByteString -> JSONB ByteString)
-> IO ByteString -> IO (JSONB ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> JSONB ByteString
forall jsonb. jsonb -> JSONB jsonb
JSONB (IO ByteString -> IO (JSONB ByteString))
-> (Maybe PGbytea -> IO ByteString)
-> Maybe PGbytea
-> IO (JSONB ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PGbytea -> IO ByteString
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 = (ByteString -> JSONB ByteString)
-> IO ByteString -> IO (JSONB ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> JSONB ByteString
forall jsonb. jsonb -> JSONB jsonb
JSONB (IO ByteString -> IO (JSONB ByteString))
-> (Maybe PGbytea -> IO ByteString)
-> Maybe PGbytea
-> IO (JSONB ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PGbytea -> IO ByteString
forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL

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

instance ToSQL (JSONB BSL.ByteString) where
  type PQDest (JSONB BSL.ByteString) = PGbytea
  toSQL :: JSONB ByteString
-> ParamAllocator
-> (Ptr (PQDest (JSONB ByteString)) -> IO r)
-> IO r
toSQL = ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL (ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r)
-> (JSONB ByteString -> ByteString)
-> JSONB ByteString
-> ParamAllocator
-> (Ptr PGbytea -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONB ByteString -> ByteString
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 = (Value -> JSONB Value) -> IO Value -> IO (JSONB Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> JSONB Value
forall jsonb. jsonb -> JSONB jsonb
JSONB (IO Value -> IO (JSONB Value))
-> (Maybe PGbytea -> IO Value) -> Maybe PGbytea -> IO (JSONB Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PGbytea -> IO Value
forall t. FromJSON t => Maybe PGbytea -> IO t
aesonFromSQL

instance ToSQL (JSONB Value) where
  type PQDest (JSONB Value) = PGbytea
  toSQL :: JSONB Value
-> ParamAllocator -> (Ptr (PQDest (JSONB Value)) -> IO r) -> IO r
toSQL = Value -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
forall t r.
ToJSON t =>
t -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
aesonToSQL (Value -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r)
-> (JSONB Value -> Value)
-> JSONB Value
-> ParamAllocator
-> (Ptr PGbytea -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONB Value -> Value
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 :: Maybe PGbytea -> IO t
aesonFromSQL Maybe PGbytea
mbase = do
  Either String t
evalue <- ByteString -> Either String t
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' (ByteString -> Either String t)
-> IO ByteString -> IO (Either String t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PQBase ByteString) -> IO ByteString
forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL Maybe PGbytea
Maybe (PQBase ByteString)
mbase
  case Either String t
evalue of
    Left String
err -> ErrorCall -> IO t
forall e a. Exception e => e -> IO a
E.throwIO (ErrorCall -> IO t) -> (String -> ErrorCall) -> String -> IO t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorCall
E.ErrorCall (String -> IO t) -> String -> IO t
forall a b. (a -> b) -> a -> b
$ String
"aesonFromSQL: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
    Right t
value -> t -> IO t
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 :: t -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
aesonToSQL = ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL (ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r)
-> (t -> ByteString)
-> t
-> ParamAllocator
-> (Ptr PGbytea -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> (t -> ByteString) -> t -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
forall a. ToJSON a => a -> ByteString
encode