module PostgreSQL.Binary.Decoding
( valueParser,
Value,
int,
float4,
float8,
bool,
bytea_strict,
bytea_lazy,
text_strict,
text_lazy,
char,
fn,
numeric,
uuid,
inet,
json_ast,
json_bytes,
jsonb_ast,
jsonb_bytes,
date,
time_int,
time_float,
timetz_int,
timetz_float,
timestamp_int,
timestamp_float,
timestamptz_int,
timestamptz_float,
interval_int,
interval_float,
Array,
array,
valueArray,
nullableValueArray,
dimensionArray,
Composite,
composite,
valueComposite,
nullableValueComposite,
hstore,
enum,
refine,
)
where
import BinaryParser
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Encoding.Error as Text
import qualified Data.Text.Lazy.Encoding as LazyText
import qualified Data.UUID as UUID
import qualified Data.Vector as Vector
import qualified Network.IP.Addr as IPAddr
import qualified PostgreSQL.Binary.Inet as Inet
import qualified PostgreSQL.Binary.Integral as Integral
import qualified PostgreSQL.Binary.Interval as Interval
import qualified PostgreSQL.Binary.Numeric as Numeric
import PostgreSQL.Binary.Prelude hiding (bool, drop, fail, failure, state, take)
import qualified PostgreSQL.Binary.Time as Time
type Value =
BinaryParser
valueParser :: Value a -> ByteString -> Either Text a
valueParser :: forall a. Value a -> ByteString -> Either Text a
valueParser =
forall a. Value a -> ByteString -> Either Text a
BinaryParser.run
{-# INLINE intOfSize #-}
intOfSize :: (Integral a, Bits a) => Int -> Value a
intOfSize :: forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
x =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Bits a, Num a) => ByteString -> a
Integral.pack (Int -> BinaryParser ByteString
bytesOfSize Int
x)
{-# INLINEABLE onContent #-}
onContent :: Value a -> Value (Maybe a)
onContent :: forall a. Value a -> Value (Maybe a)
onContent Value a
decoder =
Value Int32
size
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(-1) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Int32
n -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall a. Int -> BinaryParser a -> BinaryParser a
sized (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n) Value a
decoder)
where
size :: Value Int32
size =
forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
4 :: Value Int32
{-# INLINEABLE content #-}
content :: Value (Maybe ByteString)
content :: Value (Maybe ByteString)
content =
forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(-1) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Int
n -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (Int -> BinaryParser ByteString
bytesOfSize Int
n)
{-# INLINE nonNull #-}
nonNull :: Maybe a -> Value a
nonNull :: forall a. Maybe a -> Value a
nonNull =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Text -> BinaryParser a
failure Text
"Unexpected NULL") forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE fn #-}
fn :: (ByteString -> Either Text a) -> Value a
fn :: forall a. (ByteString -> Either Text a) -> Value a
fn ByteString -> Either Text a
fn =
BinaryParser ByteString
BinaryParser.remainders forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Text -> BinaryParser a
BinaryParser.failure forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either Text a
fn
{-# INLINE int #-}
int :: (Integral a, Bits a) => Value a
int :: forall a. (Integral a, Bits a) => Value a
int =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Bits a, Num a) => ByteString -> a
Integral.pack BinaryParser ByteString
remainders
float4 :: Value Float
float4 :: Value Float
float4 =
forall a b. a -> b
unsafeCoerce (forall a. (Integral a, Bits a) => Value a
int :: Value Int32)
float8 :: Value Double
float8 :: Value Double
float8 =
forall a b. a -> b
unsafeCoerce (forall a. (Integral a, Bits a) => Value a
int :: Value Int64)
{-# INLINE bool #-}
bool :: Value Bool
bool :: Value Bool
bool =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
== Word8
1) BinaryParser Word8
byte
{-# NOINLINE numeric #-}
numeric :: Value Scientific
numeric :: Value Scientific
numeric =
do
Int
componentsAmount <- forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2
Int16
pointIndex <- forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2
Word16
signCode <- forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2
Int -> BinaryParser ()
unitOfSize Int
2
Vector Word16
components <- forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
Vector.replicateM Int
componentsAmount (forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Text -> BinaryParser a
failure forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> Word16 -> Vector Word16 -> Either Text Scientific
Numeric.scientific Int16
pointIndex Word16
signCode Vector Word16
components)
{-# INLINEABLE uuid #-}
uuid :: Value UUID
uuid :: Value UUID
uuid =
Word32 -> Word32 -> Word32 -> Word32 -> UUID
UUID.fromWords forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
4 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
4 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
4 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
4
{-# INLINE ip4 #-}
ip4 :: Value IPAddr.IP4
ip4 :: Value IP4
ip4 =
Word8 -> Word8 -> Word8 -> Word8 -> IP4
IPAddr.ip4FromOctets forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
1
{-# INLINE ip6 #-}
ip6 :: Value IPAddr.IP6
ip6 :: Value IP6
ip6 =
Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IP6
IPAddr.ip6FromWords forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
2
{-# INLINEABLE inet #-}
inet :: Value (IPAddr.NetAddr IPAddr.IP)
inet :: Value (NetAddr IP)
inet = do
Word8
af <- forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
1
Word8
netmask <- forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
1
Word8
isCidr <- forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
1
Int8
ipSize <- forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
1
if
| Word8
af forall a. Eq a => a -> a -> Bool
== Word8
Inet.inetAddressFamily ->
do
IP4
ip <- Value IP4
ip4
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Int8 -> IP -> NetAddr IP
inetFromBytes Word8
af Word8
netmask Word8
isCidr Int8
ipSize (forall t₄ t₆. t₄ -> IP46 t₄ t₆
IPAddr.IPv4 IP4
ip)
| Word8
af forall a. Eq a => a -> a -> Bool
== Word8
Inet.inet6AddressFamily ->
do
IP6
ip <- Value IP6
ip6
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Int8 -> IP -> NetAddr IP
inetFromBytes Word8
af Word8
netmask Word8
isCidr Int8
ipSize (forall t₄ t₆. t₆ -> IP46 t₄ t₆
IPAddr.IPv6 IP6
ip)
| Bool
otherwise -> forall a. Text -> BinaryParser a
BinaryParser.failure (Text
"Unknown address family: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Word8
af))
where
inetFromBytes :: Word8 -> Word8 -> Word8 -> Int8 -> IPAddr.IP -> IPAddr.NetAddr IPAddr.IP
inetFromBytes :: Word8 -> Word8 -> Word8 -> Int8 -> IP -> NetAddr IP
inetFromBytes Word8
_ Word8
netmask Word8
_ Int8
_ IP
ip = forall n. IsNetAddr n => NetHost n -> Word8 -> n
IPAddr.netAddr IP
ip Word8
netmask
{-# INLINEABLE json_ast #-}
json_ast :: Value Aeson.Value
json_ast :: Value Value
json_ast =
BinaryParser ByteString
bytea_strict forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Text -> BinaryParser a
BinaryParser.failure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict'
{-# INLINEABLE json_bytes #-}
json_bytes :: (ByteString -> Either Text a) -> Value a
json_bytes :: forall a. (ByteString -> Either Text a) -> Value a
json_bytes ByteString -> Either Text a
cont =
BinaryParser ByteString
getAllBytes forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> BinaryParser a
parseJSON
where
getAllBytes :: BinaryParser ByteString
getAllBytes =
BinaryParser ByteString
BinaryParser.remainders
parseJSON :: ByteString -> BinaryParser a
parseJSON =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Text -> BinaryParser a
BinaryParser.failure forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either Text a
cont
{-# INLINEABLE jsonb_ast #-}
jsonb_ast :: Value Aeson.Value
jsonb_ast :: Value Value
jsonb_ast =
forall a. (ByteString -> Either Text a) -> Value a
jsonb_bytes forall a b. (a -> b) -> a -> b
$ forall a b x. (a -> b) -> Either a x -> Either b x
mapLeft forall a. IsString a => String -> a
fromString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict'
{-# INLINEABLE jsonb_bytes #-}
jsonb_bytes :: (ByteString -> Either Text a) -> Value a
jsonb_bytes :: forall a. (ByteString -> Either Text a) -> Value a
jsonb_bytes ByteString -> Either Text a
cont =
BinaryParser ByteString
getAllBytes forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> BinaryParser ByteString
trimBytes forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> BinaryParser a
parseJSON
where
getAllBytes :: BinaryParser ByteString
getAllBytes =
BinaryParser ByteString
BinaryParser.remainders
trimBytes :: ByteString -> BinaryParser ByteString
trimBytes =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Text -> BinaryParser a
BinaryParser.failure Text
"Empty input") forall (m :: * -> *) a. Monad m => a -> m a
return
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Maybe (Word8, ByteString)
ByteString.uncons
parseJSON :: ByteString -> BinaryParser a
parseJSON =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Text -> BinaryParser a
BinaryParser.failure forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either Text a
cont
{-# INLINEABLE char #-}
char :: Value Char
char :: Value Char
char =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe (Char, Text)
Text.uncons Value Text
text_strict forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (Char
c, Text
"") -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
Maybe (Char, Text)
Nothing -> forall a. Text -> BinaryParser a
failure Text
"Empty input"
Maybe (Char, Text)
_ -> forall a. Text -> BinaryParser a
failure Text
"Consumed too much"
{-# INLINEABLE text_strict #-}
text_strict :: Value Text
text_strict :: Value Text
text_strict =
do
ByteString
input <- BinaryParser ByteString
remainders
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Text -> BinaryParser a
failure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {a} {a}. (IsString a, Show a) => a -> UnicodeException -> a
exception ByteString
input) forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
input)
where
exception :: a -> UnicodeException -> a
exception a
input =
\case
Text.DecodeError String
_ Maybe Word8
_ -> forall a. IsString a => String -> a
fromString (String
"Failed to decode the following bytes in UTF-8: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
input)
UnicodeException
_ -> forall a. HasCallStack => String -> a
error String
"Unexpected unicode exception"
{-# INLINEABLE text_lazy #-}
text_lazy :: Value LazyText
text_lazy :: Value LazyText
text_lazy =
do
LazyByteString
input <- Value LazyByteString
bytea_lazy
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Text -> BinaryParser a
failure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {a} {a}. (IsString a, Show a) => a -> UnicodeException -> a
exception LazyByteString
input) forall (m :: * -> *) a. Monad m => a -> m a
return (LazyByteString -> Either UnicodeException LazyText
LazyText.decodeUtf8' LazyByteString
input)
where
exception :: a -> UnicodeException -> a
exception a
input =
\case
Text.DecodeError String
_ Maybe Word8
_ -> forall a. IsString a => String -> a
fromString (String
"Failed to decode the following bytes in UTF-8: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
input)
UnicodeException
_ -> forall a. HasCallStack => String -> a
error String
"Unexpected unicode exception"
{-# INLINE bytea_strict #-}
bytea_strict :: Value ByteString
bytea_strict :: BinaryParser ByteString
bytea_strict =
BinaryParser ByteString
remainders
{-# INLINE bytea_lazy #-}
bytea_lazy :: Value LazyByteString
bytea_lazy :: Value LazyByteString
bytea_lazy =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> LazyByteString
LazyByteString.fromStrict BinaryParser ByteString
remainders
date :: Value Day
date :: Value Day
date =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Integral a => a -> Day
Time.postgresJulianToDay forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (forall a. (Integral a, Bits a) => Value a
int :: Value Int32)
time_int :: Value TimeOfDay
time_int :: Value TimeOfDay
time_int =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> TimeOfDay
Time.microsToTimeOfDay forall a. (Integral a, Bits a) => Value a
int
time_float :: Value TimeOfDay
time_float :: Value TimeOfDay
time_float =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> TimeOfDay
Time.secsToTimeOfDay Value Double
float8
timetz_int :: Value (TimeOfDay, TimeZone)
timetz_int :: Value (TimeOfDay, TimeZone)
timetz_int =
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
8 Value TimeOfDay
time_int forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value TimeZone
tz
timetz_float :: Value (TimeOfDay, TimeZone)
timetz_float :: Value (TimeOfDay, TimeZone)
timetz_float =
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
8 Value TimeOfDay
time_float forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value TimeZone
tz
{-# INLINE tz #-}
tz :: Value TimeZone
tz :: Value TimeZone
tz =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> TimeZone
minutesToTimeZone forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => a -> a
negate forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> a
div Int
60) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (forall a. (Integral a, Bits a) => Value a
int :: Value Int32)
timestamp_int :: Value LocalTime
timestamp_int :: Value LocalTime
timestamp_int =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> LocalTime
Time.microsToLocalTime forall a. (Integral a, Bits a) => Value a
int
timestamp_float :: Value LocalTime
timestamp_float :: Value LocalTime
timestamp_float =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> LocalTime
Time.secsToLocalTime Value Double
float8
timestamptz_int :: Value UTCTime
timestamptz_int :: Value UTCTime
timestamptz_int =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> UTCTime
Time.microsToUTC forall a. (Integral a, Bits a) => Value a
int
timestamptz_float :: Value UTCTime
timestamptz_float :: Value UTCTime
timestamptz_float =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> UTCTime
Time.secsToUTC Value Double
float8
interval_int :: Value DiffTime
interval_int :: Value DiffTime
interval_int =
do
Int64
u <- forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
8 forall a. (Integral a, Bits a) => Value a
int
Int32
d <- forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
4 forall a. (Integral a, Bits a) => Value a
int
Int32
m <- forall a. (Integral a, Bits a) => Value a
int
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Interval -> DiffTime
Interval.toDiffTime forall a b. (a -> b) -> a -> b
$ Int64 -> Int32 -> Int32 -> Interval
Interval.Interval Int64
u Int32
d Int32
m
interval_float :: Value DiffTime
interval_float :: Value DiffTime
interval_float =
do
Int64
u <- forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
8 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (RealFrac a, Integral b) => a -> b
round forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. Num a => a -> a -> a
* (Rational
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Real a => a -> Rational
toRational) Value Double
float8)
Int32
d <- forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
4 forall a. (Integral a, Bits a) => Value a
int
Int32
m <- forall a. (Integral a, Bits a) => Value a
int
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Interval -> DiffTime
Interval.toDiffTime forall a b. (a -> b) -> a -> b
$ Int64 -> Int32 -> Int32 -> Interval
Interval.Interval Int64
u Int32
d Int32
m
{-# INLINEABLE hstore #-}
hstore :: (forall m. Monad m => Int -> m (k, Maybe v) -> m r) -> Value k -> Value v -> Value r
hstore :: forall k v r.
(forall (m :: * -> *). Monad m => Int -> m (k, Maybe v) -> m r)
-> Value k -> Value v -> Value r
hstore forall (m :: * -> *). Monad m => Int -> m (k, Maybe v) -> m r
replicateM Value k
keyContent Value v
valueContent =
do
Int
componentsAmount <- forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
4
forall (m :: * -> *). Monad m => Int -> m (k, Maybe v) -> m r
replicateM Int
componentsAmount BinaryParser (k, Maybe v)
component
where
component :: BinaryParser (k, Maybe v)
component =
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value k
key forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value (Maybe v)
value
where
key :: Value k
key =
forall a. Value a -> Value (Maybe a)
onContent Value k
keyContent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Maybe a -> Value a
nonNull
value :: Value (Maybe v)
value =
forall a. Value a -> Value (Maybe a)
onContent Value v
valueContent
newtype Composite a
= Composite (Value a)
deriving (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
<$ :: forall a b. a -> Composite b -> Composite a
$c<$ :: forall a b. a -> Composite b -> Composite a
fmap :: forall a b. (a -> b) -> Composite a -> Composite b
$cfmap :: forall a b. (a -> b) -> Composite a -> Composite b
Functor, Functor Composite
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
<* :: forall a b. Composite a -> Composite b -> Composite a
$c<* :: forall a b. Composite a -> Composite b -> Composite a
*> :: forall a b. Composite a -> Composite b -> Composite b
$c*> :: forall a b. Composite a -> Composite b -> Composite b
liftA2 :: forall a b c.
(a -> b -> c) -> Composite a -> Composite b -> Composite c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Composite a -> Composite b -> Composite c
<*> :: forall a b. Composite (a -> b) -> Composite a -> Composite b
$c<*> :: forall a b. Composite (a -> b) -> Composite a -> Composite b
pure :: forall a. a -> Composite a
$cpure :: forall a. a -> Composite a
Applicative, Applicative Composite
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 :: forall a. a -> Composite a
$creturn :: forall a. a -> Composite a
>> :: forall a b. Composite a -> Composite b -> Composite b
$c>> :: forall a b. Composite a -> Composite b -> Composite b
>>= :: forall a b. Composite a -> (a -> Composite b) -> Composite b
$c>>= :: forall a b. Composite a -> (a -> Composite b) -> Composite b
Monad, Monad Composite
forall a. String -> Composite a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> Composite a
$cfail :: forall a. String -> Composite a
MonadFail)
{-# INLINE composite #-}
composite :: Composite a -> Value a
composite :: forall a. Composite a -> Value a
composite (Composite Value a
decoder) =
BinaryParser ()
numOfComponents forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value a
decoder
where
numOfComponents :: BinaryParser ()
numOfComponents =
Int -> BinaryParser ()
unitOfSize Int
4
{-# INLINE nullableValueComposite #-}
nullableValueComposite :: Value a -> Composite (Maybe a)
nullableValueComposite :: forall a. Value a -> Composite (Maybe a)
nullableValueComposite Value a
valueValue =
forall a. Value a -> Composite a
Composite (BinaryParser ()
skipOid forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Value a -> Value (Maybe a)
onContent Value a
valueValue)
where
skipOid :: BinaryParser ()
skipOid =
Int -> BinaryParser ()
unitOfSize Int
4
{-# INLINE valueComposite #-}
valueComposite :: Value a -> Composite a
valueComposite :: forall a. Value a -> Composite a
valueComposite Value a
valueValue =
forall a. Value a -> Composite a
Composite (BinaryParser ()
skipOid forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Value a -> Value (Maybe a)
onContent Value a
valueValue forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Text -> BinaryParser a
failure Text
"Unexpected NULL") forall (m :: * -> *) a. Monad m => a -> m a
return)
where
skipOid :: BinaryParser ()
skipOid =
Int -> BinaryParser ()
unitOfSize Int
4
newtype Array a
= Array ([Word32] -> Value a)
deriving (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
<$ :: forall a b. a -> Array b -> Array a
$c<$ :: forall a b. a -> Array b -> Array a
fmap :: forall a b. (a -> b) -> Array a -> Array b
$cfmap :: forall a b. (a -> b) -> Array a -> Array b
Functor)
{-# INLINE array #-}
array :: Array a -> Value a
array :: forall a. Array a -> Value a
array (Array [Word32] -> Value a
decoder) =
do
Int
dimensionsAmount <- forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
4
if Int
dimensionsAmount forall a. Eq a => a -> a -> Bool
/= Int
0
then do
Int -> BinaryParser ()
unitOfSize (Int
4 forall a. Num a => a -> a -> a
+ Int
4)
[Word32]
dimensionSizes <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
dimensionsAmount forall a. (Integral a, Bits a) => Value a
dimensionSize
[Word32] -> Value a
decoder [Word32]
dimensionSizes
else [Word32] -> Value a
decoder [Word32
0]
where
dimensionSize :: BinaryParser a
dimensionSize =
forall a. (Integral a, Bits a) => Int -> Value a
intOfSize Int
4 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> BinaryParser ()
unitOfSize Int
4
{-# INLINE dimensionArray #-}
dimensionArray :: (forall m. Monad m => Int -> m a -> m b) -> Array a -> Array b
dimensionArray :: forall a b.
(forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
dimensionArray forall (m :: * -> *). Monad m => Int -> m a -> m b
replicateM (Array [Word32] -> Value a
component) =
forall a. ([Word32] -> Value a) -> Array a
Array forall a b. (a -> b) -> a -> b
$ \case
Word32
head : [Word32]
tail -> forall (m :: * -> *). Monad m => Int -> m a -> m b
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
head) ([Word32] -> Value a
component [Word32]
tail)
[Word32]
_ -> forall a. Text -> BinaryParser a
failure Text
"A missing dimension length"
{-# INLINE nullableValueArray #-}
nullableValueArray :: Value a -> Array (Maybe a)
nullableValueArray :: forall a. Value a -> Array (Maybe a)
nullableValueArray =
forall a. ([Word32] -> Value a) -> Array a
Array forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Value a -> Value (Maybe a)
onContent
{-# INLINE valueArray #-}
valueArray :: Value a -> Array a
valueArray :: forall a. Value a -> Array a
valueArray =
forall a. ([Word32] -> Value a) -> Array a
Array forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Text -> BinaryParser a
failure Text
"Unexpected NULL") forall (m :: * -> *) a. Monad m => a -> m a
return) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Value a -> Value (Maybe a)
onContent
{-# INLINE enum #-}
enum :: (Text -> Maybe a) -> Value a
enum :: forall a. (Text -> Maybe a) -> Value a
enum Text -> Maybe a
mapping =
Value Text
text_strict forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> BinaryParser a
onText
where
onText :: Text -> BinaryParser a
onText Text
text =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BinaryParser a
onNothing forall {f :: * -> *} {a}. Applicative f => a -> f a
onJust (Text -> Maybe a
mapping Text
text)
where
onNothing :: BinaryParser a
onNothing =
forall a. Text -> BinaryParser a
failure (Text
"No mapping for text \"" forall a. Semigroup a => a -> a -> a
<> Text
text forall a. Semigroup a => a -> a -> a
<> Text
"\"")
onJust :: a -> f a
onJust =
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# 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 a
m = Value a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Text -> BinaryParser a
failure forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either Text b
fn)