{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables  #-}

module Data.Record.Beam.Skeleton (
    GLargeTableSkeleton
  , TblSkeletonI
  ) where

import Data.Proxy
import Data.Record.Generic
import Data.Record.Generic.GHC
import Data.Record.Generic.Transform
import Database.Beam.Schema.Tables
import GHC.Generics hiding (Generic(..))

import qualified Data.Record.Generic.Rep as Rep

import Data.Record.Beam.Interpretation

type GLargeTableSkeleton tbl = (
    Generic (tbl Ignored)
  , Generic (tbl Uninterpreted)
  , Constraints (tbl Uninterpreted) TblSkeletonI
  , HasNormalForm (BeamInterpretation Ignored) (tbl Ignored) (tbl Uninterpreted)
  )

instance GLargeTableSkeleton tbl
      => GTableSkeleton (ThroughLRGenerics (tbl Ignored)) where
  gTblSkeleton :: Proxy (ThroughLRGenerics (tbl Ignored))
-> ThroughLRGenerics (tbl Ignored) ()
gTblSkeleton Proxy (ThroughLRGenerics (tbl Ignored))
_ =
    tbl Ignored -> ThroughLRGenerics (tbl Ignored) ()
forall a p. a -> ThroughLRGenerics a p
WrapThroughLRGenerics (tbl Ignored -> ThroughLRGenerics (tbl Ignored) ())
-> (Rep
      (Interpret (BeamInterpretation Ignored)) (tbl Uninterpreted)
    -> tbl Ignored)
-> Rep (Interpret (BeamInterpretation Ignored)) (tbl Uninterpreted)
-> ThroughLRGenerics (tbl Ignored) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep I (tbl Ignored) -> tbl Ignored
forall a. Generic a => Rep I a -> a
to (Rep I (tbl Ignored) -> tbl Ignored)
-> (Rep
      (Interpret (BeamInterpretation Ignored)) (tbl Uninterpreted)
    -> Rep I (tbl Ignored))
-> Rep (Interpret (BeamInterpretation Ignored)) (tbl Uninterpreted)
-> tbl Ignored
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy BeamInterpretation
-> Rep (Interpret (BeamInterpretation Ignored)) (tbl Uninterpreted)
-> Rep I (tbl Ignored)
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) (Rep (Interpret (BeamInterpretation Ignored)) (tbl Uninterpreted)
 -> ThroughLRGenerics (tbl Ignored) ())
-> Rep (Interpret (BeamInterpretation Ignored)) (tbl Uninterpreted)
-> ThroughLRGenerics (tbl Ignored) ()
forall a b. (a -> b) -> a -> b
$
      Proxy TblSkeletonI
-> (forall x.
    TblSkeletonI x =>
    Interpret (BeamInterpretation Ignored) x)
-> Rep (Interpret (BeamInterpretation Ignored)) (tbl Uninterpreted)
forall a (c :: * -> Constraint) (f :: * -> *).
(Generic a, Constraints a c) =>
Proxy c -> (forall x. c x => f x) -> Rep f a
Rep.cpure (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @TblSkeletonI) Interpret (BeamInterpretation Ignored) x
forall x.
TblSkeletonI x =>
Interpret (BeamInterpretation Ignored) x
tblSkeletonI

{-------------------------------------------------------------------------------
  Cases for 'gTblSkeleton'

  The 'BeamInterpretation' makes it possible to mirror the case distinction
  that beam is using in the 'GTableSkeleton' instances.
-------------------------------------------------------------------------------}

class TblSkeletonI a where
  tblSkeletonI :: Interpret (BeamInterpretation Ignored) a

instance TblSkeletonI (Uninterpreted x) where
  tblSkeletonI :: Interpret (BeamInterpretation Ignored) (Uninterpreted x)
tblSkeletonI = Interpreted (BeamInterpretation Ignored) (Uninterpreted x)
-> Interpret (BeamInterpretation Ignored) (Uninterpreted x)
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (Interpreted (BeamInterpretation Ignored) (Uninterpreted x)
 -> Interpret (BeamInterpretation Ignored) (Uninterpreted x))
-> Interpreted (BeamInterpretation Ignored) (Uninterpreted x)
-> Interpret (BeamInterpretation Ignored) (Uninterpreted x)
forall a b. (a -> b) -> a -> b
$ K1 R (Ignored x) () -> Ignored x
forall k i c (p :: k). K1 i c p -> c
unK1 K1 R (Ignored x) ()
forall field. K1 R (Ignored field) ()
fromBeam
    where
      fromBeam :: K1 R (Ignored field) ()
      fromBeam :: forall field. K1 R (Ignored field) ()
fromBeam = Proxy (K1 R (Ignored field)) -> K1 R (Ignored field) ()
forall (x :: * -> *). GTableSkeleton x => Proxy x -> x ()
gTblSkeleton Proxy (K1 R (Ignored field))
forall {k} (t :: k). Proxy t
Proxy

instance Beamable tbl => TblSkeletonI (tbl Uninterpreted) where
  tblSkeletonI :: Interpret (BeamInterpretation Ignored) (tbl Uninterpreted)
tblSkeletonI = Interpreted (BeamInterpretation Ignored) (tbl Uninterpreted)
-> Interpret (BeamInterpretation Ignored) (tbl Uninterpreted)
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (Interpreted (BeamInterpretation Ignored) (tbl Uninterpreted)
 -> Interpret (BeamInterpretation Ignored) (tbl Uninterpreted))
-> Interpreted (BeamInterpretation Ignored) (tbl Uninterpreted)
-> Interpret (BeamInterpretation Ignored) (tbl Uninterpreted)
forall a b. (a -> b) -> a -> b
$ K1 R (tbl Ignored) () -> tbl Ignored
forall k i c (p :: k). K1 i c p -> c
unK1 K1 R (tbl Ignored) ()
fromBeam
    where
      fromBeam :: K1 R (tbl Ignored) ()
      fromBeam :: K1 R (tbl Ignored) ()
fromBeam = Proxy (K1 R (tbl Ignored)) -> K1 R (tbl Ignored) ()
forall (x :: * -> *). GTableSkeleton x => Proxy x -> x ()
gTblSkeleton Proxy (K1 R (tbl Ignored))
forall {k} (t :: k). Proxy t
Proxy

instance Beamable tbl => TblSkeletonI (tbl (Nullable Uninterpreted)) where
  tblSkeletonI :: Interpret
  (BeamInterpretation Ignored) (tbl (Nullable Uninterpreted))
tblSkeletonI = Interpreted
  (BeamInterpretation Ignored) (tbl (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation Ignored) (tbl (Nullable Uninterpreted))
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (Interpreted
   (BeamInterpretation Ignored) (tbl (Nullable Uninterpreted))
 -> Interpret
      (BeamInterpretation Ignored) (tbl (Nullable Uninterpreted)))
-> Interpreted
     (BeamInterpretation Ignored) (tbl (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation Ignored) (tbl (Nullable Uninterpreted))
forall a b. (a -> b) -> a -> b
$ K1 R (tbl (Nullable Ignored)) () -> tbl (Nullable Ignored)
forall k i c (p :: k). K1 i c p -> c
unK1 K1 R (tbl (Nullable Ignored)) ()
fromBeam
    where
      fromBeam :: K1 R (tbl (Nullable Ignored)) ()
      fromBeam :: K1 R (tbl (Nullable Ignored)) ()
fromBeam = Proxy (K1 R (tbl (Nullable Ignored)))
-> K1 R (tbl (Nullable Ignored)) ()
forall (x :: * -> *). GTableSkeleton x => Proxy x -> x ()
gTblSkeleton Proxy (K1 R (tbl (Nullable Ignored)))
forall {k} (t :: k). Proxy t
Proxy