JSON.hs

module Database.PostgreSQL.PQTypes.JSON
  ( JSON (..)
  , JSONB (..)
  , aesonFromSQL
  , aesonToSQL
  ) where

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

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 {unJSON :: json}
  deriving (Eq, Functor, Ord, Show)

instance PQFormat (JSON json) where
  pqFormat = BS.pack "%json"

instance FromSQL (JSON BS.ByteString) where
  type PQBase (JSON BS.ByteString) = PGbytea
  fromSQL = fmap JSON . fromSQL

instance FromSQL (JSON BSL.ByteString) where
  type PQBase (JSON BSL.ByteString) = PGbytea
  fromSQL = fmap JSON . fromSQL

instance ToSQL (JSON BS.ByteString) where
  type PQDest (JSON BS.ByteString) = PGbytea
  toSQL = toSQL . unJSON

instance ToSQL (JSON BSL.ByteString) where
  type PQDest (JSON BSL.ByteString) = PGbytea
  toSQL = toSQL . unJSON

instance FromSQL (JSON Value) where
  type PQBase (JSON Value) = PGbytea
  fromSQL = fmap JSON . aesonFromSQL

instance ToSQL (JSON Value) where
  type PQDest (JSON Value) = PGbytea
  toSQL = aesonToSQL . unJSON

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

-- | Wrapper for (de)serializing underlying type as 'jsonb'.
newtype JSONB jsonb = JSONB {unJSONB :: jsonb}
  deriving (Eq, Functor, Ord, Show)

instance PQFormat (JSONB jsonb) where
  pqFormat = BS.pack "%jsonb"

instance FromSQL (JSONB BS.ByteString) where
  type PQBase (JSONB BS.ByteString) = PGbytea
  fromSQL = fmap JSONB . fromSQL

instance FromSQL (JSONB BSL.ByteString) where
  type PQBase (JSONB BSL.ByteString) = PGbytea
  fromSQL = fmap JSONB . fromSQL

instance ToSQL (JSONB BS.ByteString) where
  type PQDest (JSONB BS.ByteString) = PGbytea
  toSQL = toSQL . unJSONB

instance ToSQL (JSONB BSL.ByteString) where
  type PQDest (JSONB BSL.ByteString) = PGbytea
  toSQL = toSQL . unJSONB

instance FromSQL (JSONB Value) where
  type PQBase (JSONB Value) = PGbytea
  fromSQL = fmap JSONB . aesonFromSQL

instance ToSQL (JSONB Value) where
  type PQDest (JSONB Value) = PGbytea
  toSQL = aesonToSQL . 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 mbase = do
  evalue <- eitherDecodeStrict' <$> fromSQL mbase
  case evalue of
    Left err -> E.throwIO . E.ErrorCall $ "aesonFromSQL: " ++ err
    Right value -> pure 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 = toSQL . BSL.toStrict . encode