{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# language DerivingStrategies #-}

module Database.Esqueleto.PostgreSQL.JSON.Instances where

import Data.Aeson (FromJSON(..), ToJSON(..), encode, eitherDecodeStrict)
import Data.Bifunctor (first)
import qualified Data.ByteString.Lazy as BSL (toStrict)
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as T (concat, pack)
import qualified Data.Text.Encoding as TE (decodeUtf8, encodeUtf8)
import Database.Esqueleto.Internal.PersistentImport
import Database.Esqueleto.Internal.Internal (SqlExpr, Value, just, val)
import GHC.Generics (Generic)

-- | Newtype wrapper around any type with a JSON representation.
--
-- @since 3.1.0
newtype JSONB a = JSONB { forall a. JSONB a -> a
unJSONB :: a }
    deriving stock
        ( (forall x. JSONB a -> Rep (JSONB a) x)
-> (forall x. Rep (JSONB a) x -> JSONB a) -> Generic (JSONB a)
forall x. Rep (JSONB a) x -> JSONB a
forall x. JSONB a -> Rep (JSONB a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (JSONB a) x -> JSONB a
forall a x. JSONB a -> Rep (JSONB a) x
$cfrom :: forall a x. JSONB a -> Rep (JSONB a) x
from :: forall x. JSONB a -> Rep (JSONB a) x
$cto :: forall a x. Rep (JSONB a) x -> JSONB a
to :: forall x. Rep (JSONB a) x -> JSONB a
Generic
        , JSONB a -> JSONB a -> Bool
(JSONB a -> JSONB a -> Bool)
-> (JSONB a -> JSONB a -> Bool) -> Eq (JSONB a)
forall a. Eq a => JSONB a -> JSONB a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => JSONB a -> JSONB a -> Bool
== :: JSONB a -> JSONB a -> Bool
$c/= :: forall a. Eq a => JSONB a -> JSONB a -> Bool
/= :: JSONB a -> JSONB a -> Bool
Eq
        , (forall m. Monoid m => JSONB m -> m)
-> (forall m a. Monoid m => (a -> m) -> JSONB a -> m)
-> (forall m a. Monoid m => (a -> m) -> JSONB a -> m)
-> (forall a b. (a -> b -> b) -> b -> JSONB a -> b)
-> (forall a b. (a -> b -> b) -> b -> JSONB a -> b)
-> (forall b a. (b -> a -> b) -> b -> JSONB a -> b)
-> (forall b a. (b -> a -> b) -> b -> JSONB a -> b)
-> (forall a. (a -> a -> a) -> JSONB a -> a)
-> (forall a. (a -> a -> a) -> JSONB a -> a)
-> (forall a. JSONB a -> [a])
-> (forall a. JSONB a -> Bool)
-> (forall a. JSONB a -> Int)
-> (forall a. Eq a => a -> JSONB a -> Bool)
-> (forall a. Ord a => JSONB a -> a)
-> (forall a. Ord a => JSONB a -> a)
-> (forall a. Num a => JSONB a -> a)
-> (forall a. Num a => JSONB a -> a)
-> Foldable JSONB
forall a. Eq a => a -> JSONB a -> Bool
forall a. Num a => JSONB a -> a
forall a. Ord a => JSONB a -> a
forall m. Monoid m => JSONB m -> m
forall a. JSONB a -> Bool
forall a. JSONB a -> Int
forall a. JSONB a -> [a]
forall a. (a -> a -> a) -> JSONB a -> a
forall m a. Monoid m => (a -> m) -> JSONB a -> m
forall b a. (b -> a -> b) -> b -> JSONB a -> b
forall a b. (a -> b -> b) -> b -> JSONB a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => JSONB m -> m
fold :: forall m. Monoid m => JSONB m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> JSONB a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> JSONB a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> JSONB a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> JSONB a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> JSONB a -> b
foldr :: forall a b. (a -> b -> b) -> b -> JSONB a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> JSONB a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> JSONB a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> JSONB a -> b
foldl :: forall b a. (b -> a -> b) -> b -> JSONB a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> JSONB a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> JSONB a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> JSONB a -> a
foldr1 :: forall a. (a -> a -> a) -> JSONB a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> JSONB a -> a
foldl1 :: forall a. (a -> a -> a) -> JSONB a -> a
$ctoList :: forall a. JSONB a -> [a]
toList :: forall a. JSONB a -> [a]
$cnull :: forall a. JSONB a -> Bool
null :: forall a. JSONB a -> Bool
$clength :: forall a. JSONB a -> Int
length :: forall a. JSONB a -> Int
$celem :: forall a. Eq a => a -> JSONB a -> Bool
elem :: forall a. Eq a => a -> JSONB a -> Bool
$cmaximum :: forall a. Ord a => JSONB a -> a
maximum :: forall a. Ord a => JSONB a -> a
$cminimum :: forall a. Ord a => JSONB a -> a
minimum :: forall a. Ord a => JSONB a -> a
$csum :: forall a. Num a => JSONB a -> a
sum :: forall a. Num a => JSONB a -> a
$cproduct :: forall a. Num a => JSONB a -> a
product :: forall a. Num a => JSONB a -> a
Foldable
        , (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
$cfmap :: forall a b. (a -> b) -> JSONB a -> JSONB b
fmap :: forall a b. (a -> b) -> JSONB a -> JSONB b
$c<$ :: forall a b. a -> JSONB b -> JSONB a
<$ :: forall a b. a -> JSONB b -> JSONB a
Functor
        , Eq (JSONB a)
Eq (JSONB a) =>
(JSONB a -> JSONB a -> Ordering)
-> (JSONB a -> JSONB a -> Bool)
-> (JSONB a -> JSONB a -> Bool)
-> (JSONB a -> JSONB a -> Bool)
-> (JSONB a -> JSONB a -> Bool)
-> (JSONB a -> JSONB a -> JSONB a)
-> (JSONB a -> JSONB a -> JSONB a)
-> Ord (JSONB a)
JSONB a -> JSONB a -> Bool
JSONB a -> JSONB a -> Ordering
JSONB a -> JSONB a -> JSONB a
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 a. Ord a => Eq (JSONB a)
forall a. Ord a => JSONB a -> JSONB a -> Bool
forall a. Ord a => JSONB a -> JSONB a -> Ordering
forall a. Ord a => JSONB a -> JSONB a -> JSONB a
$ccompare :: forall a. Ord a => JSONB a -> JSONB a -> Ordering
compare :: JSONB a -> JSONB a -> Ordering
$c< :: forall a. Ord a => JSONB a -> JSONB a -> Bool
< :: JSONB a -> JSONB a -> Bool
$c<= :: forall a. Ord a => JSONB a -> JSONB a -> Bool
<= :: JSONB a -> JSONB a -> Bool
$c> :: forall a. Ord a => JSONB a -> JSONB a -> Bool
> :: JSONB a -> JSONB a -> Bool
$c>= :: forall a. Ord a => JSONB a -> JSONB a -> Bool
>= :: JSONB a -> JSONB a -> Bool
$cmax :: forall a. Ord a => JSONB a -> JSONB a -> JSONB a
max :: JSONB a -> JSONB a -> JSONB a
$cmin :: forall a. Ord a => JSONB a -> JSONB a -> JSONB a
min :: JSONB a -> JSONB a -> JSONB a
Ord
        , ReadPrec [JSONB a]
ReadPrec (JSONB a)
Int -> ReadS (JSONB a)
ReadS [JSONB a]
(Int -> ReadS (JSONB a))
-> ReadS [JSONB a]
-> ReadPrec (JSONB a)
-> ReadPrec [JSONB a]
-> Read (JSONB a)
forall a. Read a => ReadPrec [JSONB a]
forall a. Read a => ReadPrec (JSONB a)
forall a. Read a => Int -> ReadS (JSONB a)
forall a. Read a => ReadS [JSONB a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (JSONB a)
readsPrec :: Int -> ReadS (JSONB a)
$creadList :: forall a. Read a => ReadS [JSONB a]
readList :: ReadS [JSONB a]
$creadPrec :: forall a. Read a => ReadPrec (JSONB a)
readPrec :: ReadPrec (JSONB a)
$creadListPrec :: forall a. Read a => ReadPrec [JSONB a]
readListPrec :: ReadPrec [JSONB a]
Read
        , Int -> JSONB a -> ShowS
[JSONB a] -> ShowS
JSONB a -> String
(Int -> JSONB a -> ShowS)
-> (JSONB a -> String) -> ([JSONB a] -> ShowS) -> Show (JSONB a)
forall a. Show a => Int -> JSONB a -> ShowS
forall a. Show a => [JSONB a] -> ShowS
forall a. Show a => JSONB a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> JSONB a -> ShowS
showsPrec :: Int -> JSONB a -> ShowS
$cshow :: forall a. Show a => JSONB a -> String
show :: JSONB a -> String
$cshowList :: forall a. Show a => [JSONB a] -> ShowS
showList :: [JSONB a] -> ShowS
Show
        , Functor JSONB
Foldable JSONB
(Functor JSONB, Foldable JSONB) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> JSONB a -> f (JSONB b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    JSONB (f a) -> f (JSONB a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> JSONB a -> m (JSONB b))
-> (forall (m :: * -> *) a. Monad m => JSONB (m a) -> m (JSONB a))
-> Traversable JSONB
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => JSONB (m a) -> m (JSONB a)
forall (f :: * -> *) a. Applicative f => JSONB (f a) -> f (JSONB a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JSONB a -> m (JSONB b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JSONB a -> f (JSONB b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JSONB a -> f (JSONB b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JSONB a -> f (JSONB b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => JSONB (f a) -> f (JSONB a)
sequenceA :: forall (f :: * -> *) a. Applicative f => JSONB (f a) -> f (JSONB a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JSONB a -> m (JSONB b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JSONB a -> m (JSONB b)
$csequence :: forall (m :: * -> *) a. Monad m => JSONB (m a) -> m (JSONB a)
sequence :: forall (m :: * -> *) a. Monad m => JSONB (m a) -> m (JSONB a)
Traversable
        )
    deriving newtype
        ( Maybe (JSONB a)
Value -> Parser [JSONB a]
Value -> Parser (JSONB a)
(Value -> Parser (JSONB a))
-> (Value -> Parser [JSONB a])
-> Maybe (JSONB a)
-> FromJSON (JSONB a)
forall a. FromJSON a => Maybe (JSONB a)
forall a. FromJSON a => Value -> Parser [JSONB a]
forall a. FromJSON a => Value -> Parser (JSONB a)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall a. FromJSON a => Value -> Parser (JSONB a)
parseJSON :: Value -> Parser (JSONB a)
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [JSONB a]
parseJSONList :: Value -> Parser [JSONB a]
$comittedField :: forall a. FromJSON a => Maybe (JSONB a)
omittedField :: Maybe (JSONB a)
FromJSON
        , [JSONB a] -> Value
[JSONB a] -> Encoding
JSONB a -> Bool
JSONB a -> Value
JSONB a -> Encoding
(JSONB a -> Value)
-> (JSONB a -> Encoding)
-> ([JSONB a] -> Value)
-> ([JSONB a] -> Encoding)
-> (JSONB a -> Bool)
-> ToJSON (JSONB a)
forall a. ToJSON a => [JSONB a] -> Value
forall a. ToJSON a => [JSONB a] -> Encoding
forall a. ToJSON a => JSONB a -> Bool
forall a. ToJSON a => JSONB a -> Value
forall a. ToJSON a => JSONB a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall a. ToJSON a => JSONB a -> Value
toJSON :: JSONB a -> Value
$ctoEncoding :: forall a. ToJSON a => JSONB a -> Encoding
toEncoding :: JSONB a -> Encoding
$ctoJSONList :: forall a. ToJSON a => [JSONB a] -> Value
toJSONList :: [JSONB a] -> Value
$ctoEncodingList :: forall a. ToJSON a => [JSONB a] -> Encoding
toEncodingList :: [JSONB a] -> Encoding
$comitField :: forall a. ToJSON a => JSONB a -> Bool
omitField :: JSONB a -> Bool
ToJSON
        )

-- | 'SqlExpr' of a NULL-able 'JSONB' value. Hence the 'Maybe'.
--
-- Note: NULL here is a PostgreSQL NULL, not a JSON 'null'
type JSONBExpr a = SqlExpr (Value (Maybe (JSONB a)))

-- | Convenience function to lift a regular value into
-- a 'JSONB' expression.
jsonbVal :: (FromJSON a, ToJSON a) => a -> JSONBExpr a
jsonbVal :: forall a. (FromJSON a, ToJSON a) => a -> JSONBExpr a
jsonbVal = SqlExpr (Value (JSONB a)) -> SqlExpr (Value (Maybe (JSONB a)))
forall typ. SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ))
just (SqlExpr (Value (JSONB a)) -> SqlExpr (Value (Maybe (JSONB a))))
-> (a -> SqlExpr (Value (JSONB a)))
-> a
-> SqlExpr (Value (Maybe (JSONB a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONB a -> SqlExpr (Value (JSONB a))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val (JSONB a -> SqlExpr (Value (JSONB a)))
-> (a -> JSONB a) -> a -> SqlExpr (Value (JSONB a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> JSONB a
forall a. a -> JSONB a
JSONB

-- | Used with certain JSON operators.
--
-- This data type has 'Num' and 'IsString' instances
-- for ease of use by using integer and string literals.
--
-- >>> 3 :: JSONAccessor
-- JSONIndex 3
-- >>> -3 :: JSONAccessor
-- JSONIndex -3
--
-- >>> "name" :: JSONAccessor
-- JSONKey "name"
--
-- NOTE: DO NOT USE ANY OF THE 'Num' METHODS ON THIS TYPE!
data JSONAccessor
    = JSONIndex Int
    | JSONKey Text
    deriving ((forall x. JSONAccessor -> Rep JSONAccessor x)
-> (forall x. Rep JSONAccessor x -> JSONAccessor)
-> Generic JSONAccessor
forall x. Rep JSONAccessor x -> JSONAccessor
forall x. JSONAccessor -> Rep JSONAccessor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JSONAccessor -> Rep JSONAccessor x
from :: forall x. JSONAccessor -> Rep JSONAccessor x
$cto :: forall x. Rep JSONAccessor x -> JSONAccessor
to :: forall x. Rep JSONAccessor x -> JSONAccessor
Generic, JSONAccessor -> JSONAccessor -> Bool
(JSONAccessor -> JSONAccessor -> Bool)
-> (JSONAccessor -> JSONAccessor -> Bool) -> Eq JSONAccessor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONAccessor -> JSONAccessor -> Bool
== :: JSONAccessor -> JSONAccessor -> Bool
$c/= :: JSONAccessor -> JSONAccessor -> Bool
/= :: JSONAccessor -> JSONAccessor -> Bool
Eq, Int -> JSONAccessor -> ShowS
[JSONAccessor] -> ShowS
JSONAccessor -> String
(Int -> JSONAccessor -> ShowS)
-> (JSONAccessor -> String)
-> ([JSONAccessor] -> ShowS)
-> Show JSONAccessor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONAccessor -> ShowS
showsPrec :: Int -> JSONAccessor -> ShowS
$cshow :: JSONAccessor -> String
show :: JSONAccessor -> String
$cshowList :: [JSONAccessor] -> ShowS
showList :: [JSONAccessor] -> ShowS
Show)

-- | I repeat, DO NOT use any method other than 'fromInteger'!
instance Num JSONAccessor where
    fromInteger :: Integer -> JSONAccessor
fromInteger = Int -> JSONAccessor
JSONIndex (Int -> JSONAccessor)
-> (Integer -> Int) -> Integer -> JSONAccessor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger
    negate :: JSONAccessor -> JSONAccessor
negate (JSONIndex Int
i) = Int -> JSONAccessor
JSONIndex (Int -> JSONAccessor) -> Int -> JSONAccessor
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
negate Int
i
    negate (JSONKey Text
_) = String -> JSONAccessor
forall a. HasCallStack => String -> a
error String
"Can not negate a JSONKey"
    + :: JSONAccessor -> JSONAccessor -> JSONAccessor
(+) = JSONAccessor -> JSONAccessor -> JSONAccessor
forall a. a
numErr
    (-) = JSONAccessor -> JSONAccessor -> JSONAccessor
forall a. a
numErr
    * :: JSONAccessor -> JSONAccessor -> JSONAccessor
(*) = JSONAccessor -> JSONAccessor -> JSONAccessor
forall a. a
numErr
    abs :: JSONAccessor -> JSONAccessor
abs = JSONAccessor -> JSONAccessor
forall a. a
numErr
    signum :: JSONAccessor -> JSONAccessor
signum = JSONAccessor -> JSONAccessor
forall a. a
numErr

numErr :: a
numErr :: forall a. a
numErr = String -> a
forall a. HasCallStack => String -> a
error String
"Do not use 'Num' methods on JSONAccessors"

instance IsString JSONAccessor where
    fromString :: String -> JSONAccessor
fromString = Text -> JSONAccessor
JSONKey (Text -> JSONAccessor)
-> (String -> Text) -> String -> JSONAccessor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | @since 3.1.0
instance (FromJSON a, ToJSON a) => PersistField (JSONB a) where
    toPersistValue :: JSONB a -> PersistValue
toPersistValue = ByteString -> PersistValue
PersistLiteralEscaped (ByteString -> PersistValue)
-> (JSONB a -> ByteString) -> JSONB a -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (JSONB a -> ByteString) -> JSONB a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode (a -> ByteString) -> (JSONB a -> a) -> JSONB a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONB a -> a
forall a. JSONB a -> a
unJSONB
    fromPersistValue :: PersistValue -> Either Text (JSONB a)
fromPersistValue PersistValue
pVal = (a -> JSONB a) -> Either Text a -> Either Text (JSONB a)
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> JSONB a
forall a. a -> JSONB a
JSONB (Either Text a -> Either Text (JSONB a))
-> Either Text a -> Either Text (JSONB a)
forall a b. (a -> b) -> a -> b
$ case PersistValue
pVal of
        PersistByteString ByteString
bs -> (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 (Text -> String -> Text
badParse (Text -> String -> Text) -> Text -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
bs) (Either String a -> Either Text a)
-> Either String a -> Either Text a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
bs
        PersistText Text
t -> (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 (Text -> String -> Text
badParse Text
t) (Either String a -> Either Text a)
-> Either String a -> Either Text a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (Text -> ByteString
TE.encodeUtf8 Text
t)
        PersistValue
x -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text -> PersistValue -> Text
fromPersistValueError Text
"string or bytea" PersistValue
x

-- | jsonb
--
-- @since 3.1.0
instance (FromJSON a, ToJSON a) => PersistFieldSql (JSONB a) where
    sqlType :: Proxy (JSONB a) -> SqlType
sqlType Proxy (JSONB a)
_ = Text -> SqlType
SqlOther Text
"JSONB"

badParse :: Text -> String -> Text
badParse :: Text -> String -> Text
badParse Text
t = Text -> Text -> Text
fromPersistValueParseError Text
t (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

fromPersistValueError
    :: Text -- ^ Database type(s), should appear different from Haskell name, e.g. "integer" or "INT", not "Int".
    -> PersistValue -- ^ Incorrect value
    -> Text -- ^ Error message
fromPersistValueError :: Text -> PersistValue -> Text
fromPersistValueError Text
databaseType PersistValue
received = [Text] -> Text
T.concat
    [ Text
"Failed to parse Haskell newtype `JSONB a`; "
    , Text
"expected ", Text
databaseType
    , Text
" from database, but received: ", String -> Text
T.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
received)
    , Text
". Potential solution: Check that your database schema matches your Persistent model definitions."
    ]

fromPersistValueParseError
    :: Text -- ^ Received value
    -> Text -- ^ Additional error
    -> Text -- ^ Error message
fromPersistValueParseError :: Text -> Text -> Text
fromPersistValueParseError Text
received Text
err = [Text] -> Text
T.concat
    [ Text
"Failed to parse Haskell type `JSONB a`, "
    , Text
"but received ", Text
received
    , Text
" | with error: ", Text
err
    ]