{-|
A DSL for declaration of result decoders.
-}
module Hasql.Private.Decoders
where

import Hasql.Private.Prelude hiding (maybe, bool)
import qualified Data.Vector as Vector
import qualified PostgreSQL.Binary.Decoding as A
import qualified PostgreSQL.Binary.Data as B
import qualified Hasql.Private.Decoders.Results as Results
import qualified Hasql.Private.Decoders.Result as Result
import qualified Hasql.Private.Decoders.Row as Row
import qualified Hasql.Private.Decoders.Value as Value
import qualified Hasql.Private.Decoders.Array as Array
import qualified Hasql.Private.Decoders.Composite as Composite
import qualified Hasql.Private.Prelude as Prelude
import qualified Data.Vector.Generic as GenericVector

-- * Result
-------------------------

{-|
Decoder of a query result.
-}
newtype Result a = Result (Results.Results a) deriving (a -> Result b -> Result a
(a -> b) -> Result a -> Result b
(forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor)

{-|
Decode no value from the result.

Useful for statements like @INSERT@ or @CREATE@.
-}
{-# INLINABLE noResult #-}
noResult :: Result ()
noResult :: Result ()
noResult = Results () -> Result ()
forall a. Results a -> Result a
Result (Result () -> Results ()
forall a. Result a -> Results a
Results.single Result ()
Result.noResult)

{-|
Get the amount of rows affected by such statements as
@UPDATE@ or @DELETE@.
-}
{-# INLINABLE rowsAffected #-}
rowsAffected :: Result Int64
rowsAffected :: Result Int64
rowsAffected = Results Int64 -> Result Int64
forall a. Results a -> Result a
Result (Result Int64 -> Results Int64
forall a. Result a -> Results a
Results.single Result Int64
Result.rowsAffected)

{-|
Exactly one row.
Will raise the 'Hasql.Errors.UnexpectedAmountOfRows' error if it's any other.
-}
{-# INLINABLE singleRow #-}
singleRow :: Row a -> Result a
singleRow :: Row a -> Result a
singleRow (Row Row a
row) = Results a -> Result a
forall a. Results a -> Result a
Result (Result a -> Results a
forall a. Result a -> Results a
Results.single (Row a -> Result a
forall a. Row a -> Result a
Result.single Row a
row))

refineResult :: (a -> Either Text b) -> Result a -> Result b
refineResult :: (a -> Either Text b) -> Result a -> Result b
refineResult a -> Either Text b
refiner (Result Results a
results) = Results b -> Result b
forall a. Results a -> Result a
Result ((a -> Either Text b) -> Results a -> Results b
forall a b. (a -> Either Text b) -> Results a -> Results b
Results.refine a -> Either Text b
refiner Results a
results)

-- ** Multi-row traversers
-------------------------

{-|
Foldl multiple rows.
-}
{-# INLINABLE foldlRows #-}
foldlRows :: (a -> b -> a) -> a -> Row b -> Result a
foldlRows :: (a -> b -> a) -> a -> Row b -> Result a
foldlRows a -> b -> a
step a
init (Row Row b
row) = Results a -> Result a
forall a. Results a -> Result a
Result (Result a -> Results a
forall a. Result a -> Results a
Results.single ((a -> b -> a) -> a -> Row b -> Result a
forall a b. (a -> b -> a) -> a -> Row b -> Result a
Result.foldl a -> b -> a
step a
init Row b
row))

{-|
Foldr multiple rows.
-}
{-# INLINABLE foldrRows #-}
foldrRows :: (b -> a -> a) -> a -> Row b -> Result a
foldrRows :: (b -> a -> a) -> a -> Row b -> Result a
foldrRows b -> a -> a
step a
init (Row Row b
row) = Results a -> Result a
forall a. Results a -> Result a
Result (Result a -> Results a
forall a. Result a -> Results a
Results.single ((b -> a -> a) -> a -> Row b -> Result a
forall b a. (b -> a -> a) -> a -> Row b -> Result a
Result.foldr b -> a -> a
step a
init Row b
row))

-- ** Specialized multi-row results
-------------------------

{-|
Maybe one row or none.
-}
{-# INLINABLE rowMaybe #-}
rowMaybe :: Row a -> Result (Maybe a)
rowMaybe :: Row a -> Result (Maybe a)
rowMaybe (Row Row a
row) = Results (Maybe a) -> Result (Maybe a)
forall a. Results a -> Result a
Result (Result (Maybe a) -> Results (Maybe a)
forall a. Result a -> Results a
Results.single (Row a -> Result (Maybe a)
forall a. Row a -> Result (Maybe a)
Result.maybe Row a
row))

{-|
Zero or more rows packed into the vector.

It's recommended to prefer this function to 'rowList',
since it performs notably better.
-}
{-# INLINABLE rowVector #-}
rowVector :: Row a -> Result (Vector a)
rowVector :: Row a -> Result (Vector a)
rowVector (Row Row a
row) = Results (Vector a) -> Result (Vector a)
forall a. Results a -> Result a
Result (Result (Vector a) -> Results (Vector a)
forall a. Result a -> Results a
Results.single (Row a -> Result (Vector a)
forall a. Row a -> Result (Vector a)
Result.vector Row a
row))

{-|
Zero or more rows packed into the list.
-}
{-# INLINABLE rowList #-}
rowList :: Row a -> Result [a]
rowList :: Row a -> Result [a]
rowList = (a -> [a] -> [a]) -> [a] -> Row a -> Result [a]
forall b a. (b -> a -> a) -> a -> Row b -> Result a
foldrRows a -> [a] -> [a]
forall a. a -> [a] -> [a]
strictCons []


-- * Row
-------------------------

{-|
Decoder of an individual row,
which gets composed of column value decoders.

E.g.:

@
x :: 'Row' (Maybe Int64, Text, TimeOfDay)
x = (,,) '<$>' ('column' . 'nullable') 'int8' '<*>' ('column' . 'nonNullable') 'text' '<*>' ('column' . 'nonNullable') 'time'
@
-}
newtype Row a = Row (Row.Row a)
  deriving (a -> Row b -> Row a
(a -> b) -> Row a -> Row b
(forall a b. (a -> b) -> Row a -> Row b)
-> (forall a b. a -> Row b -> Row a) -> Functor Row
forall a b. a -> Row b -> Row a
forall a b. (a -> b) -> Row a -> Row b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Row b -> Row a
$c<$ :: forall a b. a -> Row b -> Row a
fmap :: (a -> b) -> Row a -> Row b
$cfmap :: forall a b. (a -> b) -> Row a -> Row b
Functor, Functor Row
a -> Row a
Functor Row
-> (forall a. a -> Row a)
-> (forall a b. Row (a -> b) -> Row a -> Row b)
-> (forall a b c. (a -> b -> c) -> Row a -> Row b -> Row c)
-> (forall a b. Row a -> Row b -> Row b)
-> (forall a b. Row a -> Row b -> Row a)
-> Applicative Row
Row a -> Row b -> Row b
Row a -> Row b -> Row a
Row (a -> b) -> Row a -> Row b
(a -> b -> c) -> Row a -> Row b -> Row c
forall a. a -> Row a
forall a b. Row a -> Row b -> Row a
forall a b. Row a -> Row b -> Row b
forall a b. Row (a -> b) -> Row a -> Row b
forall a b c. (a -> b -> c) -> Row a -> Row b -> Row c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Row a -> Row b -> Row a
$c<* :: forall a b. Row a -> Row b -> Row a
*> :: Row a -> Row b -> Row b
$c*> :: forall a b. Row a -> Row b -> Row b
liftA2 :: (a -> b -> c) -> Row a -> Row b -> Row c
$cliftA2 :: forall a b c. (a -> b -> c) -> Row a -> Row b -> Row c
<*> :: Row (a -> b) -> Row a -> Row b
$c<*> :: forall a b. Row (a -> b) -> Row a -> Row b
pure :: a -> Row a
$cpure :: forall a. a -> Row a
$cp1Applicative :: Functor Row
Applicative, Applicative Row
a -> Row a
Applicative Row
-> (forall a b. Row a -> (a -> Row b) -> Row b)
-> (forall a b. Row a -> Row b -> Row b)
-> (forall a. a -> Row a)
-> Monad Row
Row a -> (a -> Row b) -> Row b
Row a -> Row b -> Row b
forall a. a -> Row a
forall a b. Row a -> Row b -> Row b
forall a b. Row a -> (a -> Row b) -> Row b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Row a
$creturn :: forall a. a -> Row a
>> :: Row a -> Row b -> Row b
$c>> :: forall a b. Row a -> Row b -> Row b
>>= :: Row a -> (a -> Row b) -> Row b
$c>>= :: forall a b. Row a -> (a -> Row b) -> Row b
$cp1Monad :: Applicative Row
Monad, Monad Row
Monad Row -> (forall a. String -> Row a) -> MonadFail Row
String -> Row a
forall a. String -> Row a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Row a
$cfail :: forall a. String -> Row a
$cp1MonadFail :: Monad Row
MonadFail)

{-|
Lift an individual value decoder to a composable row decoder.
-}
{-# INLINABLE column #-}
column :: NullableOrNot Value a -> Row a
column :: NullableOrNot Value a -> Row a
column = \ case
  NonNullable (Value Value a
imp) -> Row a -> Row a
forall a. Row a -> Row a
Row (Value a -> Row a
forall a. Value a -> Row a
Row.nonNullValue Value a
imp)
  Nullable (Value Value a
imp) -> Row (Maybe a) -> Row (Maybe a)
forall a. Row a -> Row a
Row (Value a -> Row (Maybe a)
forall a. Value a -> Row (Maybe a)
Row.value Value a
imp)


-- * Nullability
-------------------------

{-|
Extensional specification of nullability over a generic decoder.
-}
data NullableOrNot decoder a where
  NonNullable :: decoder a -> NullableOrNot decoder a
  Nullable :: decoder a -> NullableOrNot decoder (Maybe a)

{-|
Specify that a decoder produces a non-nullable value.
-}
nonNullable :: decoder a -> NullableOrNot decoder a
nonNullable :: decoder a -> NullableOrNot decoder a
nonNullable = decoder a -> NullableOrNot decoder a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
NonNullable

{-|
Specify that a decoder produces a nullable value.
-}
nullable :: decoder a -> NullableOrNot decoder (Maybe a)
nullable :: decoder a -> NullableOrNot decoder (Maybe a)
nullable = decoder a -> NullableOrNot decoder (Maybe a)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
Nullable


-- * Value
-------------------------

{-|
Decoder of a value.
-}
newtype Value a = Value (Value.Value a)
  deriving (a -> Value b -> Value a
(a -> b) -> Value a -> Value b
(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
<$ :: a -> Value b -> Value a
$c<$ :: forall a b. a -> Value b -> Value a
fmap :: (a -> b) -> Value a -> Value b
$cfmap :: forall a b. (a -> b) -> Value a -> Value b
Functor)

type role Value representational

{-|
Decoder of the @BOOL@ values.
-}
{-# INLINABLE bool #-}
bool :: Value Bool
bool :: Value Bool
bool = Value Bool -> Value Bool
forall a. Value a -> Value a
Value ((Bool -> Value Bool) -> Value Bool
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Bool -> Bool -> Value Bool
forall a b. a -> b -> a
const Value Bool
A.bool))

{-|
Decoder of the @INT2@ values.
-}
{-# INLINABLE int2 #-}
int2 :: Value Int16
int2 :: Value Int16
int2 = Value Int16 -> Value Int16
forall a. Value a -> Value a
Value ((Bool -> Value Int16) -> Value Int16
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Int16 -> Bool -> Value Int16
forall a b. a -> b -> a
const Value Int16
forall a. (Integral a, Bits a) => Value a
A.int))

{-|
Decoder of the @INT4@ values.
-}
{-# INLINABLE int4 #-}
int4 :: Value Int32
int4 :: Value Int32
int4 = Value Int32 -> Value Int32
forall a. Value a -> Value a
Value ((Bool -> Value Int32) -> Value Int32
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Int32 -> Bool -> Value Int32
forall a b. a -> b -> a
const Value Int32
forall a. (Integral a, Bits a) => Value a
A.int))

{-|
Decoder of the @INT8@ values.
-}
{-# INLINABLE int8 #-}
int8 :: Value Int64
int8 :: Value Int64
int8 = {-# SCC "int8" #-}
  Value Int64 -> Value Int64
forall a. Value a -> Value a
Value ((Bool -> Value Int64) -> Value Int64
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Int64 -> Bool -> Value Int64
forall a b. a -> b -> a
const ({-# SCC "int8.int" #-} Value Int64
forall a. (Integral a, Bits a) => Value a
A.int)))

{-|
Decoder of the @FLOAT4@ values.
-}
{-# INLINABLE float4 #-}
float4 :: Value Float
float4 :: Value Float
float4 = Value Float -> Value Float
forall a. Value a -> Value a
Value ((Bool -> Value Float) -> Value Float
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Float -> Bool -> Value Float
forall a b. a -> b -> a
const Value Float
A.float4))

{-|
Decoder of the @FLOAT8@ values.
-}
{-# INLINABLE float8 #-}
float8 :: Value Double
float8 :: Value Double
float8 = Value Double -> Value Double
forall a. Value a -> Value a
Value ((Bool -> Value Double) -> Value Double
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Double -> Bool -> Value Double
forall a b. a -> b -> a
const Value Double
A.float8))

{-|
Decoder of the @NUMERIC@ values.
-}
{-# INLINABLE numeric #-}
numeric :: Value B.Scientific
numeric :: Value Scientific
numeric = Value Scientific -> Value Scientific
forall a. Value a -> Value a
Value ((Bool -> Value Scientific) -> Value Scientific
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Scientific -> Bool -> Value Scientific
forall a b. a -> b -> a
const Value Scientific
A.numeric))

{-|
Decoder of the @CHAR@ values.
Note that it supports Unicode values.
-}
{-# INLINABLE char #-}
char :: Value Char
char :: Value Char
char = Value Char -> Value Char
forall a. Value a -> Value a
Value ((Bool -> Value Char) -> Value Char
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Char -> Bool -> Value Char
forall a b. a -> b -> a
const Value Char
A.char))

{-|
Decoder of the @TEXT@ values.
-}
{-# INLINABLE text #-}
text :: Value Text
text :: Value Text
text = Value Text -> Value Text
forall a. Value a -> Value a
Value ((Bool -> Value Text) -> Value Text
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Text -> Bool -> Value Text
forall a b. a -> b -> a
const Value Text
A.text_strict))

{-|
Decoder of the @BYTEA@ values.
-}
{-# INLINABLE bytea #-}
bytea :: Value ByteString
bytea :: Value ByteString
bytea = Value ByteString -> Value ByteString
forall a. Value a -> Value a
Value ((Bool -> Value ByteString) -> Value ByteString
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value ByteString -> Bool -> Value ByteString
forall a b. a -> b -> a
const Value ByteString
A.bytea_strict))

{-|
Decoder of the @DATE@ values.
-}
{-# INLINABLE date #-}
date :: Value B.Day
date :: Value Day
date = Value Day -> Value Day
forall a. Value a -> Value a
Value ((Bool -> Value Day) -> Value Day
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Day -> Bool -> Value Day
forall a b. a -> b -> a
const Value Day
A.date))

{-|
Decoder of the @TIMESTAMP@ values.
-}
{-# INLINABLE timestamp #-}
timestamp :: Value B.LocalTime
timestamp :: Value LocalTime
timestamp = Value LocalTime -> Value LocalTime
forall a. Value a -> Value a
Value ((Bool -> Value LocalTime) -> Value LocalTime
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value LocalTime -> Value LocalTime -> Bool -> Value LocalTime
forall a. a -> a -> Bool -> a
Prelude.bool Value LocalTime
A.timestamp_float Value LocalTime
A.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.
-}
{-# INLINABLE timestamptz #-}
timestamptz :: Value B.UTCTime
timestamptz :: Value UTCTime
timestamptz = Value UTCTime -> Value UTCTime
forall a. Value a -> Value a
Value ((Bool -> Value UTCTime) -> Value UTCTime
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value UTCTime -> Value UTCTime -> Bool -> Value UTCTime
forall a. a -> a -> Bool -> a
Prelude.bool Value UTCTime
A.timestamptz_float Value UTCTime
A.timestamptz_int))

{-|
Decoder of the @TIME@ values.
-}
{-# INLINABLE time #-}
time :: Value B.TimeOfDay
time :: Value TimeOfDay
time = Value TimeOfDay -> Value TimeOfDay
forall a. Value a -> Value a
Value ((Bool -> Value TimeOfDay) -> Value TimeOfDay
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value TimeOfDay -> Value TimeOfDay -> Bool -> Value TimeOfDay
forall a. a -> a -> Bool -> a
Prelude.bool Value TimeOfDay
A.time_float Value TimeOfDay
A.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.
-}
{-# INLINABLE timetz #-}
timetz :: Value (B.TimeOfDay, B.TimeZone)
timetz :: Value (TimeOfDay, TimeZone)
timetz = Value (TimeOfDay, TimeZone) -> Value (TimeOfDay, TimeZone)
forall a. Value a -> Value a
Value ((Bool -> Value (TimeOfDay, TimeZone))
-> Value (TimeOfDay, TimeZone)
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value (TimeOfDay, TimeZone)
-> Value (TimeOfDay, TimeZone)
-> Bool
-> Value (TimeOfDay, TimeZone)
forall a. a -> a -> Bool -> a
Prelude.bool Value (TimeOfDay, TimeZone)
A.timetz_float Value (TimeOfDay, TimeZone)
A.timetz_int))

{-|
Decoder of the @INTERVAL@ values.
-}
{-# INLINABLE interval #-}
interval :: Value B.DiffTime
interval :: Value DiffTime
interval = Value DiffTime -> Value DiffTime
forall a. Value a -> Value a
Value ((Bool -> Value DiffTime) -> Value DiffTime
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value DiffTime -> Value DiffTime -> Bool -> Value DiffTime
forall a. a -> a -> Bool -> a
Prelude.bool Value DiffTime
A.interval_float Value DiffTime
A.interval_int))

{-|
Decoder of the @UUID@ values.
-}
{-# INLINABLE uuid #-}
uuid :: Value B.UUID
uuid :: Value UUID
uuid = Value UUID -> Value UUID
forall a. Value a -> Value a
Value ((Bool -> Value UUID) -> Value UUID
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value UUID -> Bool -> Value UUID
forall a b. a -> b -> a
const Value UUID
A.uuid))

{-|
Decoder of the @INET@ values.
-}
{-# INLINABLE inet #-}
inet :: Value (B.NetAddr B.IP)
inet :: Value (NetAddr IP)
inet = Value (NetAddr IP) -> Value (NetAddr IP)
forall a. Value a -> Value a
Value ((Bool -> Value (NetAddr IP)) -> Value (NetAddr IP)
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value (NetAddr IP) -> Bool -> Value (NetAddr IP)
forall a b. a -> b -> a
const Value (NetAddr IP)
A.inet))

{-|
Decoder of the @JSON@ values into a JSON AST.
-}
{-# INLINABLE json #-}
json :: Value B.Value
json :: Value Value
json = Value Value -> Value Value
forall a. Value a -> Value a
Value ((Bool -> Value Value) -> Value Value
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Value -> Bool -> Value Value
forall a b. a -> b -> a
const Value Value
A.json_ast))

{-|
Decoder of the @JSON@ values into a raw JSON 'ByteString'.
-}
{-# INLINABLE jsonBytes #-}
jsonBytes :: (ByteString -> Either Text a) -> Value a
jsonBytes :: (ByteString -> Either Text a) -> Value a
jsonBytes ByteString -> Either Text a
fn = Value a -> Value a
forall a. Value a -> Value a
Value ((Bool -> Value a) -> Value a
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value a -> Bool -> Value a
forall a b. a -> b -> a
const ((ByteString -> Either Text a) -> Value a
forall a. (ByteString -> Either Text a) -> Value a
A.json_bytes ByteString -> Either Text a
fn)))

{-|
Decoder of the @JSONB@ values into a JSON AST.
-}
{-# INLINABLE jsonb #-}
jsonb :: Value B.Value
jsonb :: Value Value
jsonb = Value Value -> Value Value
forall a. Value a -> Value a
Value ((Bool -> Value Value) -> Value Value
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value Value -> Bool -> Value Value
forall a b. a -> b -> a
const Value Value
A.jsonb_ast))

{-|
Decoder of the @JSONB@ values into a raw JSON 'ByteString'.
-}
{-# INLINABLE jsonbBytes #-}
jsonbBytes :: (ByteString -> Either Text a) -> Value a
jsonbBytes :: (ByteString -> Either Text a) -> Value a
jsonbBytes ByteString -> Either Text a
fn = Value a -> Value a
forall a. Value a -> Value a
Value ((Bool -> Value a) -> Value a
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value a -> Bool -> Value a
forall a b. a -> b -> a
const ((ByteString -> Either Text a) -> Value a
forall a. (ByteString -> Either Text a) -> Value a
A.jsonb_bytes ByteString -> Either Text a
fn)))

{-|
Lift a custom value decoder function to a 'Value' decoder.
-}
{-# INLINABLE custom #-}
custom :: (Bool -> ByteString -> Either Text a) -> Value a
custom :: (Bool -> ByteString -> Either Text a) -> Value a
custom Bool -> ByteString -> Either Text a
fn = Value a -> Value a
forall a. Value a -> Value a
Value ((Bool -> ByteString -> Either Text a) -> Value a
forall a. (Bool -> ByteString -> Either Text a) -> Value a
Value.decoderFn Bool -> ByteString -> Either Text a
fn)

{-|
Refine a value decoder, lifting the possible error to the session level.
-}
{-# INLINABLE refine #-}
refine :: (a -> Either Text b) -> Value a -> Value b
refine :: (a -> Either Text b) -> Value a -> Value b
refine a -> Either Text b
fn (Value Value a
v) = Value b -> Value b
forall a. Value a -> Value a
Value ((Bool -> Value b) -> Value b
forall a. (Bool -> Value a) -> Value a
Value.Value (\Bool
b -> (a -> Either Text b) -> Value a -> Value b
forall a b. (a -> Either Text b) -> Value a -> Value b
A.refine a -> Either Text b
fn (Value a -> Bool -> Value a
forall a. Value a -> Bool -> Value a
Value.run Value a
v Bool
b)))

{-|
A 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'
@
-}
{-# INLINABLE hstore #-}
hstore :: (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)
-> Value a
hstore forall (m :: * -> *). Monad m => Int -> m (Text, Maybe Text) -> m a
replicateM = Value a -> Value a
forall a. Value a -> Value a
Value ((Bool -> Value a) -> Value a
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value a -> Bool -> Value a
forall a b. a -> b -> a
const ((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
A.hstore forall (m :: * -> *). Monad m => Int -> m (Text, Maybe Text) -> m a
replicateM Value Text
A.text_strict Value Text
A.text_strict)))

{-|
Given a partial mapping from text to value,
produces a decoder of that value.
-}
enum :: (Text -> Maybe a) -> Value a
enum :: (Text -> Maybe a) -> Value a
enum Text -> Maybe a
mapping = Value a -> Value a
forall a. Value a -> Value a
Value ((Bool -> Value a) -> Value a
forall a. (Bool -> Value a) -> Value a
Value.decoder (Value a -> Bool -> Value a
forall a b. a -> b -> a
const ((Text -> Maybe a) -> Value a
forall a. (Text -> Maybe a) -> Value a
A.enum Text -> Maybe a
mapping)))

{-|
Lift an 'Array' decoder to a 'Value' decoder.
-}
{-# INLINABLE array #-}
array :: Array a -> Value a
array :: Array a -> Value a
array (Array Array a
imp) = Value a -> Value a
forall a. Value a -> Value a
Value ((Bool -> Value a) -> Value a
forall a. (Bool -> Value a) -> Value a
Value.decoder (Array a -> Bool -> Value a
forall a. Array a -> Bool -> Value a
Array.run Array a
imp))

{-|
Lift a value decoder of element into a unidimensional array decoder producing a list.

This function is merely a shortcut to the following expression:

@
('array' . 'dimension' Control.Monad.'replicateM' . 'element')
@

Please notice that in case of multidimensional arrays nesting 'listArray' decoder
won't work. You have to explicitly construct the array decoder using 'array'.
-}
{-# INLINE listArray #-}
listArray :: NullableOrNot Value element -> Value [element]
listArray :: NullableOrNot Value element -> Value [element]
listArray = Array [element] -> Value [element]
forall a. Array a -> Value a
array (Array [element] -> Value [element])
-> (NullableOrNot Value element -> Array [element])
-> NullableOrNot Value element
-> Value [element]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall (m :: * -> *). Monad m => Int -> m element -> m [element])
-> Array element -> Array [element]
forall a b.
(forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
dimension forall (m :: * -> *). Monad m => Int -> m element -> m [element]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Array element -> Array [element])
-> (NullableOrNot Value element -> Array element)
-> NullableOrNot Value element
-> Array [element]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NullableOrNot Value element -> Array element
forall a. NullableOrNot Value a -> Array a
element

{-|
Lift a value decoder of element into a unidimensional array decoder producing a generic vector.

This function is merely a shortcut to the following expression:

@
('array' . 'dimension' Data.Vector.Generic.'GenericVector.replicateM' . 'element')
@

Please notice that in case of multidimensional arrays nesting 'vectorArray' decoder
won't work. You have to explicitly construct the array decoder using 'array'.
-}
{-# INLINE vectorArray #-}
vectorArray :: GenericVector.Vector vector element => NullableOrNot Value element -> Value (vector element)
vectorArray :: NullableOrNot Value element -> Value (vector element)
vectorArray = Array (vector element) -> Value (vector element)
forall a. Array a -> Value a
array (Array (vector element) -> Value (vector element))
-> (NullableOrNot Value element -> Array (vector element))
-> NullableOrNot Value element
-> Value (vector element)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall (m :: * -> *).
 Monad m =>
 Int -> m element -> m (vector element))
-> Array element -> Array (vector element)
forall a b.
(forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
dimension forall (m :: * -> *).
Monad m =>
Int -> m element -> m (vector element)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> m a -> m (v a)
GenericVector.replicateM (Array element -> Array (vector element))
-> (NullableOrNot Value element -> Array element)
-> NullableOrNot Value element
-> Array (vector element)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NullableOrNot Value element -> Array element
forall a. NullableOrNot Value a -> Array a
element

{-|
Lift a 'Composite' decoder to a 'Value' decoder.
-}
{-# INLINABLE composite #-}
composite :: Composite a -> Value a
composite :: Composite a -> Value a
composite (Composite Composite a
imp) = Value a -> Value a
forall a. Value a -> Value a
Value ((Bool -> Value a) -> Value a
forall a. (Bool -> Value a) -> Value a
Value.decoder (Composite a -> Bool -> Value a
forall a. Composite a -> Bool -> Value a
Composite.run Composite a
imp))


-- * Array decoders
-------------------------

{-|
A generic array decoder.

Here's how you can use it to produce a specific array value decoder:

@
x :: 'Value' [[Text]]
x = 'array' ('dimension' 'replicateM' ('dimension' 'replicateM' ('element' ('nonNullable' 'text'))))
@
-}
newtype Array a = Array (Array.Array a)
  deriving (a -> Array b -> Array a
(a -> b) -> Array a -> Array b
(forall a b. (a -> b) -> Array a -> Array b)
-> (forall a b. a -> Array b -> Array a) -> Functor Array
forall a b. a -> Array b -> Array a
forall a b. (a -> b) -> Array a -> Array b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Array b -> Array a
$c<$ :: forall a b. a -> Array b -> Array a
fmap :: (a -> b) -> Array a -> Array b
$cfmap :: forall a b. (a -> b) -> Array a -> Array b
Functor)

{-|
A function for parsing a dimension of an array.
Provides support for multi-dimensional arrays.

Accepts:

* An implementation of the @replicateM@ function
(@Control.Monad.'Control.Monad.replicateM'@, @Data.Vector.'Data.Vector.replicateM'@),
which determines the output value.

* A decoder of its components, which can be either another 'dimension' or 'element'.
-}
{-# INLINABLE dimension #-}
dimension :: (forall m. Monad m => Int -> m a -> m b) -> Array a -> Array b
dimension :: (forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
dimension forall (m :: * -> *). Monad m => Int -> m a -> m b
replicateM (Array Array a
imp) = Array b -> Array b
forall a. Array a -> Array a
Array ((forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
forall a b.
(forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
Array.dimension forall (m :: * -> *). Monad m => Int -> m a -> m b
replicateM Array a
imp)

{-|
Lift a 'Value' decoder into an 'Array' decoder for parsing of leaf values.
-}
{-# INLINABLE element #-}
element :: NullableOrNot Value a -> Array a
element :: NullableOrNot Value a -> Array a
element = \ case
  NonNullable (Value Value a
imp) -> Array a -> Array a
forall a. Array a -> Array a
Array ((Bool -> Value a) -> Array a
forall a. (Bool -> Value a) -> Array a
Array.nonNullValue (Value a -> Bool -> Value a
forall a. Value a -> Bool -> Value a
Value.run Value a
imp))
  Nullable (Value Value a
imp) -> Array (Maybe a) -> Array (Maybe a)
forall a. Array a -> Array a
Array ((Bool -> Value a) -> Array (Maybe a)
forall a. (Bool -> Value a) -> Array (Maybe a)
Array.value (Value a -> Bool -> Value a
forall a. Value a -> Bool -> Value a
Value.run Value a
imp))


-- * Composite decoders
-------------------------

{-|
Composable decoder of composite values (rows, records).
-}
newtype Composite a = Composite (Composite.Composite a)
  deriving (a -> Composite b -> Composite a
(a -> b) -> Composite a -> Composite b
(forall a b. (a -> b) -> Composite a -> Composite b)
-> (forall a b. a -> Composite b -> Composite a)
-> Functor Composite
forall a b. a -> Composite b -> Composite a
forall a b. (a -> b) -> Composite a -> Composite b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Composite b -> Composite a
$c<$ :: forall a b. a -> Composite b -> Composite a
fmap :: (a -> b) -> Composite a -> Composite b
$cfmap :: forall a b. (a -> b) -> Composite a -> Composite b
Functor, Functor Composite
a -> Composite a
Functor Composite
-> (forall a. a -> Composite a)
-> (forall a b. Composite (a -> b) -> Composite a -> Composite b)
-> (forall a b c.
    (a -> b -> c) -> Composite a -> Composite b -> Composite c)
-> (forall a b. Composite a -> Composite b -> Composite b)
-> (forall a b. Composite a -> Composite b -> Composite a)
-> Applicative Composite
Composite a -> Composite b -> Composite b
Composite a -> Composite b -> Composite a
Composite (a -> b) -> Composite a -> Composite b
(a -> b -> c) -> Composite a -> Composite b -> Composite c
forall a. a -> Composite a
forall a b. Composite a -> Composite b -> Composite a
forall a b. Composite a -> Composite b -> Composite b
forall a b. Composite (a -> b) -> Composite a -> Composite b
forall a b c.
(a -> b -> c) -> Composite a -> Composite b -> Composite c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Composite a -> Composite b -> Composite a
$c<* :: forall a b. Composite a -> Composite b -> Composite a
*> :: Composite a -> Composite b -> Composite b
$c*> :: forall a b. Composite a -> Composite b -> Composite b
liftA2 :: (a -> b -> c) -> Composite a -> Composite b -> Composite c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Composite a -> Composite b -> Composite c
<*> :: Composite (a -> b) -> Composite a -> Composite b
$c<*> :: forall a b. Composite (a -> b) -> Composite a -> Composite b
pure :: a -> Composite a
$cpure :: forall a. a -> Composite a
$cp1Applicative :: Functor Composite
Applicative, Applicative Composite
a -> Composite a
Applicative Composite
-> (forall a b. Composite a -> (a -> Composite b) -> Composite b)
-> (forall a b. Composite a -> Composite b -> Composite b)
-> (forall a. a -> Composite a)
-> Monad Composite
Composite a -> (a -> Composite b) -> Composite b
Composite a -> Composite b -> Composite b
forall a. a -> Composite a
forall a b. Composite a -> Composite b -> Composite b
forall a b. Composite a -> (a -> Composite b) -> Composite b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Composite a
$creturn :: forall a. a -> Composite a
>> :: Composite a -> Composite b -> Composite b
$c>> :: forall a b. Composite a -> Composite b -> Composite b
>>= :: Composite a -> (a -> Composite b) -> Composite b
$c>>= :: forall a b. Composite a -> (a -> Composite b) -> Composite b
$cp1Monad :: Applicative Composite
Monad, Monad Composite
Monad Composite
-> (forall a. String -> Composite a) -> MonadFail Composite
String -> Composite a
forall a. String -> Composite a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Composite a
$cfail :: forall a. String -> Composite a
$cp1MonadFail :: Monad Composite
MonadFail)

{-|
Lift a 'Value' decoder into a 'Composite' decoder for parsing of component values.
-}
field :: NullableOrNot Value a -> Composite a
field :: NullableOrNot Value a -> Composite a
field = \ case
  NonNullable (Value Value a
imp) -> Composite a -> Composite a
forall a. Composite a -> Composite a
Composite ((Bool -> Value a) -> Composite a
forall a. (Bool -> Value a) -> Composite a
Composite.nonNullValue (Value a -> Bool -> Value a
forall a. Value a -> Bool -> Value a
Value.run Value a
imp))
  Nullable (Value Value a
imp) -> Composite (Maybe a) -> Composite (Maybe a)
forall a. Composite a -> Composite a
Composite ((Bool -> Value a) -> Composite (Maybe a)
forall a. (Bool -> Value a) -> Composite (Maybe a)
Composite.value (Value a -> Bool -> Value a
forall a. Value a -> Bool -> Value a
Value.run Value a
imp))