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

module Data.Record.Beam.ZipDatabase (
    GZipLargeDatabase
  , ZipTablesI
  ) where

import Data.Proxy
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 GZipLargeDatabase db f g h = (
    Generic (db f)
  , Generic (db g)
  , Generic (db h)
  , Generic (db Uninterpreted)
  , Constraints (db Uninterpreted) ZipTablesI
  , HasNormalForm (DefaultInterpretation f) (db f) (db Uninterpreted)
  , HasNormalForm (DefaultInterpretation g) (db g) (db Uninterpreted)
  , HasNormalForm (DefaultInterpretation h) (db h) (db Uninterpreted)
  )

instance GZipLargeDatabase db f g h
      => GZipDatabase be f g h (ThroughLRGenerics (db f))
                               (ThroughLRGenerics (db g))
                               (ThroughLRGenerics (db h)) where
  gZipDatabase :: forall (m :: * -> *).
Applicative m =>
(Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> ThroughLRGenerics (db f) ()
-> ThroughLRGenerics (db g) ()
-> m (ThroughLRGenerics (db h) ())
gZipDatabase (Proxy f
_, Proxy g
_, Proxy h
_, Proxy be
pBackend) forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
f ThroughLRGenerics (db f) ()
x ThroughLRGenerics (db g) ()
y =
      (Rep (Interpret (DefaultInterpretation h)) (db Uninterpreted)
 -> ThroughLRGenerics (db h) ())
-> m (Rep (Interpret (DefaultInterpretation h)) (db Uninterpreted))
-> m (ThroughLRGenerics (db h) ())
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (db h -> ThroughLRGenerics (db h) ()
forall a p. a -> ThroughLRGenerics a p
WrapThroughLRGenerics (db h -> ThroughLRGenerics (db h) ())
-> (Rep (Interpret (DefaultInterpretation h)) (db Uninterpreted)
    -> db h)
-> Rep (Interpret (DefaultInterpretation h)) (db Uninterpreted)
-> ThroughLRGenerics (db h) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep I (db h) -> db h
forall a. Generic a => Rep I a -> a
to (Rep I (db h) -> db h)
-> (Rep (Interpret (DefaultInterpretation h)) (db Uninterpreted)
    -> Rep I (db h))
-> Rep (Interpret (DefaultInterpretation h)) (db Uninterpreted)
-> db h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy DefaultInterpretation
-> Rep (Interpret (DefaultInterpretation h)) (db Uninterpreted)
-> Rep I (db 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 @DefaultInterpretation)) (m (Rep (Interpret (DefaultInterpretation h)) (db Uninterpreted))
 -> m (ThroughLRGenerics (db h) ()))
-> m (Rep (Interpret (DefaultInterpretation h)) (db Uninterpreted))
-> m (ThroughLRGenerics (db h) ())
forall a b. (a -> b) -> a -> b
$
        Proxy ZipTablesI
-> (forall x.
    ZipTablesI x =>
    Interpret (DefaultInterpretation f) x
    -> Interpret (DefaultInterpretation g) x
    -> m (Interpret (DefaultInterpretation h) x))
-> Rep (Interpret (DefaultInterpretation f)) (db Uninterpreted)
-> Rep (Interpret (DefaultInterpretation g)) (db Uninterpreted)
-> m (Rep (Interpret (DefaultInterpretation h)) (db 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 @ZipTablesI)
          (Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> Interpret (DefaultInterpretation f) x
-> Interpret (DefaultInterpretation g) x
-> m (Interpret (DefaultInterpretation h) x)
forall a (m :: * -> *) be (f :: * -> *) (g :: * -> *)
       (h :: * -> *).
(ZipTablesI a, Applicative m) =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> Interpret (DefaultInterpretation f) a
-> Interpret (DefaultInterpretation g) a
-> m (Interpret (DefaultInterpretation h) a)
forall (m :: * -> *) be (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> Interpret (DefaultInterpretation f) x
-> Interpret (DefaultInterpretation g) x
-> m (Interpret (DefaultInterpretation h) x)
zipTablesI Proxy be
pBackend f tbl -> g tbl -> m (h tbl)
forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
f)
          (Proxy DefaultInterpretation
-> Rep I (db f)
-> Rep (Interpret (DefaultInterpretation f)) (db 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 @DefaultInterpretation) (db f -> Rep I (db f)
forall a. Generic a => a -> Rep I a
from (ThroughLRGenerics (db f) () -> db f
forall a p. ThroughLRGenerics a p -> a
unwrapThroughLRGenerics ThroughLRGenerics (db f) ()
x)))
          (Proxy DefaultInterpretation
-> Rep I (db g)
-> Rep (Interpret (DefaultInterpretation g)) (db 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 @DefaultInterpretation) (db g -> Rep I (db g)
forall a. Generic a => a -> Rep I a
from (ThroughLRGenerics (db g) () -> db g
forall a p. ThroughLRGenerics a p -> a
unwrapThroughLRGenerics ThroughLRGenerics (db g) ()
y)))

{-------------------------------------------------------------------------------
  Internal: cases for 'gzipTables'
-------------------------------------------------------------------------------}

class ZipTablesI a where
  zipTablesI ::
        Applicative m
     => Proxy be
     -> (forall tbl. (IsDatabaseEntity be tbl, DatabaseEntityRegularRequirements be tbl) => f tbl -> g tbl -> m (h tbl))
     -> Interpret (DefaultInterpretation f) a
     -> Interpret (DefaultInterpretation g) a
     -> m (Interpret (DefaultInterpretation h) a)

instance Table tbl => ZipTablesI (Uninterpreted (TableEntity tbl)) where
  zipTablesI :: forall (m :: * -> *) be (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> Interpret
     (DefaultInterpretation f) (Uninterpreted (TableEntity tbl))
-> Interpret
     (DefaultInterpretation g) (Uninterpreted (TableEntity tbl))
-> m (Interpret
        (DefaultInterpretation h) (Uninterpreted (TableEntity tbl)))
zipTablesI Proxy be
_ forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
f = (Interpreted
   (DefaultInterpretation f) (Uninterpreted (TableEntity tbl))
 -> Interpreted
      (DefaultInterpretation g) (Uninterpreted (TableEntity tbl))
 -> m (Interpreted
         (DefaultInterpretation h) (Uninterpreted (TableEntity tbl))))
-> Interpret
     (DefaultInterpretation f) (Uninterpreted (TableEntity tbl))
-> Interpret
     (DefaultInterpretation g) (Uninterpreted (TableEntity tbl))
-> m (Interpret
        (DefaultInterpretation h) (Uninterpreted (TableEntity tbl)))
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 f (TableEntity tbl)
-> g (TableEntity tbl) -> m (h (TableEntity tbl))
Interpreted
  (DefaultInterpretation f) (Uninterpreted (TableEntity tbl))
-> Interpreted
     (DefaultInterpretation g) (Uninterpreted (TableEntity tbl))
-> m (Interpreted
        (DefaultInterpretation h) (Uninterpreted (TableEntity tbl)))
forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
f

instance Beamable tbl => ZipTablesI (Uninterpreted (ViewEntity tbl)) where
  zipTablesI :: forall (m :: * -> *) be (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> Interpret
     (DefaultInterpretation f) (Uninterpreted (ViewEntity tbl))
-> Interpret
     (DefaultInterpretation g) (Uninterpreted (ViewEntity tbl))
-> m (Interpret
        (DefaultInterpretation h) (Uninterpreted (ViewEntity tbl)))
zipTablesI Proxy be
_ forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
f = (Interpreted
   (DefaultInterpretation f) (Uninterpreted (ViewEntity tbl))
 -> Interpreted
      (DefaultInterpretation g) (Uninterpreted (ViewEntity tbl))
 -> m (Interpreted
         (DefaultInterpretation h) (Uninterpreted (ViewEntity tbl))))
-> Interpret
     (DefaultInterpretation f) (Uninterpreted (ViewEntity tbl))
-> Interpret
     (DefaultInterpretation g) (Uninterpreted (ViewEntity tbl))
-> m (Interpret
        (DefaultInterpretation h) (Uninterpreted (ViewEntity tbl)))
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 f (ViewEntity tbl) -> g (ViewEntity tbl) -> m (h (ViewEntity tbl))
Interpreted
  (DefaultInterpretation f) (Uninterpreted (ViewEntity tbl))
-> Interpreted
     (DefaultInterpretation g) (Uninterpreted (ViewEntity tbl))
-> m (Interpreted
        (DefaultInterpretation h) (Uninterpreted (ViewEntity tbl)))
forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
f

instance ZipTablesI (Uninterpreted (DomainTypeEntity a)) where
  zipTablesI :: forall (m :: * -> *) be (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> Interpret
     (DefaultInterpretation f) (Uninterpreted (DomainTypeEntity a))
-> Interpret
     (DefaultInterpretation g) (Uninterpreted (DomainTypeEntity a))
-> m (Interpret
        (DefaultInterpretation h) (Uninterpreted (DomainTypeEntity a)))
zipTablesI Proxy be
_ forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
f = (Interpreted
   (DefaultInterpretation f) (Uninterpreted (DomainTypeEntity a))
 -> Interpreted
      (DefaultInterpretation g) (Uninterpreted (DomainTypeEntity a))
 -> m (Interpreted
         (DefaultInterpretation h) (Uninterpreted (DomainTypeEntity a))))
-> Interpret
     (DefaultInterpretation f) (Uninterpreted (DomainTypeEntity a))
-> Interpret
     (DefaultInterpretation g) (Uninterpreted (DomainTypeEntity a))
-> m (Interpret
        (DefaultInterpretation h) (Uninterpreted (DomainTypeEntity a)))
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 f (DomainTypeEntity a)
-> g (DomainTypeEntity a) -> m (h (DomainTypeEntity a))
Interpreted
  (DefaultInterpretation f) (Uninterpreted (DomainTypeEntity a))
-> Interpreted
     (DefaultInterpretation g) (Uninterpreted (DomainTypeEntity a))
-> m (Interpreted
        (DefaultInterpretation h) (Uninterpreted (DomainTypeEntity a)))
forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
f