{-# LANGUAGE
AllowAmbiguousTypes
, CPP
, DataKinds
, DerivingStrategies
, FlexibleContexts
, FlexibleInstances
, FunctionalDependencies
, GeneralizedNewtypeDeriving
, LambdaCase
, MultiParamTypeClasses
, OverloadedStrings
, PolyKinds
, ScopedTypeVariables
, TypeApplications
, TypeFamilies
, TypeOperators
, UndecidableInstances
, UndecidableSuperClasses
#-}
module Squeal.PostgreSQL.Session.Decode
(
FromPG (..)
, devalue
, rowValue
, enumValue
, DecodeRow (..)
, decodeRow
, runDecodeRow
, GenericRow (..)
, genericProductRow
, appendRows
, consRow
, FromValue (..)
, FromField (..)
, FromAliasedValue (..)
, FromArray (..)
, StateT (..)
, ExceptT (..)
) where
import BinaryParser
import Control.Applicative
import Control.Arrow
import Control.Monad
#if MIN_VERSION_base(4,13,0)
#else
import Control.Monad.Fail
#endif
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State.Strict
import Control.Monad.Trans.Maybe
import Data.Bits
import Data.Coerce (coerce)
import Data.Functor.Constant (Constant(Constant))
import Data.Int (Int16, Int32, Int64)
import Data.Kind
import Data.Scientific (Scientific)
import Data.String (fromString)
import Data.Text (Text)
import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
import Data.UUID.Types (UUID)
import Data.Vector (Vector)
import Database.PostgreSQL.LibPQ (Oid(Oid))
import GHC.OverloadedLabels
import GHC.TypeLits
import Network.IP.Addr (NetAddr, IP)
import PostgreSQL.Binary.Decoding hiding (Composite)
import Unsafe.Coerce
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString as Strict (ByteString)
import qualified Data.Text.Lazy as Lazy (Text)
import qualified Data.Text as Strict (Text)
import qualified Data.Text as Strict.Text
import qualified Data.Vector as Vector
import qualified Generics.SOP as SOP
import qualified Generics.SOP.Record as SOP
import Squeal.PostgreSQL.Expression.Range
import Squeal.PostgreSQL.Type
import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Type.PG
import Squeal.PostgreSQL.Type.Schema
devalue :: Value x -> StateT Strict.ByteString (Except Strict.Text) x
devalue :: forall x. Value x -> StateT ByteString (Except Text) x
devalue = forall a b. a -> b
unsafeCoerce
revalue :: StateT Strict.ByteString (Except Strict.Text) x -> Value x
revalue :: forall x. StateT ByteString (Except Text) x -> Value x
revalue = forall a b. a -> b
unsafeCoerce
rowValue
:: (PG y ~ 'PGcomposite row, SOP.SListI row)
=> DecodeRow row y
-> StateT Strict.ByteString (Except Strict.Text) y
rowValue :: forall y (row :: RowType).
(PG y ~ 'PGcomposite row, SListI row) =>
DecodeRow row y -> StateT ByteString (Except Text) y
rowValue DecodeRow row y
decoder = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a b. (a -> b) -> a -> b
$
let
comp :: ByteString -> Either Text (NP (K (Maybe ByteString)) row)
comp = forall a. Value a -> ByteString -> Either Text a
valueParser forall a b. (a -> b) -> a -> b
$ do
Int -> BinaryParser ()
unitOfSize Int
4
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
(g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
SOP.hsequence' forall a b. (a -> b) -> a -> b
$ forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
SOP.hpure forall a b. (a -> b) -> a -> b
$ forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
SOP.Comp forall a b. (a -> b) -> a -> b
$ do
Int -> BinaryParser ()
unitOfSize Int
4
Int32
len :: Int32 <- forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
4 forall a. (Integral a, Bits a) => Value a
int
if Int32
len forall a. Eq a => a -> a -> Bool
== -Int32
1
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a (b :: k). a -> K a b
SOP.K forall a. Maybe a
Nothing)
else forall k a (b :: k). a -> K a b
SOP.K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BinaryParser ByteString
bytesOfSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)
in forall a. (ByteString -> Either Text a) -> Value a
fn (forall (row :: RowType) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
runDecodeRow DecodeRow row y
decoder forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Either Text (NP (K (Maybe ByteString)) row)
comp)
class IsPG y => FromPG y where
fromPG :: StateT Strict.ByteString (Except Strict.Text) y
instance FromPG Bool where
fromPG :: StateT ByteString (Except Text) Bool
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Bool
bool
instance FromPG Int16 where
fromPG :: StateT ByteString (Except Text) Int16
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a. (Integral a, Bits a) => Value a
int
instance FromPG Int32 where
fromPG :: StateT ByteString (Except Text) Int32
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a. (Integral a, Bits a) => Value a
int
instance FromPG Int64 where
fromPG :: StateT ByteString (Except Text) Int64
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a. (Integral a, Bits a) => Value a
int
instance FromPG Oid where
fromPG :: StateT ByteString (Except Text) Oid
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
Oid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bits a) => Value a
int
instance FromPG Float where
fromPG :: StateT ByteString (Except Text) Float
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Float
float4
instance FromPG Double where
fromPG :: StateT ByteString (Except Text) Double
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Double
float8
instance FromPG Scientific where
fromPG :: StateT ByteString (Except Text) Scientific
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Scientific
numeric
instance FromPG Money where
fromPG :: StateT ByteString (Except Text) Money
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a b. (a -> b) -> a -> b
$ Int64 -> Money
Money forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bits a) => Value a
int
instance FromPG UUID where
fromPG :: StateT ByteString (Except Text) UUID
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value UUID
uuid
instance FromPG (NetAddr IP) where
fromPG :: StateT ByteString (Except Text) (NetAddr IP)
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value (NetAddr IP)
inet
instance FromPG Char where
fromPG :: StateT ByteString (Except Text) Char
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Char
char
instance FromPG Strict.Text where
fromPG :: StateT ByteString (Except Text) Text
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Text
text_strict
instance FromPG Lazy.Text where
fromPG :: StateT ByteString (Except Text) Text
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Text
text_lazy
instance FromPG String where
fromPG :: StateT ByteString (Except Text) String
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a b. (a -> b) -> a -> b
$ Text -> String
Strict.Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Text
text_strict
instance FromPG Strict.ByteString where
fromPG :: StateT ByteString (Except Text) ByteString
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue BinaryParser ByteString
bytea_strict
instance FromPG Lazy.ByteString where
fromPG :: StateT ByteString (Except Text) ByteString
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value ByteString
bytea_lazy
instance KnownNat n => FromPG (VarChar n) where
fromPG :: StateT ByteString (Except Text) (VarChar n)
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a b. (a -> b) -> a -> b
$ Value Text
text_strict forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
t ->
case forall (n :: Nat). KnownNat n => Text -> Maybe (VarChar n)
varChar Text
t of
Maybe (VarChar n)
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> Text
Strict.Text.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Source for VarChar has wrong length"
, String
"; expected length "
, forall a. Show a => a -> String
show (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
SOP.Proxy @n))
, String
", actual length "
, forall a. Show a => a -> String
show (Text -> Int
Strict.Text.length Text
t)
, String
"."
]
Just VarChar n
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VarChar n
x
instance KnownNat n => FromPG (FixChar n) where
fromPG :: StateT ByteString (Except Text) (FixChar n)
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a b. (a -> b) -> a -> b
$ Value Text
text_strict forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
t ->
case forall (n :: Nat). KnownNat n => Text -> Maybe (FixChar n)
fixChar Text
t of
Maybe (FixChar n)
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> Text
Strict.Text.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Source for FixChar has wrong length"
, String
"; expected length "
, forall a. Show a => a -> String
show (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
SOP.Proxy @n))
, String
", actual length "
, forall a. Show a => a -> String
show (Text -> Int
Strict.Text.length Text
t)
, String
"."
]
Just FixChar n
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FixChar n
x
instance FromPG x => FromPG (Const x tag) where
fromPG :: StateT ByteString (Except Text) (Const x tag)
fromPG = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall y. FromPG y => StateT ByteString (Except Text) y
fromPG @x
instance FromPG x => FromPG (SOP.K x tag) where
fromPG :: StateT ByteString (Except Text) (K x tag)
fromPG = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall y. FromPG y => StateT ByteString (Except Text) y
fromPG @x
instance FromPG x => FromPG (Constant x tag) where
fromPG :: StateT ByteString (Except Text) (Constant x tag)
fromPG = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall y. FromPG y => StateT ByteString (Except Text) y
fromPG @x
instance FromPG Day where
fromPG :: StateT ByteString (Except Text) Day
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Day
date
instance FromPG TimeOfDay where
fromPG :: StateT ByteString (Except Text) TimeOfDay
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value TimeOfDay
time_int
instance FromPG (TimeOfDay, TimeZone) where
fromPG :: StateT ByteString (Except Text) (TimeOfDay, TimeZone)
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value (TimeOfDay, TimeZone)
timetz_int
instance FromPG LocalTime where
fromPG :: StateT ByteString (Except Text) LocalTime
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value LocalTime
timestamp_int
instance FromPG UTCTime where
fromPG :: StateT ByteString (Except Text) UTCTime
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value UTCTime
timestamptz_int
instance FromPG DiffTime where
fromPG :: StateT ByteString (Except Text) DiffTime
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value DiffTime
interval_int
instance FromPG Aeson.Value where
fromPG :: StateT ByteString (Except Text) Value
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Value
json_ast
instance Aeson.FromJSON x => FromPG (Json x) where
fromPG :: StateT ByteString (Except Text) (Json x)
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a b. (a -> b) -> a -> b
$ forall hask. hask -> Json hask
Json forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a. (ByteString -> Either Text a) -> Value a
json_bytes (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
Strict.Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict)
instance Aeson.FromJSON x => FromPG (Jsonb x) where
fromPG :: StateT ByteString (Except Text) (Jsonb x)
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a b. (a -> b) -> a -> b
$ forall hask. hask -> Jsonb hask
Jsonb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a. (ByteString -> Either Text a) -> Value a
jsonb_bytes (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
Strict.Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict)
instance (FromArray '[] ty y, ty ~ NullPG y)
=> FromPG (VarArray (Vector y)) where
fromPG :: StateT ByteString (Except Text) (VarArray (Vector y))
fromPG =
let
rep :: Int -> f a -> f (VarArray (Vector a))
rep Int
n f a
x = forall arr. arr -> VarArray arr
VarArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
Vector.replicateM Int
n f a
x
in
forall x. Value x -> StateT ByteString (Except Text) x
devalue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Array a -> Value a
array forall a b. (a -> b) -> a -> b
$ forall a b.
(forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
dimensionArray forall {f :: * -> *} {a}.
Monad f =>
Int -> f a -> f (VarArray (Vector a))
rep
(forall (dims :: [Nat]) (ty :: NullType) y.
FromArray dims ty y =>
Array y
fromArray @'[] @(NullPG y))
instance (FromArray '[] ty y, ty ~ NullPG y)
=> FromPG (VarArray [y]) where
fromPG :: StateT ByteString (Except Text) (VarArray [y])
fromPG =
let
rep :: Int -> f a -> f (VarArray [a])
rep Int
n f a
x = forall arr. arr -> VarArray arr
VarArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n f a
x
in
forall x. Value x -> StateT ByteString (Except Text) x
devalue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Array a -> Value a
array forall a b. (a -> b) -> a -> b
$ forall a b.
(forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
dimensionArray forall {f :: * -> *} {a}.
Applicative f =>
Int -> f a -> f (VarArray [a])
rep
(forall (dims :: [Nat]) (ty :: NullType) y.
FromArray dims ty y =>
Array y
fromArray @'[] @(NullPG y))
instance FromArray dims ty y => FromPG (FixArray y) where
fromPG :: StateT ByteString (Except Text) (FixArray y)
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a b. (a -> b) -> a -> b
$ forall arr. arr -> FixArray arr
FixArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Array a -> Value a
array (forall (dims :: [Nat]) (ty :: NullType) y.
FromArray dims ty y =>
Array y
fromArray @dims @ty @y)
instance
( SOP.IsEnumType y
, SOP.HasDatatypeInfo y
, LabelsPG y ~ labels
) => FromPG (Enumerated y) where
fromPG :: StateT ByteString (Except Text) (Enumerated y)
fromPG =
let
greadConstructor
:: SOP.All ((~) '[]) xss
=> NP SOP.ConstructorInfo xss
-> String
-> Maybe (SOP.SOP SOP.I xss)
greadConstructor :: forall (xss :: [[*]]).
All ((~) '[]) xss =>
NP ConstructorInfo xss -> String -> Maybe (SOP I xss)
greadConstructor NP ConstructorInfo xss
Nil String
_ = forall a. Maybe a
Nothing
greadConstructor (ConstructorInfo x
constructor :* NP ConstructorInfo xs
constructors) String
name =
if String
name forall a. Eq a => a -> a -> Bool
== forall (xs :: [*]). ConstructorInfo xs -> String
SOP.constructorName ConstructorInfo x
constructor
then forall a. a -> Maybe a
Just (forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP.SOP (forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
SOP.Z forall {k} (a :: k -> *). NP a '[]
Nil))
else forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP.SOP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
SOP.S forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
SOP.unSOP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (xss :: [[*]]).
All ((~) '[]) xss =>
NP ConstructorInfo xss -> String -> Maybe (SOP I xss)
greadConstructor NP ConstructorInfo xs
constructors String
name
in
forall x. Value x -> StateT ByteString (Except Text) x
devalue
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall enum. enum -> Enumerated enum
Enumerated
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Text -> Maybe a) -> Value a
enum
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Generic a => Rep a -> a
SOP.to
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (xss :: [[*]]).
All ((~) '[]) xss =>
NP ConstructorInfo xss -> String -> Maybe (SOP I xss)
greadConstructor
(forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
SOP.constructorInfo (forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
SOP.datatypeInfo (forall {k} (t :: k). Proxy t
SOP.Proxy @y)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Strict.Text.unpack
instance
( SOP.IsRecord y ys
, SOP.AllZip FromField row ys
, RowPG y ~ row
) => FromPG (Composite y) where
fromPG :: StateT ByteString (Except Text) (Composite y)
fromPG = forall y (row :: RowType).
(PG y ~ 'PGcomposite row, SListI row) =>
DecodeRow row y -> StateT ByteString (Except Text) y
rowValue (forall record. record -> Composite record
Composite forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (row :: RowType) y (ys :: RecordCode).
GenericRow row y ys =>
DecodeRow row y
genericRow)
instance FromPG y => FromPG (Range y) where
fromPG :: StateT ByteString (Except Text) (Range y)
fromPG = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall a b. (a -> b) -> a -> b
$ do
Word8
flag <- BinaryParser Word8
byte
if forall a. Bits a => a -> Int -> Bool
testBit Word8
flag Int
0 then forall (m :: * -> *) a. Monad m => a -> m a
return forall x. Range x
Empty else do
Bound y
lower <-
if forall a. Bits a => a -> Int -> Bool
testBit Word8
flag Int
3
then forall (m :: * -> *) a. Monad m => a -> m a
return forall x. Bound x
Infinite
else do
Int
len <- forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
4 forall a. (Integral a, Bits a) => Value a
int
y
l <- forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
len (forall x. StateT ByteString (Except Text) x -> Value x
revalue forall y. FromPG y => StateT ByteString (Except Text) y
fromPG)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. Bits a => a -> Int -> Bool
testBit Word8
flag Int
1 then forall x. x -> Bound x
Closed y
l else forall x. x -> Bound x
Open y
l
Bound y
upper <-
if forall a. Bits a => a -> Int -> Bool
testBit Word8
flag Int
4
then forall (m :: * -> *) a. Monad m => a -> m a
return forall x. Bound x
Infinite
else do
Int
len <- forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
4 forall a. (Integral a, Bits a) => Value a
int
y
l <- forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
len (forall x. StateT ByteString (Except Text) x -> Value x
revalue forall y. FromPG y => StateT ByteString (Except Text) y
fromPG)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. Bits a => a -> Int -> Bool
testBit Word8
flag Int
2 then forall x. x -> Bound x
Closed y
l else forall x. x -> Bound x
Open y
l
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall x. Bound x -> Bound x -> Range x
NonEmpty Bound y
lower Bound y
upper
class FromValue (ty :: NullType) (y :: Type) where
fromValue :: Maybe Strict.ByteString -> Either Strict.Text y
instance (FromPG y, pg ~ PG y) => FromValue ('NotNull pg) y where
fromValue :: Maybe ByteString -> Either Text y
fromValue = \case
Maybe ByteString
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"fromField: saw NULL when expecting NOT NULL"
Just ByteString
bytestring -> forall a. Value a -> ByteString -> Either Text a
valueParser (forall x. StateT ByteString (Except Text) x -> Value x
revalue forall y. FromPG y => StateT ByteString (Except Text) y
fromPG) ByteString
bytestring
instance (FromPG y, pg ~ PG y) => FromValue ('Null pg) (Maybe y) where
fromValue :: Maybe ByteString -> Either Text (Maybe y)
fromValue = \case
Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just ByteString
bytestring -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Value a -> ByteString -> Either Text a
valueParser (forall x. StateT ByteString (Except Text) x -> Value x
revalue forall y. FromPG y => StateT ByteString (Except Text) y
fromPG) ByteString
bytestring
class FromField (field :: (Symbol, NullType)) (y :: (Symbol, Type)) where
fromField :: Maybe Strict.ByteString -> Either Strict.Text (SOP.P y)
instance (FromValue ty y, fld0 ~ fld1)
=> FromField (fld0 ::: ty) (fld1 ::: y) where
fromField :: Maybe ByteString -> Either Text (P (fld1 ::: y))
fromField = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (p :: (a, *)). Snd p -> P p
SOP.P forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ty :: NullType) y.
FromValue ty y =>
Maybe ByteString -> Either Text y
fromValue @ty
class FromArray (dims :: [Nat]) (ty :: NullType) (y :: Type) where
fromArray :: Array y
instance (FromPG y, pg ~ PG y) => FromArray '[] ('NotNull pg) y where
fromArray :: Array y
fromArray = forall a. Value a -> Array a
valueArray (forall x. StateT ByteString (Except Text) x -> Value x
revalue forall y. FromPG y => StateT ByteString (Except Text) y
fromPG)
instance (FromPG y, pg ~ PG y) => FromArray '[] ('Null pg) (Maybe y) where
fromArray :: Array (Maybe y)
fromArray = forall a. Value a -> Array (Maybe a)
nullableValueArray (forall x. StateT ByteString (Except Text) x -> Value x
revalue forall y. FromPG y => StateT ByteString (Except Text) y
fromPG)
instance
( SOP.IsProductType product ys
, Length ys ~ dim
, SOP.All ((~) y) ys
, FromArray dims ty y )
=> FromArray (dim ': dims) ty product where
fromArray :: Array product
fromArray =
let
rep :: p -> f x -> f b
rep p
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Generic a => Rep a -> a
SOP.to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP.SOP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
SOP.Z) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x (xs :: [*]) (m :: * -> *).
(All ((~) x) xs, Monad m, SListI xs) =>
m x -> m (NP I xs)
replicateMN
in
forall a b.
(forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
dimensionArray forall {b} {x :: [*]} {xs :: [[*]]} {f :: * -> *} {x} {p}.
(Code b ~ (x : xs), Generic b, Monad f, All ((~) x) x) =>
p -> f x -> f b
rep (forall (dims :: [Nat]) (ty :: NullType) y.
FromArray dims ty y =>
Array y
fromArray @dims @ty @y)
replicateMN
:: forall x xs m. (SOP.All ((~) x) xs, Monad m, SOP.SListI xs)
=> m x -> m (SOP.NP SOP.I xs)
replicateMN :: forall x (xs :: [*]) (m :: * -> *).
(All ((~) x) xs, Monad m, SListI xs) =>
m x -> m (NP I xs)
replicateMN m x
mx = forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
(g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
SOP.hsequence' forall a b. (a -> b) -> a -> b
$
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
SOP.hcpure (forall {k} (t :: k). Proxy t
SOP.Proxy :: SOP.Proxy ((~) x)) (forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
SOP.Comp (forall a. a -> I a
SOP.I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
mx))
newtype DecodeRow (row :: RowType) (y :: Type) = DecodeRow
{ forall (row :: RowType) y.
DecodeRow row y
-> ReaderT (NP (K (Maybe ByteString)) row) (Except Text) y
unDecodeRow :: ReaderT
(SOP.NP (SOP.K (Maybe Strict.ByteString)) row) (Except Strict.Text) y }
deriving newtype
( forall (row :: RowType) a b.
a -> DecodeRow row b -> DecodeRow row a
forall (row :: RowType) a b.
(a -> b) -> DecodeRow row a -> DecodeRow row b
forall a b. a -> DecodeRow row b -> DecodeRow row a
forall a b. (a -> b) -> DecodeRow row a -> DecodeRow row 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 -> DecodeRow row b -> DecodeRow row a
$c<$ :: forall (row :: RowType) a b.
a -> DecodeRow row b -> DecodeRow row a
fmap :: forall a b. (a -> b) -> DecodeRow row a -> DecodeRow row b
$cfmap :: forall (row :: RowType) a b.
(a -> b) -> DecodeRow row a -> DecodeRow row b
Functor
, forall (row :: RowType). Functor (DecodeRow row)
forall (row :: RowType) a. a -> DecodeRow row a
forall (row :: RowType) a b.
DecodeRow row a -> DecodeRow row b -> DecodeRow row a
forall (row :: RowType) a b.
DecodeRow row a -> DecodeRow row b -> DecodeRow row b
forall (row :: RowType) a b.
DecodeRow row (a -> b) -> DecodeRow row a -> DecodeRow row b
forall (row :: RowType) a b c.
(a -> b -> c)
-> DecodeRow row a -> DecodeRow row b -> DecodeRow row c
forall a. a -> DecodeRow row a
forall a b. DecodeRow row a -> DecodeRow row b -> DecodeRow row a
forall a b. DecodeRow row a -> DecodeRow row b -> DecodeRow row b
forall a b.
DecodeRow row (a -> b) -> DecodeRow row a -> DecodeRow row b
forall a b c.
(a -> b -> c)
-> DecodeRow row a -> DecodeRow row b -> DecodeRow 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
<* :: forall a b. DecodeRow row a -> DecodeRow row b -> DecodeRow row a
$c<* :: forall (row :: RowType) a b.
DecodeRow row a -> DecodeRow row b -> DecodeRow row a
*> :: forall a b. DecodeRow row a -> DecodeRow row b -> DecodeRow row b
$c*> :: forall (row :: RowType) a b.
DecodeRow row a -> DecodeRow row b -> DecodeRow row b
liftA2 :: forall a b c.
(a -> b -> c)
-> DecodeRow row a -> DecodeRow row b -> DecodeRow row c
$cliftA2 :: forall (row :: RowType) a b c.
(a -> b -> c)
-> DecodeRow row a -> DecodeRow row b -> DecodeRow row c
<*> :: forall a b.
DecodeRow row (a -> b) -> DecodeRow row a -> DecodeRow row b
$c<*> :: forall (row :: RowType) a b.
DecodeRow row (a -> b) -> DecodeRow row a -> DecodeRow row b
pure :: forall a. a -> DecodeRow row a
$cpure :: forall (row :: RowType) a. a -> DecodeRow row a
Applicative
, forall (row :: RowType). Applicative (DecodeRow row)
forall (row :: RowType) a. DecodeRow row a
forall (row :: RowType) a. DecodeRow row a -> DecodeRow row [a]
forall (row :: RowType) a.
DecodeRow row a -> DecodeRow row a -> DecodeRow row a
forall a. DecodeRow row a
forall a. DecodeRow row a -> DecodeRow row [a]
forall a. DecodeRow row a -> DecodeRow row a -> DecodeRow row a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. DecodeRow row a -> DecodeRow row [a]
$cmany :: forall (row :: RowType) a. DecodeRow row a -> DecodeRow row [a]
some :: forall a. DecodeRow row a -> DecodeRow row [a]
$csome :: forall (row :: RowType) a. DecodeRow row a -> DecodeRow row [a]
<|> :: forall a. DecodeRow row a -> DecodeRow row a -> DecodeRow row a
$c<|> :: forall (row :: RowType) a.
DecodeRow row a -> DecodeRow row a -> DecodeRow row a
empty :: forall a. DecodeRow row a
$cempty :: forall (row :: RowType) a. DecodeRow row a
Alternative
, forall (row :: RowType). Applicative (DecodeRow row)
forall (row :: RowType) a. a -> DecodeRow row a
forall (row :: RowType) a b.
DecodeRow row a -> DecodeRow row b -> DecodeRow row b
forall (row :: RowType) a b.
DecodeRow row a -> (a -> DecodeRow row b) -> DecodeRow row b
forall a. a -> DecodeRow row a
forall a b. DecodeRow row a -> DecodeRow row b -> DecodeRow row b
forall a b.
DecodeRow row a -> (a -> DecodeRow row b) -> DecodeRow 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 :: forall a. a -> DecodeRow row a
$creturn :: forall (row :: RowType) a. a -> DecodeRow row a
>> :: forall a b. DecodeRow row a -> DecodeRow row b -> DecodeRow row b
$c>> :: forall (row :: RowType) a b.
DecodeRow row a -> DecodeRow row b -> DecodeRow row b
>>= :: forall a b.
DecodeRow row a -> (a -> DecodeRow row b) -> DecodeRow row b
$c>>= :: forall (row :: RowType) a b.
DecodeRow row a -> (a -> DecodeRow row b) -> DecodeRow row b
Monad
, forall (row :: RowType). Monad (DecodeRow row)
forall (row :: RowType). Alternative (DecodeRow row)
forall (row :: RowType) a. DecodeRow row a
forall (row :: RowType) a.
DecodeRow row a -> DecodeRow row a -> DecodeRow row a
forall a. DecodeRow row a
forall a. DecodeRow row a -> DecodeRow row a -> DecodeRow row a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. DecodeRow row a -> DecodeRow row a -> DecodeRow row a
$cmplus :: forall (row :: RowType) a.
DecodeRow row a -> DecodeRow row a -> DecodeRow row a
mzero :: forall a. DecodeRow row a
$cmzero :: forall (row :: RowType) a. DecodeRow row a
MonadPlus
, MonadError Strict.Text )
instance MonadFail (DecodeRow row) where
fail :: forall a. String -> DecodeRow row a
fail = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
runDecodeRow
:: DecodeRow row y
-> SOP.NP (SOP.K (Maybe Strict.ByteString)) row
-> Either Strict.Text y
runDecodeRow :: forall (row :: RowType) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
runDecodeRow = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e a. Except e a -> Either e a
runExcept forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (row :: RowType) y.
DecodeRow row y
-> ReaderT (NP (K (Maybe ByteString)) row) (Except Text) y
unDecodeRow
appendRows
:: SOP.SListI left
=> (l -> r -> z)
-> DecodeRow left l
-> DecodeRow right r
-> DecodeRow (Join left right) z
appendRows :: forall (left :: RowType) l r z (right :: RowType).
SListI left =>
(l -> r -> z)
-> DecodeRow left l
-> DecodeRow right r
-> DecodeRow (Join left right) z
appendRows l -> r -> z
f DecodeRow left l
decL DecodeRow right r
decR = forall (row :: RowType) y.
(NP (K (Maybe ByteString)) row -> Either Text y) -> DecodeRow row y
decodeRow forall a b. (a -> b) -> a -> b
$ \NP (K (Maybe ByteString)) (Join left right)
row -> case forall {k} (xs :: [k]) (ys :: [k]) (expr :: k -> *).
SListI xs =>
NP expr (Join xs ys) -> (NP expr xs, NP expr ys)
disjoin NP (K (Maybe ByteString)) (Join left right)
row of
(NP (K (Maybe ByteString)) left
rowL, NP (K (Maybe ByteString)) right
rowR) -> l -> r -> z
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (row :: RowType) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
runDecodeRow DecodeRow left l
decL NP (K (Maybe ByteString)) left
rowL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (row :: RowType) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
runDecodeRow DecodeRow right r
decR NP (K (Maybe ByteString)) right
rowR
consRow
:: FromValue head h
=> (h -> t -> z)
-> Alias col
-> DecodeRow tail t
-> DecodeRow (col ::: head ': tail) z
consRow :: forall (head :: NullType) h t z (col :: Symbol) (tail :: RowType).
FromValue head h =>
(h -> t -> z)
-> Alias col
-> DecodeRow tail t
-> DecodeRow ((col ::: head) : tail) z
consRow h -> t -> z
f Alias col
_ DecodeRow tail t
dec = forall (row :: RowType) y.
(NP (K (Maybe ByteString)) row -> Either Text y) -> DecodeRow row y
decodeRow forall a b. (a -> b) -> a -> b
$ \case
(SOP.K Maybe ByteString
h :: SOP.K (Maybe Strict.ByteString) (col ::: head)) :* NP (K (Maybe ByteString)) xs
t
-> h -> t -> z
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ty :: NullType) y.
FromValue ty y =>
Maybe ByteString -> Either Text y
fromValue @head Maybe ByteString
h forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (row :: RowType) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
runDecodeRow DecodeRow tail t
dec NP (K (Maybe ByteString)) xs
t
decodeRow
:: (SOP.NP (SOP.K (Maybe Strict.ByteString)) row -> Either Strict.Text y)
-> DecodeRow row y
decodeRow :: forall (row :: RowType) y.
(NP (K (Maybe ByteString)) row -> Either Text y) -> DecodeRow row y
decodeRow NP (K (Maybe ByteString)) row -> Either Text y
dec = forall (row :: RowType) y.
ReaderT (NP (K (Maybe ByteString)) row) (Except Text) y
-> DecodeRow row y
DecodeRow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP (K (Maybe ByteString)) row -> Either Text y
dec
instance {-# OVERLAPPING #-} (KnownSymbol fld, FromValue ty y)
=> IsLabel fld (DecodeRow (fld ::: ty ': row) y) where
fromLabel :: DecodeRow ((fld ::: ty) : row) y
fromLabel = forall (row :: RowType) y.
(NP (K (Maybe ByteString)) row -> Either Text y) -> DecodeRow row y
decodeRow forall a b. (a -> b) -> a -> b
$ \(SOP.K Maybe ByteString
b SOP.:* NP (K (Maybe ByteString)) xs
_) -> do
let
flderr :: Text
flderr = forall a. Monoid a => [a] -> a
mconcat
[ Text
"field name: "
, Text
"\"", forall a. IsString a => String -> a
fromString (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
SOP.Proxy @fld)), Text
"\"; "
]
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Text
flderr forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ forall (ty :: NullType) y.
FromValue ty y =>
Maybe ByteString -> Either Text y
fromValue @ty Maybe ByteString
b
instance {-# OVERLAPPABLE #-} IsLabel fld (DecodeRow row y)
=> IsLabel fld (DecodeRow (field ': row) y) where
fromLabel :: DecodeRow (field : row) y
fromLabel = forall (row :: RowType) y.
(NP (K (Maybe ByteString)) row -> Either Text y) -> DecodeRow row y
decodeRow forall a b. (a -> b) -> a -> b
$ \(K (Maybe ByteString) x
_ SOP.:* NP (K (Maybe ByteString)) xs
bs) ->
forall (row :: RowType) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
runDecodeRow (forall (x :: Symbol) a. IsLabel x a => a
fromLabel @fld) NP (K (Maybe ByteString)) xs
bs
instance {-# OVERLAPPING #-} (KnownSymbol fld, FromValue ty (Maybe y))
=> IsLabel fld (MaybeT (DecodeRow (fld ::: ty ': row)) y) where
fromLabel :: MaybeT (DecodeRow ((fld ::: ty) : row)) y
fromLabel = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (row :: RowType) y.
(NP (K (Maybe ByteString)) row -> Either Text y) -> DecodeRow row y
decodeRow forall a b. (a -> b) -> a -> b
$ \(SOP.K Maybe ByteString
b SOP.:* NP (K (Maybe ByteString)) xs
_) -> do
let
flderr :: Text
flderr = forall a. Monoid a => [a] -> a
mconcat
[ Text
"field name: "
, Text
"\"", forall a. IsString a => String -> a
fromString (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
SOP.Proxy @fld)), Text
"\"; "
]
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Text
flderr forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ forall (ty :: NullType) y.
FromValue ty y =>
Maybe ByteString -> Either Text y
fromValue @ty Maybe ByteString
b
instance {-# OVERLAPPABLE #-} IsLabel fld (MaybeT (DecodeRow row) y)
=> IsLabel fld (MaybeT (DecodeRow (field ': row)) y) where
fromLabel :: MaybeT (DecodeRow (field : row)) y
fromLabel = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (row :: RowType) y.
(NP (K (Maybe ByteString)) row -> Either Text y) -> DecodeRow row y
decodeRow forall a b. (a -> b) -> a -> b
$ \(K (Maybe ByteString) x
_ SOP.:* NP (K (Maybe ByteString)) xs
bs) ->
forall (row :: RowType) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
runDecodeRow (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (forall (x :: Symbol) a. IsLabel x a => a
fromLabel @fld)) NP (K (Maybe ByteString)) xs
bs
class
( SOP.IsRecord y ys
, row ~ RowPG y
, SOP.AllZip FromField row ys
) => GenericRow row y ys where
genericRow :: DecodeRow row y
instance
( row ~ RowPG y
, SOP.IsRecord y ys
, SOP.AllZip FromField row ys
) => GenericRow row y ys where
genericRow :: DecodeRow row y
genericRow
= forall (row :: RowType) y.
ReaderT (NP (K (Maybe ByteString)) row) (Except Text) y
-> DecodeRow row y
DecodeRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (r :: RecordCode). IsRecord a r => RecordRep a -> a
SOP.fromRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
(g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
SOP.hsequence'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k1 l1 k2 l2 (h1 :: (k1 -> *) -> l1 -> *)
(h2 :: (k2 -> *) -> l2 -> *) (c :: k1 -> k2 -> Constraint)
(xs :: l1) (ys :: l2) (proxy :: (k1 -> k2 -> Constraint) -> *)
(f :: k1 -> *) (g :: k2 -> *).
(HTrans h1 h2, AllZipN (Prod h1) c xs ys) =>
proxy c
-> (forall (x :: k1) (y :: k2). c x y => f x -> g y)
-> h1 f xs
-> h2 g ys
SOP.htrans (forall {k} (t :: k). Proxy t
SOP.Proxy @FromField) forall (ty :: (Symbol, NullType)) (z :: (Symbol, *)).
FromField ty z =>
K (Maybe ByteString) ty -> (:.:) (Except Text) P z
runField
where
runField
:: forall ty z. FromField ty z
=> SOP.K (Maybe Strict.ByteString) ty
-> (Except Strict.Text SOP.:.: SOP.P) z
runField :: forall (ty :: (Symbol, NullType)) (z :: (Symbol, *)).
FromField ty z =>
K (Maybe ByteString) ty -> (:.:) (Except Text) P z
runField
= forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
SOP.Comp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (field :: (Symbol, NullType)) (y :: (Symbol, *)).
FromField field y =>
Maybe ByteString -> Either Text (P y)
fromField @ty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). K a b -> a
SOP.unK
class FromAliasedValue (field :: (Symbol, NullType)) (y :: Type) where
fromAliasedValue :: Maybe Strict.ByteString -> Either Strict.Text y
instance FromValue ty y => FromAliasedValue (fld ::: ty) y where
fromAliasedValue :: Maybe ByteString -> Either Text y
fromAliasedValue = forall (ty :: NullType) y.
FromValue ty y =>
Maybe ByteString -> Either Text y
fromValue @ty
genericProductRow
:: ( SOP.IsProductType y ys
, SOP.AllZip FromAliasedValue row ys
)
=> DecodeRow row y
genericProductRow :: forall y (ys :: [*]) (row :: RowType).
(IsProductType y ys, AllZip FromAliasedValue row ys) =>
DecodeRow row y
genericProductRow
= forall (row :: RowType) y.
ReaderT (NP (K (Maybe ByteString)) row) (Except Text) y
-> DecodeRow row y
DecodeRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (xs :: [*]). IsProductType a xs => NP I xs -> a
SOP.productTypeTo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
(g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
SOP.hsequence'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k1 l1 k2 l2 (h1 :: (k1 -> *) -> l1 -> *)
(h2 :: (k2 -> *) -> l2 -> *) (c :: k1 -> k2 -> Constraint)
(xs :: l1) (ys :: l2) (proxy :: (k1 -> k2 -> Constraint) -> *)
(f :: k1 -> *) (g :: k2 -> *).
(HTrans h1 h2, AllZipN (Prod h1) c xs ys) =>
proxy c
-> (forall (x :: k1) (y :: k2). c x y => f x -> g y)
-> h1 f xs
-> h2 g ys
SOP.htrans (forall {k} (t :: k). Proxy t
SOP.Proxy @FromAliasedValue) forall (ty :: (Symbol, NullType)) z.
FromAliasedValue ty z =>
K (Maybe ByteString) ty -> (:.:) (Except Text) I z
runField
where
runField
:: forall ty z. FromAliasedValue ty z
=> SOP.K (Maybe Strict.ByteString) ty
-> (Except Strict.Text SOP.:.: SOP.I) z
runField :: forall (ty :: (Symbol, NullType)) z.
FromAliasedValue ty z =>
K (Maybe ByteString) ty -> (:.:) (Except Text) I z
runField
= forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
SOP.Comp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> I a
SOP.I
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (field :: (Symbol, NullType)) y.
FromAliasedValue field y =>
Maybe ByteString -> Either Text y
fromAliasedValue @ty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). K a b -> a
SOP.unK
enumValue
:: (SOP.All KnownSymbol labels, PG y ~ 'PGenum labels)
=> NP (SOP.K y) labels
-> StateT Strict.ByteString (Except Strict.Text) y
enumValue :: forall (labels :: [Symbol]) y.
(All KnownSymbol labels, PG y ~ 'PGenum labels) =>
NP (K y) labels -> StateT ByteString (Except Text) y
enumValue = forall x. Value x -> StateT ByteString (Except Text) x
devalue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Text -> Maybe a) -> Value a
enum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (labels :: [Symbol]) y.
All KnownSymbol labels =>
NP (K y) labels -> Text -> Maybe y
labels
where
labels
:: SOP.All KnownSymbol labels
=> NP (SOP.K y) labels
-> Text -> Maybe y
labels :: forall (labels :: [Symbol]) y.
All KnownSymbol labels =>
NP (K y) labels -> Text -> Maybe y
labels = \case
NP (K y) labels
Nil -> \Text
_ -> forall a. Maybe a
Nothing
((K y x
y :: SOP.K y label) :* NP (K y) xs
ys) -> \ Text
str ->
if Text
str forall a. Eq a => a -> a -> Bool
== forall a. IsString a => String -> a
fromString (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
SOP.Proxy @label))
then forall a. a -> Maybe a
Just (forall {k} a (b :: k). K a b -> a
SOP.unK K y x
y)
else forall (labels :: [Symbol]) y.
All KnownSymbol labels =>
NP (K y) labels -> Text -> Maybe y
labels NP (K y) xs
ys Text
str