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

instance Monad (FromBackendRowM be) where
  return :: forall a. a -> FromBackendRowM be a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  FromBackendRowM F (FromBackendRowF be) a
a >>= :: forall a b.
FromBackendRowM be a
-> (a -> FromBackendRowM be b) -> FromBackendRowM be b
>>= a -> FromBackendRowM be b
b =
    forall be a. F (FromBackendRowF be) a -> FromBackendRowM be a
FromBackendRowM forall a b. (a -> b) -> a -> b
$
    F (FromBackendRowF be) a
a 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 :: forall a. String -> FromBackendRowM be a
fail = forall be a. F (FromBackendRowF be) a -> FromBackendRowM be a
FromBackendRowM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall be f. BeamRowReadError -> FromBackendRowF be f
FailParseWith forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ColumnParseError
ColumnErrorInternal

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

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

peekField :: (Typeable a, BackendFromField be a) => FromBackendRowM be (Maybe a)
peekField :: forall a be.
(Typeable a, BackendFromField be a) =>
FromBackendRowM be (Maybe a)
peekField = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall be a. F (FromBackendRowF be) a -> FromBackendRowM be a
FromBackendRowM (forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (forall be a f.
(BackendFromField be a, Typeable a) =>
(a -> f) -> FromBackendRowF be f
ParseOneField forall a. a -> a
id))) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = 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)
_ = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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)
_ = forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @e) (forall {k} (t :: k). Proxy t
Proxy @p)
instance GFromBackendRow be e U1 where
  gFromBackendRow :: Proxy e -> FromBackendRowM be (U1 ())
gFromBackendRow Proxy e
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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)
_ = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (forall {k} (t :: k). Proxy t
Proxy @aExp) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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)
_ = forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @aExp) (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @bExp) (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))
_ = forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (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))
_ = forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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))
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (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)))
_ = forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)))
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @(t (Nullable Identity)))
instance BeamBackend be => FromBackendRow be () where
  fromBackendRow :: FromBackendRowM be ()
fromBackendRow = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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 = forall (n :: Nat) (m :: * -> *) a.
(KnownNat n, Monad m) =>
m a -> m (Vector n a)
Vector.replicateM 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)
_ = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (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 = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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)
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (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 = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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)
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @b) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (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 = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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)
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @b) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @c) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (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 = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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)
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @b) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @c) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @d) forall a. Num a => a -> a -> a
+
                      forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (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 = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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)
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @b) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @c) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @d) forall a. Num a => a -> a -> a
+
                      forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @e) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (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 = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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)
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @b) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @c) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @d) forall a. Num a => a -> a -> a
+
                      forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @e) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @f) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (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 = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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)
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @b) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @c) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @d) forall a. Num a => a -> a -> a
+
                      forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @e) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @f) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @g) forall a. Num a => a -> a -> a
+ forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (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 = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (forall {k} (t :: k). Proxy t
Proxy @(Rep (tbl Exposed)))
  valuesNeeded :: Proxy be -> Proxy (tbl Identity) -> Int
valuesNeeded Proxy be
be Proxy (tbl Identity)
_ = forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @(Rep (tbl Exposed))) (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 = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy exposed -> FromBackendRowM be (rep ())
gFromBackendRow (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))
_ = forall be (exposed :: * -> *) (rep :: * -> *).
GFromBackendRow be exposed rep =>
Proxy be -> Proxy exposed -> Proxy rep -> Int
gValuesNeeded Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @(Rep (tbl (Nullable Exposed)))) (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 =
    (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded (forall {k} (t :: k). Proxy t
Proxy @be) (forall {k} (t :: k). Proxy t
Proxy @(Maybe x)))
                  (do SqlNull
SqlNull <- forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow
                      forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
  valuesNeeded :: Proxy be -> Proxy (Maybe x) -> Int
valuesNeeded Proxy be
be Proxy (Maybe x)
_ = forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded Proxy be
be (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 = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a. a -> SqlSerial a
SqlSerial forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow