module Hasql.Codecs.Decoders.Value
  ( Value (..),
    bool,
    int2,
    int4,
    int8,
    float4,
    float8,
    numeric,
    char,
    text,
    varchar,
    bpchar,
    bytea,
    date,
    timestamp,
    timestamptz,
    time,
    timetz,
    interval,
    uuid,
    inet,
    macaddr,
    json,
    jsonBytes,
    jsonb,
    jsonbBytes,
    int4range,
    int8range,
    numrange,
    tsrange,
    tstzrange,
    daterange,
    int4multirange,
    int8multirange,
    nummultirange,
    tsmultirange,
    tstzmultirange,
    datemultirange,
    citext,
    custom,
    refine,
    hstore,
    enum,
    toDimensionality,
    toDecoder,
    toSchema,
    toTypeName,
    toOid,
    toBaseOid,
    toArrayOid,
    toHandler,
    toByteStringParser,
    isArray,
  )
where

import Data.Aeson qualified as Aeson
import Data.IP qualified as Iproute
import Hasql.Codecs.RequestingOid qualified as RequestingOid
import Hasql.Codecs.TypeInfo qualified as TypeInfo
import Hasql.Platform.Prelude hiding (bool)
import PostgreSQL.Binary.Decoding qualified as Binary
import PostgreSQL.Binary.Range qualified as R

-- |
-- Value decoder.
data Value a
  = Value
      -- | Schema name.
      (Maybe Text)
      -- | Type name.
      Text
      -- | Statically known OID for the type.
      (Maybe Word32)
      -- | Statically known OID for the array-type with this type as the element.
      (Maybe Word32)
      -- | Dimensionality. If 0 then it is a scalar value, otherwise it is an array with that many dimensions.
      Word
      -- | Decoding function on a registry of OIDs by type name.
      (RequestingOid.RequestingOid (Binary.Value a))
  deriving ((forall a b. (a -> b) -> Value a -> Value b)
-> (forall a b. a -> Value b -> Value a) -> Functor Value
forall a b. a -> Value b -> Value a
forall a b. (a -> b) -> Value a -> Value 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) -> Value a -> Value b
fmap :: forall a b. (a -> b) -> Value a -> Value b
$c<$ :: forall a b. a -> Value b -> Value a
<$ :: forall a b. a -> Value b -> Value a
Functor)

type role Value representational

instance Filterable Value where
  {-# INLINE mapMaybe #-}
  mapMaybe :: forall a b. (a -> Maybe b) -> Value a -> Value b
mapMaybe a -> Maybe b
fn =
    (a -> Either Text b) -> Value a -> Value b
forall a b. (a -> Either Text b) -> Value a -> Value b
refine (Either Text b -> (b -> Either Text b) -> Maybe b -> Either Text b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text b
forall a b. a -> Either a b
Left Text
"Invalid value") b -> Either Text b
forall a b. b -> Either a b
Right (Maybe b -> Either Text b) -> (a -> Maybe b) -> a -> Either Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Maybe b
fn)

-- |
-- Create a decoder from TypeInfo metadata and a decoding function.
{-# INLINE primitive #-}
primitive :: Text -> TypeInfo.TypeInfo -> Binary.Value a -> Value a
primitive :: forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
typeName TypeInfo
pti Value a
decoder =
  Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value a)
-> Value a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value a)
-> Value a
Value Maybe Text
forall a. Maybe a
Nothing Text
typeName (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (TypeInfo -> Word32
TypeInfo.toBaseOid TypeInfo
pti)) (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (TypeInfo -> Word32
TypeInfo.toArrayOid TypeInfo
pti)) Word
0 (Value a -> RequestingOid (Value a)
forall a. a -> RequestingOid a
RequestingOid.lift Value a
decoder)

-- * Static types

-- |
-- Decoder of the @BOOL@ values.
{-# INLINEABLE bool #-}
bool :: Value Bool
bool :: Value Bool
bool = Text -> TypeInfo -> Value Bool -> Value Bool
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"bool" TypeInfo
TypeInfo.bool Value Bool
Binary.bool

-- |
-- Decoder of the @INT2@ values.
{-# INLINEABLE int2 #-}
int2 :: Value Int16
int2 :: Value Int16
int2 = Text -> TypeInfo -> Value Int16 -> Value Int16
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"int2" TypeInfo
TypeInfo.int2 Value Int16
forall a. (Integral a, Bits a) => Value a
Binary.int

-- |
-- Decoder of the @INT4@ values.
{-# INLINEABLE int4 #-}
int4 :: Value Int32
int4 :: Value Int32
int4 = Text -> TypeInfo -> Value Int32 -> Value Int32
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"int4" TypeInfo
TypeInfo.int4 Value Int32
forall a. (Integral a, Bits a) => Value a
Binary.int

-- |
-- Decoder of the @INT8@ values.
{-# INLINEABLE int8 #-}
int8 :: Value Int64
int8 :: Value Int64
int8 =
  {-# SCC "int8" #-}
  Text -> TypeInfo -> Value Int64 -> Value Int64
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"int8" TypeInfo
TypeInfo.int8 ({-# SCC "int8.int" #-} Value Int64
forall a. (Integral a, Bits a) => Value a
Binary.int)

-- |
-- Decoder of the @FLOAT4@ values.
{-# INLINEABLE float4 #-}
float4 :: Value Float
float4 :: Value Float
float4 = Text -> TypeInfo -> Value Float -> Value Float
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"float4" TypeInfo
TypeInfo.float4 Value Float
Binary.float4

-- |
-- Decoder of the @FLOAT8@ values.
{-# INLINEABLE float8 #-}
float8 :: Value Double
float8 :: Value Double
float8 = Text -> TypeInfo -> Value Double -> Value Double
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"float8" TypeInfo
TypeInfo.float8 Value Double
Binary.float8

-- |
-- Decoder of the @NUMERIC@ values.
{-# INLINEABLE numeric #-}
numeric :: Value Scientific
numeric :: Value Scientific
numeric = Text -> TypeInfo -> Value Scientific -> Value Scientific
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"numeric" TypeInfo
TypeInfo.numeric Value Scientific
Binary.numeric

-- |
-- Decoder of the @CHAR@ values.
-- Note that it supports Unicode values.
{-# INLINEABLE char #-}
char :: Value Char
char :: Value Char
char = Text -> TypeInfo -> Value Char -> Value Char
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"char" TypeInfo
TypeInfo.char Value Char
Binary.char

-- |
-- Decoder of the @TEXT@ values.
{-# INLINEABLE text #-}
text :: Value Text
text :: Value Text
text = Text -> TypeInfo -> Value Text -> Value Text
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"text" TypeInfo
TypeInfo.text Value Text
Binary.text_strict

-- |
-- Decoder of the @VARCHAR@ values.
{-# INLINEABLE varchar #-}
varchar :: Value Text
varchar :: Value Text
varchar = Text -> TypeInfo -> Value Text -> Value Text
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"varchar" TypeInfo
TypeInfo.varchar Value Text
Binary.text_strict

-- |
-- Decoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values.
{-# INLINEABLE bpchar #-}
bpchar :: Value Text
bpchar :: Value Text
bpchar = Text -> TypeInfo -> Value Text -> Value Text
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"bpchar" TypeInfo
TypeInfo.bpchar Value Text
Binary.text_strict

-- |
-- Decoder of the @BYTEA@ values.
{-# INLINEABLE bytea #-}
bytea :: Value ByteString
bytea :: Value ByteString
bytea = Text -> TypeInfo -> Value ByteString -> Value ByteString
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"bytea" TypeInfo
TypeInfo.bytea Value ByteString
Binary.bytea_strict

-- |
-- Decoder of the @DATE@ values.
{-# INLINEABLE date #-}
date :: Value Day
date :: Value Day
date = Text -> TypeInfo -> Value Day -> Value Day
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"date" TypeInfo
TypeInfo.date Value Day
Binary.date

-- |
-- Decoder of the @TIMESTAMP@ values.
{-# INLINEABLE timestamp #-}
timestamp :: Value LocalTime
timestamp :: Value LocalTime
timestamp = Text -> TypeInfo -> Value LocalTime -> Value LocalTime
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"timestamp" TypeInfo
TypeInfo.timestamp Value LocalTime
Binary.timestamp_int

-- |
-- Decoder of the @TIMESTAMPTZ@ values.
--
-- /NOTICE/
--
-- Postgres does not store the timezone information of @TIMESTAMPTZ@.
-- Instead it stores a UTC value and performs silent conversions
-- to the currently set timezone, when dealt with in the text format.
-- However this library bypasses the silent conversions
-- and communicates with Postgres using the UTC values directly.
{-# INLINEABLE timestamptz #-}
timestamptz :: Value UTCTime
timestamptz :: Value UTCTime
timestamptz = Text -> TypeInfo -> Value UTCTime -> Value UTCTime
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"timestamptz" TypeInfo
TypeInfo.timestamptz Value UTCTime
Binary.timestamptz_int

-- |
-- Decoder of the @TIME@ values.
{-# INLINEABLE time #-}
time :: Value TimeOfDay
time :: Value TimeOfDay
time = Text -> TypeInfo -> Value TimeOfDay -> Value TimeOfDay
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"time" TypeInfo
TypeInfo.time Value TimeOfDay
Binary.time_int

-- |
-- Decoder of the @TIMETZ@ values.
--
-- Unlike in case of @TIMESTAMPTZ@,
-- Postgres does store the timezone information for @TIMETZ@.
-- However the Haskell's \"time\" library does not contain any composite type,
-- that fits the task, so we use a pair of 'TimeOfDay' and 'TimeZone'
-- to represent a value on the Haskell's side.
{-# INLINEABLE timetz #-}
timetz :: Value (TimeOfDay, TimeZone)
timetz :: Value (TimeOfDay, TimeZone)
timetz = Text
-> TypeInfo
-> Value (TimeOfDay, TimeZone)
-> Value (TimeOfDay, TimeZone)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"timetz" TypeInfo
TypeInfo.timetz Value (TimeOfDay, TimeZone)
Binary.timetz_int

-- |
-- Decoder of the @INTERVAL@ values.
{-# INLINEABLE interval #-}
interval :: Value DiffTime
interval :: Value DiffTime
interval = Text -> TypeInfo -> Value DiffTime -> Value DiffTime
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"interval" TypeInfo
TypeInfo.interval Value DiffTime
Binary.interval_int

-- |
-- Decoder of the @UUID@ values.
{-# INLINEABLE uuid #-}
uuid :: Value UUID
uuid :: Value UUID
uuid = Text -> TypeInfo -> Value UUID -> Value UUID
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"uuid" TypeInfo
TypeInfo.uuid Value UUID
Binary.uuid

-- |
-- Decoder of the @INET@ values.
{-# INLINEABLE inet #-}
inet :: Value Iproute.IPRange
inet :: Value IPRange
inet = Text -> TypeInfo -> Value IPRange -> Value IPRange
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"inet" TypeInfo
TypeInfo.inet Value IPRange
Binary.inet

-- |
-- Decoder of the @MACADDR@ values.
--
-- Represented as a 6-tuple of Word8 values in big endian order. If
-- you use `ip` library consider using it with `fromOctets`.
--
-- > (\(a,b,c,d,e,f) -> fromOctets a b c d e f) <$> macaddr
{-# INLINEABLE macaddr #-}
macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)
macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)
macaddr = Text
-> TypeInfo
-> Value (Word8, Word8, Word8, Word8, Word8, Word8)
-> Value (Word8, Word8, Word8, Word8, Word8, Word8)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"macaddr" TypeInfo
TypeInfo.macaddr Value (Word8, Word8, Word8, Word8, Word8, Word8)
Binary.macaddr

-- |
-- Decoder of the @JSON@ values into a JSON AST.
{-# INLINEABLE json #-}
json :: Value Aeson.Value
json :: Value Value
json = Text -> TypeInfo -> Value Value -> Value Value
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"json" TypeInfo
TypeInfo.json Value Value
Binary.json_ast

-- |
-- Decoder of the @JSON@ values into a raw JSON 'ByteString'.
{-# INLINEABLE jsonBytes #-}
jsonBytes :: (ByteString -> Either Text a) -> Value a
jsonBytes :: forall a. (ByteString -> Either Text a) -> Value a
jsonBytes ByteString -> Either Text a
fn = Text -> TypeInfo -> Value a -> Value a
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"json" TypeInfo
TypeInfo.json ((ByteString -> Either Text a) -> Value a
forall a. (ByteString -> Either Text a) -> Value a
Binary.json_bytes ByteString -> Either Text a
fn)

-- |
-- Decoder of the @JSONB@ values into a JSON AST.
{-# INLINEABLE jsonb #-}
jsonb :: Value Aeson.Value
jsonb :: Value Value
jsonb = Text -> TypeInfo -> Value Value -> Value Value
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"jsonb" TypeInfo
TypeInfo.jsonb Value Value
Binary.jsonb_ast

-- |
-- Decoder of the @JSONB@ values into a raw JSON 'ByteString'.
{-# INLINEABLE jsonbBytes #-}
jsonbBytes :: (ByteString -> Either Text a) -> Value a
jsonbBytes :: forall a. (ByteString -> Either Text a) -> Value a
jsonbBytes ByteString -> Either Text a
fn = Text -> TypeInfo -> Value a -> Value a
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"jsonb" TypeInfo
TypeInfo.jsonb ((ByteString -> Either Text a) -> Value a
forall a. (ByteString -> Either Text a) -> Value a
Binary.jsonb_bytes ByteString -> Either Text a
fn)

-- |
-- Decoder of the @INT4RANGE@ values.
{-# INLINEABLE int4range #-}
int4range :: Value (R.Range Int32)
int4range :: Value (Range Int32)
int4range = Text -> TypeInfo -> Value (Range Int32) -> Value (Range Int32)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"int4range" TypeInfo
TypeInfo.int4range Value (Range Int32)
Binary.int4range

-- |
-- Decoder of the @INT8RANGE@ values.
{-# INLINEABLE int8range #-}
int8range :: Value (R.Range Int64)
int8range :: Value (Range Int64)
int8range = Text -> TypeInfo -> Value (Range Int64) -> Value (Range Int64)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"int8range" TypeInfo
TypeInfo.int8range Value (Range Int64)
Binary.int8range

-- |
-- Decoder of the @NUMRANGE@ values.
{-# INLINEABLE numrange #-}
numrange :: Value (R.Range Scientific)
numrange :: Value (Range Scientific)
numrange = Text
-> TypeInfo -> Value (Range Scientific) -> Value (Range Scientific)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"numrange" TypeInfo
TypeInfo.numrange Value (Range Scientific)
Binary.numrange

-- |
-- Decoder of the @TSRANGE@ values.
{-# INLINEABLE tsrange #-}
tsrange :: Value (R.Range LocalTime)
tsrange :: Value (Range LocalTime)
tsrange = Text
-> TypeInfo -> Value (Range LocalTime) -> Value (Range LocalTime)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"tsrange" TypeInfo
TypeInfo.tsrange Value (Range LocalTime)
Binary.tsrange_int

-- |
-- Decoder of the @TSTZRANGE@ values.
{-# INLINEABLE tstzrange #-}
tstzrange :: Value (R.Range UTCTime)
tstzrange :: Value (Range UTCTime)
tstzrange = Text -> TypeInfo -> Value (Range UTCTime) -> Value (Range UTCTime)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"tstzrange" TypeInfo
TypeInfo.tstzrange Value (Range UTCTime)
Binary.tstzrange_int

-- |
-- Decoder of the @DATERANGE@ values.
{-# INLINEABLE daterange #-}
daterange :: Value (R.Range Day)
daterange :: Value (Range Day)
daterange = Text -> TypeInfo -> Value (Range Day) -> Value (Range Day)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"daterange" TypeInfo
TypeInfo.daterange Value (Range Day)
Binary.daterange

-- |
-- Decoder of the @INT4MULTIRANGE@ values.
{-# INLINEABLE int4multirange #-}
int4multirange :: Value (R.Multirange Int32)
int4multirange :: Value (Multirange Int32)
int4multirange = Text
-> TypeInfo -> Value (Multirange Int32) -> Value (Multirange Int32)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"int4multirange" TypeInfo
TypeInfo.int4multirange Value (Multirange Int32)
Binary.int4multirange

-- |
-- Decoder of the @INT8MULTIRANGE@ values.
{-# INLINEABLE int8multirange #-}
int8multirange :: Value (R.Multirange Int64)
int8multirange :: Value (Multirange Int64)
int8multirange = Text
-> TypeInfo -> Value (Multirange Int64) -> Value (Multirange Int64)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"int8multirange" TypeInfo
TypeInfo.int8multirange Value (Multirange Int64)
Binary.int8multirange

-- |
-- Decoder of the @NUMMULTIRANGE@ values.
{-# INLINEABLE nummultirange #-}
nummultirange :: Value (R.Multirange Scientific)
nummultirange :: Value (Multirange Scientific)
nummultirange = Text
-> TypeInfo
-> Value (Multirange Scientific)
-> Value (Multirange Scientific)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"nummultirange" TypeInfo
TypeInfo.nummultirange Value (Multirange Scientific)
Binary.nummultirange

-- |
-- Decoder of the @TSMULTIRANGE@ values.
{-# INLINEABLE tsmultirange #-}
tsmultirange :: Value (R.Multirange LocalTime)
tsmultirange :: Value (Multirange LocalTime)
tsmultirange = Text
-> TypeInfo
-> Value (Multirange LocalTime)
-> Value (Multirange LocalTime)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"tsmultirange" TypeInfo
TypeInfo.tsmultirange Value (Multirange LocalTime)
Binary.tsmultirange_int

-- |
-- Decoder of the @TSTZMULTIRANGE@ values.
{-# INLINEABLE tstzmultirange #-}
tstzmultirange :: Value (R.Multirange UTCTime)
tstzmultirange :: Value (Multirange UTCTime)
tstzmultirange = Text
-> TypeInfo
-> Value (Multirange UTCTime)
-> Value (Multirange UTCTime)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"tstzmultirange" TypeInfo
TypeInfo.tstzmultirange Value (Multirange UTCTime)
Binary.tstzmultirange_int

-- |
-- Decoder of the @DATEMULTIRANGE@ values.
{-# INLINEABLE datemultirange #-}
datemultirange :: Value (R.Multirange Day)
datemultirange :: Value (Multirange Day)
datemultirange = Text
-> TypeInfo -> Value (Multirange Day) -> Value (Multirange Day)
forall a. Text -> TypeInfo -> Value a -> Value a
primitive Text
"datemultirange" TypeInfo
TypeInfo.datemultirange Value (Multirange Day)
Binary.datemultirange

-- |
-- Decoder of the @CITEXT@ values.
--
-- Requires the @citext@ extension to be installed in the database.
{-# INLINEABLE citext #-}
citext :: Value Text
citext :: Value Text
citext = Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value Text)
-> Value Text
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value a)
-> Value a
Value Maybe Text
forall a. Maybe a
Nothing Text
"citext" Maybe Word32
forall a. Maybe a
Nothing Maybe Word32
forall a. Maybe a
Nothing Word
0 (Value Text -> RequestingOid (Value Text)
forall a. a -> RequestingOid a
RequestingOid.lift Value Text
Binary.text_strict)

-- |
-- Low level API for defining custom value decoders.
{-# INLINEABLE custom #-}
custom ::
  -- | Schema name.
  Maybe Text ->
  -- | Type name.
  Text ->
  -- | Possible static OIDs for the type. The first is for scalar values the second is for arrays.
  --
  -- When unspecified, the OIDs will be automatically determined at runtime by looking up by name.
  Maybe (Word32, Word32) ->
  -- | Other named types whose OIDs are needed for deserializing.
  --
  -- E.g., when decoding composite types you can check the OIDs of its fields against the ones specified by Postgres.
  --
  -- When any of the requested types is missing in the database an error will be raised upon the statement execution.
  [(Maybe Text, Text)] ->
  -- | Deserialization function in the context of resolved OIDs of the types requested in the previous parameter.
  --
  -- It's safe to assume that all of the requested types will be present.
  -- In case you run the provided lookup function with unmentioned type names it will produce OID of 0 for them, standing for unknown type in Postgres.
  ( ((Maybe Text, Text) -> (Word32, Word32)) ->
    ByteString ->
    Either Text a
  ) ->
  Value a
custom :: forall a.
Maybe Text
-> Text
-> Maybe (Word32, Word32)
-> [(Maybe Text, Text)]
-> (((Maybe Text, Text) -> (Word32, Word32))
    -> ByteString -> Either Text a)
-> Value a
custom Maybe Text
schema Text
typeName Maybe (Word32, Word32)
staticOids [(Maybe Text, Text)]
requestedTypes ((Maybe Text, Text) -> (Word32, Word32))
-> ByteString -> Either Text a
fn =
  Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value a)
-> Value a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value a)
-> Value a
Value
    Maybe Text
schema
    Text
typeName
    ((Word32, Word32) -> Word32
forall a b. (a, b) -> a
fst ((Word32, Word32) -> Word32)
-> Maybe (Word32, Word32) -> Maybe Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Word32, Word32)
staticOids)
    ((Word32, Word32) -> Word32
forall a b. (a, b) -> b
snd ((Word32, Word32) -> Word32)
-> Maybe (Word32, Word32) -> Maybe Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Word32, Word32)
staticOids)
    Word
0
    ([(Maybe Text, Text)]
-> (((Maybe Text, Text) -> (Word32, Word32)) -> Value a)
-> RequestingOid (Value a)
forall a.
[(Maybe Text, Text)]
-> (((Maybe Text, Text) -> (Word32, Word32)) -> a)
-> RequestingOid a
RequestingOid.requestAndHandle [(Maybe Text, Text)]
requestedTypes ((ByteString -> Either Text a) -> Value a
forall a. (ByteString -> Either Text a) -> Value a
Binary.fn ((ByteString -> Either Text a) -> Value a)
-> (((Maybe Text, Text) -> (Word32, Word32))
    -> ByteString -> Either Text a)
-> ((Maybe Text, Text) -> (Word32, Word32))
-> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Maybe Text, Text) -> (Word32, Word32))
-> ByteString -> Either Text a
fn))

-- |
-- Refine a value decoder, lifting the possible error to the session level.
{-# INLINE refine #-}
refine :: (a -> Either Text b) -> Value a -> Value b
refine :: forall a b. (a -> Either Text b) -> Value a -> Value b
refine a -> Either Text b
fn (Value Maybe Text
schema Text
typeName Maybe Word32
typeOid Maybe Word32
arrayOid Word
dimensionality RequestingOid (Value a)
decoder) =
  Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value b)
-> Value b
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value a)
-> Value a
Value Maybe Text
schema Text
typeName Maybe Word32
typeOid Maybe Word32
arrayOid Word
dimensionality ((Value a -> Value b)
-> RequestingOid (Value a) -> RequestingOid (Value b)
forall a b.
(a -> b)
-> LookingUp (Maybe Text, Text) (Word32, Word32) a
-> LookingUp (Maybe Text, Text) (Word32, Word32) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Either Text b) -> Value a -> Value b
forall a b. (a -> Either Text b) -> Value a -> Value b
Binary.refine a -> Either Text b
fn) RequestingOid (Value a)
decoder)

-- |
-- Binary generic decoder of @HSTORE@ values.
--
-- Here's how you can use it to construct a specific value:
--
-- @
-- x :: Value [(Text, Maybe Text)]
-- x = hstore 'replicateM'
-- @
{-# INLINEABLE hstore #-}
hstore :: (forall m. (Monad m) => Int -> m (Text, Maybe Text) -> m a) -> Value a
hstore :: forall a.
(forall (m :: * -> *).
 Monad m =>
 Int -> m (Text, Maybe Text) -> m a)
-> Value a
hstore forall (m :: * -> *). Monad m => Int -> m (Text, Maybe Text) -> m a
replicateM =
  Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value a)
-> Value a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value a)
-> Value a
Value Maybe Text
forall a. Maybe a
Nothing Text
"hstore" Maybe Word32
forall a. Maybe a
Nothing Maybe Word32
forall a. Maybe a
Nothing Word
0 (Value a -> RequestingOid (Value a)
forall a. a -> RequestingOid a
RequestingOid.lift ((forall (m :: * -> *).
 Monad m =>
 Int -> m (Text, Maybe Text) -> m a)
-> Value Text -> Value Text -> Value a
forall k v r.
(forall (m :: * -> *). Monad m => Int -> m (k, Maybe v) -> m r)
-> Value k -> Value v -> Value r
Binary.hstore Int -> m (Text, Maybe Text) -> m a
forall (m :: * -> *). Monad m => Int -> m (Text, Maybe Text) -> m a
replicateM Value Text
Binary.text_strict Value Text
Binary.text_strict))

-- |
-- Given a partial mapping from text to value, produces a decoder of that value for a named enum type.
enum ::
  -- | Schema name.
  Maybe Text ->
  -- | Type name.
  Text ->
  -- | Mapping from text to value.
  (Text -> Maybe a) ->
  Value a
enum :: forall a. Maybe Text -> Text -> (Text -> Maybe a) -> Value a
enum Maybe Text
schema Text
typeName Text -> Maybe a
mapping =
  Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value a)
-> Value a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Value a)
-> Value a
Value Maybe Text
schema Text
typeName Maybe Word32
forall a. Maybe a
Nothing Maybe Word32
forall a. Maybe a
Nothing Word
0 (Value a -> RequestingOid (Value a)
forall a. a -> RequestingOid a
RequestingOid.lift ((Text -> Maybe a) -> Value a
forall a. (Text -> Maybe a) -> Value a
Binary.enum Text -> Maybe a
mapping))

-- * Relations

toDimensionality :: Value a -> Word
toDimensionality :: forall a. Value a -> Word
toDimensionality (Value Maybe Text
_ Text
_ Maybe Word32
_ Maybe Word32
_ Word
dimensionality RequestingOid (Value a)
_) = Word
dimensionality

toSchema :: Value a -> Maybe Text
toSchema :: forall a. Value a -> Maybe Text
toSchema (Value Maybe Text
schema Text
_ Maybe Word32
_ Maybe Word32
_ Word
_ RequestingOid (Value a)
_) = Maybe Text
schema

toTypeName :: Value a -> Text
toTypeName :: forall a. Value a -> Text
toTypeName (Value Maybe Text
_ Text
typeName Maybe Word32
_ Maybe Word32
_ Word
_ RequestingOid (Value a)
_) = Text
typeName

toOid :: Value a -> Maybe Word32
toOid :: forall a. Value a -> Maybe Word32
toOid (Value Maybe Text
_ Text
_ Maybe Word32
baseOid Maybe Word32
arrayOid Word
dimensionality RequestingOid (Value a)
_) =
  if Word
dimensionality Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0
    then Maybe Word32
arrayOid
    else Maybe Word32
baseOid

toBaseOid :: Value a -> Maybe Word32
toBaseOid :: forall a. Value a -> Maybe Word32
toBaseOid (Value Maybe Text
_ Text
_ Maybe Word32
baseOid Maybe Word32
_ Word
_ RequestingOid (Value a)
_) = Maybe Word32
baseOid

toArrayOid :: Value a -> Maybe Word32
toArrayOid :: forall a. Value a -> Maybe Word32
toArrayOid (Value Maybe Text
_ Text
_ Maybe Word32
_ Maybe Word32
oid Word
_ RequestingOid (Value a)
_) = Maybe Word32
oid

toDecoder :: Value a -> RequestingOid.RequestingOid (Binary.Value a)
toDecoder :: forall a. Value a -> RequestingOid (Value a)
toDecoder (Value Maybe Text
_ Text
_ Maybe Word32
_ Maybe Word32
_ Word
_ RequestingOid (Value a)
decoder) = RequestingOid (Value a)
decoder

{-# INLINE toHandler #-}
toHandler :: Value a -> HashMap (Maybe Text, Text) (Word32, Word32) -> Binary.Value a
toHandler :: forall a.
Value a -> HashMap (Maybe Text, Text) (Word32, Word32) -> Value a
toHandler (Value Maybe Text
_ Text
_ Maybe Word32
_ Maybe Word32
_ Word
_ RequestingOid (Value a)
decoder) = RequestingOid (Value a)
-> HashMap (Maybe Text, Text) (Word32, Word32) -> Value a
forall a.
RequestingOid a -> HashMap (Maybe Text, Text) (Word32, Word32) -> a
RequestingOid.toBase RequestingOid (Value a)
decoder

{-# INLINE toByteStringParser #-}
toByteStringParser :: Value a -> (HashMap (Maybe Text, Text) (Word32, Word32) -> ByteString -> Either Text a)
toByteStringParser :: forall a.
Value a
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> ByteString
-> Either Text a
toByteStringParser (Value Maybe Text
_ Text
_ Maybe Word32
_ Maybe Word32
_ Word
_ RequestingOid (Value a)
decoder) HashMap (Maybe Text, Text) (Word32, Word32)
oidCache = Value a -> ByteString -> Either Text a
forall a. Value a -> ByteString -> Either Text a
Binary.valueParser (RequestingOid (Value a)
-> HashMap (Maybe Text, Text) (Word32, Word32) -> Value a
forall a.
RequestingOid a -> HashMap (Maybe Text, Text) (Word32, Word32) -> a
RequestingOid.toBase RequestingOid (Value a)
decoder HashMap (Maybe Text, Text) (Word32, Word32)
oidCache)

isArray :: Value a -> Bool
isArray :: forall a. Value a -> Bool
isArray (Value Maybe Text
_ Text
_ Maybe Word32
_ Maybe Word32
_ Word
dimensionality RequestingOid (Value a)
_) = Word
dimensionality Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0