{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

module Database.Beam.AutoMigrate.Generic where

import Data.Bifunctor
import Data.Kind
import qualified Data.List as L
import qualified Data.Map.Strict as M
import Data.Proxy
import qualified Data.Set as S
import Database.Beam.AutoMigrate.Annotated
import Database.Beam.AutoMigrate.Compat
import Database.Beam.AutoMigrate.Types
import Database.Beam.AutoMigrate.Util (pkFieldNames)
import Database.Beam.Schema (PrimaryKey, TableEntity)
import qualified Database.Beam.Schema as Beam
import Database.Beam.Schema.Tables (Beamable (..), dbEntityDescriptor, dbEntityName)
import GHC.Generics
import GHC.TypeLits
import Lens.Micro ((^.))

--
--- Machinery to derive a 'Schema' from a 'DatabaseSettings'.
--

class GSchema be db (anns :: [Annotation]) (x :: * -> *) where
  gSchema :: AnnotatedDatabaseSettings be db -> Proxy anns -> x p -> Schema

-- Table-specific classes

class GTables be db (anns :: [Annotation]) (x :: * -> *) where
  gTables :: AnnotatedDatabaseSettings be db -> Proxy anns -> x p -> (Tables, Sequences)

class GTableEntry (be :: *) (db :: DatabaseKind) (anns :: [Annotation]) (tableFound :: Bool) (x :: * -> *) where
  gTableEntries ::
    AnnotatedDatabaseSettings be db ->
    Proxy anns ->
    Proxy tableFound ->
    x p ->
    ([(TableName, Table)], Sequences)

class GTable be db (x :: * -> *) where
  gTable :: AnnotatedDatabaseSettings be db -> x p -> Table

-- Enumerations-specific classes

class GEnums be db x where
  gEnums :: AnnotatedDatabaseSettings be db -> x p -> Enumerations

-- Column-specific classes

-- | Type-level witness of whether or not we have to generate an extra \"SEQUENCE\" in case the table
--  field is a 'SqlSerial'.
data GenSequencesForSerial
  = GenSequences
  | NoGenSequences

class GColumns (genSeqs :: GenSequencesForSerial) (x :: * -> *) where
  gColumns :: Proxy genSeqs -> TableName -> x p -> (Columns, Sequences)

class GTableConstraintColumns be db x where
  gTableConstraintsColumns :: AnnotatedDatabaseSettings be db -> TableName -> x p -> S.Set TableConstraint

--
-- Deriving information about 'Schema's
--

instance GSchema be db anns x => GSchema be db anns (D1 f x) where
  gSchema :: AnnotatedDatabaseSettings be db -> Proxy anns -> D1 f x p -> Schema
gSchema AnnotatedDatabaseSettings be db
db Proxy anns
p (M1 x p
x) = AnnotatedDatabaseSettings be db -> Proxy anns -> x p -> Schema
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (x :: * -> *) p.
GSchema be db anns x =>
AnnotatedDatabaseSettings be db -> Proxy anns -> x p -> Schema
gSchema AnnotatedDatabaseSettings be db
db Proxy anns
p x p
x

instance
  ( Constructor f,
    GTables be db anns x,
    GEnums be db x
  ) =>
  GSchema be db anns (C1 f x)
  where
  gSchema :: AnnotatedDatabaseSettings be db -> Proxy anns -> C1 f x p -> Schema
gSchema AnnotatedDatabaseSettings be db
db Proxy anns
p (M1 x p
x) =
    let (Tables
tables, Sequences
sequences) = AnnotatedDatabaseSettings be db
-> Proxy anns -> x p -> (Tables, Sequences)
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (x :: * -> *) p.
GTables be db anns x =>
AnnotatedDatabaseSettings be db
-> Proxy anns -> x p -> (Tables, Sequences)
gTables AnnotatedDatabaseSettings be db
db Proxy anns
p x p
x
     in Schema :: Tables -> Enumerations -> Sequences -> Schema
Schema
          { schemaTables :: Tables
schemaTables = Tables
tables,
            schemaEnumerations :: Enumerations
schemaEnumerations = AnnotatedDatabaseSettings be db -> x p -> Enumerations
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GEnums be db x =>
AnnotatedDatabaseSettings be db -> x p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db x p
x,
            schemaSequences :: Sequences
schemaSequences = Sequences
sequences
          }

--
-- Deriving information about 'Enums'.
--

instance GEnums be db x => GEnums be db (D1 f x) where
  gEnums :: AnnotatedDatabaseSettings be db -> D1 f x p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db (M1 x p
x) = AnnotatedDatabaseSettings be db -> x p -> Enumerations
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GEnums be db x =>
AnnotatedDatabaseSettings be db -> x p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db x p
x

instance GEnums be db x => GEnums be db (C1 f x) where
  gEnums :: AnnotatedDatabaseSettings be db -> C1 f x p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db (M1 x p
x) = AnnotatedDatabaseSettings be db -> x p -> Enumerations
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GEnums be db x =>
AnnotatedDatabaseSettings be db -> x p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db x p
x

instance (GEnums be db a, GEnums be db b) => GEnums be db (a :*: b) where
  gEnums :: AnnotatedDatabaseSettings be db -> (:*:) a b p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db (a p
a :*: b p
b) = AnnotatedDatabaseSettings be db -> a p -> Enumerations
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GEnums be db x =>
AnnotatedDatabaseSettings be db -> x p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db a p
a Enumerations -> Enumerations -> Enumerations
forall a. Semigroup a => a -> a -> a
<> AnnotatedDatabaseSettings be db -> b p -> Enumerations
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GEnums be db x =>
AnnotatedDatabaseSettings be db -> x p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db b p
b

instance
  ( IsAnnotatedDatabaseEntity be (TableEntity tbl),
    Beam.Table tbl,
    GEnums be db (Rep (TableSchema tbl)),
    Generic (TableSchema tbl)
  ) =>
  GEnums be db (S1 f (K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl))))
  where
  gEnums :: AnnotatedDatabaseSettings be db
-> S1 f (K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl))) p
-> Enumerations
gEnums AnnotatedDatabaseSettings be db
db (M1 (K1 AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity)) =
    AnnotatedDatabaseSettings be db
-> Rep (TableSchema tbl) Any -> Enumerations
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GEnums be db x =>
AnnotatedDatabaseSettings be db -> x p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db (TableSchema tbl -> Rep (TableSchema tbl) Any
forall a x. Generic a => a -> Rep a x
from (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> TableSchema tbl
forall be (tbl :: (* -> *) -> *).
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> TableSchema tbl
dbAnnotatedSchema (AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity AnnotatedDatabaseEntity be db (TableEntity tbl)
-> Getting
     (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
     (AnnotatedDatabaseEntity be db (TableEntity tbl))
     (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
-> AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
forall s a. s -> Getting a s a -> a
^. Getting
  (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
  (AnnotatedDatabaseEntity be db (TableEntity tbl))
  (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
  (AnnotatedDatabaseEntity be db entityType)
  (AnnotatedDatabaseEntityDescriptor be entityType)
annotatedDescriptor)))

instance
  {-# OVERLAPS #-}
  (GEnums be db (Rep (sub f)), Generic (sub f)) =>
  GEnums be db (S1 m (K1 R (sub f)))
  where
  gEnums :: AnnotatedDatabaseSettings be db
-> S1 m (K1 R (sub f)) p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db (M1 (K1 sub f
e)) = AnnotatedDatabaseSettings be db -> Rep (sub f) Any -> Enumerations
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GEnums be db x =>
AnnotatedDatabaseSettings be db -> x p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
db (sub f -> Rep (sub f) Any
forall a x. Generic a => a -> Rep a x
from sub f
e)

instance HasColumnType ty => GEnums be db (S1 f (K1 R (TableFieldSchema tbl ty))) where
  gEnums :: AnnotatedDatabaseSettings be db
-> S1 f (K1 R (TableFieldSchema tbl ty)) p -> Enumerations
gEnums AnnotatedDatabaseSettings be db
_ (M1 (K1 TableFieldSchema tbl ty
_)) = Proxy ty -> Enumerations
forall ty. HasColumnType ty => Proxy ty -> Enumerations
defaultEnums (Proxy ty
forall k (t :: k). Proxy t
Proxy @ty)

-- primary-key-wrapped types do not yield any enumerations.

instance GEnums be db (S1 f (K1 R (PrimaryKey tbl1 (TableFieldSchema tbl2)))) where
  gEnums :: AnnotatedDatabaseSettings be db
-> S1 f (K1 R (PrimaryKey tbl1 (TableFieldSchema tbl2))) p
-> Enumerations
gEnums AnnotatedDatabaseSettings be db
_ (M1 (K1 PrimaryKey tbl1 (TableFieldSchema tbl2)
_)) = Enumerations
forall a. Monoid a => a
mempty

instance GEnums be db (S1 f (K1 R (PrimaryKey tbl1 (g (TableFieldSchema tbl2))))) where
  gEnums :: AnnotatedDatabaseSettings be db
-> S1 f (K1 R (PrimaryKey tbl1 (g (TableFieldSchema tbl2)))) p
-> Enumerations
gEnums AnnotatedDatabaseSettings be db
_ (M1 (K1 PrimaryKey tbl1 (g (TableFieldSchema tbl2))
_)) = Enumerations
forall a. Monoid a => a
mempty

--
-- Deriving information about 'Table's.
--

instance GTableEntry be db anns 'False (S1 f x) => GTables be db anns (S1 f x) where
  gTables :: AnnotatedDatabaseSettings be db
-> Proxy anns -> S1 f x p -> (Tables, Sequences)
gTables AnnotatedDatabaseSettings be db
db Proxy anns
p S1 f x p
x =
    let ([(TableName, Table)]
tbls, Sequences
sqs) = AnnotatedDatabaseSettings be db
-> Proxy anns
-> Proxy 'False
-> S1 f x p
-> ([(TableName, Table)], Sequences)
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (tableFound :: Bool) (x :: * -> *) p.
GTableEntry be db anns tableFound x =>
AnnotatedDatabaseSettings be db
-> Proxy anns
-> Proxy tableFound
-> x p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be db
db Proxy anns
p (Proxy 'False
forall k (t :: k). Proxy t
Proxy @'False) S1 f x p
x
     in ([(TableName, Table)] -> Tables
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(TableName, Table)]
tbls, Sequences
sqs)

instance GTableEntry be db anns tableFound x => GTableEntry be db anns tableFound (S1 f x) where
  gTableEntries :: AnnotatedDatabaseSettings be db
-> Proxy anns
-> Proxy tableFound
-> S1 f x p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be db
db Proxy anns
p1 Proxy tableFound
p2 (M1 x p
x) = AnnotatedDatabaseSettings be db
-> Proxy anns
-> Proxy tableFound
-> x p
-> ([(TableName, Table)], Sequences)
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (tableFound :: Bool) (x :: * -> *) p.
GTableEntry be db anns tableFound x =>
AnnotatedDatabaseSettings be db
-> Proxy anns
-> Proxy tableFound
-> x p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be db
db Proxy anns
p1 Proxy tableFound
p2 x p
x

instance (GTables be db anns a, GTables be db anns b) => GTables be db anns (a :*: b) where
  gTables :: AnnotatedDatabaseSettings be db
-> Proxy anns -> (:*:) a b p -> (Tables, Sequences)
gTables AnnotatedDatabaseSettings be db
db Proxy anns
p (a p
a :*: b p
b) = AnnotatedDatabaseSettings be db
-> Proxy anns -> a p -> (Tables, Sequences)
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (x :: * -> *) p.
GTables be db anns x =>
AnnotatedDatabaseSettings be db
-> Proxy anns -> x p -> (Tables, Sequences)
gTables AnnotatedDatabaseSettings be db
db Proxy anns
p a p
a (Tables, Sequences) -> (Tables, Sequences) -> (Tables, Sequences)
forall a. Semigroup a => a -> a -> a
<> AnnotatedDatabaseSettings be db
-> Proxy anns -> b p -> (Tables, Sequences)
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (x :: * -> *) p.
GTables be db anns x =>
AnnotatedDatabaseSettings be db
-> Proxy anns -> x p -> (Tables, Sequences)
gTables AnnotatedDatabaseSettings be db
db Proxy anns
p b p
b

mkTableEntryNoFkDiscovery ::
  ( GColumns 'GenSequences (Rep (TableSchema tbl)),
    Generic (TableSchema tbl),
    Beam.Table tbl
  ) =>
  AnnotatedDatabaseEntity be db (TableEntity tbl) ->
  ((TableName, Table), Sequences)
mkTableEntryNoFkDiscovery :: AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
mkTableEntryNoFkDiscovery AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity =
  let entity :: DatabaseEntity be db (TableEntity tbl)
entity = AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity AnnotatedDatabaseEntity be db (TableEntity tbl)
-> Getting
     (DatabaseEntity be db (TableEntity tbl))
     (AnnotatedDatabaseEntity be db (TableEntity tbl))
     (DatabaseEntity be db (TableEntity tbl))
-> DatabaseEntity be db (TableEntity tbl)
forall s a. s -> Getting a s a -> a
^. Getting
  (DatabaseEntity be db (TableEntity tbl))
  (AnnotatedDatabaseEntity be db (TableEntity tbl))
  (DatabaseEntity be db (TableEntity tbl))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
  (AnnotatedDatabaseEntity be db entityType)
  (DatabaseEntity be db entityType)
deannotate
      tName :: Text
tName = DatabaseEntity be db (TableEntity tbl)
entity DatabaseEntity be db (TableEntity tbl)
-> Getting Text (DatabaseEntity be db (TableEntity tbl)) Text
-> Text
forall s a. s -> Getting a s a -> a
^. Getting
  Text
  (DatabaseEntity be db (TableEntity tbl))
  (DatabaseEntityDescriptor be (TableEntity tbl))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
  (DatabaseEntity be db entityType)
  (DatabaseEntityDescriptor be entityType)
dbEntityDescriptor Getting
  Text
  (DatabaseEntity be db (TableEntity tbl))
  (DatabaseEntityDescriptor be (TableEntity tbl))
-> ((Text -> Const Text Text)
    -> DatabaseEntityDescriptor be (TableEntity tbl)
    -> Const Text (DatabaseEntityDescriptor be (TableEntity tbl)))
-> Getting Text (DatabaseEntity be db (TableEntity tbl)) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> DatabaseEntityDescriptor be (TableEntity tbl)
-> Const Text (DatabaseEntityDescriptor be (TableEntity tbl))
forall be entityType.
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntityDescriptor be entityType) Text
dbEntityName
      pkColSet :: Set ColumnName
pkColSet = [ColumnName] -> Set ColumnName
forall a. Ord a => [a] -> Set a
S.fromList ([ColumnName] -> Set ColumnName) -> [ColumnName] -> Set ColumnName
forall a b. (a -> b) -> a -> b
$ DatabaseEntity be db (TableEntity tbl) -> [ColumnName]
forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Beamable (PrimaryKey tbl), Table tbl) =>
DatabaseEntity be db (TableEntity tbl) -> [ColumnName]
pkFieldNames DatabaseEntity be db (TableEntity tbl)
entity
      pks :: Set TableConstraint
pks = if Set ColumnName -> Bool
forall a. Set a -> Bool
S.null Set ColumnName
pkColSet then Set TableConstraint
forall a. Monoid a => a
mempty else TableConstraint -> Set TableConstraint
forall a. a -> Set a
S.singleton (Text -> Set ColumnName -> TableConstraint
PrimaryKey (Text
tName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_pkey") Set ColumnName
pkColSet)
      (Columns
columns, Sequences
seqs) = Proxy 'GenSequences
-> TableName -> Rep (TableSchema tbl) Any -> (Columns, Sequences)
forall (genSeqs :: GenSequencesForSerial) (x :: * -> *) p.
GColumns genSeqs x =>
Proxy genSeqs -> TableName -> x p -> (Columns, Sequences)
gColumns (Proxy 'GenSequences
forall k (t :: k). Proxy t
Proxy @'GenSequences) (Text -> TableName
TableName Text
tName) (Rep (TableSchema tbl) Any -> (Columns, Sequences))
-> (TableSchema tbl -> Rep (TableSchema tbl) Any)
-> TableSchema tbl
-> (Columns, Sequences)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableSchema tbl -> Rep (TableSchema tbl) Any
forall a x. Generic a => a -> Rep a x
from (TableSchema tbl -> (Columns, Sequences))
-> TableSchema tbl -> (Columns, Sequences)
forall a b. (a -> b) -> a -> b
$ AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> TableSchema tbl
forall be (tbl :: (* -> *) -> *).
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> TableSchema tbl
dbAnnotatedSchema (AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity AnnotatedDatabaseEntity be db (TableEntity tbl)
-> Getting
     (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
     (AnnotatedDatabaseEntity be db (TableEntity tbl))
     (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
-> AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
forall s a. s -> Getting a s a -> a
^. Getting
  (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
  (AnnotatedDatabaseEntity be db (TableEntity tbl))
  (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
  (AnnotatedDatabaseEntity be db entityType)
  (AnnotatedDatabaseEntityDescriptor be entityType)
annotatedDescriptor)
      annotatedCons :: Set TableConstraint
annotatedCons = AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> Set TableConstraint
forall be (tbl :: (* -> *) -> *).
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> Set TableConstraint
dbAnnotatedConstraints (AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity AnnotatedDatabaseEntity be db (TableEntity tbl)
-> Getting
     (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
     (AnnotatedDatabaseEntity be db (TableEntity tbl))
     (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
-> AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
forall s a. s -> Getting a s a -> a
^. Getting
  (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
  (AnnotatedDatabaseEntity be db (TableEntity tbl))
  (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
  (AnnotatedDatabaseEntity be db entityType)
  (AnnotatedDatabaseEntityDescriptor be entityType)
annotatedDescriptor)
   in ((Text -> TableName
TableName Text
tName, Set TableConstraint -> Columns -> Table
Table (Set TableConstraint
pks Set TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Semigroup a => a -> a -> a
<> Set TableConstraint
annotatedCons) Columns
columns), Sequences
seqs)

mkTableEntryFkDiscovery ::
  ( GColumns 'GenSequences (Rep (TableSchema tbl)),
    Generic (TableSchema tbl),
    Beam.Table tbl,
    GTableConstraintColumns be db (Rep (TableSchema tbl))
  ) =>
  AnnotatedDatabaseSettings be db ->
  AnnotatedDatabaseEntity be db (TableEntity tbl) ->
  ((TableName, Table), Sequences)
mkTableEntryFkDiscovery :: AnnotatedDatabaseSettings be db
-> AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
mkTableEntryFkDiscovery AnnotatedDatabaseSettings be db
db AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity =
  let ((TableName
tName, Table
table), Sequences
seqs) = AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
(GColumns 'GenSequences (Rep (TableSchema tbl)),
 Generic (TableSchema tbl), Table tbl) =>
AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
mkTableEntryNoFkDiscovery AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity
      discoveredCons :: Set TableConstraint
discoveredCons =
        AnnotatedDatabaseSettings be db
-> TableName -> Rep (TableSchema tbl) Any -> Set TableConstraint
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GTableConstraintColumns be db x =>
AnnotatedDatabaseSettings be db
-> TableName -> x p -> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db TableName
tName (Rep (TableSchema tbl) Any -> Set TableConstraint)
-> (TableSchema tbl -> Rep (TableSchema tbl) Any)
-> TableSchema tbl
-> Set TableConstraint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableSchema tbl -> Rep (TableSchema tbl) Any
forall a x. Generic a => a -> Rep a x
from (TableSchema tbl -> Set TableConstraint)
-> TableSchema tbl -> Set TableConstraint
forall a b. (a -> b) -> a -> b
$ AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> TableSchema tbl
forall be (tbl :: (* -> *) -> *).
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> TableSchema tbl
dbAnnotatedSchema (AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity AnnotatedDatabaseEntity be db (TableEntity tbl)
-> Getting
     (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
     (AnnotatedDatabaseEntity be db (TableEntity tbl))
     (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
-> AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
forall s a. s -> Getting a s a -> a
^. Getting
  (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
  (AnnotatedDatabaseEntity be db (TableEntity tbl))
  (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
  (AnnotatedDatabaseEntity be db entityType)
  (AnnotatedDatabaseEntityDescriptor be entityType)
annotatedDescriptor)
   in ((TableName
tName, Table
table {tableConstraints :: Set TableConstraint
tableConstraints = Set TableConstraint
discoveredCons Set TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Semigroup a => a -> a -> a
<> Table -> Set TableConstraint
tableConstraints Table
table}), Sequences
seqs)

--
-- Automatic FK-discovery algorithm starts here
--
-- The general idea is to carry around a (tableFound :: Bool) type-level witness to be used as we uncons
-- the type-level list. If we find a match, we toggle-off the FK-discovery algorithm, otherwise we don't.

instance
  ( GColumns 'GenSequences (Rep (TableSchema tbl)),
    Generic (TableSchema tbl),
    Beam.Table tbl,
    GTableEntry be db xs (TestTableEqual tbl tbl') (K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl)))
  ) =>
  GTableEntry be db (UserDefinedFk tbl' ': xs) 'False (K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl)))
  where
  gTableEntries :: AnnotatedDatabaseSettings be db
-> Proxy ('UserDefinedFk tbl' : xs)
-> Proxy 'False
-> K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl)) p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be db
_ Proxy ('UserDefinedFk tbl' : xs)
_ Proxy 'False
_ (K1 AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity) = ((TableName, Table) -> [(TableName, Table)])
-> ((TableName, Table), Sequences)
-> ([(TableName, Table)], Sequences)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TableName, Table) -> [(TableName, Table)] -> [(TableName, Table)]
forall a. a -> [a] -> [a]
: []) (AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
(GColumns 'GenSequences (Rep (TableSchema tbl)),
 Generic (TableSchema tbl), Table tbl) =>
AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
mkTableEntryNoFkDiscovery AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity)

instance
  ( GColumns 'GenSequences (Rep (TableSchema tbl)),
    Generic (TableSchema tbl),
    Beam.Table tbl
  ) =>
  GTableEntry be db (UserDefinedFk tbl' ': xs) 'True (K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl)))
  where
  gTableEntries :: AnnotatedDatabaseSettings be db
-> Proxy ('UserDefinedFk tbl' : xs)
-> Proxy 'True
-> K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl)) p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be db
_ Proxy ('UserDefinedFk tbl' : xs)
_ Proxy 'True
_ (K1 AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity) = ((TableName, Table) -> [(TableName, Table)])
-> ((TableName, Table), Sequences)
-> ([(TableName, Table)], Sequences)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TableName, Table) -> [(TableName, Table)] -> [(TableName, Table)]
forall a. a -> [a] -> [a]
: []) (AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
(GColumns 'GenSequences (Rep (TableSchema tbl)),
 Generic (TableSchema tbl), Table tbl) =>
AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
mkTableEntryNoFkDiscovery AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity)

-- At this point we explored the full list and the previous equality check yielded 'True, which means a
-- match was found. We disable the FK-discovery algorithm.

instance
  ( IsAnnotatedDatabaseEntity be (TableEntity tbl),
    GColumns 'GenSequences (Rep (TableSchema tbl)),
    Generic (TableSchema tbl),
    Beam.Table tbl
  ) =>
  GTableEntry be db '[] 'True (K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl)))
  where
  gTableEntries :: AnnotatedDatabaseSettings be db
-> Proxy '[]
-> Proxy 'True
-> K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl)) p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be db
_ Proxy '[]
_ Proxy 'True
_ (K1 AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity) = ((TableName, Table) -> [(TableName, Table)])
-> ((TableName, Table), Sequences)
-> ([(TableName, Table)], Sequences)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TableName, Table) -> [(TableName, Table)] -> [(TableName, Table)]
forall a. a -> [a] -> [a]
: []) (AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
(GColumns 'GenSequences (Rep (TableSchema tbl)),
 Generic (TableSchema tbl), Table tbl) =>
AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
mkTableEntryNoFkDiscovery AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity)

-- At this point we explored the full list and the previous equality check yielded 'False, so we kickoff the
-- automatic FK-discovery algorithm.

instance
  ( IsAnnotatedDatabaseEntity be (TableEntity tbl),
    GColumns 'GenSequences (Rep (TableSchema tbl)),
    Generic (TableSchema tbl),
    Beam.Table tbl,
    GTableConstraintColumns be db (Rep (TableSchema tbl))
  ) =>
  GTableEntry be db '[] 'False (K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl)))
  where
  gTableEntries :: AnnotatedDatabaseSettings be db
-> Proxy '[]
-> Proxy 'False
-> K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl)) p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be db
db Proxy '[]
Proxy Proxy 'False
Proxy (K1 AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity) = ((TableName, Table) -> [(TableName, Table)])
-> ((TableName, Table), Sequences)
-> ([(TableName, Table)], Sequences)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TableName, Table) -> [(TableName, Table)] -> [(TableName, Table)]
forall a. a -> [a] -> [a]
: []) (AnnotatedDatabaseSettings be db
-> AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
(GColumns 'GenSequences (Rep (TableSchema tbl)),
 Generic (TableSchema tbl), Table tbl,
 GTableConstraintColumns be db (Rep (TableSchema tbl))) =>
AnnotatedDatabaseSettings be db
-> AnnotatedDatabaseEntity be db (TableEntity tbl)
-> ((TableName, Table), Sequences)
mkTableEntryFkDiscovery AnnotatedDatabaseSettings be db
db AnnotatedDatabaseEntity be db (TableEntity tbl)
annEntity)

-- sub-db support for GTableEntry

instance
  ( Generic (innerDB (AnnotatedDatabaseEntity be outerDB)),
    Beam.Database be innerDB,
    GTableEntry be outerDB xs found (Rep (innerDB (AnnotatedDatabaseEntity be outerDB)))
  ) =>
  GTableEntry be outerDB xs found (K1 R (innerDB (AnnotatedDatabaseEntity be outerDB)))
  where
  gTableEntries :: AnnotatedDatabaseSettings be outerDB
-> Proxy xs
-> Proxy found
-> K1 R (innerDB (AnnotatedDatabaseEntity be outerDB)) p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be outerDB
outerDB Proxy xs
p1 Proxy found
p2 (K1 innerDB (AnnotatedDatabaseEntity be outerDB)
innerDB) =
    AnnotatedDatabaseSettings be outerDB
-> Proxy xs
-> Proxy found
-> Rep (innerDB (AnnotatedDatabaseEntity be outerDB)) Any
-> ([(TableName, Table)], Sequences)
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (tableFound :: Bool) (x :: * -> *) p.
GTableEntry be db anns tableFound x =>
AnnotatedDatabaseSettings be db
-> Proxy anns
-> Proxy tableFound
-> x p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be outerDB
outerDB Proxy xs
p1 Proxy found
p2 (innerDB (AnnotatedDatabaseEntity be outerDB)
-> Rep (innerDB (AnnotatedDatabaseEntity be outerDB)) Any
forall a x. Generic a => a -> Rep a x
from innerDB (AnnotatedDatabaseEntity be outerDB)
innerDB)

instance GTableEntry be outerDB xs found x => GTableEntry be outerDB xs found (D1 f x) where
  gTableEntries :: AnnotatedDatabaseSettings be outerDB
-> Proxy xs
-> Proxy found
-> D1 f x p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be outerDB
outerDB Proxy xs
p1 Proxy found
p2 (M1 x p
x) = AnnotatedDatabaseSettings be outerDB
-> Proxy xs
-> Proxy found
-> x p
-> ([(TableName, Table)], Sequences)
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (tableFound :: Bool) (x :: * -> *) p.
GTableEntry be db anns tableFound x =>
AnnotatedDatabaseSettings be db
-> Proxy anns
-> Proxy tableFound
-> x p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be outerDB
outerDB Proxy xs
p1 Proxy found
p2 x p
x

instance GTableEntry be outerDB xs found x => GTableEntry be outerDB xs found (C1 f x) where
  gTableEntries :: AnnotatedDatabaseSettings be outerDB
-> Proxy xs
-> Proxy found
-> C1 f x p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be outerDB
outerDB Proxy xs
p1 Proxy found
p2 (M1 x p
x) = AnnotatedDatabaseSettings be outerDB
-> Proxy xs
-> Proxy found
-> x p
-> ([(TableName, Table)], Sequences)
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (tableFound :: Bool) (x :: * -> *) p.
GTableEntry be db anns tableFound x =>
AnnotatedDatabaseSettings be db
-> Proxy anns
-> Proxy tableFound
-> x p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be outerDB
outerDB Proxy xs
p1 Proxy found
p2 x p
x

instance
  (GTableEntry be outerDB xs found a, GTableEntry be outerDB xs found b) =>
  GTableEntry be outerDB xs found (a :*: b)
  where
  gTableEntries :: AnnotatedDatabaseSettings be outerDB
-> Proxy xs
-> Proxy found
-> (:*:) a b p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be outerDB
outerDB Proxy xs
p1 Proxy found
p2 (a p
a :*: b p
b) =
    AnnotatedDatabaseSettings be outerDB
-> Proxy xs
-> Proxy found
-> a p
-> ([(TableName, Table)], Sequences)
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (tableFound :: Bool) (x :: * -> *) p.
GTableEntry be db anns tableFound x =>
AnnotatedDatabaseSettings be db
-> Proxy anns
-> Proxy tableFound
-> x p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be outerDB
outerDB Proxy xs
p1 Proxy found
p2 a p
a ([(TableName, Table)], Sequences)
-> ([(TableName, Table)], Sequences)
-> ([(TableName, Table)], Sequences)
forall a. Semigroup a => a -> a -> a
<> AnnotatedDatabaseSettings be outerDB
-> Proxy xs
-> Proxy found
-> b p
-> ([(TableName, Table)], Sequences)
forall be (db :: (* -> *) -> *) (anns :: [Annotation])
       (tableFound :: Bool) (x :: * -> *) p.
GTableEntry be db anns tableFound x =>
AnnotatedDatabaseSettings be db
-> Proxy anns
-> Proxy tableFound
-> x p
-> ([(TableName, Table)], Sequences)
gTableEntries AnnotatedDatabaseSettings be outerDB
outerDB Proxy xs
p1 Proxy found
p2 b p
b

-- end of sub-db support for GTableEntry

instance GColumns gseq x => GColumns gseq (D1 f x) where
  gColumns :: Proxy gseq -> TableName -> D1 f x p -> (Columns, Sequences)
gColumns Proxy gseq
p TableName
t (M1 x p
x) = Proxy gseq -> TableName -> x p -> (Columns, Sequences)
forall (genSeqs :: GenSequencesForSerial) (x :: * -> *) p.
GColumns genSeqs x =>
Proxy genSeqs -> TableName -> x p -> (Columns, Sequences)
gColumns Proxy gseq
p TableName
t x p
x

instance GTableConstraintColumns be db x => GTableConstraintColumns be db (D1 f x) where
  gTableConstraintsColumns :: AnnotatedDatabaseSettings be db
-> TableName -> D1 f x p -> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db TableName
tbl (M1 x p
x) = AnnotatedDatabaseSettings be db
-> TableName -> x p -> Set TableConstraint
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GTableConstraintColumns be db x =>
AnnotatedDatabaseSettings be db
-> TableName -> x p -> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db TableName
tbl x p
x

instance GColumns gseq x => GColumns gseq (C1 f x) where
  gColumns :: Proxy gseq -> TableName -> C1 f x p -> (Columns, Sequences)
gColumns Proxy gseq
p TableName
t (M1 x p
x) = Proxy gseq -> TableName -> x p -> (Columns, Sequences)
forall (genSeqs :: GenSequencesForSerial) (x :: * -> *) p.
GColumns genSeqs x =>
Proxy genSeqs -> TableName -> x p -> (Columns, Sequences)
gColumns Proxy gseq
p TableName
t x p
x

instance GTableConstraintColumns be db x => GTableConstraintColumns be db (C1 f x) where
  gTableConstraintsColumns :: AnnotatedDatabaseSettings be db
-> TableName -> C1 f x p -> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db TableName
tbl (M1 x p
x) = AnnotatedDatabaseSettings be db
-> TableName -> x p -> Set TableConstraint
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GTableConstraintColumns be db x =>
AnnotatedDatabaseSettings be db
-> TableName -> x p -> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db TableName
tbl x p
x

instance (GColumns p a, GColumns p b) => GColumns p (a :*: b) where
  gColumns :: Proxy p -> TableName -> (:*:) a b p -> (Columns, Sequences)
gColumns Proxy p
p TableName
t (a p
a :*: b p
b) = Proxy p -> TableName -> a p -> (Columns, Sequences)
forall (genSeqs :: GenSequencesForSerial) (x :: * -> *) p.
GColumns genSeqs x =>
Proxy genSeqs -> TableName -> x p -> (Columns, Sequences)
gColumns Proxy p
p TableName
t a p
a (Columns, Sequences)
-> (Columns, Sequences) -> (Columns, Sequences)
forall a. Semigroup a => a -> a -> a
<> Proxy p -> TableName -> b p -> (Columns, Sequences)
forall (genSeqs :: GenSequencesForSerial) (x :: * -> *) p.
GColumns genSeqs x =>
Proxy genSeqs -> TableName -> x p -> (Columns, Sequences)
gColumns Proxy p
p TableName
t b p
b

instance (GTableConstraintColumns be db a, GTableConstraintColumns be db b) => GTableConstraintColumns be db (a :*: b) where
  gTableConstraintsColumns :: AnnotatedDatabaseSettings be db
-> TableName -> (:*:) a b p -> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db TableName
tbl (a p
a :*: b p
b) = Set TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Ord a => Set a -> Set a -> Set a
S.union (AnnotatedDatabaseSettings be db
-> TableName -> a p -> Set TableConstraint
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GTableConstraintColumns be db x =>
AnnotatedDatabaseSettings be db
-> TableName -> x p -> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db TableName
tbl a p
a) (AnnotatedDatabaseSettings be db
-> TableName -> b p -> Set TableConstraint
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GTableConstraintColumns be db x =>
AnnotatedDatabaseSettings be db
-> TableName -> x p -> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db TableName
tbl b p
b)

--
-- Column entries
--

instance HasCompanionSequence ty => GColumns 'GenSequences (S1 m (K1 R (TableFieldSchema tbl ty))) where
  gColumns :: Proxy 'GenSequences
-> TableName
-> S1 m (K1 R (TableFieldSchema tbl ty)) p
-> (Columns, Sequences)
gColumns Proxy 'GenSequences
Proxy TableName
t (M1 (K1 (TableFieldSchema ColumnName
name (FieldSchema ColumnType
ty Set ColumnConstraint
constr)))) =
    case Proxy ty
-> TableName
-> ColumnName
-> Maybe ((SequenceName, Sequence), ColumnConstraint)
forall ty.
HasCompanionSequence ty =>
Proxy ty
-> TableName
-> ColumnName
-> Maybe ((SequenceName, Sequence), ColumnConstraint)
hasCompanionSequence (Proxy ty
forall k (t :: k). Proxy t
Proxy @ty) TableName
t ColumnName
name of
      Maybe ((SequenceName, Sequence), ColumnConstraint)
Nothing ->
        (ColumnName -> Column -> Columns
forall k a. k -> a -> Map k a
M.singleton ColumnName
name (ColumnType -> Set ColumnConstraint -> Column
Column ColumnType
ty Set ColumnConstraint
constr), Sequences
forall a. Monoid a => a
mempty)
      Just ((SequenceName, Sequence)
sq, ColumnConstraint
extraDefault) ->
        (ColumnName -> Column -> Columns
forall k a. k -> a -> Map k a
M.singleton ColumnName
name (ColumnType -> Set ColumnConstraint -> Column
Column ColumnType
ty (ColumnConstraint -> Set ColumnConstraint -> Set ColumnConstraint
forall a. Ord a => a -> Set a -> Set a
S.insert ColumnConstraint
extraDefault Set ColumnConstraint
constr)), (SequenceName -> Sequence -> Sequences)
-> (SequenceName, Sequence) -> Sequences
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SequenceName -> Sequence -> Sequences
forall k a. k -> a -> Map k a
M.singleton (SequenceName, Sequence)
sq)

instance GColumns 'NoGenSequences (S1 m (K1 R (TableFieldSchema tbl ty))) where
  gColumns :: Proxy 'NoGenSequences
-> TableName
-> S1 m (K1 R (TableFieldSchema tbl ty)) p
-> (Columns, Sequences)
gColumns Proxy 'NoGenSequences
Proxy TableName
_ (M1 (K1 (TableFieldSchema ColumnName
name (FieldSchema ColumnType
ty Set ColumnConstraint
constr)))) =
    (ColumnName -> Column -> Columns
forall k a. k -> a -> Map k a
M.singleton ColumnName
name (ColumnType -> Set ColumnConstraint -> Column
Column ColumnType
ty Set ColumnConstraint
constr), Sequences
forall a. Monoid a => a
mempty)

gColumnsPK ::
  TableName ->
  S1 m (K1 R (TableFieldSchema tbl ty)) p ->
  (Columns, Sequences)
gColumnsPK :: TableName
-> S1 m (K1 R (TableFieldSchema tbl ty)) p -> (Columns, Sequences)
gColumnsPK TableName
_ (M1 (K1 (TableFieldSchema ColumnName
name (FieldSchema ColumnType
ty Set ColumnConstraint
constr)))) =
  (ColumnName -> Column -> Columns
forall k a. k -> a -> Map k a
M.singleton ColumnName
name (ColumnType -> Set ColumnConstraint -> Column
Column ColumnType
ty Set ColumnConstraint
constr), Sequences
forall a. Monoid a => a
mempty)

instance
  {-# OVERLAPS #-}
  ( GColumns p (Rep (sub f)),
    Generic (sub f)
  ) =>
  GColumns p (S1 m (K1 R (sub f)))
  where
  gColumns :: Proxy p
-> TableName -> S1 m (K1 R (sub f)) p -> (Columns, Sequences)
gColumns Proxy p
p TableName
t (M1 (K1 sub f
e)) = Proxy p -> TableName -> Rep (sub f) Any -> (Columns, Sequences)
forall (genSeqs :: GenSequencesForSerial) (x :: * -> *) p.
GColumns genSeqs x =>
Proxy genSeqs -> TableName -> x p -> (Columns, Sequences)
gColumns Proxy p
p TableName
t (sub f -> Rep (sub f) Any
forall a x. Generic a => a -> Rep a x
from sub f
e)

-- If a PrimaryKey is referenced in another table, we do not want to recreate the \"SEQUENCE\" and
-- \"nextval\" default constraint associated with the original field.
instance
  ( GColumns 'NoGenSequences (Rep (PrimaryKey tbl f)),
    Generic (PrimaryKey tbl f),
    Beamable (PrimaryKey tbl)
  ) =>
  GColumns x (S1 m (K1 R (PrimaryKey tbl f)))
  where
  gColumns :: Proxy x
-> TableName
-> S1 m (K1 R (PrimaryKey tbl f)) p
-> (Columns, Sequences)
gColumns Proxy x
_ TableName
t (M1 (K1 PrimaryKey tbl f
e)) = Proxy 'NoGenSequences
-> TableName -> Rep (PrimaryKey tbl f) Any -> (Columns, Sequences)
forall (genSeqs :: GenSequencesForSerial) (x :: * -> *) p.
GColumns genSeqs x =>
Proxy genSeqs -> TableName -> x p -> (Columns, Sequences)
gColumns (Proxy 'NoGenSequences
forall k (t :: k). Proxy t
Proxy @NoGenSequences) TableName
t (PrimaryKey tbl f -> Rep (PrimaryKey tbl f) Any
forall a x. Generic a => a -> Rep a x
from PrimaryKey tbl f
e)

instance GTableConstraintColumns be db (S1 m (K1 R (TableFieldSchema tbl ty))) where
  gTableConstraintsColumns :: AnnotatedDatabaseSettings be db
-> TableName
-> S1 m (K1 R (TableFieldSchema tbl ty)) p
-> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
_db TableName
_tbl (M1 (K1 TableFieldSchema tbl ty
_)) = Set TableConstraint
forall a. Set a
S.empty

instance
  {-# OVERLAPS #-}
  ( Generic (AnnotatedDatabaseSettings be db),
    Generic (sub f),
    GColumns 'GenSequences (Rep (sub f)),
    GTableConstraintColumns be db (Rep (sub f))
  ) =>
  GTableConstraintColumns be db (S1 m (K1 R (sub f)))
  where
  gTableConstraintsColumns :: AnnotatedDatabaseSettings be db
-> TableName -> S1 m (K1 R (sub f)) p -> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db TableName
tname (M1 (K1 sub f
e)) =
    AnnotatedDatabaseSettings be db
-> TableName -> Rep (sub f) Any -> Set TableConstraint
forall k be (db :: (* -> *) -> *) (x :: k -> *) (p :: k).
GTableConstraintColumns be db x =>
AnnotatedDatabaseSettings be db
-> TableName -> x p -> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db TableName
tname (sub f -> Rep (sub f) Any
forall a x. Generic a => a -> Rep a x
from sub f
e)

instance
  ( Generic (AnnotatedDatabaseSettings be db),
    Generic (PrimaryKey tbl f),
    GColumns 'NoGenSequences (Rep (PrimaryKey tbl f)),
    GTableLookupSettings sel tbl (Rep (AnnotatedDatabaseSettings be db)),
    m ~ MetaSel sel su ss ds
  ) =>
  GTableConstraintColumns be db (S1 m (K1 R (PrimaryKey tbl f)))
  where
  gTableConstraintsColumns :: AnnotatedDatabaseSettings be db
-> TableName
-> S1 m (K1 R (PrimaryKey tbl f)) p
-> Set TableConstraint
gTableConstraintsColumns AnnotatedDatabaseSettings be db
db (TableName Text
tname) (M1 (K1 PrimaryKey tbl f
e)) =
    case [ColumnName]
cnames of
      [] -> Set TableConstraint
forall a. Set a
S.empty -- TODO: if for whatever reason we have no columns in our key, we don't generate a constraint
      ColumnName Text
cname : [ColumnName]
_ ->
        TableConstraint -> Set TableConstraint
forall a. a -> Set a
S.singleton
          ( Text
-> TableName
-> Set (ColumnName, ColumnName)
-> ReferenceAction
-> ReferenceAction
-> TableConstraint
ForeignKey
              (Text
tname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_fkey")
              TableName
reftname
              ([(ColumnName, ColumnName)] -> Set (ColumnName, ColumnName)
forall a. Ord a => [a] -> Set a
S.fromList ([ColumnName] -> [ColumnName] -> [(ColumnName, ColumnName)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([ColumnName] -> [ColumnName]
forall a. Ord a => [a] -> [a]
L.sort [ColumnName]
cnames) ([ColumnName] -> [ColumnName]
forall a. Ord a => [a] -> [a]
L.sort [ColumnName]
refcnames)))
              ReferenceAction
NoAction -- TODO: what should the default be?
              ReferenceAction
NoAction -- TODO: what should the default be?
          )
    where
      cnames :: [ColumnName]
      cnames :: [ColumnName]
cnames = Columns -> [ColumnName]
forall k a. Map k a -> [k]
M.keys (Columns -> [ColumnName]) -> Columns -> [ColumnName]
forall a b. (a -> b) -> a -> b
$ (Columns, Sequences) -> Columns
forall a b. (a, b) -> a
fst (Proxy 'NoGenSequences
-> TableName -> Rep (PrimaryKey tbl f) Any -> (Columns, Sequences)
forall (genSeqs :: GenSequencesForSerial) (x :: * -> *) p.
GColumns genSeqs x =>
Proxy genSeqs -> TableName -> x p -> (Columns, Sequences)
gColumns (Proxy 'NoGenSequences
forall k (t :: k). Proxy t
Proxy @NoGenSequences) (Text -> TableName
TableName Text
tname) (PrimaryKey tbl f -> Rep (PrimaryKey tbl f) Any
forall a x. Generic a => a -> Rep a x
from PrimaryKey tbl f
e))

      reftname :: TableName
      refcnames :: [ColumnName]
      (TableName
reftname, [ColumnName]
refcnames) = Proxy sel
-> Proxy tbl
-> Rep (AnnotatedDatabaseSettings be db) Any
-> (TableName, [ColumnName])
forall k (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: k -> *)
       (p :: k).
GTableLookupSettings sel tbl x =>
Proxy sel -> Proxy tbl -> x p -> (TableName, [ColumnName])
gTableLookupSettings (Proxy sel
forall k (t :: k). Proxy t
Proxy @sel) (Proxy tbl
forall k (t :: k). Proxy t
Proxy @tbl) (AnnotatedDatabaseSettings be db
-> Rep (AnnotatedDatabaseSettings be db) Any
forall a x. Generic a => a -> Rep a x
from AnnotatedDatabaseSettings be db
db)

-- We want a type class for the table lookup, because we want to return a
-- value-level table name based on the database settings!

-- | Lookup a table by type in the given DB settings.
--
-- The selector name is only provided for error messages.
--
-- Only returns if the table type is unique.
-- Returns the table name and the column names of its primary key.
class GTableLookupSettings (sel :: Maybe Symbol) (tbl :: TableKind) x where
  gTableLookupSettings :: Proxy sel -> Proxy tbl -> x p -> (TableName, [ColumnName])

-- | Helper class that takes an additional continuation parameter 'k'.
--
-- We treat 'k' as a type-level stack with 'U1' being the empty stack and
-- ':*:' used right-associatively to place items onto the stack.
--
-- The reason we do not use a type-level list here is that we also need
-- a term-level representation of the continuation, and we already have
-- suitable inhabitants for 'U1' and ':*:'.
class GTableLookupTables (sel :: Maybe Symbol) (tbl :: TableKind) (x :: Type -> Type) (k :: Type -> Type) where
  gTableLookupTables :: Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])

-- | We use this function to continue searching once we've already found
-- a match, and to abort if we find a second match.
class GTableLookupTablesExpectFail (sel :: Maybe Symbol) (tbl :: TableKind) (x :: Type -> Type) (k :: Type -> Type) where
  gTableLookupTablesExpectFail :: Proxy sel -> Proxy tbl -> (TableName, [ColumnName]) -> x p -> k p -> (TableName, [ColumnName])

instance
  (GTableLookupSettings sel tbl x) =>
  GTableLookupSettings sel tbl (D1 f x)
  where
  gTableLookupSettings :: Proxy sel -> Proxy tbl -> D1 f x p -> (TableName, [ColumnName])
gTableLookupSettings Proxy sel
sel Proxy tbl
tbl (M1 x p
x) = Proxy sel -> Proxy tbl -> x p -> (TableName, [ColumnName])
forall k (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: k -> *)
       (p :: k).
GTableLookupSettings sel tbl x =>
Proxy sel -> Proxy tbl -> x p -> (TableName, [ColumnName])
gTableLookupSettings Proxy sel
sel Proxy tbl
tbl x p
x

instance
  (GTableLookupTables sel tbl x U1) =>
  GTableLookupSettings sel tbl (C1 f x)
  where
  gTableLookupSettings :: Proxy sel -> Proxy tbl -> C1 f x p -> (TableName, [ColumnName])
gTableLookupSettings Proxy sel
sel Proxy tbl
tbl (M1 x p
x) = Proxy sel -> Proxy tbl -> x p -> U1 p -> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTables sel tbl x k =>
Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl x p
x U1 p
forall k (p :: k). U1 p
U1

instance
  (GTableLookupTables sel tbl x k) =>
  GTableLookupTables sel tbl (S1 f x) k
  where
  gTableLookupTables :: Proxy sel
-> Proxy tbl -> S1 f x p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl (M1 x p
x) = Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTables sel tbl x k =>
Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl x p
x

instance
  ( GTableLookupTables sel tbl a (b :*: k)
  ) =>
  GTableLookupTables sel tbl (a :*: b) k
  where
  gTableLookupTables :: Proxy sel
-> Proxy tbl -> (:*:) a b p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl (a p
a :*: b p
b) k p
k = Proxy sel
-> Proxy tbl -> a p -> (:*:) b k p -> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTables sel tbl x k =>
Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl a p
a (b p
b b p -> k p -> (:*:) b k p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: k p
k)

instance
  (GTableLookupTablesExpectFail sel tbl x k) =>
  GTableLookupTablesExpectFail sel tbl (S1 f x) k
  where
  gTableLookupTablesExpectFail :: Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> S1 f x p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r (M1 x p
x) = Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> x p
-> k p
-> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTablesExpectFail sel tbl x k =>
Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> x p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r x p
x

instance
  ( GTableLookupTablesExpectFail sel tbl a (b :*: k)
  ) =>
  GTableLookupTablesExpectFail sel tbl (a :*: b) k
  where
  gTableLookupTablesExpectFail :: Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> (:*:) a b p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r (a p
a :*: b p
b) k p
k = Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> a p
-> (:*:) b k p
-> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTablesExpectFail sel tbl x k =>
Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> x p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r a p
a (b p
b b p -> k p -> (:*:) b k p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: k p
k)

instance
  ( GTableLookupTable (TestTableEqual tbl tbl') sel tbl k,
    Beamable tbl',
    Beam.Table tbl'
  ) =>
  GTableLookupTables sel tbl (K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl'))) k
  where
  gTableLookupTables :: Proxy sel
-> Proxy tbl
-> K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl')) p
-> k p
-> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl (K1 AnnotatedDatabaseEntity be db (TableEntity tbl')
annEntity) k p
k =
    let entity :: DatabaseEntity be db (TableEntity tbl')
entity = AnnotatedDatabaseEntity be db (TableEntity tbl')
annEntity AnnotatedDatabaseEntity be db (TableEntity tbl')
-> Getting
     (DatabaseEntity be db (TableEntity tbl'))
     (AnnotatedDatabaseEntity be db (TableEntity tbl'))
     (DatabaseEntity be db (TableEntity tbl'))
-> DatabaseEntity be db (TableEntity tbl')
forall s a. s -> Getting a s a -> a
^. Getting
  (DatabaseEntity be db (TableEntity tbl'))
  (AnnotatedDatabaseEntity be db (TableEntity tbl'))
  (DatabaseEntity be db (TableEntity tbl'))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
  (AnnotatedDatabaseEntity be db entityType)
  (DatabaseEntity be db entityType)
deannotate
        tname :: Text
tname = DatabaseEntity be db (TableEntity tbl')
entity DatabaseEntity be db (TableEntity tbl')
-> Getting Text (DatabaseEntity be db (TableEntity tbl')) Text
-> Text
forall s a. s -> Getting a s a -> a
^. Getting
  Text
  (DatabaseEntity be db (TableEntity tbl'))
  (DatabaseEntityDescriptor be (TableEntity tbl'))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
  (DatabaseEntity be db entityType)
  (DatabaseEntityDescriptor be entityType)
dbEntityDescriptor Getting
  Text
  (DatabaseEntity be db (TableEntity tbl'))
  (DatabaseEntityDescriptor be (TableEntity tbl'))
-> ((Text -> Const Text Text)
    -> DatabaseEntityDescriptor be (TableEntity tbl')
    -> Const Text (DatabaseEntityDescriptor be (TableEntity tbl')))
-> Getting Text (DatabaseEntity be db (TableEntity tbl')) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> DatabaseEntityDescriptor be (TableEntity tbl')
-> Const Text (DatabaseEntityDescriptor be (TableEntity tbl'))
forall be entityType.
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntityDescriptor be entityType) Text
dbEntityName
        cnames :: [ColumnName]
cnames = DatabaseEntity be db (TableEntity tbl') -> [ColumnName]
forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Beamable (PrimaryKey tbl), Table tbl) =>
DatabaseEntity be db (TableEntity tbl) -> [ColumnName]
pkFieldNames DatabaseEntity be db (TableEntity tbl')
entity
     in Proxy (TestTableEqual tbl tbl')
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> k p
-> (TableName, [ColumnName])
forall (b :: Bool) (sel :: Maybe Symbol) (tbl :: (* -> *) -> *)
       (k :: * -> *) p.
GTableLookupTable b sel tbl k =>
Proxy b
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> k p
-> (TableName, [ColumnName])
gTableLookupTable (Proxy (TestTableEqual tbl tbl')
forall k (t :: k). Proxy t
Proxy @(TestTableEqual tbl tbl')) Proxy sel
sel Proxy tbl
tbl (Text -> TableName
TableName Text
tname, [ColumnName]
cnames) k p
k

-- sub-db support for GTableLookupTables

instance
  ( GTableLookupTables sel tbl (Rep (innerDB (AnnotatedDatabaseEntity be outerDB))) k,
    Beam.Database be innerDB,
    Generic (innerDB (AnnotatedDatabaseEntity be outerDB))
  ) =>
  GTableLookupTables sel tbl (K1 R (innerDB (AnnotatedDatabaseEntity be outerDB))) k
  where
  gTableLookupTables :: Proxy sel
-> Proxy tbl
-> K1 R (innerDB (AnnotatedDatabaseEntity be outerDB)) p
-> k p
-> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl (K1 innerDB (AnnotatedDatabaseEntity be outerDB)
subDB) k p
k =
    Proxy sel
-> Proxy tbl
-> Rep (innerDB (AnnotatedDatabaseEntity be outerDB)) p
-> k p
-> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTables sel tbl x k =>
Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl (innerDB (AnnotatedDatabaseEntity be outerDB)
-> Rep (innerDB (AnnotatedDatabaseEntity be outerDB)) p
forall a x. Generic a => a -> Rep a x
from innerDB (AnnotatedDatabaseEntity be outerDB)
subDB) k p
k

instance GTableLookupTables sel tbl x k => GTableLookupTables sel tbl (D1 f x) k where
  gTableLookupTables :: Proxy sel
-> Proxy tbl -> D1 f x p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl (M1 x p
x) k p
k = Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTables sel tbl x k =>
Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl x p
x k p
k

instance GTableLookupTables sel tbl x k => GTableLookupTables sel tbl (C1 f x) k where
  gTableLookupTables :: Proxy sel
-> Proxy tbl -> C1 f x p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl (M1 x p
x) k p
k = Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTables sel tbl x k =>
Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl x p
x k p
k

-- end of sub-db support for GTableLookupTables

instance
  ( GTableLookupTableExpectFail (TestTableEqual tbl tbl') sel tbl k,
    Beamable tbl'
  ) =>
  GTableLookupTablesExpectFail sel tbl (K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl'))) k
  where
  gTableLookupTablesExpectFail :: Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> K1 R (AnnotatedDatabaseEntity be db (TableEntity tbl')) p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r (K1 AnnotatedDatabaseEntity be db (TableEntity tbl')
_entity) =
    Proxy (TestTableEqual tbl tbl')
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> k p
-> (TableName, [ColumnName])
forall (b :: Bool) (sel :: Maybe Symbol) (tbl :: (* -> *) -> *)
       (k :: * -> *) p.
GTableLookupTableExpectFail b sel tbl k =>
Proxy b
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> k p
-> (TableName, [ColumnName])
gTableLookupTableExpectFail (Proxy (TestTableEqual tbl tbl')
forall k (t :: k). Proxy t
Proxy @(TestTableEqual tbl tbl')) Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r

-- sub-db support for GTableLookupTablesExpectFail

instance
  ( GTableLookupTablesExpectFail sel tbl (Rep (innerDb (AnnotatedDatabaseEntity be outerDb))) k,
    Generic (innerDb (AnnotatedDatabaseEntity be outerDb)),
    Beam.Database be innerDb
  ) =>
  GTableLookupTablesExpectFail sel tbl (K1 R (innerDb (AnnotatedDatabaseEntity be outerDb))) k
  where
  gTableLookupTablesExpectFail :: Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> K1 R (innerDb (AnnotatedDatabaseEntity be outerDb)) p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r (K1 innerDb (AnnotatedDatabaseEntity be outerDb)
subDB) =
    Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> Rep (innerDb (AnnotatedDatabaseEntity be outerDb)) p
-> k p
-> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTablesExpectFail sel tbl x k =>
Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> x p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r (innerDb (AnnotatedDatabaseEntity be outerDb)
-> Rep (innerDb (AnnotatedDatabaseEntity be outerDb)) p
forall a x. Generic a => a -> Rep a x
from innerDb (AnnotatedDatabaseEntity be outerDb)
subDB)

instance
  ( GTableLookupTablesExpectFail sel tbl x k
  ) =>
  GTableLookupTablesExpectFail sel tbl (D1 f x) k
  where
  gTableLookupTablesExpectFail :: Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> D1 f x p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r (M1 x p
x) =
    Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> x p
-> k p
-> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTablesExpectFail sel tbl x k =>
Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> x p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r x p
x

instance
  ( GTableLookupTablesExpectFail sel tbl x k
  ) =>
  GTableLookupTablesExpectFail sel tbl (C1 f x) k
  where
  gTableLookupTablesExpectFail :: Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> C1 f x p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r (M1 x p
x) =
    Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> x p
-> k p
-> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTablesExpectFail sel tbl x k =>
Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> x p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r x p
x

-- end of sub-db support for GTableLookupTablesExpectFail

type family TestTableEqual (tbl1 :: TableKind) (tbl2 :: TableKind) :: Bool where
  TestTableEqual tbl tbl = True
  TestTableEqual _ _ = False

class GTableLookupTable (b :: Bool) (sel :: Maybe Symbol) (tbl :: TableKind) (k :: Type -> Type) where
  gTableLookupTable :: Proxy b -> Proxy sel -> Proxy tbl -> (TableName, [ColumnName]) -> k p -> (TableName, [ColumnName])

class GTableLookupTableExpectFail (b :: Bool) (sel :: Maybe Symbol) (tbl :: TableKind) (k :: Type -> Type) where
  gTableLookupTableExpectFail :: Proxy b -> Proxy sel -> Proxy tbl -> (TableName, [ColumnName]) -> k p -> (TableName, [ColumnName])

instance GTableLookupTable True sel tbl U1 where
  gTableLookupTable :: Proxy 'True
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> U1 p
-> (TableName, [ColumnName])
gTableLookupTable Proxy 'True
_ Proxy sel
_ Proxy tbl
_ (TableName, [ColumnName])
r U1 p
_ = (TableName, [ColumnName])
r

type LookupAmbiguous (sel :: Maybe Symbol) (tbl :: TableKind) =
  Text "Could not derive foreign key constraint for " :<>: ShowField sel :<>: Text ","
    :$$: Text "because there are several tables of type `" :<>: ShowType tbl :<>: Text "' in the schema."
    :$$: Text "In this scenario you have to manually disable the FK-discovery algorithm for all the tables "
    :$$: Text "hit by such ambiguity, for example by creating your Schema via: "
    :$$: Text ""
    :$$: Text "fromAnnotatedDbSettings annotatedDB (Proxy @'[ 'UserDefinedFk TBL1, 'UserDefinedFk TBL2, .. ])"
    :$$: Text ""
    :$$: Text "Where `TBL1..n` are types referencing " :<>: ShowType tbl :<>: Text " in the schema."
    :$$: Text "Once done that, you can explicitly provide manual FKs for the tables by using `foreignKeyOnPk` "
    :$$: Text "when annotating your `DatabaseSettings`."

type LookupFailed (sel :: Maybe Symbol) (tbl :: TableKind) =
  Text "Could not derive foreign key constraint for " :<>: ShowField sel :<>: Text ","
    :$$: Text "because there are no tables of type `" :<>: ShowType tbl :<>: Text "' in the schema."
    :$$: Text "This might be because this particular " :<>: ShowField sel :<>: Text " doesn't appear anywhere "
    :$$: Text "in your database, so the FK-discovery mechanism doesn't know how to reach it. Please note that "
    :$$: Text "in presence of nested databases there might be more than one field with the same name referencing "
    :$$: Text "different things. You might want to check you are adding or targeting the correct one."

type family ShowField (sel :: Maybe Symbol) :: ErrorMessage where
  ShowField Nothing = Text "unnamed field"
  ShowField (Just sel) = Text "field `" :<>: Text sel :<>: Text "'"

instance TypeError (LookupAmbiguous sel tbl) => GTableLookupTableExpectFail True sel tbl k where
  gTableLookupTableExpectFail :: Proxy 'True
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> k p
-> (TableName, [ColumnName])
gTableLookupTableExpectFail Proxy 'True
_ Proxy sel
_ Proxy tbl
_ (TableName, [ColumnName])
_ k p
_ = [Char] -> (TableName, [ColumnName])
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

instance (GTableLookupTablesExpectFail sel tbl k ks) => GTableLookupTable True sel tbl (k :*: ks) where
  gTableLookupTable :: Proxy 'True
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> (:*:) k ks p
-> (TableName, [ColumnName])
gTableLookupTable Proxy 'True
_ Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r (k p
k :*: ks p
ks) = Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> k p
-> ks p
-> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTablesExpectFail sel tbl x k =>
Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> x p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r k p
k ks p
ks

instance TypeError (LookupFailed sel tbl) => GTableLookupTable False sel tbl U1 where
  gTableLookupTable :: Proxy 'False
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> U1 p
-> (TableName, [ColumnName])
gTableLookupTable Proxy 'False
_ Proxy sel
_ Proxy tbl
_ (TableName, [ColumnName])
_ = [Char] -> U1 p -> (TableName, [ColumnName])
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

instance GTableLookupTableExpectFail False sel tbl U1 where
  gTableLookupTableExpectFail :: Proxy 'False
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> U1 p
-> (TableName, [ColumnName])
gTableLookupTableExpectFail Proxy 'False
_ Proxy sel
_ Proxy tbl
_ (TableName, [ColumnName])
r U1 p
_ = (TableName, [ColumnName])
r

instance (GTableLookupTablesExpectFail sel tbl k ks) => GTableLookupTableExpectFail False sel tbl (k :*: ks) where
  gTableLookupTableExpectFail :: Proxy 'False
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> (:*:) k ks p
-> (TableName, [ColumnName])
gTableLookupTableExpectFail Proxy 'False
_ Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r (k p
k :*: ks p
ks) = Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> k p
-> ks p
-> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTablesExpectFail sel tbl x k =>
Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> x p
-> k p
-> (TableName, [ColumnName])
gTableLookupTablesExpectFail Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
r k p
k ks p
ks

instance GTableLookupTables sel tbl k ks => GTableLookupTable False sel tbl (k :*: ks) where
  gTableLookupTable :: Proxy 'False
-> Proxy sel
-> Proxy tbl
-> (TableName, [ColumnName])
-> (:*:) k ks p
-> (TableName, [ColumnName])
gTableLookupTable Proxy 'False
_ Proxy sel
sel Proxy tbl
tbl (TableName, [ColumnName])
_ (k p
k :*: ks p
ks) =
    Proxy sel -> Proxy tbl -> k p -> ks p -> (TableName, [ColumnName])
forall (sel :: Maybe Symbol) (tbl :: (* -> *) -> *) (x :: * -> *)
       (k :: * -> *) p.
GTableLookupTables sel tbl x k =>
Proxy sel -> Proxy tbl -> x p -> k p -> (TableName, [ColumnName])
gTableLookupTables Proxy sel
sel Proxy tbl
tbl k p
k ks p
ks