-- | Postgres SQL Value
--
-- Deals with Postgres scalar values, converting them to and from 'Text', and to
-- JSON 'Value'.
module Hasura.Backends.Postgres.SQL.Value
  ( PGScalarValue (..),
    pgScalarValueToJson,
    withConstructorFn,
    parsePGValue,
    scientificToInteger,
    scientificToFloat,
    textToScalarValue,
    TxtEncodedVal (..),
    txtEncodedVal,
    binEncoder,
    txtEncoder,
    toPrepParam,
    withScalarTypeAnn,
    withTypeAnn,
  )
where

import Data.Aeson
import Data.Aeson.Text qualified as AE
import Data.Aeson.Types qualified as AT
import Data.ByteString qualified as B
import Data.Int
import Data.Scientific
import Data.Text qualified as T
import Data.Text.Conversions qualified as TC
import Data.Text.Encoding qualified as TE
import Data.Text.Lazy qualified as TL
import Data.Time
import Data.UUID qualified as UUID
import Database.PG.Query qualified as PG
import Database.PG.Query.PTI qualified as PTI
import Database.PostgreSQL.LibPQ qualified as PQ
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Prelude
import Hasura.SQL.GeoJSON
import Hasura.SQL.Time
import Hasura.SQL.Types
import Hasura.SQL.Value (TxtEncodedVal (..))
import PostgreSQL.Binary.Encoding qualified as PE

newtype RasterWKB = RasterWKB {RasterWKB -> Base16 ByteString
getRasterWKB :: TC.Base16 B.ByteString}
  deriving (Int -> RasterWKB -> ShowS
[RasterWKB] -> ShowS
RasterWKB -> [Char]
(Int -> RasterWKB -> ShowS)
-> (RasterWKB -> [Char])
-> ([RasterWKB] -> ShowS)
-> Show RasterWKB
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RasterWKB -> ShowS
showsPrec :: Int -> RasterWKB -> ShowS
$cshow :: RasterWKB -> [Char]
show :: RasterWKB -> [Char]
$cshowList :: [RasterWKB] -> ShowS
showList :: [RasterWKB] -> ShowS
Show, RasterWKB -> RasterWKB -> Bool
(RasterWKB -> RasterWKB -> Bool)
-> (RasterWKB -> RasterWKB -> Bool) -> Eq RasterWKB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RasterWKB -> RasterWKB -> Bool
== :: RasterWKB -> RasterWKB -> Bool
$c/= :: RasterWKB -> RasterWKB -> Bool
/= :: RasterWKB -> RasterWKB -> Bool
Eq)

instance FromJSON RasterWKB where
  parseJSON :: Value -> Parser RasterWKB
parseJSON = \case
    String Text
t -> case Text -> Maybe (Base16 ByteString)
forall a. FromText a => Text -> a
TC.fromText Text
t of
      Just Base16 ByteString
v -> RasterWKB -> Parser RasterWKB
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (RasterWKB -> Parser RasterWKB) -> RasterWKB -> Parser RasterWKB
forall a b. (a -> b) -> a -> b
$ Base16 ByteString -> RasterWKB
RasterWKB Base16 ByteString
v
      Maybe (Base16 ByteString)
Nothing ->
        [Char] -> Parser RasterWKB
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail
          [Char]
"invalid hexadecimal representation of raster well known binary format"
    Value
_ -> [Char] -> Parser RasterWKB
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expecting String for raster"

instance ToJSON RasterWKB where
  toJSON :: RasterWKB -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (RasterWKB -> Text) -> RasterWKB -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 ByteString -> Text
forall a. ToText a => a -> Text
TC.toText (Base16 ByteString -> Text)
-> (RasterWKB -> Base16 ByteString) -> RasterWKB -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RasterWKB -> Base16 ByteString
getRasterWKB

newtype Ltree = Ltree Text
  deriving (Int -> Ltree -> ShowS
[Ltree] -> ShowS
Ltree -> [Char]
(Int -> Ltree -> ShowS)
-> (Ltree -> [Char]) -> ([Ltree] -> ShowS) -> Show Ltree
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ltree -> ShowS
showsPrec :: Int -> Ltree -> ShowS
$cshow :: Ltree -> [Char]
show :: Ltree -> [Char]
$cshowList :: [Ltree] -> ShowS
showList :: [Ltree] -> ShowS
Show, Ltree -> Ltree -> Bool
(Ltree -> Ltree -> Bool) -> (Ltree -> Ltree -> Bool) -> Eq Ltree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ltree -> Ltree -> Bool
== :: Ltree -> Ltree -> Bool
$c/= :: Ltree -> Ltree -> Bool
/= :: Ltree -> Ltree -> Bool
Eq)

instance ToJSON Ltree where
  toJSON :: Ltree -> Value
toJSON (Ltree Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t

instance FromJSON Ltree where
  parseJSON :: Value -> Parser Ltree
parseJSON = \case
    String Text
t ->
      if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
T.null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
".") Text
t
        then [Char] -> Parser Ltree
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
message
        else Ltree -> Parser Ltree
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ltree -> Parser Ltree) -> Ltree -> Parser Ltree
forall a b. (a -> b) -> a -> b
$ Text -> Ltree
Ltree Text
t
    Value
_ -> [Char] -> Parser Ltree
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
message
    where
      message :: [Char]
message = [Char]
"Expecting label path: a sequence of zero or more labels separated by dots, for example L1.L2.L3"

-- @PGScalarValue@ represents any value that can be a column in a Postgres table
data PGScalarValue
  = PGValInteger Int32
  | PGValSmallInt Int16
  | PGValBigInt Int64
  | PGValFloat Float
  | PGValDouble Double
  | PGValNumeric Scientific
  | PGValMoney Scientific
  | PGValBoolean Bool
  | PGValChar Char
  | PGValVarchar Text
  | PGValText Text
  | PGValCitext Text
  | PGValDate Day
  | PGValTimeStamp LocalTime
  | PGValTimeStampTZ UTCTime
  | PGValTimeTZ ZonedTimeOfDay
  | PGNull PGScalarType
  | PGValJSON PG.JSON
  | PGValJSONB PG.JSONB
  | PGValGeo GeometryWithCRS
  | PGValRaster RasterWKB
  | PGValUUID UUID.UUID
  | PGValLtree Ltree
  | PGValLquery Text
  | PGValLtxtquery Text
  | PGValUnknown Text
  | PGValArray [PGScalarValue]
  deriving (Int -> PGScalarValue -> ShowS
[PGScalarValue] -> ShowS
PGScalarValue -> [Char]
(Int -> PGScalarValue -> ShowS)
-> (PGScalarValue -> [Char])
-> ([PGScalarValue] -> ShowS)
-> Show PGScalarValue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGScalarValue -> ShowS
showsPrec :: Int -> PGScalarValue -> ShowS
$cshow :: PGScalarValue -> [Char]
show :: PGScalarValue -> [Char]
$cshowList :: [PGScalarValue] -> ShowS
showList :: [PGScalarValue] -> ShowS
Show, PGScalarValue -> PGScalarValue -> Bool
(PGScalarValue -> PGScalarValue -> Bool)
-> (PGScalarValue -> PGScalarValue -> Bool) -> Eq PGScalarValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGScalarValue -> PGScalarValue -> Bool
== :: PGScalarValue -> PGScalarValue -> Bool
$c/= :: PGScalarValue -> PGScalarValue -> Bool
/= :: PGScalarValue -> PGScalarValue -> Bool
Eq)

pgScalarValueToJson :: PGScalarValue -> Value
pgScalarValueToJson :: PGScalarValue -> Value
pgScalarValueToJson = \case
  PGValInteger Int32
i -> Int32 -> Value
forall a. ToJSON a => a -> Value
toJSON Int32
i
  PGValSmallInt Int16
i -> Int16 -> Value
forall a. ToJSON a => a -> Value
toJSON Int16
i
  PGValBigInt Int64
i -> Int64 -> Value
forall a. ToJSON a => a -> Value
toJSON Int64
i
  PGValFloat Float
f -> Float -> Value
forall a. ToJSON a => a -> Value
toJSON Float
f
  PGValDouble Double
d -> Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
d
  PGValNumeric Scientific
sc -> Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Scientific
sc
  PGValMoney Scientific
m -> Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Scientific
m
  PGValBoolean Bool
b -> Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
b
  PGValChar Char
t -> Char -> Value
forall a. ToJSON a => a -> Value
toJSON Char
t
  PGValVarchar Text
t -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  PGValText Text
t -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  PGValCitext Text
t -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  PGValDate Day
d -> Day -> Value
forall a. ToJSON a => a -> Value
toJSON Day
d
  PGValTimeStamp LocalTime
u -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ LocalTime -> Text
forall t. FormatTime t => t -> Text
formatTimestamp LocalTime
u
  PGValTimeStampTZ UTCTime
u -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ UTCTime -> Text
forall t. FormatTime t => t -> Text
formatTimestamp UTCTime
u
  PGValTimeTZ (ZonedTimeOfDay TimeOfDay
tod TimeZone
tz) ->
    [Char] -> Value
forall a. ToJSON a => a -> Value
toJSON (TimeOfDay -> [Char]
forall a. Show a => a -> [Char]
show TimeOfDay
tod [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ TimeZone -> [Char]
timeZoneOffsetString TimeZone
tz)
  PGNull PGScalarType
_ -> Value
Null
  PGValJSON (PG.JSON Value
j) -> Value
j
  PGValJSONB (PG.JSONB Value
j) -> Value
j
  PGValGeo GeometryWithCRS
o -> GeometryWithCRS -> Value
forall a. ToJSON a => a -> Value
toJSON GeometryWithCRS
o
  PGValRaster RasterWKB
r -> RasterWKB -> Value
forall a. ToJSON a => a -> Value
toJSON RasterWKB
r
  PGValUUID UUID
u -> UUID -> Value
forall a. ToJSON a => a -> Value
toJSON UUID
u
  PGValLtree Ltree
t -> Ltree -> Value
forall a. ToJSON a => a -> Value
toJSON Ltree
t
  PGValLquery Text
t -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  PGValLtxtquery Text
t -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  PGValUnknown Text
t -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  PGValArray [PGScalarValue]
a -> [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ((PGScalarValue -> Value) -> [PGScalarValue] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map PGScalarValue -> Value
pgScalarValueToJson [PGScalarValue]
a)

textToScalarValue :: Maybe Text -> PGScalarValue
textToScalarValue :: Maybe Text -> PGScalarValue
textToScalarValue = PGScalarValue
-> (Text -> PGScalarValue) -> Maybe Text -> PGScalarValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PGScalarType -> PGScalarValue
PGNull PGScalarType
PGText) Text -> PGScalarValue
PGValText

withConstructorFn :: PGScalarType -> S.SQLExp -> S.SQLExp
withConstructorFn :: PGScalarType -> SQLExp -> SQLExp
withConstructorFn PGScalarType
ty SQLExp
v
  | PGScalarType -> Bool
isGeoType PGScalarType
ty = Text -> [SQLExp] -> Maybe OrderByExp -> SQLExp
S.SEFnApp Text
"ST_GeomFromGeoJSON" [SQLExp
v] Maybe OrderByExp
forall a. Maybe a
Nothing
  | PGScalarType
ty PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGRaster = Text -> [SQLExp] -> Maybe OrderByExp -> SQLExp
S.SEFnApp Text
"ST_RastFromHexWKB" [SQLExp
v] Maybe OrderByExp
forall a. Maybe a
Nothing
  | Bool
otherwise = SQLExp
v

-- FIXME: shouldn't this also use 'withConstructorFn'?
withScalarTypeAnn :: PGScalarType -> S.SQLExp -> S.SQLExp
withScalarTypeAnn :: PGScalarType -> SQLExp -> SQLExp
withScalarTypeAnn PGScalarType
colTy SQLExp
v = SQLExp -> TypeAnn -> SQLExp
S.SETyAnn SQLExp
v (TypeAnn -> SQLExp)
-> (CollectableType PGScalarType -> TypeAnn)
-> CollectableType PGScalarType
-> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollectableType PGScalarType -> TypeAnn
S.mkTypeAnn (CollectableType PGScalarType -> SQLExp)
-> CollectableType PGScalarType -> SQLExp
forall a b. (a -> b) -> a -> b
$ PGScalarType -> CollectableType PGScalarType
forall a. a -> CollectableType a
CollectableTypeScalar PGScalarType
colTy

withTypeAnn :: CollectableType PGScalarType -> S.SQLExp -> S.SQLExp
withTypeAnn :: CollectableType PGScalarType -> SQLExp -> SQLExp
withTypeAnn CollectableType PGScalarType
ty SQLExp
expr = (SQLExp -> TypeAnn -> SQLExp) -> TypeAnn -> SQLExp -> SQLExp
forall a b c. (a -> b -> c) -> b -> a -> c
flip SQLExp -> TypeAnn -> SQLExp
S.SETyAnn (CollectableType PGScalarType -> TypeAnn
S.mkTypeAnn CollectableType PGScalarType
ty)
  (SQLExp -> SQLExp) -> SQLExp -> SQLExp
forall a b. (a -> b) -> a -> b
$ case CollectableType PGScalarType
ty of
    CollectableTypeScalar PGScalarType
baseTy -> PGScalarType -> SQLExp -> SQLExp
withConstructorFn PGScalarType
baseTy SQLExp
expr
    CollectableTypeArray PGScalarType
_ -> SQLExp
expr

-- TODO: those two functions are useful outside of Postgres, and
-- should be moved to a common place of the code. Perhaps the Prelude?
scientificToInteger :: (Integral i, Bounded i) => Scientific -> AT.Parser i
scientificToInteger :: forall i. (Integral i, Bounded i) => Scientific -> Parser i
scientificToInteger Scientific
num =
  Scientific -> Maybe i
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
num
    Maybe i -> Parser i -> Parser i
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` [Char] -> Parser i
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail
      ( [Char]
"The value "
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Scientific -> [Char]
forall a. Show a => a -> [Char]
show Scientific
num
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" lies outside the "
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"bounds or is not an integer. Maybe it is a "
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"float, or is there integer overflow?"
      )

scientificToFloat :: (RealFloat f) => Scientific -> AT.Parser f
scientificToFloat :: forall f. RealFloat f => Scientific -> Parser f
scientificToFloat Scientific
num =
  Scientific -> Either f f
forall a. RealFloat a => Scientific -> Either a a
toBoundedRealFloat Scientific
num
    Either f f -> (f -> Parser f) -> Parser f
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` \f
_ ->
      [Char] -> Parser f
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail
        ( [Char]
"The value "
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Scientific -> [Char]
forall a. Show a => a -> [Char]
show Scientific
num
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" lies outside the "
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"bounds. Is it overflowing the float bounds?"
        )

parsePGValue :: PGScalarType -> Value -> AT.Parser PGScalarValue
parsePGValue :: PGScalarType -> Value -> Parser PGScalarValue
parsePGValue PGScalarType
ty Value
val = case (PGScalarType
ty, Value
val) of
  (PGScalarType
_, Value
Null) -> PGScalarValue -> Parser PGScalarValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PGScalarValue -> Parser PGScalarValue)
-> PGScalarValue -> Parser PGScalarValue
forall a b. (a -> b) -> a -> b
$ PGScalarType -> PGScalarValue
PGNull PGScalarType
ty
  (PGUnknown Text
_, String Text
t) -> PGScalarValue -> Parser PGScalarValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PGScalarValue -> Parser PGScalarValue)
-> PGScalarValue -> Parser PGScalarValue
forall a b. (a -> b) -> a -> b
$ Text -> PGScalarValue
PGValUnknown Text
t
  (PGScalarType
PGRaster, Value
_) -> Parser PGScalarValue
parseTyped -- strictly parse raster value
  (PGScalarType
PGLtree, Value
_) -> Parser PGScalarValue
parseTyped
  (PGScalarType
_, String Text
t) -> Parser PGScalarValue
parseTyped Parser PGScalarValue
-> Parser PGScalarValue -> Parser PGScalarValue
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PGScalarValue -> Parser PGScalarValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> PGScalarValue
PGValUnknown Text
t)
  (PGScalarType
_, Value
_) -> Parser PGScalarValue
parseTyped
  where
    parseBoundedInt :: forall i. (Integral i, Bounded i) => Value -> AT.Parser i
    parseBoundedInt :: forall i. (Integral i, Bounded i) => Value -> Parser i
parseBoundedInt = [Char] -> (Scientific -> Parser i) -> Value -> Parser i
forall a. [Char] -> (Scientific -> Parser a) -> Value -> Parser a
withScientific ([Char]
"Integer expected for input type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PGScalarType -> [Char]
forall a. Show a => a -> [Char]
show PGScalarType
ty) Scientific -> Parser i
forall i. (Integral i, Bounded i) => Scientific -> Parser i
scientificToInteger

    parseBoundedFloat :: forall a. (RealFloat a) => Value -> AT.Parser a
    parseBoundedFloat :: forall a. RealFloat a => Value -> Parser a
parseBoundedFloat = [Char] -> (Scientific -> Parser a) -> Value -> Parser a
forall a. [Char] -> (Scientific -> Parser a) -> Value -> Parser a
withScientific ([Char]
"Float expected for input type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PGScalarType -> [Char]
forall a. Show a => a -> [Char]
show PGScalarType
ty) Scientific -> Parser a
forall f. RealFloat f => Scientific -> Parser f
scientificToFloat

    parseTyped :: Parser PGScalarValue
parseTyped = case PGScalarType
ty of
      PGScalarType
PGSmallInt -> Int16 -> PGScalarValue
PGValSmallInt (Int16 -> PGScalarValue) -> Parser Int16 -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int16
forall i. (Integral i, Bounded i) => Value -> Parser i
parseBoundedInt Value
val
      PGScalarType
PGInteger -> Int32 -> PGScalarValue
PGValInteger (Int32 -> PGScalarValue) -> Parser Int32 -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int32
forall i. (Integral i, Bounded i) => Value -> Parser i
parseBoundedInt Value
val
      PGScalarType
PGBigInt -> Int64 -> PGScalarValue
PGValBigInt (Int64 -> PGScalarValue) -> Parser Int64 -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int64
forall i. (Integral i, Bounded i) => Value -> Parser i
parseBoundedInt Value
val
      PGScalarType
PGSerial -> Int32 -> PGScalarValue
PGValInteger (Int32 -> PGScalarValue) -> Parser Int32 -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int32
forall i. (Integral i, Bounded i) => Value -> Parser i
parseBoundedInt Value
val
      PGScalarType
PGBigSerial -> Int64 -> PGScalarValue
PGValBigInt (Int64 -> PGScalarValue) -> Parser Int64 -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int64
forall i. (Integral i, Bounded i) => Value -> Parser i
parseBoundedInt Value
val
      PGScalarType
PGFloat -> Float -> PGScalarValue
PGValFloat (Float -> PGScalarValue) -> Parser Float -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Float
forall a. RealFloat a => Value -> Parser a
parseBoundedFloat Value
val
      PGScalarType
PGDouble -> Double -> PGScalarValue
PGValDouble (Double -> PGScalarValue) -> Parser Double -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Double
forall a. RealFloat a => Value -> Parser a
parseBoundedFloat Value
val
      PGScalarType
PGNumeric -> Scientific -> PGScalarValue
PGValNumeric (Scientific -> PGScalarValue)
-> Parser Scientific -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Scientific
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGMoney -> Scientific -> PGScalarValue
PGValMoney (Scientific -> PGScalarValue)
-> Parser Scientific -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Scientific
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGBoolean -> Bool -> PGScalarValue
PGValBoolean (Bool -> PGScalarValue) -> Parser Bool -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGChar -> Char -> PGScalarValue
PGValChar (Char -> PGScalarValue) -> Parser Char -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Char
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGVarchar -> Text -> PGScalarValue
PGValVarchar (Text -> PGScalarValue) -> Parser Text -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGText -> Text -> PGScalarValue
PGValText (Text -> PGScalarValue) -> Parser Text -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGCitext -> Text -> PGScalarValue
PGValCitext (Text -> PGScalarValue) -> Parser Text -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGDate -> Day -> PGScalarValue
PGValDate (Day -> PGScalarValue) -> Parser Day -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Day
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGTimeStamp -> LocalTime -> PGScalarValue
PGValTimeStamp (LocalTime -> PGScalarValue)
-> Parser LocalTime -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LocalTime
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGTimeStampTZ -> UTCTime -> PGScalarValue
PGValTimeStampTZ (UTCTime -> PGScalarValue)
-> Parser UTCTime -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser UTCTime
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGTimeTZ -> ZonedTimeOfDay -> PGScalarValue
PGValTimeTZ (ZonedTimeOfDay -> PGScalarValue)
-> Parser ZonedTimeOfDay -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ZonedTimeOfDay
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGJSON -> JSON -> PGScalarValue
PGValJSON (JSON -> PGScalarValue)
-> (Value -> JSON) -> Value -> PGScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> JSON
PG.JSON (Value -> PGScalarValue) -> Parser Value -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Value
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGJSONB -> JSONB -> PGScalarValue
PGValJSONB (JSONB -> PGScalarValue)
-> (Value -> JSONB) -> Value -> PGScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> JSONB
PG.JSONB (Value -> PGScalarValue) -> Parser Value -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Value
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGGeometry -> GeometryWithCRS -> PGScalarValue
PGValGeo (GeometryWithCRS -> PGScalarValue)
-> Parser GeometryWithCRS -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GeometryWithCRS
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGGeography -> GeometryWithCRS -> PGScalarValue
PGValGeo (GeometryWithCRS -> PGScalarValue)
-> Parser GeometryWithCRS -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GeometryWithCRS
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGRaster -> RasterWKB -> PGScalarValue
PGValRaster (RasterWKB -> PGScalarValue)
-> Parser RasterWKB -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser RasterWKB
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGUUID -> UUID -> PGScalarValue
PGValUUID (UUID -> PGScalarValue) -> Parser UUID -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser UUID
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGLtree -> Ltree -> PGScalarValue
PGValLtree (Ltree -> PGScalarValue) -> Parser Ltree -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Ltree
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGLquery -> Text -> PGScalarValue
PGValLquery (Text -> PGScalarValue) -> Parser Text -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGScalarType
PGLtxtquery -> Text -> PGScalarValue
PGValLtxtquery (Text -> PGScalarValue) -> Parser Text -> Parser PGScalarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      PGUnknown Text
tyName ->
        [Char] -> Parser PGScalarValue
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser PGScalarValue) -> [Char] -> Parser PGScalarValue
forall a b. (a -> b) -> a -> b
$ [Char]
"A string is expected for type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
tyName
      PGCompositeScalar Text
tyName ->
        [Char] -> Parser PGScalarValue
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser PGScalarValue) -> [Char] -> Parser PGScalarValue
forall a b. (a -> b) -> a -> b
$ [Char]
"A string is expected for type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
tyName
      PGEnumScalar Text
tyName ->
        [Char] -> Parser PGScalarValue
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser PGScalarValue) -> [Char] -> Parser PGScalarValue
forall a b. (a -> b) -> a -> b
$ [Char]
"A string is expected for type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
tyName
      PGArray PGScalarType
s -> Value -> Parser [Value]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val Parser [Value]
-> ([Value] -> Parser PGScalarValue) -> Parser PGScalarValue
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PGScalarValue] -> PGScalarValue)
-> Parser [PGScalarValue] -> Parser PGScalarValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PGScalarValue] -> PGScalarValue
PGValArray (Parser [PGScalarValue] -> Parser PGScalarValue)
-> ([Value] -> Parser [PGScalarValue])
-> [Value]
-> Parser PGScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser PGScalarValue)
-> [Value] -> Parser [PGScalarValue]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (PGScalarType -> Value -> Parser PGScalarValue
parsePGValue PGScalarType
s)

txtEncodedVal :: PGScalarValue -> TxtEncodedVal
txtEncodedVal :: PGScalarValue -> TxtEncodedVal
txtEncodedVal = \case
  PGValInteger Int32
i -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Int32 -> Text
forall a. Show a => a -> Text
tshow Int32
i
  PGValSmallInt Int16
i -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Int16 -> Text
forall a. Show a => a -> Text
tshow Int16
i
  PGValBigInt Int64
i -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
i
  PGValFloat Float
f -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Float -> Text
forall a. Show a => a -> Text
tshow Float
f
  PGValDouble Double
d -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Double -> Text
forall a. Show a => a -> Text
tshow Double
d
  PGValNumeric Scientific
sc -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Scientific -> Text
forall a. Show a => a -> Text
tshow Scientific
sc
  -- PostgreSQL doesn't like scientific notation for money, so pass it
  -- with 2 decimal places.
  PGValMoney Scientific
m -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> [Char]
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Scientific
m
  PGValBoolean Bool
b -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
b
  PGValChar Char
t -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
t
  PGValVarchar Text
t -> Text -> TxtEncodedVal
TELit Text
t
  PGValText Text
t -> Text -> TxtEncodedVal
TELit Text
t
  PGValCitext Text
t -> Text -> TxtEncodedVal
TELit Text
t
  PGValDate Day
d -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Day -> [Char]
showGregorian Day
d
  PGValTimeStamp LocalTime
u -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ LocalTime -> Text
forall t. FormatTime t => t -> Text
formatTimestamp LocalTime
u
  PGValTimeStampTZ UTCTime
u -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ UTCTime -> Text
forall t. FormatTime t => t -> Text
formatTimestamp UTCTime
u
  PGValTimeTZ (ZonedTimeOfDay TimeOfDay
tod TimeZone
tz) ->
    Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (TimeOfDay -> [Char]
forall a. Show a => a -> [Char]
show TimeOfDay
tod [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ TimeZone -> [Char]
timeZoneOffsetString TimeZone
tz)
  PGNull PGScalarType
_ ->
    TxtEncodedVal
TENull
  PGValJSON (PG.JSON Value
j) ->
    Text -> TxtEncodedVal
TELit
      (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.toStrict
      (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Text
forall a. ToJSON a => a -> Text
AE.encodeToLazyText Value
j
  PGValJSONB (PG.JSONB Value
j) ->
    Text -> TxtEncodedVal
TELit
      (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.toStrict
      (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Text
forall a. ToJSON a => a -> Text
AE.encodeToLazyText Value
j
  PGValGeo GeometryWithCRS
o ->
    Text -> TxtEncodedVal
TELit
      (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.toStrict
      (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ GeometryWithCRS -> Text
forall a. ToJSON a => a -> Text
AE.encodeToLazyText GeometryWithCRS
o
  PGValRaster RasterWKB
r -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Base16 ByteString -> Text
forall a. ToText a => a -> Text
TC.toText (Base16 ByteString -> Text) -> Base16 ByteString -> Text
forall a b. (a -> b) -> a -> b
$ RasterWKB -> Base16 ByteString
getRasterWKB RasterWKB
r
  PGValUUID UUID
u -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ UUID -> Text
UUID.toText UUID
u
  PGValLtree (Ltree Text
t) -> Text -> TxtEncodedVal
TELit Text
t
  PGValLquery Text
t -> Text -> TxtEncodedVal
TELit Text
t
  PGValLtxtquery Text
t -> Text -> TxtEncodedVal
TELit Text
t
  PGValUnknown Text
t -> Text -> TxtEncodedVal
TELit Text
t
  PGValArray [PGScalarValue]
ts -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ [PGScalarValue] -> Text
buildArrayLiteral [PGScalarValue]
ts

binEncoder :: PGScalarValue -> PG.PrepArg
binEncoder :: PGScalarValue -> PrepArg
binEncoder = \case
  PGValInteger Int32
i -> Int32 -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Int32
i
  PGValSmallInt Int16
i -> Int16 -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Int16
i
  PGValBigInt Int64
i -> Int64 -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Int64
i
  PGValFloat Float
f -> Float -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Float
f
  PGValDouble Double
d -> Double -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Double
d
  PGValNumeric Scientific
sc -> Scientific -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Scientific
sc
  PGValMoney Scientific
m -> Scientific -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Scientific
m
  PGValBoolean Bool
b -> Bool -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Bool
b
  PGValChar Char
t -> Char -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Char
t
  PGValVarchar Text
t -> Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Text
t
  PGValText Text
t -> Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Text
t
  PGValCitext Text
t -> Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Text
t
  PGValDate Day
d -> Day -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Day
d
  PGValTimeStamp LocalTime
u -> LocalTime -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal LocalTime
u
  PGValTimeStampTZ UTCTime
u -> UTCTime -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal UTCTime
u
  PGValTimeTZ (ZonedTimeOfDay TimeOfDay
t TimeZone
z) -> Oid
-> ((TimeOfDay, TimeZone) -> Encoding)
-> (TimeOfDay, TimeZone)
-> PrepArg
forall a. Oid -> (a -> Encoding) -> a -> PrepArg
PG.toPrepValHelper Oid
PTI.timetz (TimeOfDay, TimeZone) -> Encoding
PE.timetz_int (TimeOfDay
t, TimeZone
z)
  PGNull PGScalarType
ty -> (PGScalarType -> Oid
pgTypeOid PGScalarType
ty, Maybe (ByteString, Format)
forall a. Maybe a
Nothing)
  PGValJSON JSON
u -> JSON -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal JSON
u
  PGValJSONB JSONB
u -> JSONB -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal JSONB
u
  PGValGeo GeometryWithCRS
o -> Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal (Text -> PrepArg) -> Text -> PrepArg
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ GeometryWithCRS -> Text
forall a. ToJSON a => a -> Text
AE.encodeToLazyText GeometryWithCRS
o
  PGValRaster RasterWKB
r -> Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal (Text -> PrepArg) -> Text -> PrepArg
forall a b. (a -> b) -> a -> b
$ Base16 ByteString -> Text
forall a. ToText a => a -> Text
TC.toText (Base16 ByteString -> Text) -> Base16 ByteString -> Text
forall a b. (a -> b) -> a -> b
$ RasterWKB -> Base16 ByteString
getRasterWKB RasterWKB
r
  PGValUUID UUID
u -> UUID -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal UUID
u
  PGValLtree (Ltree Text
t) -> Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Text
t
  PGValLquery Text
t -> Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Text
t
  PGValLtxtquery Text
t -> Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal Text
t
  PGValUnknown Text
t -> (Oid
PTI.auto, (ByteString, Format) -> Maybe (ByteString, Format)
forall a. a -> Maybe a
Just (Text -> ByteString
TE.encodeUtf8 Text
t, Format
PQ.Text))
  PGValArray [PGScalarValue]
s -> (Oid
PTI.auto, (ByteString, Format) -> Maybe (ByteString, Format)
forall a. a -> Maybe a
Just (Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [PGScalarValue] -> Text
buildArrayLiteral [PGScalarValue]
s, Format
PQ.Text))

formatTimestamp :: (FormatTime t) => t -> Text
formatTimestamp :: forall t. FormatTime t => t -> Text
formatTimestamp = [Char] -> Text
T.pack ([Char] -> Text) -> (t -> [Char]) -> t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> [Char] -> t -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%0Y-%m-%dT%T%QZ"

txtEncoder :: PGScalarValue -> S.SQLExp
txtEncoder :: PGScalarValue -> SQLExp
txtEncoder PGScalarValue
colVal = case PGScalarValue -> TxtEncodedVal
txtEncodedVal PGScalarValue
colVal of
  TxtEncodedVal
TENull -> SQLExp
S.SENull
  TELit Text
t -> Text -> SQLExp
S.SELit Text
t

-- arrays are sufficiently complicated, e.g. in the case of empty and unknown element arrays,
-- for us to default to text encoding in all cases, and defer to Postgres' handling of them
--
-- FIXME: this will fail if we ever introduce the box type as a @PGScalarValue@,
-- which uses a different seperator https://www.postgresql.org/docs/current/arrays.html#ARRAYS-INPUT
-- https://github.com/hasura/graphql-engine-mono/issues/4892
buildArrayLiteral :: [PGScalarValue] -> Text
buildArrayLiteral :: [PGScalarValue] -> Text
buildArrayLiteral [PGScalarValue]
ts =
  [Text] -> Text
T.concat [Text
"{", Text -> [Text] -> Text
T.intercalate Text
"," ((PGScalarValue -> Text) -> [PGScalarValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (TxtEncodedVal -> Text
inner (TxtEncodedVal -> Text)
-> (PGScalarValue -> TxtEncodedVal) -> PGScalarValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGScalarValue -> TxtEncodedVal
encodeElement) [PGScalarValue]
ts), Text
"}"]
  where
    -- present text elements as json strings
    escape :: Text -> Text
escape = Text -> Text
TL.toStrict (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. ToJSON a => a -> Text
AE.encodeToLazyText
    encodeElement :: PGScalarValue -> TxtEncodedVal
encodeElement = \case
      PGValChar Char
t -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
escape (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
t
      PGValVarchar Text
t -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
escape Text
t
      PGValText Text
t -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
escape Text
t
      PGValCitext Text
t -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
escape Text
t
      PGValLquery Text
t -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
escape Text
t
      PGValLtxtquery Text
t -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
escape Text
t
      PGValUnknown Text
t -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
escape Text
t
      PGValJSON (PG.JSON Value
j) -> case Value
j of
        -- this is delicate - we want to encode JSON
        -- that is provided to HGE as raw JSON literals provided via variables,
        -- and in stringified form as received when
        -- inlined in a query. Therefore we need to check whether any string
        -- receive is a genuine JSON string value, or a stringified rich value.
        String Text
s -> case ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode (Text -> ByteString
txtToLbs Text
s) of
          Just Value
jv -> Value -> TxtEncodedVal
fromJson Value
jv -- it was some actual JSON in disguise! encode it like usual
          Maybe Value
Nothing -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
escape (Text -> Text
escape Text
s) -- it's an actual JSON string, so add quotes again
        Value
_ -> Value -> TxtEncodedVal
fromJson Value
j
      PGValJSONB (PG.JSONB Value
j) -> case Value
j of
        -- we do the same for JSONB as JSON
        String Text
s -> case ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode (Text -> ByteString
txtToLbs Text
s) of
          Just Value
jv -> Value -> TxtEncodedVal
fromJsonb Value
jv -- it was some actual JSON in disguise! encode it like usual
          Maybe Value
Nothing -> Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal) -> Text -> TxtEncodedVal
forall a b. (a -> b) -> a -> b
$ Text -> Text
escape (Text -> Text
escape Text
s) -- it's an actual JSON string, so add quotes again
        Value
_ -> Value -> TxtEncodedVal
fromJsonb Value
j
      PGScalarValue
other -> PGScalarValue -> TxtEncodedVal
txtEncodedVal PGScalarValue
other

    fromJson :: Value -> TxtEncodedVal
fromJson = Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal)
-> (Value -> Text) -> Value -> TxtEncodedVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escape (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
bsToTxt (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
PE.encodingBytes (Encoding -> ByteString)
-> (Value -> Encoding) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Encoding
PE.json_ast
    fromJsonb :: Value -> TxtEncodedVal
fromJsonb = Text -> TxtEncodedVal
TELit (Text -> TxtEncodedVal)
-> (Value -> Text) -> Value -> TxtEncodedVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escape (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
bsToTxt (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
PE.encodingBytes (Encoding -> ByteString)
-> (Value -> Encoding) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Encoding
PE.jsonb_ast

    inner :: TxtEncodedVal -> Text
inner = \case
      TxtEncodedVal
TENull -> Text
"null"
      TELit Text
t -> Text
t

{- Note [Type casting prepared params]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prepared values are passed to Postgres via text encoding. Explicit type cast for prepared params
is needed to distinguish the column types. For example, the parameter for citext column type is
generated as ($i)::citext where 'i' is parameter position (integer).

Also see https://github.com/hasura/graphql-engine/issues/2818
-}

toPrepParam :: Int -> PGScalarType -> S.SQLExp
toPrepParam :: Int -> PGScalarType -> SQLExp
toPrepParam Int
i PGScalarType
ty =
  -- See Note [Type casting prepared params] above
  PGScalarType -> SQLExp -> SQLExp
withScalarTypeAnn PGScalarType
ty (SQLExp -> SQLExp) -> (SQLExp -> SQLExp) -> SQLExp -> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGScalarType -> SQLExp -> SQLExp
withConstructorFn PGScalarType
ty (SQLExp -> SQLExp) -> SQLExp -> SQLExp
forall a b. (a -> b) -> a -> b
$ Int -> SQLExp
S.SEPrep Int
i