{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE UndecidableInstances  #-}

module Data.Record.Beam.ZipTables (
    GZipLargeTables
  , ZipBeamFieldsI
  ) where

import Data.Kind
import Data.Proxy
import Data.Record.Beam.Internal
import Data.Record.Beam.Interpretation
import Data.Record.Generic
import Data.Record.Generic.GHC
import Data.Record.Generic.Transform
import Database.Beam.Schema.Tables

import qualified Data.Record.Generic.Rep as Rep

type GZipLargeTables table f g h = (
    Generic (table f)
  , Generic (table g)
  , Generic (table h)
  , Generic (table Uninterpreted)
  , Constraints (table Uninterpreted) ZipBeamFieldsI
  , HasNormalForm (BeamInterpretation f) (table f) (table Uninterpreted)
  , HasNormalForm (BeamInterpretation g) (table g) (table Uninterpreted)
  , HasNormalForm (BeamInterpretation h) (table h) (table Uninterpreted)
  )

instance GZipLargeTables table f g h
      => GZipTables f g h exposedRep
                          (ThroughLRGenerics (table f))
                          (ThroughLRGenerics (table g))
                          (ThroughLRGenerics (table h)) where
  gZipTables :: forall (m :: * -> *).
Applicative m =>
Proxy exposedRep
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> ThroughLRGenerics (table f) ()
-> ThroughLRGenerics (table g) ()
-> m (ThroughLRGenerics (table h) ())
gZipTables Proxy exposedRep
_ forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
f ThroughLRGenerics (table f) ()
x ThroughLRGenerics (table g) ()
y =
    (Rep (Interpret (BeamInterpretation h)) (table Uninterpreted)
 -> ThroughLRGenerics (table h) ())
-> m (Rep (Interpret (BeamInterpretation h)) (table Uninterpreted))
-> m (ThroughLRGenerics (table h) ())
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (table h -> ThroughLRGenerics (table h) ()
forall a p. a -> ThroughLRGenerics a p
WrapThroughLRGenerics (table h -> ThroughLRGenerics (table h) ())
-> (Rep (Interpret (BeamInterpretation h)) (table Uninterpreted)
    -> table h)
-> Rep (Interpret (BeamInterpretation h)) (table Uninterpreted)
-> ThroughLRGenerics (table h) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep I (table h) -> table h
forall a. Generic a => Rep I a -> a
to (Rep I (table h) -> table h)
-> (Rep (Interpret (BeamInterpretation h)) (table Uninterpreted)
    -> Rep I (table h))
-> Rep (Interpret (BeamInterpretation h)) (table Uninterpreted)
-> table h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy BeamInterpretation
-> Rep (Interpret (BeamInterpretation h)) (table Uninterpreted)
-> Rep I (table h)
forall {k} {dom} (d :: (k -> *) -> dom) (f :: k -> *)
       (x :: (k -> *) -> *).
HasNormalForm (d f) (x f) (x Uninterpreted) =>
Proxy d -> Rep (Interpret (d f)) (x Uninterpreted) -> Rep I (x f)
denormalize1 (forall {k} (t :: k). Proxy t
forall (t :: (* -> *) -> *). Proxy t
Proxy @BeamInterpretation)) (m (Rep (Interpret (BeamInterpretation h)) (table Uninterpreted))
 -> m (ThroughLRGenerics (table h) ()))
-> m (Rep (Interpret (BeamInterpretation h)) (table Uninterpreted))
-> m (ThroughLRGenerics (table h) ())
forall a b. (a -> b) -> a -> b
$
      Proxy ZipBeamFieldsI
-> (forall x.
    ZipBeamFieldsI x =>
    Interpret (BeamInterpretation f) x
    -> Interpret (BeamInterpretation g) x
    -> m (Interpret (BeamInterpretation h) x))
-> Rep (Interpret (BeamInterpretation f)) (table Uninterpreted)
-> Rep (Interpret (BeamInterpretation g)) (table Uninterpreted)
-> m (Rep (Interpret (BeamInterpretation h)) (table Uninterpreted))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *)
       (c :: * -> Constraint) a.
(Generic a, Applicative m, Constraints a c) =>
Proxy c
-> (forall x. c x => f x -> g x -> m (h x))
-> Rep f a
-> Rep g a
-> m (Rep h a)
Rep.czipWithM
        (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @ZipBeamFieldsI)
        ((forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> Interpret (BeamInterpretation f) x
-> Interpret (BeamInterpretation g) x
-> m (Interpret (BeamInterpretation h) x)
forall a (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
(ZipBeamFieldsI a, Applicative m) =>
(forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x))
-> Interpret (BeamInterpretation f) a
-> Interpret (BeamInterpretation g) a
-> m (Interpret (BeamInterpretation h) a)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x))
-> Interpret (BeamInterpretation f) x
-> Interpret (BeamInterpretation g) x
-> m (Interpret (BeamInterpretation h) x)
zipBeamFieldsI Columnar' f x -> Columnar' g x -> m (Columnar' h x)
forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
f)
        (Proxy BeamInterpretation
-> Rep I (table f)
-> Rep (Interpret (BeamInterpretation f)) (table Uninterpreted)
forall {k} {dom} (d :: (k -> *) -> dom) (f :: k -> *)
       (x :: (k -> *) -> *).
HasNormalForm (d f) (x f) (x Uninterpreted) =>
Proxy d -> Rep I (x f) -> Rep (Interpret (d f)) (x Uninterpreted)
normalize1 (forall {k} (t :: k). Proxy t
forall (t :: (* -> *) -> *). Proxy t
Proxy @BeamInterpretation) (table f -> Rep I (table f)
forall a. Generic a => a -> Rep I a
from (ThroughLRGenerics (table f) () -> table f
forall a p. ThroughLRGenerics a p -> a
unwrapThroughLRGenerics ThroughLRGenerics (table f) ()
x)))
        (Proxy BeamInterpretation
-> Rep I (table g)
-> Rep (Interpret (BeamInterpretation g)) (table Uninterpreted)
forall {k} {dom} (d :: (k -> *) -> dom) (f :: k -> *)
       (x :: (k -> *) -> *).
HasNormalForm (d f) (x f) (x Uninterpreted) =>
Proxy d -> Rep I (x f) -> Rep (Interpret (d f)) (x Uninterpreted)
normalize1 (forall {k} (t :: k). Proxy t
forall (t :: (* -> *) -> *). Proxy t
Proxy @BeamInterpretation) (table g -> Rep I (table g)
forall a. Generic a => a -> Rep I a
from (ThroughLRGenerics (table g) () -> table g
forall a p. ThroughLRGenerics a p -> a
unwrapThroughLRGenerics ThroughLRGenerics (table g) ()
y)))

{-------------------------------------------------------------------------------
  Cases for 'gZipTables'
-------------------------------------------------------------------------------}

class ZipBeamFieldsI (a :: Type) where
  zipBeamFieldsI ::
       Applicative m
    => (forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x))
    -> Interpret (BeamInterpretation f) a
    -> Interpret (BeamInterpretation g) a
    -> m (Interpret (BeamInterpretation h) a)

instance ZipBeamFieldsI (Uninterpreted x) where
  zipBeamFieldsI :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x))
-> Interpret (BeamInterpretation f) (Uninterpreted x)
-> Interpret (BeamInterpretation g) (Uninterpreted x)
-> m (Interpret (BeamInterpretation h) (Uninterpreted x))
zipBeamFieldsI forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x)
f = (Interpreted (BeamInterpretation f) (Uninterpreted x)
 -> Interpreted (BeamInterpretation g) (Uninterpreted x)
 -> m (Interpreted (BeamInterpretation h) (Uninterpreted x)))
-> Interpret (BeamInterpretation f) (Uninterpreted x)
-> Interpret (BeamInterpretation g) (Uninterpreted x)
-> m (Interpret (BeamInterpretation h) (Uninterpreted x))
forall {dom1} {dom2} {dom3} (m :: * -> *) (dx :: dom1) x
       (dy :: dom2) y (dz :: dom3) z.
Applicative m =>
(Interpreted dx x -> Interpreted dy y -> m (Interpreted dz z))
-> Interpret dx x -> Interpret dy y -> m (Interpret dz z)
liftInterpretedA2 ((Interpreted (BeamInterpretation f) (Uninterpreted x)
  -> Interpreted (BeamInterpretation g) (Uninterpreted x)
  -> m (Interpreted (BeamInterpretation h) (Uninterpreted x)))
 -> Interpret (BeamInterpretation f) (Uninterpreted x)
 -> Interpret (BeamInterpretation g) (Uninterpreted x)
 -> m (Interpret (BeamInterpretation h) (Uninterpreted x)))
-> (Interpreted (BeamInterpretation f) (Uninterpreted x)
    -> Interpreted (BeamInterpretation g) (Uninterpreted x)
    -> m (Interpreted (BeamInterpretation h) (Uninterpreted x)))
-> Interpret (BeamInterpretation f) (Uninterpreted x)
-> Interpret (BeamInterpretation g) (Uninterpreted x)
-> m (Interpret (BeamInterpretation h) (Uninterpreted x))
forall a b. (a -> b) -> a -> b
$ Proxy x
-> (Columnar' f x -> Columnar' g x -> m (Columnar' h x))
-> Columnar f x
-> Columnar g x
-> m (Columnar h x)
forall (m :: * -> *) x (f :: * -> *) (g :: * -> *) (h :: * -> *).
Functor m =>
Proxy x
-> (Columnar' f x -> Columnar' g x -> m (Columnar' h x))
-> Columnar f x
-> Columnar g x
-> m (Columnar h x)
liftColumnarA2 (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @x) Columnar' f x -> Columnar' g x -> m (Columnar' h x)
forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x)
f

instance Beamable table => ZipBeamFieldsI (table Uninterpreted) where
  zipBeamFieldsI :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x))
-> Interpret (BeamInterpretation f) (table Uninterpreted)
-> Interpret (BeamInterpretation g) (table Uninterpreted)
-> m (Interpret (BeamInterpretation h) (table Uninterpreted))
zipBeamFieldsI forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x)
f = (Interpreted (BeamInterpretation f) (table Uninterpreted)
 -> Interpreted (BeamInterpretation g) (table Uninterpreted)
 -> m (Interpreted (BeamInterpretation h) (table Uninterpreted)))
-> Interpret (BeamInterpretation f) (table Uninterpreted)
-> Interpret (BeamInterpretation g) (table Uninterpreted)
-> m (Interpret (BeamInterpretation h) (table Uninterpreted))
forall {dom1} {dom2} {dom3} (m :: * -> *) (dx :: dom1) x
       (dy :: dom2) y (dz :: dom3) z.
Applicative m =>
(Interpreted dx x -> Interpreted dy y -> m (Interpreted dz z))
-> Interpret dx x -> Interpret dy y -> m (Interpret dz z)
liftInterpretedA2 ((Interpreted (BeamInterpretation f) (table Uninterpreted)
  -> Interpreted (BeamInterpretation g) (table Uninterpreted)
  -> m (Interpreted (BeamInterpretation h) (table Uninterpreted)))
 -> Interpret (BeamInterpretation f) (table Uninterpreted)
 -> Interpret (BeamInterpretation g) (table Uninterpreted)
 -> m (Interpret (BeamInterpretation h) (table Uninterpreted)))
-> (Interpreted (BeamInterpretation f) (table Uninterpreted)
    -> Interpreted (BeamInterpretation g) (table Uninterpreted)
    -> m (Interpreted (BeamInterpretation h) (table Uninterpreted)))
-> Interpret (BeamInterpretation f) (table Uninterpreted)
-> Interpret (BeamInterpretation g) (table Uninterpreted)
-> m (Interpret (BeamInterpretation h) (table Uninterpreted))
forall a b. (a -> b) -> a -> b
$ (forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x))
-> table f -> table g -> m (table h)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM Columnar' f a -> Columnar' g a -> m (Columnar' h a)
forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x)
f

instance Beamable table => ZipBeamFieldsI (table (Nullable Uninterpreted)) where
  zipBeamFieldsI :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x))
-> Interpret
     (BeamInterpretation f) (table (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation g) (table (Nullable Uninterpreted))
-> m (Interpret
        (BeamInterpretation h) (table (Nullable Uninterpreted)))
zipBeamFieldsI forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x)
f = (Interpreted
   (BeamInterpretation f) (table (Nullable Uninterpreted))
 -> Interpreted
      (BeamInterpretation g) (table (Nullable Uninterpreted))
 -> m (Interpreted
         (BeamInterpretation h) (table (Nullable Uninterpreted))))
-> Interpret
     (BeamInterpretation f) (table (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation g) (table (Nullable Uninterpreted))
-> m (Interpret
        (BeamInterpretation h) (table (Nullable Uninterpreted)))
forall {dom1} {dom2} {dom3} (m :: * -> *) (dx :: dom1) x
       (dy :: dom2) y (dz :: dom3) z.
Applicative m =>
(Interpreted dx x -> Interpreted dy y -> m (Interpreted dz z))
-> Interpret dx x -> Interpret dy y -> m (Interpret dz z)
liftInterpretedA2 ((Interpreted
    (BeamInterpretation f) (table (Nullable Uninterpreted))
  -> Interpreted
       (BeamInterpretation g) (table (Nullable Uninterpreted))
  -> m (Interpreted
          (BeamInterpretation h) (table (Nullable Uninterpreted))))
 -> Interpret
      (BeamInterpretation f) (table (Nullable Uninterpreted))
 -> Interpret
      (BeamInterpretation g) (table (Nullable Uninterpreted))
 -> m (Interpret
         (BeamInterpretation h) (table (Nullable Uninterpreted))))
-> (Interpreted
      (BeamInterpretation f) (table (Nullable Uninterpreted))
    -> Interpreted
         (BeamInterpretation g) (table (Nullable Uninterpreted))
    -> m (Interpreted
            (BeamInterpretation h) (table (Nullable Uninterpreted))))
-> Interpret
     (BeamInterpretation f) (table (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation g) (table (Nullable Uninterpreted))
-> m (Interpret
        (BeamInterpretation h) (table (Nullable Uninterpreted)))
forall a b. (a -> b) -> a -> b
$ (forall a.
 Columnar' (Nullable f) a
 -> Columnar' (Nullable g) a -> m (Columnar' (Nullable h) a))
-> table (Nullable f)
-> table (Nullable g)
-> m (table (Nullable h))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM ((forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x))
-> forall a.
   Columnar' (Nullable f) a
   -> Columnar' (Nullable g) a -> m (Columnar' (Nullable h) a)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Functor m =>
(forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x))
-> forall x.
   Columnar' (Nullable f) x
   -> Columnar' (Nullable g) x -> m (Columnar' (Nullable h) x)
liftNullableA2 Columnar' f x -> Columnar' g x -> m (Columnar' h x)
forall x. Columnar' f x -> Columnar' g x -> m (Columnar' h x)
f)