{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

module Data.Record.Beam.DbSettings (
    GAutoLargeDbSettings
  , DbSettingsI
  ) where

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

{-------------------------------------------------------------------------------
  DB settings
-------------------------------------------------------------------------------}

type GAutoLargeDbSettings be db = (
    Generic (db Uninterpreted)
  , Generic (db (DatabaseEntity be db))
  , HasNormalForm (DefaultInterpretation (DatabaseEntity be db)) (db (DatabaseEntity be db)) (db Uninterpreted)
  , Constraints (db Uninterpreted) (DbSettingsI be db)
  )

instance GAutoLargeDbSettings be db
      => (GAutoDbSettings (ThroughLRGenerics (db (DatabaseEntity be db)) ())) where
  autoDbSettings' :: ThroughLRGenerics (db (DatabaseEntity be db)) ()
autoDbSettings' = db (DatabaseEntity be db)
-> ThroughLRGenerics (db (DatabaseEntity be db)) ()
forall a p. a -> ThroughLRGenerics a p
WrapThroughLRGenerics (db (DatabaseEntity be db)
 -> ThroughLRGenerics (db (DatabaseEntity be db)) ())
-> db (DatabaseEntity be db)
-> ThroughLRGenerics (db (DatabaseEntity be db)) ()
forall a b. (a -> b) -> a -> b
$
      Rep I (db (DatabaseEntity be db)) -> db (DatabaseEntity be db)
forall a. Generic a => Rep I a -> a
to (Rep I (db (DatabaseEntity be db)) -> db (DatabaseEntity be db))
-> (Rep
      (Interpret (DefaultInterpretation (DatabaseEntity be db)))
      (db Uninterpreted)
    -> Rep I (db (DatabaseEntity be db)))
-> Rep
     (Interpret (DefaultInterpretation (DatabaseEntity be db)))
     (db Uninterpreted)
-> db (DatabaseEntity be db)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy DefaultInterpretation
-> Rep
     (Interpret (DefaultInterpretation (DatabaseEntity be db)))
     (db Uninterpreted)
-> Rep I (db (DatabaseEntity be db))
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) (Rep
   (Interpret (DefaultInterpretation (DatabaseEntity be db)))
   (db Uninterpreted)
 -> db (DatabaseEntity be db))
-> Rep
     (Interpret (DefaultInterpretation (DatabaseEntity be db)))
     (db Uninterpreted)
-> db (DatabaseEntity be db)
forall a b. (a -> b) -> a -> b
$
        Proxy (DbSettingsI be db)
-> (forall x.
    DbSettingsI be db x =>
    GhcFieldMetadata x
    -> Interpret (DefaultInterpretation (DatabaseEntity be db)) x)
-> Rep GhcFieldMetadata (db Uninterpreted)
-> Rep
     (Interpret (DefaultInterpretation (DatabaseEntity be db)))
     (db Uninterpreted)
forall a (c :: * -> Constraint) (f :: * -> *) (g :: * -> *).
(Generic a, Constraints a c) =>
Proxy c -> (forall x. c x => f x -> g x) -> Rep f a -> Rep g a
Rep.cmap
          (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @(DbSettingsI be db))
          GhcFieldMetadata x
-> Interpret (DefaultInterpretation (DatabaseEntity be db)) x
forall x.
DbSettingsI be db x =>
GhcFieldMetadata x
-> Interpret (DefaultInterpretation (DatabaseEntity be db)) x
forall be (db :: (* -> *) -> *) x.
DbSettingsI be db x =>
GhcFieldMetadata x
-> Interpret (DefaultInterpretation (DatabaseEntity be db)) x
dbSettingsI
          (GhcMetadata (db Uninterpreted)
-> Rep GhcFieldMetadata (db Uninterpreted)
forall a. GhcMetadata a -> Rep GhcFieldMetadata a
ghcMetadataFields (Proxy (db Uninterpreted) -> GhcMetadata (db Uninterpreted)
forall a (proxy :: * -> *). Generic a => proxy a -> GhcMetadata a
ghcMetadata (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(db Uninterpreted))))

class DbSettingsI be db x where
  dbSettingsI ::
       GhcFieldMetadata x
    -> Interpret (DefaultInterpretation (DatabaseEntity be db)) x

instance (IsDatabaseEntity be x, DatabaseEntityDefaultRequirements be x)
      => DbSettingsI be db (Uninterpreted x) where
  dbSettingsI :: GhcFieldMetadata (Uninterpreted x)
-> Interpret
     (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x)
dbSettingsI (GhcFieldMetadata Proxy f
p) = Interpreted
  (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x)
-> Interpret
     (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x)
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (Interpreted
   (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x)
 -> Interpret
      (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x))
-> Interpreted
     (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x)
-> Interpret
     (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x)
forall a b. (a -> b) -> a -> b
$ K1 R (DatabaseEntity be db x) Any -> DatabaseEntity be db x
K1 R (DatabaseEntity be db x) Any
-> Interpreted
     (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x)
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R (DatabaseEntity be db x) Any
 -> Interpreted
      (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x))
-> (M1 S f (K1 R (DatabaseEntity be db x)) Any
    -> K1 R (DatabaseEntity be db x) Any)
-> M1 S f (K1 R (DatabaseEntity be db x)) Any
-> Interpreted
     (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S f (K1 R (DatabaseEntity be db x)) Any
-> K1 R (DatabaseEntity be db x) Any
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 S f (K1 R (DatabaseEntity be db x)) Any
 -> Interpreted
      (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x))
-> M1 S f (K1 R (DatabaseEntity be db x)) Any
-> Interpreted
     (DefaultInterpretation (DatabaseEntity be db)) (Uninterpreted x)
forall a b. (a -> b) -> a -> b
$ Proxy f -> M1 S f (K1 R (DatabaseEntity be db x)) Any
forall (f :: Meta) p.
Selector f =>
Proxy f -> S1 f (K1 R (DatabaseEntity be db x)) p
fromBeam Proxy f
p
    where
      fromBeam ::
           Selector f
        => Proxy f
        -> S1 f (K1 R (DatabaseEntity be db x)) p
      fromBeam :: forall (f :: Meta) p.
Selector f =>
Proxy f -> S1 f (K1 R (DatabaseEntity be db x)) p
fromBeam Proxy f
_ = S1 f (K1 R (DatabaseEntity be db x)) p
forall x. GAutoDbSettings x => x
autoDbSettings'

{-------------------------------------------------------------------------------
  Table settings
-------------------------------------------------------------------------------}

type GDefaultLargeTableFieldSettings tbl sub = (
    Generic (tbl (TableField sub))
  , Generic (tbl Uninterpreted)
  , HasNormalForm (BeamInterpretation (TableField sub)) (tbl (TableField sub)) (tbl Uninterpreted)
  , Constraints (tbl Uninterpreted) (TableSettingsI sub)
  )

instance GDefaultLargeTableFieldSettings tbl sub
      => GDefaultTableFieldSettings (ThroughLRGenerics (tbl (TableField sub)) ())
  where
    gDefTblFieldSettings :: Proxy (ThroughLRGenerics (tbl (TableField sub)) ())
-> ThroughLRGenerics (tbl (TableField sub)) ()
gDefTblFieldSettings Proxy (ThroughLRGenerics (tbl (TableField sub)) ())
_ = tbl (TableField sub) -> ThroughLRGenerics (tbl (TableField sub)) ()
forall a p. a -> ThroughLRGenerics a p
WrapThroughLRGenerics (tbl (TableField sub)
 -> ThroughLRGenerics (tbl (TableField sub)) ())
-> tbl (TableField sub)
-> ThroughLRGenerics (tbl (TableField sub)) ()
forall a b. (a -> b) -> a -> b
$
        Rep I (tbl (TableField sub)) -> tbl (TableField sub)
forall a. Generic a => Rep I a -> a
to (Rep I (tbl (TableField sub)) -> tbl (TableField sub))
-> (Rep
      (Interpret (BeamInterpretation (TableField sub)))
      (tbl Uninterpreted)
    -> Rep I (tbl (TableField sub)))
-> Rep
     (Interpret (BeamInterpretation (TableField sub)))
     (tbl Uninterpreted)
-> tbl (TableField sub)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy BeamInterpretation
-> Rep
     (Interpret (BeamInterpretation (TableField sub)))
     (tbl Uninterpreted)
-> Rep I (tbl (TableField sub))
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 (TableField sub)))
   (tbl Uninterpreted)
 -> tbl (TableField sub))
-> Rep
     (Interpret (BeamInterpretation (TableField sub)))
     (tbl Uninterpreted)
-> tbl (TableField sub)
forall a b. (a -> b) -> a -> b
$
          Proxy (TableSettingsI sub)
-> (forall x.
    TableSettingsI sub x =>
    GhcFieldMetadata x
    -> Interpret (BeamInterpretation (TableField sub)) x)
-> Rep GhcFieldMetadata (tbl Uninterpreted)
-> Rep
     (Interpret (BeamInterpretation (TableField sub)))
     (tbl Uninterpreted)
forall a (c :: * -> Constraint) (f :: * -> *) (g :: * -> *).
(Generic a, Constraints a c) =>
Proxy c -> (forall x. c x => f x -> g x) -> Rep f a -> Rep g a
Rep.cmap
            (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @(TableSettingsI sub))
            GhcFieldMetadata x
-> Interpret (BeamInterpretation (TableField sub)) x
forall x.
TableSettingsI sub x =>
GhcFieldMetadata x
-> Interpret (BeamInterpretation (TableField sub)) x
forall (tbl :: (* -> *) -> *) x.
TableSettingsI tbl x =>
GhcFieldMetadata x
-> Interpret (BeamInterpretation (TableField tbl)) x
tableSettingsI
            (GhcMetadata (tbl Uninterpreted)
-> Rep GhcFieldMetadata (tbl Uninterpreted)
forall a. GhcMetadata a -> Rep GhcFieldMetadata a
ghcMetadataFields (Proxy (tbl Uninterpreted) -> GhcMetadata (tbl Uninterpreted)
forall a (proxy :: * -> *). Generic a => proxy a -> GhcMetadata a
ghcMetadata (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(tbl Uninterpreted))))

class TableSettingsI tbl x where
  tableSettingsI ::
       GhcFieldMetadata x
    -> Interpret (BeamInterpretation (TableField tbl)) x

instance TableSettingsI tbl (Uninterpreted x) where
  tableSettingsI :: GhcFieldMetadata (Uninterpreted x)
-> Interpret
     (BeamInterpretation (TableField tbl)) (Uninterpreted x)
tableSettingsI (GhcFieldMetadata Proxy f
p) = Interpreted (BeamInterpretation (TableField tbl)) (Uninterpreted x)
-> Interpret
     (BeamInterpretation (TableField tbl)) (Uninterpreted x)
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (Interpreted
   (BeamInterpretation (TableField tbl)) (Uninterpreted x)
 -> Interpret
      (BeamInterpretation (TableField tbl)) (Uninterpreted x))
-> Interpreted
     (BeamInterpretation (TableField tbl)) (Uninterpreted x)
-> Interpret
     (BeamInterpretation (TableField tbl)) (Uninterpreted x)
forall a b. (a -> b) -> a -> b
$ K1 R (TableField tbl x) Any -> TableField tbl x
K1 R (TableField tbl x) Any
-> Interpreted
     (BeamInterpretation (TableField tbl)) (Uninterpreted x)
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R (TableField tbl x) Any
 -> Interpreted
      (BeamInterpretation (TableField tbl)) (Uninterpreted x))
-> (M1 S f (K1 R (TableField tbl x)) Any
    -> K1 R (TableField tbl x) Any)
-> M1 S f (K1 R (TableField tbl x)) Any
-> Interpreted
     (BeamInterpretation (TableField tbl)) (Uninterpreted x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S f (K1 R (TableField tbl x)) Any -> K1 R (TableField tbl x) Any
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 S f (K1 R (TableField tbl x)) Any
 -> Interpreted
      (BeamInterpretation (TableField tbl)) (Uninterpreted x))
-> M1 S f (K1 R (TableField tbl x)) Any
-> Interpreted
     (BeamInterpretation (TableField tbl)) (Uninterpreted x)
forall a b. (a -> b) -> a -> b
$ Proxy f -> M1 S f (K1 R (TableField tbl x)) Any
forall (f :: Meta) p.
Selector f =>
Proxy f -> S1 f (K1 R (TableField tbl x)) p
fromBeam Proxy f
p
    where
      fromBeam :: Selector f => Proxy f -> S1 f (K1 R (TableField tbl x)) p
      fromBeam :: forall (f :: Meta) p.
Selector f =>
Proxy f -> S1 f (K1 R (TableField tbl x)) p
fromBeam Proxy f
_ = Proxy (S1 f (K1 R (TableField tbl x)) p)
-> S1 f (K1 R (TableField tbl x)) p
forall x. GDefaultTableFieldSettings x => Proxy x -> x
gDefTblFieldSettings Proxy (S1 f (K1 R (TableField tbl x)) p)
forall {k} (t :: k). Proxy t
Proxy

instance ( ChooseSubTableStrategy tbl sub ~ strategy
         , SubTableStrategyImpl strategy (TableField tbl) sub
         , Beamable sub
         ) => TableSettingsI tbl (sub Uninterpreted) where
  tableSettingsI :: GhcFieldMetadata (sub Uninterpreted)
-> Interpret
     (BeamInterpretation (TableField tbl)) (sub Uninterpreted)
tableSettingsI (GhcFieldMetadata Proxy f
p) = Interpreted
  (BeamInterpretation (TableField tbl)) (sub Uninterpreted)
-> Interpret
     (BeamInterpretation (TableField tbl)) (sub Uninterpreted)
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (Interpreted
   (BeamInterpretation (TableField tbl)) (sub Uninterpreted)
 -> Interpret
      (BeamInterpretation (TableField tbl)) (sub Uninterpreted))
-> Interpreted
     (BeamInterpretation (TableField tbl)) (sub Uninterpreted)
-> Interpret
     (BeamInterpretation (TableField tbl)) (sub Uninterpreted)
forall a b. (a -> b) -> a -> b
$ K1 R (sub (TableField tbl)) Any -> sub (TableField tbl)
K1 R (sub (TableField tbl)) Any
-> Interpreted
     (BeamInterpretation (TableField tbl)) (sub Uninterpreted)
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R (sub (TableField tbl)) Any
 -> Interpreted
      (BeamInterpretation (TableField tbl)) (sub Uninterpreted))
-> (M1 S f (K1 R (sub (TableField tbl))) Any
    -> K1 R (sub (TableField tbl)) Any)
-> M1 S f (K1 R (sub (TableField tbl))) Any
-> Interpreted
     (BeamInterpretation (TableField tbl)) (sub Uninterpreted)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S f (K1 R (sub (TableField tbl))) Any
-> K1 R (sub (TableField tbl)) Any
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 S f (K1 R (sub (TableField tbl))) Any
 -> Interpreted
      (BeamInterpretation (TableField tbl)) (sub Uninterpreted))
-> M1 S f (K1 R (sub (TableField tbl))) Any
-> Interpreted
     (BeamInterpretation (TableField tbl)) (sub Uninterpreted)
forall a b. (a -> b) -> a -> b
$ Proxy f -> M1 S f (K1 R (sub (TableField tbl))) Any
forall (f :: Meta) p.
Selector f =>
Proxy f -> S1 f (K1 R (sub (TableField tbl))) p
fromBeam Proxy f
p
    where
      fromBeam :: Selector f => Proxy f -> S1 f (K1 R (sub (TableField tbl))) p
      fromBeam :: forall (f :: Meta) p.
Selector f =>
Proxy f -> S1 f (K1 R (sub (TableField tbl))) p
fromBeam Proxy f
_ = Proxy (S1 f (K1 R (sub (TableField tbl))) p)
-> S1 f (K1 R (sub (TableField tbl))) p
forall x. GDefaultTableFieldSettings x => Proxy x -> x
gDefTblFieldSettings Proxy (S1 f (K1 R (sub (TableField tbl))) p)
forall {k} (t :: k). Proxy t
Proxy

instance ( ChooseSubTableStrategy tbl sub ~ strategy
         , SubTableStrategyImpl strategy (Nullable (TableField tbl)) sub
         , Beamable sub
         ) => TableSettingsI tbl (sub (Nullable Uninterpreted)) where
  tableSettingsI :: GhcFieldMetadata (sub (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation (TableField tbl))
     (sub (Nullable Uninterpreted))
tableSettingsI (GhcFieldMetadata Proxy f
p) = Interpreted
  (BeamInterpretation (TableField tbl))
  (sub (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation (TableField tbl))
     (sub (Nullable Uninterpreted))
forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret (Interpreted
   (BeamInterpretation (TableField tbl))
   (sub (Nullable Uninterpreted))
 -> Interpret
      (BeamInterpretation (TableField tbl))
      (sub (Nullable Uninterpreted)))
-> Interpreted
     (BeamInterpretation (TableField tbl))
     (sub (Nullable Uninterpreted))
-> Interpret
     (BeamInterpretation (TableField tbl))
     (sub (Nullable Uninterpreted))
forall a b. (a -> b) -> a -> b
$ K1 R (sub (Nullable (TableField tbl))) Any
-> sub (Nullable (TableField tbl))
K1 R (sub (Nullable (TableField tbl))) Any
-> Interpreted
     (BeamInterpretation (TableField tbl))
     (sub (Nullable Uninterpreted))
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R (sub (Nullable (TableField tbl))) Any
 -> Interpreted
      (BeamInterpretation (TableField tbl))
      (sub (Nullable Uninterpreted)))
-> (M1 S f (K1 R (sub (Nullable (TableField tbl)))) Any
    -> K1 R (sub (Nullable (TableField tbl))) Any)
-> M1 S f (K1 R (sub (Nullable (TableField tbl)))) Any
-> Interpreted
     (BeamInterpretation (TableField tbl))
     (sub (Nullable Uninterpreted))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S f (K1 R (sub (Nullable (TableField tbl)))) Any
-> K1 R (sub (Nullable (TableField tbl))) Any
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 S f (K1 R (sub (Nullable (TableField tbl)))) Any
 -> Interpreted
      (BeamInterpretation (TableField tbl))
      (sub (Nullable Uninterpreted)))
-> M1 S f (K1 R (sub (Nullable (TableField tbl)))) Any
-> Interpreted
     (BeamInterpretation (TableField tbl))
     (sub (Nullable Uninterpreted))
forall a b. (a -> b) -> a -> b
$ Proxy f -> M1 S f (K1 R (sub (Nullable (TableField tbl)))) Any
forall (f :: Meta) p.
Selector f =>
Proxy f -> S1 f (K1 R (sub (Nullable (TableField tbl)))) p
fromBeam Proxy f
p
    where
      fromBeam :: Selector f => Proxy f -> S1 f (K1 R (sub (Nullable (TableField tbl)))) p
      fromBeam :: forall (f :: Meta) p.
Selector f =>
Proxy f -> S1 f (K1 R (sub (Nullable (TableField tbl)))) p
fromBeam Proxy f
_ = Proxy (S1 f (K1 R (sub (Nullable (TableField tbl)))) p)
-> S1 f (K1 R (sub (Nullable (TableField tbl)))) p
forall x. GDefaultTableFieldSettings x => Proxy x -> x
gDefTblFieldSettings Proxy (S1 f (K1 R (sub (Nullable (TableField tbl)))) p)
forall {k} (t :: k). Proxy t
Proxy