{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}

module Database.Beam.Backend.SQL.Row
  ( FromBackendRowF(..), FromBackendRowM(..)
  , parseOneField, peekField

  , ColumnParseError(..), BeamRowReadError(..)

  , FromBackendRow(..)
  ) where

import           Database.Beam.Backend.SQL.Types
import           Database.Beam.Backend.Types

import           Control.Applicative
import           Control.Exception (Exception)
import           Control.Monad.Free.Church
import           Control.Monad.Identity
import           Data.Kind (Type)
import           Data.Tagged
import           Data.Typeable
import           Data.Vector.Sized (Vector)
import qualified Data.Vector.Sized as Vector

import qualified Control.Monad.Fail as Fail

import           GHC.Generics
import           GHC.TypeLits

-- | The exact error encountered
data ColumnParseError
  = ColumnUnexpectedNull
  | ColumnNotEnoughColumns !Int
  | ColumnTypeMismatch
  { ColumnParseError -> String
ctmHaskellType :: String
  , ColumnParseError -> String
ctmSQLType     :: String
  , ColumnParseError -> String
ctmMessage     :: String
  }
  | ColumnErrorInternal String
  deriving (Int -> ColumnParseError -> ShowS
[ColumnParseError] -> ShowS
ColumnParseError -> String
(Int -> ColumnParseError -> ShowS)
-> (ColumnParseError -> String)
-> ([ColumnParseError] -> ShowS)
-> Show ColumnParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnParseError] -> ShowS
$cshowList :: [ColumnParseError] -> ShowS
show :: ColumnParseError -> String
$cshow :: ColumnParseError -> String
showsPrec :: Int -> ColumnParseError -> ShowS
$cshowsPrec :: Int -> ColumnParseError -> ShowS
Show, ColumnParseError -> ColumnParseError -> Bool
(ColumnParseError -> ColumnParseError -> Bool)
-> (ColumnParseError -> ColumnParseError -> Bool)
-> Eq ColumnParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnParseError -> ColumnParseError -> Bool
$c/= :: ColumnParseError -> ColumnParseError -> Bool
== :: ColumnParseError -> ColumnParseError -> Bool
$c== :: ColumnParseError -> ColumnParseError -> Bool
Eq, Eq ColumnParseError
Eq ColumnParseError
-> (ColumnParseError -> ColumnParseError -> Ordering)
-> (ColumnParseError -> ColumnParseError -> Bool)
-> (ColumnParseError -> ColumnParseError -> Bool)
-> (ColumnParseError -> ColumnParseError -> Bool)
-> (ColumnParseError -> ColumnParseError -> Bool)
-> (ColumnParseError -> ColumnParseError -> ColumnParseError)
-> (ColumnParseError -> ColumnParseError -> ColumnParseError)
-> Ord ColumnParseError
ColumnParseError -> ColumnParseError -> Bool
ColumnParseError -> ColumnParseError -> Ordering
ColumnParseError -> ColumnParseError -> ColumnParseError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColumnParseError -> ColumnParseError -> ColumnParseError
$cmin :: ColumnParseError -> ColumnParseError -> ColumnParseError
max :: ColumnParseError -> ColumnParseError -> ColumnParseError
$cmax :: ColumnParseError -> ColumnParseError -> ColumnParseError
>= :: ColumnParseError -> ColumnParseError -> Bool
$c>= :: ColumnParseError -> ColumnParseError -> Bool
> :: ColumnParseError -> ColumnParseError -> Bool
$c> :: ColumnParseError -> ColumnParseError -> Bool
<= :: ColumnParseError -> ColumnParseError -> Bool
$c<= :: ColumnParseError -> ColumnParseError -> Bool
< :: ColumnParseError -> ColumnParseError -> Bool
$c< :: ColumnParseError -> ColumnParseError -> Bool
compare :: ColumnParseError -> ColumnParseError -> Ordering
$ccompare :: ColumnParseError -> ColumnParseError -> Ordering
$cp1Ord :: Eq ColumnParseError
Ord)

-- | An error that may occur when parsing a row. Contains an optional
-- annotation of which column was being parsed (if available).
data BeamRowReadError
  = BeamRowReadError
  { BeamRowReadError -> Maybe Int
brreColumn :: !(Maybe Int)
  , BeamRowReadError -> ColumnParseError
brreError  :: !ColumnParseError
  } deriving (Int -> BeamRowReadError -> ShowS
[BeamRowReadError] -> ShowS
BeamRowReadError -> String
(Int -> BeamRowReadError -> ShowS)
-> (BeamRowReadError -> String)
-> ([BeamRowReadError] -> ShowS)
-> Show BeamRowReadError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeamRowReadError] -> ShowS
$cshowList :: [BeamRowReadError] -> ShowS
show :: BeamRowReadError -> String
$cshow :: BeamRowReadError -> String
showsPrec :: Int -> BeamRowReadError -> ShowS
$cshowsPrec :: Int -> BeamRowReadError -> ShowS
Show, BeamRowReadError -> BeamRowReadError -> Bool
(BeamRowReadError -> BeamRowReadError -> Bool)
-> (BeamRowReadError -> BeamRowReadError -> Bool)
-> Eq BeamRowReadError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeamRowReadError -> BeamRowReadError -> Bool
$c/= :: BeamRowReadError -> BeamRowReadError -> Bool
== :: BeamRowReadError -> BeamRowReadError -> Bool
$c== :: BeamRowReadError -> BeamRowReadError -> Bool
Eq, Eq BeamRowReadError
Eq BeamRowReadError
-> (BeamRowReadError -> BeamRowReadError -> Ordering)
-> (BeamRowReadError -> BeamRowReadError -> Bool)
-> (BeamRowReadError -> BeamRowReadError -> Bool)
-> (BeamRowReadError -> BeamRowReadError -> Bool)
-> (BeamRowReadError -> BeamRowReadError -> Bool)
-> (BeamRowReadError -> BeamRowReadError -> BeamRowReadError)
-> (BeamRowReadError -> BeamRowReadError -> BeamRowReadError)
-> Ord BeamRowReadError
BeamRowReadError -> BeamRowReadError -> Bool
BeamRowReadError -> BeamRowReadError -> Ordering
BeamRowReadError -> BeamRowReadError -> BeamRowReadError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BeamRowReadError -> BeamRowReadError -> BeamRowReadError
$cmin :: BeamRowReadError -> BeamRowReadError -> BeamRowReadError
max :: BeamRowReadError -> BeamRowReadError -> BeamRowReadError
$cmax :: BeamRowReadError -> BeamRowReadError -> BeamRowReadError
>= :: BeamRowReadError -> BeamRowReadError -> Bool
$c>= :: BeamRowReadError -> BeamRowReadError -> Bool
> :: BeamRowReadError -> BeamRowReadError -> Bool
$c> :: BeamRowReadError -> BeamRowReadError -> Bool
<= :: BeamRowReadError -> BeamRowReadError -> Bool
$c<= :: BeamRowReadError -> BeamRowReadError -> Bool
< :: BeamRowReadError -> BeamRowReadError -> Bool
$c< :: BeamRowReadError -> BeamRowReadError -> Bool
compare :: BeamRowReadError -> BeamRowReadError -> Ordering
$ccompare :: BeamRowReadError -> BeamRowReadError -> Ordering
$cp1Ord :: Eq BeamRowReadError
Ord)
instance Exception BeamRowReadError

data FromBackendRowF be f where
  ParseOneField :: (BackendFromField be a, Typeable a) => (a -> f) -> FromBackendRowF be f
  Alt :: FromBackendRowM be a -> FromBackendRowM be a -> (a -> f) -> FromBackendRowF be f
  FailParseWith :: BeamRowReadError -> FromBackendRowF be f
instance Functor (FromBackendRowF be) where
  fmap :: (a -> b) -> FromBackendRowF be a -> FromBackendRowF be b
fmap a -> b
f = \case
    ParseOneField a -> a
p -> (a -> b) -> FromBackendRowF be b
forall be a f.
(BackendFromField be a, Typeable a) =>
(a -> f) -> FromBackendRowF be f
ParseOneField ((a -> b) -> FromBackendRowF be b)
-> (a -> b) -> FromBackendRowF be b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p
    Alt FromBackendRowM be a
a FromBackendRowM be a
b a -> a
p -> FromBackendRowM be a
-> FromBackendRowM be a -> (a -> b) -> FromBackendRowF be b
forall be a f.
FromBackendRowM be a
-> FromBackendRowM be a -> (a -> f) -> FromBackendRowF be f
Alt FromBackendRowM be a
a FromBackendRowM be a
b ((a -> b) -> FromBackendRowF be b)
-> (a -> b) -> FromBackendRowF be b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p
    FailParseWith BeamRowReadError
e -> BeamRowReadError -> FromBackendRowF be b
forall be f. BeamRowReadError -> FromBackendRowF be f
FailParseWith BeamRowReadError
e
newtype FromBackendRowM be a = FromBackendRowM (F (FromBackendRowF be) a)
  deriving (a -> FromBackendRowM be b -> FromBackendRowM be a
(a -> b) -> FromBackendRowM be a -> FromBackendRowM be b
(forall a b.
 (a -> b) -> FromBackendRowM be a -> FromBackendRowM be b)
-> (forall a b. a -> FromBackendRowM be b -> FromBackendRowM be a)
-> Functor (FromBackendRowM be)
forall a b. a -> FromBackendRowM be b -> FromBackendRowM be a
forall a b.
(a -> b) -> FromBackendRowM be a -> FromBackendRowM be b
forall be a b. a -> FromBackendRowM be b -> FromBackendRowM be a
forall be a b.
(a -> b) -> FromBackendRowM be a -> FromBackendRowM be b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FromBackendRowM be b -> FromBackendRowM be a
$c<$ :: forall be a b. a -> FromBackendRowM be b -> FromBackendRowM be a
fmap :: (a -> b) -> FromBackendRowM be a -> FromBackendRowM be b
$cfmap :: forall be a b.
(a -> b) -> FromBackendRowM be a -> FromBackendRowM be b
Functor, Functor (FromBackendRowM be)
a -> FromBackendRowM be a
Functor (FromBackendRowM be)
-> (forall a. a -> FromBackendRowM be a)
-> (forall a b.
    FromBackendRowM be (a -> b)
    -> FromBackendRowM be a -> FromBackendRowM be b)
-> (forall a b c.
    (a -> b -> c)
    -> FromBackendRowM be a
    -> FromBackendRowM be b
    -> FromBackendRowM be c)
-> (forall a b.
    FromBackendRowM be a
    -> FromBackendRowM be b -> FromBackendRowM be b)
-> (forall a b.
    FromBackendRowM be a
    -> FromBackendRowM be b -> FromBackendRowM be a)
-> Applicative (FromBackendRowM be)
FromBackendRowM be a
-> FromBackendRowM be b -> FromBackendRowM be b
FromBackendRowM be a
-> FromBackendRowM be b -> FromBackendRowM be a
FromBackendRowM be (a -> b)
-> FromBackendRowM be a -> FromBackendRowM be b
(a -> b -> c)
-> FromBackendRowM be a
-> FromBackendRowM be b
-> FromBackendRowM be c
forall be. Functor (FromBackendRowM be)
forall a. a -> FromBackendRowM be a
forall be a. a -> FromBackendRowM be a
forall a b.
FromBackendRowM be a
-> FromBackendRowM be b -> FromBackendRowM be a
forall a b.
FromBackendRowM be a
-> FromBackendRowM be b -> FromBackendRowM be b
forall a b.
FromBackendRowM be (a -> b)
-> FromBackendRowM be a -> FromBackendRowM be b
forall be a b.
FromBackendRowM be a
-> FromBackendRowM be b -> FromBackendRowM be a
forall be a b.
FromBackendRowM be a
-> FromBackendRowM be b -> FromBackendRowM be b
forall be a b.
FromBackendRowM be (a -> b)
-> FromBackendRowM be a -> FromBackendRowM be b
forall a b c.
(a -> b -> c)
-> FromBackendRowM be a
-> FromBackendRowM be b
-> FromBackendRowM be c
forall be a b c.
(a -> b -> c)
-> FromBackendRowM be a
-> FromBackendRowM be b
-> FromBackendRowM be 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
<* :: FromBackendRowM be a
-> FromBackendRowM be b -> FromBackendRowM be a
$c<* :: forall be a b.
FromBackendRowM be a
-> FromBackendRowM be b -> FromBackendRowM be a
*> :: FromBackendRowM be a
-> FromBackendRowM be b -> FromBackendRowM be b
$c*> :: forall be a b.
FromBackendRowM be a
-> FromBackendRowM be b -> FromBackendRowM be b
liftA2 :: (a -> b -> c)
-> FromBackendRowM be a
-> FromBackendRowM be b
-> FromBackendRowM be c
$cliftA2 :: forall be a b c.
(a -> b -> c)
-> FromBackendRowM be a
-> FromBackendRowM be b
-> FromBackendRowM be c
<*> :: FromBackendRowM be (a -> b)
-> FromBackendRowM be a -> FromBackendRowM be b
$c<*> :: forall be a b.
FromBackendRowM be (a -> b)
-> FromBackendRowM be a -> FromBackendRowM be b
pure :: a -> FromBackendRowM be a
$cpure :: forall be a. a -> FromBackendRowM be a
$cp1Applicative :: forall be. Functor (FromBackendRowM be)
Applicative)

instance Monad (FromBackendRowM be) where
  return :: a -> FromBackendRowM be a
return = a -> FromBackendRowM be a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  FromBackendRowM F (FromBackendRowF be) a
a >>= :: FromBackendRowM be a
-> (a -> FromBackendRowM be b) -> FromBackendRowM be b
>>= a -> FromBackendRowM be b
b =
    F (FromBackendRowF be) b -> FromBackendRowM be b
forall be a. F (FromBackendRowF be) a -> FromBackendRowM be a
FromBackendRowM (F (FromBackendRowF be) b -> FromBackendRowM be b)
-> F (FromBackendRowF be) b -> FromBackendRowM be b
forall a b. (a -> b) -> a -> b
$
    F (FromBackendRowF be) a
a F (FromBackendRowF be) a
-> (a -> F (FromBackendRowF be) b) -> F (FromBackendRowF be) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
x -> let FromBackendRowM F (FromBackendRowF be) b
b' = a -> FromBackendRowM be b
b a
x in F (FromBackendRowF be) b
b')

instance Fail.MonadFail (FromBackendRowM be) where
  fail :: String -> FromBackendRowM be a
fail = F (FromBackendRowF be) a -> FromBackendRowM be a
forall be a. F (FromBackendRowF be) a -> FromBackendRowM be a
FromBackendRowM (F (FromBackendRowF be) a -> FromBackendRowM be a)
-> (String -> F (FromBackendRowF be) a)
-> String
-> FromBackendRowM be a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromBackendRowF be a -> F (FromBackendRowF be) a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (FromBackendRowF be a -> F (FromBackendRowF be) a)
-> (String -> FromBackendRowF be a)
-> String
-> F (FromBackendRowF be) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeamRowReadError -> FromBackendRowF be a
forall be f. BeamRowReadError -> FromBackendRowF be f
FailParseWith (BeamRowReadError -> FromBackendRowF be a)
-> (String -> BeamRowReadError) -> String -> FromBackendRowF be a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError Maybe Int
forall a. Maybe a
Nothing (ColumnParseError -> BeamRowReadError)
-> (String -> ColumnParseError) -> String -> BeamRowReadError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ColumnParseError
ColumnErrorInternal

instance Alternative (FromBackendRowM be) where
  empty :: FromBackendRowM be a
empty   = String -> FromBackendRowM be a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
"empty"
  FromBackendRowM be a
a <|> :: FromBackendRowM be a
-> FromBackendRowM be a -> FromBackendRowM be a
<|> FromBackendRowM be a
b =
    F (FromBackendRowF be) a -> FromBackendRowM be a
forall be a. F (FromBackendRowF be) a -> FromBackendRowM be a
FromBackendRowM (FromBackendRowF be a -> F (FromBackendRowF be) a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (FromBackendRowM be a
-> FromBackendRowM be a -> (a -> a) -> FromBackendRowF be a
forall be a f.
FromBackendRowM be a
-> FromBackendRowM be a -> (a -> f) -> FromBackendRowF be f
Alt FromBackendRowM be a
a FromBackendRowM be a
b a -> a
forall a. a -> a
id))

parseOneField :: (BackendFromField be a, Typeable a) => FromBackendRowM be a
parseOneField :: FromBackendRowM be a
parseOneField = do
  a
x <- F (FromBackendRowF be) a -> FromBackendRowM be a
forall be a. F (FromBackendRowF be) a -> FromBackendRowM be a
FromBackendRowM (FromBackendRowF be a -> F (FromBackendRowF be) a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF ((a -> a) -> FromBackendRowF be a
forall be a f.
(BackendFromField be a, Typeable a) =>
(a -> f) -> FromBackendRowF be f
ParseOneField a -> a
forall a. a -> a
id))
  a -> FromBackendRowM be a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

peekField :: (Typeable a, BackendFromField be a) => FromBackendRowM be (Maybe a)
peekField :: FromBackendRowM be (Maybe a)
peekField = (a -> Maybe a)
-> FromBackendRowM be a -> FromBackendRowM be (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (F (FromBackendRowF be) a -> FromBackendRowM be a
forall be a. F (FromBackendRowF be) a -> FromBackendRowM be a
FromBackendRowM (FromBackendRowF be a -> F (FromBackendRowF be) a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF ((a -> a) -> FromBackendRowF be a
forall be a f.
(BackendFromField be a, Typeable a) =>
(a -> f) -> FromBackendRowF be f
ParseOneField a -> a
forall a. a -> a
id))) FromBackendRowM be (Maybe a)
-> FromBackendRowM be (Maybe a) -> FromBackendRowM be (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> FromBackendRowM be (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- BeamBackend instead of BeamSqlBackend to prevent circular super class
class BeamBackend be => FromBackendRow be a where
  -- | Parses a beam row. This should not fail, except in the case of
  -- an internal bug in beam deserialization code. If it does fail,
  -- this should throw a 'BeamRowParseError'.
  fromBackendRow :: FromBackendRowM be a
  default fromBackendRow :: (Typeable a, BackendFromField be a) => FromBackendRowM be a
  fromBackendRow = FromBackendRowM be a
forall be a.
(BackendFromField be a, Typeable a) =>
FromBackendRowM be a
parseOneField

  valuesNeeded :: Proxy be -> Proxy a -> Int
  valuesNeeded Proxy be
_ Proxy a
_ = Int
1

class GFromBackendRow be (exposed :: Type -> Type) rep where
  gFromBackendRow :: Proxy exposed -> FromBackendRowM be (rep ())
  gValuesNeeded :: Proxy be -> Proxy exposed -> Proxy rep -> Int
instance GFromBackendRow be e p => GFromBackendRow be (M1 t f e) (M1 t f p) where
  gFromBackendRow :: Proxy (M1 t f e) -> FromBackendRowM be (M1 t f p ())
gFromBackendRow Proxy (M1 t f e)
_ = p () -> M1 t f p ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (p () -> M1 t f p ())
-> FromBackendRowM be (p ()) -> FromBackendRowM be (M1 t f p ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy e -> FromBackendRowM be (p ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy e
forall k (t :: k). Proxy t
Proxy @e)
  gValuesNeeded :: Proxy be -> Proxy (M1 t f e) -> Proxy (M1 t f p) -> Int
gValuesNeeded Proxy be
be Proxy (M1 t f e)
_ Proxy (M1 t f p)
_ = Proxy be -> Proxy e -> Proxy p -> Int
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded Proxy be
be (Proxy e
forall k (t :: k). Proxy t
Proxy @e) (Proxy p
forall k (t :: k). Proxy t
Proxy @p)
instance GFromBackendRow be e U1 where
  gFromBackendRow :: Proxy e -> FromBackendRowM be (U1 ())
gFromBackendRow Proxy e
_ = U1 () -> FromBackendRowM be (U1 ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 ()
forall k (p :: k). U1 p
U1
  gValuesNeeded :: Proxy be -> Proxy e -> Proxy U1 -> Int
gValuesNeeded Proxy be
_ Proxy e
_ Proxy U1
_ = Int
0
instance (GFromBackendRow be aExp a, GFromBackendRow be bExp b) => GFromBackendRow be (aExp :*: bExp) (a :*: b) where
  gFromBackendRow :: Proxy (aExp :*: bExp) -> FromBackendRowM be ((:*:) a b ())
gFromBackendRow Proxy (aExp :*: bExp)
_ = a () -> b () -> (:*:) a b ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a () -> b () -> (:*:) a b ())
-> FromBackendRowM be (a ())
-> FromBackendRowM be (b () -> (:*:) a b ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy aExp -> FromBackendRowM be (a ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy aExp
forall k (t :: k). Proxy t
Proxy @aExp) FromBackendRowM be (b () -> (:*:) a b ())
-> FromBackendRowM be (b ()) -> FromBackendRowM be ((:*:) a b ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy bExp -> FromBackendRowM be (b ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy bExp
forall k (t :: k). Proxy t
Proxy @bExp)
  gValuesNeeded :: Proxy be -> Proxy (aExp :*: bExp) -> Proxy (a :*: b) -> Int
gValuesNeeded Proxy be
be Proxy (aExp :*: bExp)
_ Proxy (a :*: b)
_ = Proxy be -> Proxy aExp -> Proxy a -> Int
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded Proxy be
be (Proxy aExp
forall k (t :: k). Proxy t
Proxy @aExp) (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy bExp -> Proxy b -> Int
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded Proxy be
be (Proxy bExp
forall k (t :: k). Proxy t
Proxy @bExp) (Proxy b
forall k (t :: k). Proxy t
Proxy @b)
instance FromBackendRow be x => GFromBackendRow be (K1 R (Exposed x)) (K1 R x) where
  gFromBackendRow :: Proxy (K1 R (Exposed x)) -> FromBackendRowM be (K1 R x ())
gFromBackendRow Proxy (K1 R (Exposed x))
_ = x -> K1 R x ()
forall k i c (p :: k). c -> K1 i c p
K1 (x -> K1 R x ())
-> FromBackendRowM be x -> FromBackendRowM be (K1 R x ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM be x
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow
  gValuesNeeded :: Proxy be -> Proxy (K1 R (Exposed x)) -> Proxy (K1 R x) -> Int
gValuesNeeded Proxy be
be Proxy (K1 R (Exposed x))
_ Proxy (K1 R x)
_ = Proxy be -> Proxy x -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy x
forall k (t :: k). Proxy t
Proxy @x)
instance FromBackendRow be (t Identity) => GFromBackendRow be (K1 R (t Exposed)) (K1 R (t Identity)) where
    gFromBackendRow :: Proxy (K1 R (t Exposed))
-> FromBackendRowM be (K1 R (t Identity) ())
gFromBackendRow Proxy (K1 R (t Exposed))
_ = t Identity -> K1 R (t Identity) ()
forall k i c (p :: k). c -> K1 i c p
K1 (t Identity -> K1 R (t Identity) ())
-> FromBackendRowM be (t Identity)
-> FromBackendRowM be (K1 R (t Identity) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM be (t Identity)
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow
    gValuesNeeded :: Proxy be
-> Proxy (K1 R (t Exposed)) -> Proxy (K1 R (t Identity)) -> Int
gValuesNeeded Proxy be
be Proxy (K1 R (t Exposed))
_ Proxy (K1 R (t Identity))
_ = Proxy be -> Proxy (t Identity) -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy (t Identity)
forall k (t :: k). Proxy t
Proxy @(t Identity))
instance FromBackendRow be (t (Nullable Identity)) => GFromBackendRow be (K1 R (t (Nullable Exposed))) (K1 R (t (Nullable Identity))) where
    gFromBackendRow :: Proxy (K1 R (t (Nullable Exposed)))
-> FromBackendRowM be (K1 R (t (Nullable Identity)) ())
gFromBackendRow Proxy (K1 R (t (Nullable Exposed)))
_ = t (Nullable Identity) -> K1 R (t (Nullable Identity)) ()
forall k i c (p :: k). c -> K1 i c p
K1 (t (Nullable Identity) -> K1 R (t (Nullable Identity)) ())
-> FromBackendRowM be (t (Nullable Identity))
-> FromBackendRowM be (K1 R (t (Nullable Identity)) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM be (t (Nullable Identity))
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow
    gValuesNeeded :: Proxy be
-> Proxy (K1 R (t (Nullable Exposed)))
-> Proxy (K1 R (t (Nullable Identity)))
-> Int
gValuesNeeded Proxy be
be Proxy (K1 R (t (Nullable Exposed)))
_ Proxy (K1 R (t (Nullable Identity)))
_ = Proxy be -> Proxy (t (Nullable Identity)) -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy (t (Nullable Identity))
forall k (t :: k). Proxy t
Proxy @(t (Nullable Identity)))
instance BeamBackend be => FromBackendRow be () where
  fromBackendRow :: FromBackendRowM be ()
fromBackendRow = D1
  ('MetaData "()" "GHC.Tuple" "ghc-prim" 'False)
  (C1 ('MetaCons "()" 'PrefixI 'False) U1)
  ()
-> ()
forall a x. Generic a => Rep a x -> a
to (D1
   ('MetaData "()" "GHC.Tuple" "ghc-prim" 'False)
   (C1 ('MetaCons "()" 'PrefixI 'False) U1)
   ()
 -> ())
-> FromBackendRowM
     be
     (D1
        ('MetaData "()" "GHC.Tuple" "ghc-prim" 'False)
        (C1 ('MetaCons "()" 'PrefixI 'False) U1)
        ())
-> FromBackendRowM be ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy
  (D1
     ('MetaData "()" "GHC.Tuple" "ghc-prim" 'False)
     (C1 ('MetaCons "()" 'PrefixI 'False) U1))
-> FromBackendRowM
     be
     (D1
        ('MetaData "()" "GHC.Tuple" "ghc-prim" 'False)
        (C1 ('MetaCons "()" 'PrefixI 'False) U1)
        ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy (Rep ())
forall k (t :: k). Proxy t
Proxy @(Rep ()))
  valuesNeeded :: Proxy be -> Proxy () -> Int
valuesNeeded Proxy be
_ Proxy ()
_ = Int
0

instance ( BeamBackend be, KnownNat n, FromBackendRow be a ) => FromBackendRow be (Vector n a) where
  fromBackendRow :: FromBackendRowM be (Vector n a)
fromBackendRow = FromBackendRowM be a -> FromBackendRowM be (Vector n a)
forall (n :: Nat) (m :: * -> *) a.
(KnownNat n, Monad m) =>
m a -> m (Vector n a)
Vector.replicateM FromBackendRowM be a
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow
  valuesNeeded :: Proxy be -> Proxy (Vector n a) -> Int
valuesNeeded Proxy be
_ Proxy (Vector n a)
_ = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy @n))

instance ( BeamBackend be, FromBackendRow be a, FromBackendRow be b ) =>
  FromBackendRow be (a, b) where
  fromBackendRow :: FromBackendRowM be (a, b)
fromBackendRow = D1
  ('MetaData "(,)" "GHC.Tuple" "ghc-prim" 'False)
  (C1
     ('MetaCons "(,)" 'PrefixI 'False)
     (S1
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (Rec0 a)
      :*: S1
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (Rec0 b)))
  ()
-> (a, b)
forall a x. Generic a => Rep a x -> a
to (D1
   ('MetaData "(,)" "GHC.Tuple" "ghc-prim" 'False)
   (C1
      ('MetaCons "(,)" 'PrefixI 'False)
      (S1
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (Rec0 a)
       :*: S1
             ('MetaSel
                'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
             (Rec0 b)))
   ()
 -> (a, b))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,)" 'PrefixI 'False)
           (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 a)
            :*: S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 b)))
        ())
-> FromBackendRowM be (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy
  (D1
     ('MetaData "(,)" "GHC.Tuple" "ghc-prim" 'False)
     (C1
        ('MetaCons "(,)" 'PrefixI 'False)
        (S1
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (Rec0 (Exposed a))
         :*: S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 (Exposed b)))))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,)" 'PrefixI 'False)
           (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 a)
            :*: S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 b)))
        ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy (Rep (Exposed a, Exposed b))
forall k (t :: k). Proxy t
Proxy @(Rep (Exposed a, Exposed b)))
  valuesNeeded :: Proxy be -> Proxy (a, b) -> Int
valuesNeeded Proxy be
be Proxy (a, b)
_ = Proxy be -> Proxy a -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy b -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy b
forall k (t :: k). Proxy t
Proxy @b)
instance ( BeamBackend be, FromBackendRow be a, FromBackendRow be b, FromBackendRow be c ) =>
  FromBackendRow be (a, b, c) where
  fromBackendRow :: FromBackendRowM be (a, b, c)
fromBackendRow = D1
  ('MetaData "(,,)" "GHC.Tuple" "ghc-prim" 'False)
  (C1
     ('MetaCons "(,,)" 'PrefixI 'False)
     (S1
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (Rec0 a)
      :*: (S1
             ('MetaSel
                'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
             (Rec0 b)
           :*: S1
                 ('MetaSel
                    'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                 (Rec0 c))))
  ()
-> (a, b, c)
forall a x. Generic a => Rep a x -> a
to (D1
   ('MetaData "(,,)" "GHC.Tuple" "ghc-prim" 'False)
   (C1
      ('MetaCons "(,,)" 'PrefixI 'False)
      (S1
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (Rec0 a)
       :*: (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 b)
            :*: S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 c))))
   ()
 -> (a, b, c))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,)" 'PrefixI 'False)
           (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 a)
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 b)
                 :*: S1
                       ('MetaSel
                          'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                       (Rec0 c))))
        ())
-> FromBackendRowM be (a, b, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy
  (D1
     ('MetaData "(,,)" "GHC.Tuple" "ghc-prim" 'False)
     (C1
        ('MetaCons "(,,)" 'PrefixI 'False)
        (S1
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (Rec0 (Exposed a))
         :*: (S1
                ('MetaSel
                   'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                (Rec0 (Exposed b))
              :*: S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 (Exposed c))))))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,)" 'PrefixI 'False)
           (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 a)
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 b)
                 :*: S1
                       ('MetaSel
                          'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                       (Rec0 c))))
        ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy (Rep (Exposed a, Exposed b, Exposed c))
forall k (t :: k). Proxy t
Proxy @(Rep (Exposed a, Exposed b, Exposed c)))
  valuesNeeded :: Proxy be -> Proxy (a, b, c) -> Int
valuesNeeded Proxy be
be Proxy (a, b, c)
_ = Proxy be -> Proxy a -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy b -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy c -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy c
forall k (t :: k). Proxy t
Proxy @c)
instance ( BeamBackend be
         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c
         , FromBackendRow be d ) =>
  FromBackendRow be (a, b, c, d) where
  fromBackendRow :: FromBackendRowM be (a, b, c, d)
fromBackendRow = D1
  ('MetaData "(,,,)" "GHC.Tuple" "ghc-prim" 'False)
  (C1
     ('MetaCons "(,,,)" 'PrefixI 'False)
     ((S1
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (Rec0 a)
       :*: S1
             ('MetaSel
                'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
             (Rec0 b))
      :*: (S1
             ('MetaSel
                'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
             (Rec0 c)
           :*: S1
                 ('MetaSel
                    'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                 (Rec0 d))))
  ()
-> (a, b, c, d)
forall a x. Generic a => Rep a x -> a
to (D1
   ('MetaData "(,,,)" "GHC.Tuple" "ghc-prim" 'False)
   (C1
      ('MetaCons "(,,,)" 'PrefixI 'False)
      ((S1
          ('MetaSel
             'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
          (Rec0 a)
        :*: S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 b))
       :*: (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 c)
            :*: S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 d))))
   ()
 -> (a, b, c, d))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,,)" 'PrefixI 'False)
           ((S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 b))
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 c)
                 :*: S1
                       ('MetaSel
                          'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                       (Rec0 d))))
        ())
-> FromBackendRowM be (a, b, c, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy
  (D1
     ('MetaData "(,,,)" "GHC.Tuple" "ghc-prim" 'False)
     (C1
        ('MetaCons "(,,,)" 'PrefixI 'False)
        ((S1
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (Rec0 (Exposed a))
          :*: S1
                ('MetaSel
                   'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                (Rec0 (Exposed b)))
         :*: (S1
                ('MetaSel
                   'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                (Rec0 (Exposed c))
              :*: S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 (Exposed d))))))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,,)" 'PrefixI 'False)
           ((S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 b))
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 c)
                 :*: S1
                       ('MetaSel
                          'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                       (Rec0 d))))
        ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy (Rep (Exposed a, Exposed b, Exposed c, Exposed d))
forall k (t :: k). Proxy t
Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d)))
  valuesNeeded :: Proxy be -> Proxy (a, b, c, d) -> Int
valuesNeeded Proxy be
be Proxy (a, b, c, d)
_ = Proxy be -> Proxy a -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy b -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy c -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy c
forall k (t :: k). Proxy t
Proxy @c) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy d -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy d
forall k (t :: k). Proxy t
Proxy @d)
instance ( BeamBackend be
         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c
         , FromBackendRow be d, FromBackendRow be e ) =>
  FromBackendRow be (a, b, c, d, e) where
  fromBackendRow :: FromBackendRowM be (a, b, c, d, e)
fromBackendRow = D1
  ('MetaData "(,,,,)" "GHC.Tuple" "ghc-prim" 'False)
  (C1
     ('MetaCons "(,,,,)" 'PrefixI 'False)
     ((S1
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (Rec0 a)
       :*: S1
             ('MetaSel
                'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
             (Rec0 b))
      :*: (S1
             ('MetaSel
                'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
             (Rec0 c)
           :*: (S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 d)
                :*: S1
                      ('MetaSel
                         'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                      (Rec0 e)))))
  ()
-> (a, b, c, d, e)
forall a x. Generic a => Rep a x -> a
to (D1
   ('MetaData "(,,,,)" "GHC.Tuple" "ghc-prim" 'False)
   (C1
      ('MetaCons "(,,,,)" 'PrefixI 'False)
      ((S1
          ('MetaSel
             'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
          (Rec0 a)
        :*: S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 b))
       :*: (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 c)
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 d)
                 :*: S1
                       ('MetaSel
                          'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                       (Rec0 e)))))
   ()
 -> (a, b, c, d, e))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,,,)" 'PrefixI 'False)
           ((S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 b))
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 c)
                 :*: (S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 d)
                      :*: S1
                            ('MetaSel
                               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                            (Rec0 e)))))
        ())
-> FromBackendRowM be (a, b, c, d, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy
  (D1
     ('MetaData "(,,,,)" "GHC.Tuple" "ghc-prim" 'False)
     (C1
        ('MetaCons "(,,,,)" 'PrefixI 'False)
        ((S1
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (Rec0 (Exposed a))
          :*: S1
                ('MetaSel
                   'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                (Rec0 (Exposed b)))
         :*: (S1
                ('MetaSel
                   'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                (Rec0 (Exposed c))
              :*: (S1
                     ('MetaSel
                        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                     (Rec0 (Exposed d))
                   :*: S1
                         ('MetaSel
                            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                         (Rec0 (Exposed e)))))))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,,,)" 'PrefixI 'False)
           ((S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 b))
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 c)
                 :*: (S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 d)
                      :*: S1
                            ('MetaSel
                               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                            (Rec0 e)))))
        ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy (Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e))
forall k (t :: k). Proxy t
Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e)))
  valuesNeeded :: Proxy be -> Proxy (a, b, c, d, e) -> Int
valuesNeeded Proxy be
be Proxy (a, b, c, d, e)
_ = Proxy be -> Proxy a -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy b -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy c -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy c
forall k (t :: k). Proxy t
Proxy @c) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy d -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy d
forall k (t :: k). Proxy t
Proxy @d) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      Proxy be -> Proxy e -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy e
forall k (t :: k). Proxy t
Proxy @e)
instance ( BeamBackend be
         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c
         , FromBackendRow be d, FromBackendRow be e, FromBackendRow be f ) =>
  FromBackendRow be (a, b, c, d, e, f) where
  fromBackendRow :: FromBackendRowM be (a, b, c, d, e, f)
fromBackendRow = D1
  ('MetaData "(,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
  (C1
     ('MetaCons "(,,,,,)" 'PrefixI 'False)
     ((S1
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (Rec0 a)
       :*: (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 b)
            :*: S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 c)))
      :*: (S1
             ('MetaSel
                'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
             (Rec0 d)
           :*: (S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 e)
                :*: S1
                      ('MetaSel
                         'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                      (Rec0 f)))))
  ()
-> (a, b, c, d, e, f)
forall a x. Generic a => Rep a x -> a
to (D1
   ('MetaData "(,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
   (C1
      ('MetaCons "(,,,,,)" 'PrefixI 'False)
      ((S1
          ('MetaSel
             'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
          (Rec0 a)
        :*: (S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 b)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 c)))
       :*: (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 d)
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 e)
                 :*: S1
                       ('MetaSel
                          'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                       (Rec0 f)))))
   ()
 -> (a, b, c, d, e, f))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,,,,)" 'PrefixI 'False)
           ((S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)
             :*: (S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 b)
                  :*: S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 c)))
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 d)
                 :*: (S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 e)
                      :*: S1
                            ('MetaSel
                               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                            (Rec0 f)))))
        ())
-> FromBackendRowM be (a, b, c, d, e, f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy
  (D1
     ('MetaData "(,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
     (C1
        ('MetaCons "(,,,,,)" 'PrefixI 'False)
        ((S1
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (Rec0 (Exposed a))
          :*: (S1
                 ('MetaSel
                    'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                 (Rec0 (Exposed b))
               :*: S1
                     ('MetaSel
                        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                     (Rec0 (Exposed c))))
         :*: (S1
                ('MetaSel
                   'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                (Rec0 (Exposed d))
              :*: (S1
                     ('MetaSel
                        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                     (Rec0 (Exposed e))
                   :*: S1
                         ('MetaSel
                            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                         (Rec0 (Exposed f)))))))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,,,,)" 'PrefixI 'False)
           ((S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)
             :*: (S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 b)
                  :*: S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 c)))
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 d)
                 :*: (S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 e)
                      :*: S1
                            ('MetaSel
                               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                            (Rec0 f)))))
        ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy
  (Rep
     (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f))
forall k (t :: k). Proxy t
Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f)))
  valuesNeeded :: Proxy be -> Proxy (a, b, c, d, e, f) -> Int
valuesNeeded Proxy be
be Proxy (a, b, c, d, e, f)
_ = Proxy be -> Proxy a -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy b -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy c -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy c
forall k (t :: k). Proxy t
Proxy @c) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy d -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy d
forall k (t :: k). Proxy t
Proxy @d) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      Proxy be -> Proxy e -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy e
forall k (t :: k). Proxy t
Proxy @e) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy f -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy f
forall k (t :: k). Proxy t
Proxy @f)
instance ( BeamBackend be
         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c
         , FromBackendRow be d, FromBackendRow be e, FromBackendRow be f
         , FromBackendRow be g ) =>
  FromBackendRow be (a, b, c, d, e, f, g) where
  fromBackendRow :: FromBackendRowM be (a, b, c, d, e, f, g)
fromBackendRow = D1
  ('MetaData "(,,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
  (C1
     ('MetaCons "(,,,,,,)" 'PrefixI 'False)
     ((S1
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (Rec0 a)
       :*: (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 b)
            :*: S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 c)))
      :*: ((S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 d)
            :*: S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 e))
           :*: (S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 f)
                :*: S1
                      ('MetaSel
                         'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                      (Rec0 g)))))
  ()
-> (a, b, c, d, e, f, g)
forall a x. Generic a => Rep a x -> a
to (D1
   ('MetaData "(,,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
   (C1
      ('MetaCons "(,,,,,,)" 'PrefixI 'False)
      ((S1
          ('MetaSel
             'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
          (Rec0 a)
        :*: (S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 b)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 c)))
       :*: ((S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 d)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 e))
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 f)
                 :*: S1
                       ('MetaSel
                          'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                       (Rec0 g)))))
   ()
 -> (a, b, c, d, e, f, g))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,,,,,)" 'PrefixI 'False)
           ((S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)
             :*: (S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 b)
                  :*: S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 c)))
            :*: ((S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 d)
                  :*: S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 e))
                 :*: (S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 f)
                      :*: S1
                            ('MetaSel
                               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                            (Rec0 g)))))
        ())
-> FromBackendRowM be (a, b, c, d, e, f, g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy
  (D1
     ('MetaData "(,,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
     (C1
        ('MetaCons "(,,,,,,)" 'PrefixI 'False)
        ((S1
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (Rec0 (Exposed a))
          :*: (S1
                 ('MetaSel
                    'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                 (Rec0 (Exposed b))
               :*: S1
                     ('MetaSel
                        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                     (Rec0 (Exposed c))))
         :*: ((S1
                 ('MetaSel
                    'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                 (Rec0 (Exposed d))
               :*: S1
                     ('MetaSel
                        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                     (Rec0 (Exposed e)))
              :*: (S1
                     ('MetaSel
                        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                     (Rec0 (Exposed f))
                   :*: S1
                         ('MetaSel
                            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                         (Rec0 (Exposed g)))))))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,,,,,)" 'PrefixI 'False)
           ((S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)
             :*: (S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 b)
                  :*: S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 c)))
            :*: ((S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 d)
                  :*: S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 e))
                 :*: (S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 f)
                      :*: S1
                            ('MetaSel
                               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                            (Rec0 g)))))
        ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy
  (Rep
     (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f,
      Exposed g))
forall k (t :: k). Proxy t
Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f, Exposed g)))
  valuesNeeded :: Proxy be -> Proxy (a, b, c, d, e, f, g) -> Int
valuesNeeded Proxy be
be Proxy (a, b, c, d, e, f, g)
_ = Proxy be -> Proxy a -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy b -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy c -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy c
forall k (t :: k). Proxy t
Proxy @c) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy d -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy d
forall k (t :: k). Proxy t
Proxy @d) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      Proxy be -> Proxy e -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy e
forall k (t :: k). Proxy t
Proxy @e) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy f -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy f
forall k (t :: k). Proxy t
Proxy @f) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy g -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy g
forall k (t :: k). Proxy t
Proxy @g)
instance ( BeamBackend be
         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c
         , FromBackendRow be d, FromBackendRow be e, FromBackendRow be f
         , FromBackendRow be g, FromBackendRow be h ) =>
  FromBackendRow be (a, b, c, d, e, f, g, h) where
  fromBackendRow :: FromBackendRowM be (a, b, c, d, e, f, g, h)
fromBackendRow = D1
  ('MetaData "(,,,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
  (C1
     ('MetaCons "(,,,,,,,)" 'PrefixI 'False)
     (((S1
          ('MetaSel
             'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
          (Rec0 a)
        :*: S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 b))
       :*: (S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 c)
            :*: S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 d)))
      :*: ((S1
              ('MetaSel
                 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
              (Rec0 e)
            :*: S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 f))
           :*: (S1
                  ('MetaSel
                     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                  (Rec0 g)
                :*: S1
                      ('MetaSel
                         'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                      (Rec0 h)))))
  ()
-> (a, b, c, d, e, f, g, h)
forall a x. Generic a => Rep a x -> a
to (D1
   ('MetaData "(,,,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
   (C1
      ('MetaCons "(,,,,,,,)" 'PrefixI 'False)
      (((S1
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (Rec0 a)
         :*: S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 b))
        :*: (S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 c)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 d)))
       :*: ((S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 e)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 f))
            :*: (S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 g)
                 :*: S1
                       ('MetaSel
                          'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                       (Rec0 h)))))
   ()
 -> (a, b, c, d, e, f, g, h))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,,,,,,)" 'PrefixI 'False)
           (((S1
                ('MetaSel
                   'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                (Rec0 a)
              :*: S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 b))
             :*: (S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 c)
                  :*: S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 d)))
            :*: ((S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 e)
                  :*: S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 f))
                 :*: (S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 g)
                      :*: S1
                            ('MetaSel
                               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                            (Rec0 h)))))
        ())
-> FromBackendRowM be (a, b, c, d, e, f, g, h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy
  (D1
     ('MetaData "(,,,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
     (C1
        ('MetaCons "(,,,,,,,)" 'PrefixI 'False)
        (((S1
             ('MetaSel
                'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
             (Rec0 (Exposed a))
           :*: S1
                 ('MetaSel
                    'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                 (Rec0 (Exposed b)))
          :*: (S1
                 ('MetaSel
                    'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                 (Rec0 (Exposed c))
               :*: S1
                     ('MetaSel
                        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                     (Rec0 (Exposed d))))
         :*: ((S1
                 ('MetaSel
                    'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                 (Rec0 (Exposed e))
               :*: S1
                     ('MetaSel
                        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                     (Rec0 (Exposed f)))
              :*: (S1
                     ('MetaSel
                        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                     (Rec0 (Exposed g))
                   :*: S1
                         ('MetaSel
                            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                         (Rec0 (Exposed h)))))))
-> FromBackendRowM
     be
     (D1
        ('MetaData "(,,,,,,,)" "GHC.Tuple" "ghc-prim" 'False)
        (C1
           ('MetaCons "(,,,,,,,)" 'PrefixI 'False)
           (((S1
                ('MetaSel
                   'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                (Rec0 a)
              :*: S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 b))
             :*: (S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 c)
                  :*: S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 d)))
            :*: ((S1
                    ('MetaSel
                       'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                    (Rec0 e)
                  :*: S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 f))
                 :*: (S1
                        ('MetaSel
                           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                        (Rec0 g)
                      :*: S1
                            ('MetaSel
                               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                            (Rec0 h)))))
        ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy
  (Rep
     (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f,
      Exposed g, Exposed h))
forall k (t :: k). Proxy t
Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f, Exposed g, Exposed h)))
  valuesNeeded :: Proxy be -> Proxy (a, b, c, d, e, f, g, h) -> Int
valuesNeeded Proxy be
be Proxy (a, b, c, d, e, f, g, h)
_ = Proxy be -> Proxy a -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy b -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy c -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy c
forall k (t :: k). Proxy t
Proxy @c) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy d -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy d
forall k (t :: k). Proxy t
Proxy @d) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      Proxy be -> Proxy e -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy e
forall k (t :: k). Proxy t
Proxy @e) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy f -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy f
forall k (t :: k). Proxy t
Proxy @f) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy g -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy g
forall k (t :: k). Proxy t
Proxy @g) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy be -> Proxy h -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy h
forall k (t :: k). Proxy t
Proxy @h)

instance ( BeamBackend be, Generic (tbl Identity), Generic (tbl Exposed)
         , GFromBackendRow be (Rep (tbl Exposed)) (Rep (tbl Identity))) =>

    FromBackendRow be (tbl Identity) where
  fromBackendRow :: FromBackendRowM be (tbl Identity)
fromBackendRow = Rep (tbl Identity) () -> tbl Identity
forall a x. Generic a => Rep a x -> a
to (Rep (tbl Identity) () -> tbl Identity)
-> FromBackendRowM be (Rep (tbl Identity) ())
-> FromBackendRowM be (tbl Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Rep (tbl Exposed))
-> FromBackendRowM be (Rep (tbl Identity) ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy (Rep (tbl Exposed))
forall k (t :: k). Proxy t
Proxy @(Rep (tbl Exposed)))
  valuesNeeded :: Proxy be -> Proxy (tbl Identity) -> Int
valuesNeeded Proxy be
be Proxy (tbl Identity)
_ = Proxy be
-> Proxy (Rep (tbl Exposed)) -> Proxy (Rep (tbl Identity)) -> Int
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded Proxy be
be (Proxy (Rep (tbl Exposed))
forall k (t :: k). Proxy t
Proxy @(Rep (tbl Exposed))) (Proxy (Rep (tbl Identity))
forall k (t :: k). Proxy t
Proxy @(Rep (tbl Identity)))
instance ( BeamBackend be, Generic (tbl (Nullable Identity)), Generic (tbl (Nullable Exposed))
         , GFromBackendRow be (Rep (tbl (Nullable Exposed))) (Rep (tbl (Nullable Identity)))) =>

    FromBackendRow be (tbl (Nullable Identity)) where
  fromBackendRow :: FromBackendRowM be (tbl (Nullable Identity))
fromBackendRow = Rep (tbl (Nullable Identity)) () -> tbl (Nullable Identity)
forall a x. Generic a => Rep a x -> a
to (Rep (tbl (Nullable Identity)) () -> tbl (Nullable Identity))
-> FromBackendRowM be (Rep (tbl (Nullable Identity)) ())
-> FromBackendRowM be (tbl (Nullable Identity))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Rep (tbl (Nullable Exposed)))
-> FromBackendRowM be (Rep (tbl (Nullable Identity)) ())
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (Proxy (Rep (tbl (Nullable Exposed)))
forall k (t :: k). Proxy t
Proxy @(Rep (tbl (Nullable Exposed))))
  valuesNeeded :: Proxy be -> Proxy (tbl (Nullable Identity)) -> Int
valuesNeeded Proxy be
be Proxy (tbl (Nullable Identity))
_ = Proxy be
-> Proxy (Rep (tbl (Nullable Exposed)))
-> Proxy (Rep (tbl (Nullable Identity)))
-> Int
forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded Proxy be
be (Proxy (Rep (tbl (Nullable Exposed)))
forall k (t :: k). Proxy t
Proxy @(Rep (tbl (Nullable Exposed)))) (Proxy (Rep (tbl (Nullable Identity)))
forall k (t :: k). Proxy t
Proxy @(Rep (tbl (Nullable Identity))))

instance (FromBackendRow be x, FromBackendRow be SqlNull) => FromBackendRow be (Maybe x) where
  fromBackendRow :: FromBackendRowM be (Maybe x)
fromBackendRow =
    (x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x)
-> FromBackendRowM be x -> FromBackendRowM be (Maybe x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM be x
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow) FromBackendRowM be (Maybe x)
-> FromBackendRowM be (Maybe x) -> FromBackendRowM be (Maybe x)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (Maybe x
forall a. Maybe a
Nothing Maybe x -> FromBackendRowM be () -> FromBackendRowM be (Maybe x)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      Int -> FromBackendRowM be () -> FromBackendRowM be ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Proxy be -> Proxy (Maybe x) -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded (Proxy be
forall k (t :: k). Proxy t
Proxy @be) (Proxy (Maybe x)
forall k (t :: k). Proxy t
Proxy @(Maybe x)))
                  (do SqlNull
SqlNull <- FromBackendRowM be SqlNull
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow
                      () -> FromBackendRowM be ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
  valuesNeeded :: Proxy be -> Proxy (Maybe x) -> Int
valuesNeeded Proxy be
be Proxy (Maybe x)
_ = Proxy be -> Proxy x -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (Proxy x
forall k (t :: k). Proxy t
Proxy @x)

#if !MIN_VERSION_base(4, 16, 0)
deriving instance Generic (a, b, c, d, e, f, g, h)
#endif

instance (BeamBackend be, FromBackendRow be t) => FromBackendRow be (Tagged tag t) where
  fromBackendRow :: FromBackendRowM be (Tagged tag t)
fromBackendRow = t -> Tagged tag t
forall k (s :: k) b. b -> Tagged s b
Tagged (t -> Tagged tag t)
-> FromBackendRowM be t -> FromBackendRowM be (Tagged tag t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM be t
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow

instance FromBackendRow be x => FromBackendRow be (SqlSerial x) where
  fromBackendRow :: FromBackendRowM be (SqlSerial x)
fromBackendRow = x -> SqlSerial x
forall a. a -> SqlSerial a
SqlSerial (x -> SqlSerial x)
-> FromBackendRowM be x -> FromBackendRowM be (SqlSerial x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM be x
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow