{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}

-- | Defines a generic schema type that can be used to define schemas for Beam tables
module Database.Beam.Schema.Tables
    (
    -- * Database Types
      Database
    , zipTables

    , DatabaseSettings
    , IsDatabaseEntity(..)
    , DatabaseEntityDescriptor(..)
    , DatabaseEntity(..), TableEntity, ViewEntity, DomainTypeEntity
    , dbEntityDescriptor
    , dbName, dbSchema, dbTableFields
    , DatabaseModification, EntityModification(..)
    , FieldModification(..)
    , dbModification, tableModification, withDbModification
    , withTableModification, modifyTable, modifyEntityName
    , setEntityName, modifyTableFields, fieldNamed
    , modifyEntitySchema, setEntitySchema
    , defaultDbSettings, embedDatabase

    , RenamableWithRule(..), RenamableField(..)
    , FieldRenamer(..)

    , Lenses, LensFor(..)

    -- * Columnar and Column Tags
    , Columnar, C, Columnar'(..)
    , ComposeColumnar(..)
    , Nullable, TableField(..)
    , Exposed
    , fieldName, fieldPath

    , TableSettings, HaskellTable
    , TableSkeleton, Ignored(..)
    , GFieldsFulfillConstraint(..), FieldsFulfillConstraint
    , FieldsFulfillConstraintNullable
    , WithConstraint(..)
    , HasConstraint(..)
    , TagReducesTo(..), ReplaceBaseTag
    , withConstrainedFields, withConstraints
    , withNullableConstrainedFields, withNullableConstraints

    -- * Tables
    , Table(..), Beamable(..)
    , Retaggable(..), (:*:)(..) -- Reexported for use with 'alongsideTable'
    , defTblFieldSettings
    , tableValuesNeeded
    , pk
    , allBeamValues, changeBeamRep
    , alongsideTable
    , defaultFieldName

    -- * Exported so we can override defaults
    -- ** For 'Beamable'
    , GZipTables(..)
    , GTableSkeleton(..)
    -- ** For 'Database'
    , GZipDatabase(..)
    -- ** For 'defaultDbSettings'
    , GAutoDbSettings(..)
    , GDefaultTableFieldSettings(..)
    , ChooseSubTableStrategy
    , SubTableStrategyImpl
    )
    where

import           Database.Beam.Backend.Types

import           Control.Applicative (liftA2)
import           Control.Arrow (first)
import           Control.Monad.Identity
import           Control.Monad.Writer (Writer, execWriter, tell)

import           Data.Char (isUpper, toLower)
import           Data.Foldable (fold)
import           Data.Kind (Type, Constraint)
import qualified Data.List.NonEmpty as NE
import           Data.Monoid
import           Data.Proxy
import           Data.String (IsString(..))
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Typeable

import qualified GHC.Generics as Generic
import           GHC.Generics hiding (R, C)
import           GHC.TypeLits

import           Lens.Micro hiding (to)

-- | Allows introspection into database types.
--
--   All database types must be of kind '(Type -> Type) -> Type'. If
--   the type parameter is named 'f', each field must be of the type
--   of 'f' applied to some type for which an 'IsDatabaseEntity'
--   instance exists.
--
--   The 'be' type parameter is necessary so that the compiler can
--   ensure that backend-specific entities only work on the proper
--   backend.
--
--   Entities are documented under [the corresponding
--   section](Database.Beam.Schema#entities) and in the
--   [manual](https://haskell-beam.github.io/beam/user-guide/databases/)
class Database be db where

    -- | Default derived function. Do not implement this yourself.
    --
    --   The idea is that, for any two databases over particular entity tags 'f'
    --   and 'g', if we can take any entity in 'f' and 'g' to the corresponding
    --   entity in 'h' (in the possibly effectful applicative functor 'm'), then we can
    --   transform the two databases over 'f' and 'g' to a database in 'h',
    --   within 'm'.
    --
    --   If that doesn't make sense, don't worry. This is mostly beam internal
    zipTables :: Applicative m
              => Proxy be
              -> (forall tbl. (IsDatabaseEntity be tbl, DatabaseEntityRegularRequirements be tbl) =>
                  f tbl -> g tbl -> m (h tbl))
              -> db f -> db g -> m (db h)
    default zipTables :: ( Generic (db f), Generic (db g), Generic (db h)
                         , Applicative m
                         , GZipDatabase be f g h
                                        (Rep (db f)) (Rep (db g)) (Rep (db h)) ) =>
                         Proxy be ->
                         (forall tbl. (IsDatabaseEntity be tbl, DatabaseEntityRegularRequirements be tbl) => f tbl -> g tbl -> m (h tbl)) ->
                         db f -> db g -> m (db h)
    -- We need the pattern type signature on 'combine' to get around a type checking bug in GHC 8.0.1. In future releases,
    -- we will switch to the standard forall.
    zipTables Proxy be
be forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine (db f
f :: db f) (db g
g :: db g) =
      (Proxy h -> m (db h)) -> m (db h)
forall (h :: * -> *) (m :: * -> *).
(Proxy h -> m (db h)) -> m (db h)
refl ((Proxy h -> m (db h)) -> m (db h))
-> (Proxy h -> m (db h)) -> m (db h)
forall a b. (a -> b) -> a -> b
$ \Proxy h
h ->
        Rep (db h) () -> db h
forall a x. Generic a => Rep a x -> a
forall x. Rep (db h) x -> db h
to (Rep (db h) () -> db h) -> m (Rep (db h) ()) -> m (db h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> Rep (db f) ()
-> Rep (db g) ()
-> m (Rep (db h) ())
forall be (f :: * -> *) (g :: * -> *) (h :: * -> *) (x :: * -> *)
       (y :: * -> *) (z :: * -> *) (m :: * -> *).
(GZipDatabase be f g h x y z, 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))
-> x ()
-> y ()
-> m (z ())
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))
-> Rep (db f) ()
-> Rep (db g) ()
-> m (Rep (db h) ())
gZipDatabase (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @f, forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @g, Proxy h
h, Proxy be
be) f tbl -> g tbl -> m (h tbl)
forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine (db f -> Rep (db f) ()
forall x. db f -> Rep (db f) x
forall a x. Generic a => a -> Rep a x
from db f
f) (db g -> Rep (db g) ()
forall x. db g -> Rep (db g) x
forall a x. Generic a => a -> Rep a x
from db g
g)
      where
        -- For GHC 8.0.1 renamer bug
        refl :: (Proxy h -> m (db h)) -> m (db h)
        refl :: forall (h :: * -> *) (m :: * -> *).
(Proxy h -> m (db h)) -> m (db h)
refl Proxy h -> m (db h)
fn = Proxy h -> m (db h)
fn Proxy h
forall {k} (t :: k). Proxy t
Proxy

-- | Automatically provide names for tables, and descriptions for tables (using
--   'defTblFieldSettings'). Your database must implement 'Generic', and must be
--   auto-derivable. For more information on name generation, see the
--   [manual](https://haskell-beam.github.io/beam/user-guide/models)
defaultDbSettings :: ( Generic (DatabaseSettings be db)
                     , GAutoDbSettings (Rep (DatabaseSettings be db) ()) ) =>
                     DatabaseSettings be db
defaultDbSettings :: forall be (db :: (* -> *) -> *).
(Generic (DatabaseSettings be db),
 GAutoDbSettings (Rep (DatabaseSettings be db) ())) =>
DatabaseSettings be db
defaultDbSettings = Rep (DatabaseSettings be db) () -> DatabaseSettings be db
forall x. Generic x => Rep x () -> x
to' Rep (DatabaseSettings be db) ()
forall x. GAutoDbSettings x => x
autoDbSettings'

-- | A helper data type that lets you modify a database schema. Converts all
-- entities in the database into functions from that entity to itself.
type DatabaseModification f be db = db (EntityModification f be)
-- | A newtype wrapper around 'f e -> f e' (i.e., an endomorphism between entity
--   types in 'f'). You usually want to use 'modifyTable' or another function to
--   contstruct these for you.
newtype EntityModification f be e = EntityModification (Endo (f e))
  deriving (Semigroup (EntityModification f be e)
EntityModification f be e
Semigroup (EntityModification f be e) =>
EntityModification f be e
-> (EntityModification f be e
    -> EntityModification f be e -> EntityModification f be e)
-> ([EntityModification f be e] -> EntityModification f be e)
-> Monoid (EntityModification f be e)
[EntityModification f be e] -> EntityModification f be e
EntityModification f be e
-> EntityModification f be e -> EntityModification f be e
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (f :: * -> *) be e. Semigroup (EntityModification f be e)
forall (f :: * -> *) be e. EntityModification f be e
forall (f :: * -> *) be e.
[EntityModification f be e] -> EntityModification f be e
forall (f :: * -> *) be e.
EntityModification f be e
-> EntityModification f be e -> EntityModification f be e
$cmempty :: forall (f :: * -> *) be e. EntityModification f be e
mempty :: EntityModification f be e
$cmappend :: forall (f :: * -> *) be e.
EntityModification f be e
-> EntityModification f be e -> EntityModification f be e
mappend :: EntityModification f be e
-> EntityModification f be e -> EntityModification f be e
$cmconcat :: forall (f :: * -> *) be e.
[EntityModification f be e] -> EntityModification f be e
mconcat :: [EntityModification f be e] -> EntityModification f be e
Monoid, NonEmpty (EntityModification f be e) -> EntityModification f be e
EntityModification f be e
-> EntityModification f be e -> EntityModification f be e
(EntityModification f be e
 -> EntityModification f be e -> EntityModification f be e)
-> (NonEmpty (EntityModification f be e)
    -> EntityModification f be e)
-> (forall b.
    Integral b =>
    b -> EntityModification f be e -> EntityModification f be e)
-> Semigroup (EntityModification f be e)
forall b.
Integral b =>
b -> EntityModification f be e -> EntityModification f be e
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (f :: * -> *) be e.
NonEmpty (EntityModification f be e) -> EntityModification f be e
forall (f :: * -> *) be e.
EntityModification f be e
-> EntityModification f be e -> EntityModification f be e
forall (f :: * -> *) be e b.
Integral b =>
b -> EntityModification f be e -> EntityModification f be e
$c<> :: forall (f :: * -> *) be e.
EntityModification f be e
-> EntityModification f be e -> EntityModification f be e
<> :: EntityModification f be e
-> EntityModification f be e -> EntityModification f be e
$csconcat :: forall (f :: * -> *) be e.
NonEmpty (EntityModification f be e) -> EntityModification f be e
sconcat :: NonEmpty (EntityModification f be e) -> EntityModification f be e
$cstimes :: forall (f :: * -> *) be e b.
Integral b =>
b -> EntityModification f be e -> EntityModification f be e
stimes :: forall b.
Integral b =>
b -> EntityModification f be e -> EntityModification f be e
Semigroup)
-- | A newtype wrapper around 'Columnar f a -> Columnar f a' (i.e., an
--   endomorphism between 'Columnar's over 'f'). You usually want to use
--   'fieldNamed' or the 'IsString' instance to rename the field, when 'f ~
--   TableField'
newtype FieldModification f a
  = FieldModification (Columnar f a -> Columnar f a)

-- | Return a 'DatabaseModification' that does nothing. This is useful if you
--   only want to rename one table. You can do
--
-- > dbModification { tbl1 = modifyTable (\oldNm -> "NewTableName") tableModification }
dbModification :: forall f be db. Database be db => DatabaseModification f be db
dbModification :: forall (f :: * -> *) be (db :: (* -> *) -> *).
Database be db =>
DatabaseModification f be db
dbModification = Identity (DatabaseModification f be db)
-> DatabaseModification f be db
forall a. Identity a -> a
runIdentity (Identity (DatabaseModification f be db)
 -> DatabaseModification f be db)
-> Identity (DatabaseModification f be db)
-> DatabaseModification f be db
forall a b. (a -> b) -> a -> b
$
                 Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    EntityModification f be tbl
    -> EntityModification f be tbl
    -> Identity (EntityModification f be tbl))
-> DatabaseModification f be db
-> DatabaseModification f be db
-> Identity (DatabaseModification f be db)
forall be (db :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Database be db, Applicative m) =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
zipTables (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @be) (\EntityModification f be tbl
_ EntityModification f be tbl
_ -> EntityModification f be tbl
-> Identity (EntityModification f be tbl)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntityModification f be tbl
forall a. Monoid a => a
mempty) (DatabaseModification f be db
forall a. HasCallStack => a
undefined :: DatabaseModification f be db) (DatabaseModification f be db
forall a. HasCallStack => a
undefined :: DatabaseModification f be db)

-- | Return a table modification (for use with 'modifyTable') that does nothing.
--   Useful if you only want to change the table name, or if you only want to
--   modify a few fields.
--
--   For example,
--
-- > tableModification { field1 = "Column1" }
--
--   is a table modification (where 'f ~ TableField tbl') that changes the
--   column name of 'field1' to "Column1".
tableModification :: forall f tbl. Beamable tbl => tbl (FieldModification f)
tableModification :: forall (f :: * -> *) (tbl :: (* -> *) -> *).
Beamable tbl =>
tbl (FieldModification f)
tableModification = Identity (tbl (FieldModification f)) -> tbl (FieldModification f)
forall a. Identity a -> a
runIdentity (Identity (tbl (FieldModification f)) -> tbl (FieldModification f))
-> Identity (tbl (FieldModification f))
-> tbl (FieldModification f)
forall a b. (a -> b) -> a -> b
$
                    (forall a.
 Columnar' Ignored a
 -> Columnar' Ignored a
 -> Identity (Columnar' (FieldModification f) a))
-> tbl Ignored
-> tbl Ignored
-> Identity (tbl (FieldModification f))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\(Columnar' Columnar Ignored a
_ :: Columnar' Ignored x) (Columnar' Columnar Ignored a
_ :: Columnar' Ignored x) ->
                                      Columnar' (FieldModification f) a
-> Identity (Columnar' (FieldModification f) a)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar (FieldModification f) a
-> Columnar' (FieldModification f) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((Columnar f a -> Columnar f a) -> FieldModification f a
forall (f :: * -> *) a.
(Columnar f a -> Columnar f a) -> FieldModification f a
FieldModification Columnar f a -> Columnar f a
forall a. a -> a
id :: FieldModification f x))) (tbl Ignored
forall a. HasCallStack => a
undefined :: TableSkeleton tbl) (tbl Ignored
forall a. HasCallStack => a
undefined :: TableSkeleton tbl)

-- | Modify a database according to a given modification. Most useful for
--   'DatabaseSettings' to change the name mappings of tables and fields. For
--   example, you can use this to modify the default names of a table
--
-- > db :: DatabaseSettings MyDb
-- > db = defaultDbSettings `withDbModification`
-- >      dbModification {
-- >        -- Change default name "table1" to "Table_1". Change the name of "table1Field1" to "first_name"
-- >        table1 = setEntityName "Table_1" <> modifyTableFields tableModification { 
-- >            table1Field1 = "first_name" 
-- >         }
-- >      }
withDbModification :: forall db be entity
                    . Database be db
                   => db (entity be db)
                   -> DatabaseModification (entity be db) be db
                   -> db (entity be db)
withDbModification :: forall (db :: (* -> *) -> *) be
       (entity :: * -> ((* -> *) -> *) -> * -> *).
Database be db =>
db (entity be db)
-> DatabaseModification (entity be db) be db -> db (entity be db)
withDbModification db (entity be db)
db DatabaseModification (entity be db) be db
mods =
  Identity (db (entity be db)) -> db (entity be db)
forall a. Identity a -> a
runIdentity (Identity (db (entity be db)) -> db (entity be db))
-> Identity (db (entity be db)) -> db (entity be db)
forall a b. (a -> b) -> a -> b
$ Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    entity be db tbl
    -> EntityModification (entity be db) be tbl
    -> Identity (entity be db tbl))
-> db (entity be db)
-> DatabaseModification (entity be db) be db
-> Identity (db (entity be db))
forall be (db :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Database be db, Applicative m) =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
zipTables (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @be) (\entity be db tbl
tbl (EntityModification Endo (entity be db tbl)
entityFn) -> entity be db tbl -> Identity (entity be db tbl)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Endo (entity be db tbl) -> entity be db tbl -> entity be db tbl
forall a. Endo a -> a -> a
appEndo Endo (entity be db tbl)
entityFn entity be db tbl
tbl)) db (entity be db)
db DatabaseModification (entity be db) be db
mods

-- | Modify a table according to the given field modifications. Invoked by
--   'modifyTable' to apply the modification in the database. Not used as often in
--   user code, but provided for completeness.
withTableModification :: Beamable tbl => tbl (FieldModification f) -> tbl f -> tbl f
withTableModification :: forall (tbl :: (* -> *) -> *) (f :: * -> *).
Beamable tbl =>
tbl (FieldModification f) -> tbl f -> tbl f
withTableModification tbl (FieldModification f)
mods tbl f
tbl =
  Identity (tbl f) -> tbl f
forall a. Identity a -> a
runIdentity (Identity (tbl f) -> tbl f) -> Identity (tbl f) -> tbl f
forall a b. (a -> b) -> a -> b
$ (forall a.
 Columnar' f a
 -> Columnar' (FieldModification f) a -> Identity (Columnar' f a))
-> tbl f -> tbl (FieldModification f) -> Identity (tbl f)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\(Columnar' Columnar f a
field :: Columnar' f a) (Columnar' (FieldModification Columnar f a -> Columnar f a
fieldFn :: FieldModification f a)) ->
                                  Columnar' f a -> Identity (Columnar' f a)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar f a -> Columnar' f a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Columnar f a -> Columnar f a
fieldFn Columnar f a
field))) tbl f
tbl tbl (FieldModification f)
mods

-- | Provide an 'EntityModification' for 'TableEntity's. Allows you to modify
--   the name of the table and provide a modification for each field in the
--   table. See the examples for 'withDbModification' for more.
modifyTable :: (Beamable tbl, Table tbl)
            => (Text -> Text)
            -> tbl (FieldModification (TableField tbl))
            -> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
modifyTable :: forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Beamable tbl, Table tbl) =>
(Text -> Text)
-> tbl (FieldModification (TableField tbl))
-> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
modifyTable Text -> Text
modTblNm tbl (FieldModification (TableField tbl))
modFields = (Text -> Text)
-> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
forall be entity (db :: (* -> *) -> *).
IsDatabaseEntity be entity =>
(Text -> Text)
-> EntityModification (DatabaseEntity be db) be entity
modifyEntityName Text -> Text
modTblNm EntityModification (DatabaseEntity be db) be (TableEntity tbl)
-> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
-> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
forall a. Semigroup a => a -> a -> a
<> tbl (FieldModification (TableField tbl))
-> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
tbl (FieldModification (TableField tbl))
-> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
modifyTableFields tbl (FieldModification (TableField tbl))
modFields
{-# DEPRECATED modifyTable "Instead of 'modifyTable fTblNm fFields', use 'modifyEntityName _ <> modifyTableFields _'" #-}

-- | Construct an 'EntityModification' to rename any database entity
modifyEntityName :: IsDatabaseEntity be entity => (Text -> Text) -> EntityModification (DatabaseEntity be db) be entity
modifyEntityName :: forall be entity (db :: (* -> *) -> *).
IsDatabaseEntity be entity =>
(Text -> Text)
-> EntityModification (DatabaseEntity be db) be entity
modifyEntityName Text -> Text
modTblNm = Endo (DatabaseEntity be db entity)
-> EntityModification (DatabaseEntity be db) be entity
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification ((DatabaseEntity be db entity -> DatabaseEntity be db entity)
-> Endo (DatabaseEntity be db entity)
forall a. (a -> a) -> Endo a
Endo (\(DatabaseEntity DatabaseEntityDescriptor be entity
tbl) -> DatabaseEntityDescriptor be entity -> DatabaseEntity be db entity
forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
DatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
DatabaseEntity (DatabaseEntityDescriptor be entity
tbl DatabaseEntityDescriptor be entity
-> (DatabaseEntityDescriptor be entity
    -> DatabaseEntityDescriptor be entity)
-> DatabaseEntityDescriptor be entity
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> DatabaseEntityDescriptor be entity
-> Identity (DatabaseEntityDescriptor be entity)
forall be entityType.
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntityDescriptor be entityType) Text
Lens' (DatabaseEntityDescriptor be entity) Text
dbEntityName ((Text -> Identity Text)
 -> DatabaseEntityDescriptor be entity
 -> Identity (DatabaseEntityDescriptor be entity))
-> (Text -> Text)
-> DatabaseEntityDescriptor be entity
-> DatabaseEntityDescriptor be entity
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> Text
modTblNm)))

-- | Construct an 'EntityModification' to set the schema of a database entity
modifyEntitySchema :: IsDatabaseEntity be entity => (Maybe Text -> Maybe Text) -> EntityModification (DatabaseEntity be db) be entity
modifyEntitySchema :: forall be entity (db :: (* -> *) -> *).
IsDatabaseEntity be entity =>
(Maybe Text -> Maybe Text)
-> EntityModification (DatabaseEntity be db) be entity
modifyEntitySchema Maybe Text -> Maybe Text
modSchema = Endo (DatabaseEntity be db entity)
-> EntityModification (DatabaseEntity be db) be entity
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification ((DatabaseEntity be db entity -> DatabaseEntity be db entity)
-> Endo (DatabaseEntity be db entity)
forall a. (a -> a) -> Endo a
Endo (\(DatabaseEntity DatabaseEntityDescriptor be entity
tbl) -> DatabaseEntityDescriptor be entity -> DatabaseEntity be db entity
forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
DatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
DatabaseEntity (DatabaseEntityDescriptor be entity
tbl DatabaseEntityDescriptor be entity
-> (DatabaseEntityDescriptor be entity
    -> DatabaseEntityDescriptor be entity)
-> DatabaseEntityDescriptor be entity
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> DatabaseEntityDescriptor be entity
-> Identity (DatabaseEntityDescriptor be entity)
forall be entityType.
IsDatabaseEntity be entityType =>
Traversal' (DatabaseEntityDescriptor be entityType) (Maybe Text)
Traversal' (DatabaseEntityDescriptor be entity) (Maybe Text)
dbEntitySchema ((Maybe Text -> Identity (Maybe Text))
 -> DatabaseEntityDescriptor be entity
 -> Identity (DatabaseEntityDescriptor be entity))
-> (Maybe Text -> Maybe Text)
-> DatabaseEntityDescriptor be entity
-> DatabaseEntityDescriptor be entity
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe Text -> Maybe Text
modSchema)))

-- | Change the entity name without consulting the beam-assigned one
setEntityName :: IsDatabaseEntity be entity => Text -> EntityModification (DatabaseEntity be db) be entity
setEntityName :: forall be entity (db :: (* -> *) -> *).
IsDatabaseEntity be entity =>
Text -> EntityModification (DatabaseEntity be db) be entity
setEntityName Text
nm = (Text -> Text)
-> EntityModification (DatabaseEntity be db) be entity
forall be entity (db :: (* -> *) -> *).
IsDatabaseEntity be entity =>
(Text -> Text)
-> EntityModification (DatabaseEntity be db) be entity
modifyEntityName (\Text
_ -> Text
nm)

setEntitySchema :: IsDatabaseEntity be entity => Maybe Text -> EntityModification (DatabaseEntity be db) be entity
setEntitySchema :: forall be entity (db :: (* -> *) -> *).
IsDatabaseEntity be entity =>
Maybe Text -> EntityModification (DatabaseEntity be db) be entity
setEntitySchema Maybe Text
nm = (Maybe Text -> Maybe Text)
-> EntityModification (DatabaseEntity be db) be entity
forall be entity (db :: (* -> *) -> *).
IsDatabaseEntity be entity =>
(Maybe Text -> Maybe Text)
-> EntityModification (DatabaseEntity be db) be entity
modifyEntitySchema (\Maybe Text
_ -> Maybe Text
nm)

-- | Embed database settings in a larger database
embedDatabase :: forall be embedded db. Database be embedded => DatabaseSettings be embedded -> embedded (EntityModification (DatabaseEntity be db) be)
embedDatabase :: forall be (embedded :: (* -> *) -> *) (db :: (* -> *) -> *).
Database be embedded =>
DatabaseSettings be embedded
-> embedded (EntityModification (DatabaseEntity be db) be)
embedDatabase DatabaseSettings be embedded
db =
    Identity (embedded (EntityModification (DatabaseEntity be db) be))
-> embedded (EntityModification (DatabaseEntity be db) be)
forall a. Identity a -> a
runIdentity (Identity (embedded (EntityModification (DatabaseEntity be db) be))
 -> embedded (EntityModification (DatabaseEntity be db) be))
-> Identity
     (embedded (EntityModification (DatabaseEntity be db) be))
-> embedded (EntityModification (DatabaseEntity be db) be)
forall a b. (a -> b) -> a -> b
$
    Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    DatabaseEntity be embedded tbl
    -> DatabaseEntity be embedded tbl
    -> Identity (EntityModification (DatabaseEntity be db) be tbl))
-> DatabaseSettings be embedded
-> DatabaseSettings be embedded
-> Identity
     (embedded (EntityModification (DatabaseEntity be db) be))
forall be (db :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Database be db, Applicative m) =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> embedded f
-> embedded g
-> m (embedded h)
zipTables (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @be)
              (\(DatabaseEntity DatabaseEntityDescriptor be tbl
x) DatabaseEntity be embedded tbl
_ -> EntityModification (DatabaseEntity be db) be tbl
-> Identity (EntityModification (DatabaseEntity be db) be tbl)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Endo (DatabaseEntity be db tbl)
-> EntityModification (DatabaseEntity be db) be tbl
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification ((DatabaseEntity be db tbl -> DatabaseEntity be db tbl)
-> Endo (DatabaseEntity be db tbl)
forall a. (a -> a) -> Endo a
Endo (\DatabaseEntity be db tbl
_ -> DatabaseEntityDescriptor be tbl -> DatabaseEntity be db tbl
forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
DatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
DatabaseEntity DatabaseEntityDescriptor be tbl
x))))
              DatabaseSettings be embedded
db DatabaseSettings be embedded
db

-- | Construct an 'EntityModification' to rename the fields of a 'TableEntity'
modifyTableFields :: tbl (FieldModification (TableField tbl)) -> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
modifyTableFields :: forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
tbl (FieldModification (TableField tbl))
-> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
modifyTableFields tbl (FieldModification (TableField tbl))
modFields = Endo (DatabaseEntity be db (TableEntity tbl))
-> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification ((DatabaseEntity be db (TableEntity tbl)
 -> DatabaseEntity be db (TableEntity tbl))
-> Endo (DatabaseEntity be db (TableEntity tbl))
forall a. (a -> a) -> Endo a
Endo (\(DatabaseEntity tbl :: DatabaseEntityDescriptor be (TableEntity tbl)
tbl@(DatabaseTable {})) -> DatabaseEntityDescriptor be (TableEntity tbl)
-> DatabaseEntity be db (TableEntity tbl)
forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
DatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
DatabaseEntity DatabaseEntityDescriptor be (TableEntity tbl)
tbl { dbTableSettings = withTableModification modFields (dbTableSettings tbl) }))

-- | A field modification to rename the field. Also offered under the 'IsString'
--   instance for 'FieldModification (TableField tbl) a' for convenience.
fieldNamed :: Text -> FieldModification (TableField tbl) a
fieldNamed :: forall (tbl :: (* -> *) -> *) a.
Text -> FieldModification (TableField tbl) a
fieldNamed Text
newName = (Columnar (TableField tbl) a -> Columnar (TableField tbl) a)
-> FieldModification (TableField tbl) a
forall (f :: * -> *) a.
(Columnar f a -> Columnar f a) -> FieldModification f a
FieldModification ((Text -> Identity Text)
-> TableField tbl a -> Identity (TableField tbl a)
forall (table :: (* -> *) -> *) ty (f :: * -> *).
Functor f =>
(Text -> f Text) -> TableField table ty -> f (TableField table ty)
fieldName ((Text -> Identity Text)
 -> TableField tbl a -> Identity (TableField tbl a))
-> Text -> TableField tbl a -> TableField tbl a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
newName)

newtype FieldRenamer entity = FieldRenamer { forall entity. FieldRenamer entity -> entity -> entity
withFieldRenamer :: entity -> entity }

class RenamableField f where
  renameField :: Proxy f -> Proxy a -> (NE.NonEmpty Text -> Text) -> Columnar f a -> Columnar f a
instance RenamableField (TableField tbl) where
  renameField :: forall a.
Proxy (TableField tbl)
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar (TableField tbl) a
-> Columnar (TableField tbl) a
renameField Proxy (TableField tbl)
_ Proxy a
_ NonEmpty Text -> Text
f (TableField NonEmpty Text
path Text
_) = NonEmpty Text -> Text -> TableField tbl a
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField NonEmpty Text
path (NonEmpty Text -> Text
f NonEmpty Text
path)

class RenamableWithRule mod where
  renamingFields :: (NE.NonEmpty Text -> Text) -> mod
instance Database be db => RenamableWithRule (db (EntityModification (DatabaseEntity be db) be)) where
  renamingFields :: (NonEmpty Text -> Text)
-> db (EntityModification (DatabaseEntity be db) be)
renamingFields NonEmpty Text -> Text
renamer =
    Identity (db (EntityModification (DatabaseEntity be db) be))
-> db (EntityModification (DatabaseEntity be db) be)
forall a. Identity a -> a
runIdentity (Identity (db (EntityModification (DatabaseEntity be db) be))
 -> db (EntityModification (DatabaseEntity be db) be))
-> Identity (db (EntityModification (DatabaseEntity be db) be))
-> db (EntityModification (DatabaseEntity be db) be)
forall a b. (a -> b) -> a -> b
$
    Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    EntityModification (ZonkAny 2) be tbl
    -> EntityModification (ZonkAny 1) be tbl
    -> Identity (EntityModification (DatabaseEntity be db) be tbl))
-> db (EntityModification (ZonkAny 2) be)
-> db (EntityModification (ZonkAny 1) be)
-> Identity (db (EntityModification (DatabaseEntity be db) be))
forall be (db :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Database be db, Applicative m) =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
zipTables (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @be) (\EntityModification (ZonkAny 2) be tbl
_ EntityModification (ZonkAny 1) be tbl
_ -> EntityModification (DatabaseEntity be db) be tbl
-> Identity (EntityModification (DatabaseEntity be db) be tbl)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((NonEmpty Text -> Text)
-> EntityModification (DatabaseEntity be db) be tbl
forall mod. RenamableWithRule mod => (NonEmpty Text -> Text) -> mod
renamingFields NonEmpty Text -> Text
renamer))
              (DatabaseModification f be db
forall a. HasCallStack => a
forall {f :: * -> *}. DatabaseModification f be db
undefined :: DatabaseModification f be db)
              (DatabaseModification f be db
forall a. HasCallStack => a
forall {f :: * -> *}. DatabaseModification f be db
undefined :: DatabaseModification f be db)
instance IsDatabaseEntity be entity => RenamableWithRule (EntityModification (DatabaseEntity be db) be entity) where
  renamingFields :: (NonEmpty Text -> Text)
-> EntityModification (DatabaseEntity be db) be entity
renamingFields NonEmpty Text -> Text
renamer =
    Endo (DatabaseEntity be db entity)
-> EntityModification (DatabaseEntity be db) be entity
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification ((DatabaseEntity be db entity -> DatabaseEntity be db entity)
-> Endo (DatabaseEntity be db entity)
forall a. (a -> a) -> Endo a
Endo (\(DatabaseEntity DatabaseEntityDescriptor be entity
tbl) -> DatabaseEntityDescriptor be entity -> DatabaseEntity be db entity
forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
DatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
DatabaseEntity (FieldRenamer (DatabaseEntityDescriptor be entity)
-> DatabaseEntityDescriptor be entity
-> DatabaseEntityDescriptor be entity
forall entity. FieldRenamer entity -> entity -> entity
withFieldRenamer ((NonEmpty Text -> Text)
-> FieldRenamer (DatabaseEntityDescriptor be entity)
forall mod. RenamableWithRule mod => (NonEmpty Text -> Text) -> mod
renamingFields NonEmpty Text -> Text
renamer) DatabaseEntityDescriptor be entity
tbl)))
instance (Beamable tbl, RenamableField f) => RenamableWithRule (tbl (FieldModification f)) where
  renamingFields :: (NonEmpty Text -> Text) -> tbl (FieldModification f)
renamingFields NonEmpty Text -> Text
renamer =
    Identity (tbl (FieldModification f)) -> tbl (FieldModification f)
forall a. Identity a -> a
runIdentity (Identity (tbl (FieldModification f)) -> tbl (FieldModification f))
-> Identity (tbl (FieldModification f))
-> tbl (FieldModification f)
forall a b. (a -> b) -> a -> b
$
    (forall a.
 Columnar' Ignored a
 -> Columnar' Ignored a
 -> Identity (Columnar' (FieldModification f) a))
-> tbl Ignored
-> tbl Ignored
-> Identity (tbl (FieldModification f))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\(Columnar' Columnar Ignored a
_ :: Columnar' Ignored x) (Columnar' Columnar Ignored a
_ :: Columnar' Ignored x) ->
                       Columnar' (FieldModification f) a
-> Identity (Columnar' (FieldModification f) a)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar (FieldModification f) a
-> Columnar' (FieldModification f) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((Columnar f a -> Columnar f a) -> FieldModification f a
forall (f :: * -> *) a.
(Columnar f a -> Columnar f a) -> FieldModification f a
FieldModification (Proxy f
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar f a
-> Columnar f a
forall a.
Proxy f
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar f a
-> Columnar f a
forall (f :: * -> *) a.
RenamableField f =>
Proxy f
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar f a
-> Columnar f a
renameField (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @f) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @x) NonEmpty Text -> Text
renamer) :: FieldModification f x) ::
                               Columnar' (FieldModification f) x))
                   (tbl Ignored
forall a. HasCallStack => a
undefined :: TableSkeleton tbl) (tbl Ignored
forall a. HasCallStack => a
undefined :: TableSkeleton tbl)

instance IsString (FieldModification (TableField tbl) a) where
  fromString :: String -> FieldModification (TableField tbl) a
fromString = Text -> FieldModification (TableField tbl) a
forall (tbl :: (* -> *) -> *) a.
Text -> FieldModification (TableField tbl) a
fieldNamed (Text -> FieldModification (TableField tbl) a)
-> (String -> Text)
-> String
-> FieldModification (TableField tbl) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- * Database entity types

-- | An entity tag for tables. See the documentation for 'Table' or consult the
--   [manual](https://haskell-beam.github.io/beam/user-guide/models) for more.
data TableEntity (tbl :: (Type -> Type) -> Type)
data ViewEntity (view :: (Type -> Type) -> Type)
--data UniqueConstraint (tbl :: (* -> *) -> *) (c :: (* -> *) -> *)
data DomainTypeEntity (ty :: Type)
--data CharacterSetEntity
--data CollationEntity
--data TranslationEntity
--data AssertionEntity

class RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor be entityType)) =>
    IsDatabaseEntity be entityType where
  data DatabaseEntityDescriptor be entityType :: Type
  type DatabaseEntityDefaultRequirements be entityType :: Constraint
  type DatabaseEntityRegularRequirements be entityType :: Constraint

  dbEntityName :: Lens' (DatabaseEntityDescriptor be entityType) Text
  dbEntitySchema :: Traversal' (DatabaseEntityDescriptor be entityType) (Maybe Text)

  dbEntityAuto :: DatabaseEntityDefaultRequirements be entityType =>
                  Text -> DatabaseEntityDescriptor be entityType

instance Beamable tbl => RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor be (TableEntity tbl))) where
  renamingFields :: (NonEmpty Text -> Text)
-> FieldRenamer (DatabaseEntityDescriptor be (TableEntity tbl))
renamingFields NonEmpty Text -> Text
renamer =
    (DatabaseEntityDescriptor be (TableEntity tbl)
 -> DatabaseEntityDescriptor be (TableEntity tbl))
-> FieldRenamer (DatabaseEntityDescriptor be (TableEntity tbl))
forall entity. (entity -> entity) -> FieldRenamer entity
FieldRenamer ((DatabaseEntityDescriptor be (TableEntity tbl)
  -> DatabaseEntityDescriptor be (TableEntity tbl))
 -> FieldRenamer (DatabaseEntityDescriptor be (TableEntity tbl)))
-> (DatabaseEntityDescriptor be (TableEntity tbl)
    -> DatabaseEntityDescriptor be (TableEntity tbl))
-> FieldRenamer (DatabaseEntityDescriptor be (TableEntity tbl))
forall a b. (a -> b) -> a -> b
$ \DatabaseEntityDescriptor be (TableEntity tbl)
tbl ->
      DatabaseEntityDescriptor be (TableEntity tbl)
tbl { dbTableSettings =
              changeBeamRep (\(Columnar' Columnar (TableField tbl) a
tblField :: Columnar' (TableField tbl) a) ->
                               Columnar (TableField tbl) a -> Columnar' (TableField tbl) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Proxy (TableField tbl)
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar (TableField tbl) a
-> Columnar (TableField tbl) a
forall a.
Proxy (TableField tbl)
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar (TableField tbl) a
-> Columnar (TableField tbl) a
forall (f :: * -> *) a.
RenamableField f =>
Proxy f
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar f a
-> Columnar f a
renameField (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(TableField tbl))
                                                      (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                                                      NonEmpty Text -> Text
renamer Columnar (TableField tbl) a
tblField)
                                 :: Columnar' (TableField tbl) a) $
              dbTableSettings tbl }

instance Beamable tbl => IsDatabaseEntity be (TableEntity tbl) where
  data DatabaseEntityDescriptor be (TableEntity tbl) where
    DatabaseTable
      :: Table tbl =>
       { forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema      :: Maybe Text
       , forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableOrigName    :: Text
       , forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName :: Text
       , forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings    :: TableSettings tbl }
      -> DatabaseEntityDescriptor be (TableEntity tbl)
  type DatabaseEntityDefaultRequirements be (TableEntity tbl) =
    ( GDefaultTableFieldSettings (Rep (TableSettings tbl) ())
    , Generic (TableSettings tbl), Table tbl, Beamable tbl )
  type DatabaseEntityRegularRequirements be (TableEntity tbl) =
    ( Table tbl, Beamable tbl )

  dbEntityName :: Lens' (DatabaseEntityDescriptor be (TableEntity tbl)) Text
dbEntityName Text -> f Text
f DatabaseEntityDescriptor be (TableEntity tbl)
tbl = (Text -> DatabaseEntityDescriptor be (TableEntity tbl))
-> f Text -> f (DatabaseEntityDescriptor be (TableEntity tbl))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
t' -> DatabaseEntityDescriptor be (TableEntity tbl)
tbl { dbTableCurrentName = t' }) (Text -> f Text
f (DatabaseEntityDescriptor be (TableEntity tbl) -> Text
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor be (TableEntity tbl)
tbl))
  dbEntitySchema :: Traversal'
  (DatabaseEntityDescriptor be (TableEntity tbl)) (Maybe Text)
dbEntitySchema Maybe Text -> f (Maybe Text)
f DatabaseEntityDescriptor be (TableEntity tbl)
tbl = (Maybe Text -> DatabaseEntityDescriptor be (TableEntity tbl))
-> f (Maybe Text)
-> f (DatabaseEntityDescriptor be (TableEntity tbl))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Text
s' -> DatabaseEntityDescriptor be (TableEntity tbl)
tbl { dbTableSchema = s'}) (Maybe Text -> f (Maybe Text)
f (DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor be (TableEntity tbl)
tbl))
  dbEntityAuto :: DatabaseEntityDefaultRequirements be (TableEntity tbl) =>
Text -> DatabaseEntityDescriptor be (TableEntity tbl)
dbEntityAuto Text
nm =
    Maybe Text
-> Text
-> Text
-> TableSettings tbl
-> DatabaseEntityDescriptor be (TableEntity tbl)
forall (tbl :: (* -> *) -> *) be.
Table tbl =>
Maybe Text
-> Text
-> Text
-> TableSettings tbl
-> DatabaseEntityDescriptor be (TableEntity tbl)
DatabaseTable Maybe Text
forall a. Maybe a
Nothing Text
nm (Text -> Text
unCamelCaseSel Text
nm) TableSettings tbl
forall (table :: (* -> *) -> *).
(Generic (TableSettings table),
 GDefaultTableFieldSettings (Rep (TableSettings table) ())) =>
TableSettings table
defTblFieldSettings

instance Beamable tbl => RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor be (ViewEntity tbl))) where
  renamingFields :: (NonEmpty Text -> Text)
-> FieldRenamer (DatabaseEntityDescriptor be (ViewEntity tbl))
renamingFields NonEmpty Text -> Text
renamer =
    (DatabaseEntityDescriptor be (ViewEntity tbl)
 -> DatabaseEntityDescriptor be (ViewEntity tbl))
-> FieldRenamer (DatabaseEntityDescriptor be (ViewEntity tbl))
forall entity. (entity -> entity) -> FieldRenamer entity
FieldRenamer ((DatabaseEntityDescriptor be (ViewEntity tbl)
  -> DatabaseEntityDescriptor be (ViewEntity tbl))
 -> FieldRenamer (DatabaseEntityDescriptor be (ViewEntity tbl)))
-> (DatabaseEntityDescriptor be (ViewEntity tbl)
    -> DatabaseEntityDescriptor be (ViewEntity tbl))
-> FieldRenamer (DatabaseEntityDescriptor be (ViewEntity tbl))
forall a b. (a -> b) -> a -> b
$ \DatabaseEntityDescriptor be (ViewEntity tbl)
vw ->
      DatabaseEntityDescriptor be (ViewEntity tbl)
vw { dbViewSettings =
             changeBeamRep (\(Columnar' Columnar (TableField tbl) a
tblField :: Columnar' (TableField tbl) a) ->
                              Columnar (TableField tbl) a -> Columnar' (TableField tbl) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Proxy (TableField tbl)
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar (TableField tbl) a
-> Columnar (TableField tbl) a
forall a.
Proxy (TableField tbl)
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar (TableField tbl) a
-> Columnar (TableField tbl) a
forall (f :: * -> *) a.
RenamableField f =>
Proxy f
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar f a
-> Columnar f a
renameField (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(TableField tbl))
                                                     (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                                                     NonEmpty Text -> Text
renamer Columnar (TableField tbl) a
tblField)
                                :: Columnar' (TableField tbl) a) $
             dbViewSettings vw }

instance Beamable tbl => IsDatabaseEntity be (ViewEntity tbl) where
  data DatabaseEntityDescriptor be (ViewEntity tbl) where
    DatabaseView
      :: { forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (ViewEntity tbl) -> Maybe Text
dbViewSchema :: Maybe Text
         , forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (ViewEntity tbl) -> Text
dbViewOrigName :: Text
         , forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (ViewEntity tbl) -> Text
dbViewCurrentName :: Text
         , forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (ViewEntity tbl) -> TableSettings tbl
dbViewSettings :: TableSettings tbl }
      -> DatabaseEntityDescriptor be (ViewEntity tbl)
  type DatabaseEntityDefaultRequirements be (ViewEntity tbl) =
    ( GDefaultTableFieldSettings (Rep (TableSettings tbl) ())
    , Generic (TableSettings tbl), Beamable tbl )
  type DatabaseEntityRegularRequirements be (ViewEntity tbl) =
    (  Beamable tbl )

  dbEntityName :: Lens' (DatabaseEntityDescriptor be (ViewEntity tbl)) Text
dbEntityName Text -> f Text
f DatabaseEntityDescriptor be (ViewEntity tbl)
vw = (Text -> DatabaseEntityDescriptor be (ViewEntity tbl))
-> f Text -> f (DatabaseEntityDescriptor be (ViewEntity tbl))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
t' -> DatabaseEntityDescriptor be (ViewEntity tbl)
vw { dbViewCurrentName = t' }) (Text -> f Text
f (DatabaseEntityDescriptor be (ViewEntity tbl) -> Text
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (ViewEntity tbl) -> Text
dbViewCurrentName DatabaseEntityDescriptor be (ViewEntity tbl)
vw))
  dbEntitySchema :: Traversal'
  (DatabaseEntityDescriptor be (ViewEntity tbl)) (Maybe Text)
dbEntitySchema Maybe Text -> f (Maybe Text)
f DatabaseEntityDescriptor be (ViewEntity tbl)
vw = (Maybe Text -> DatabaseEntityDescriptor be (ViewEntity tbl))
-> f (Maybe Text)
-> f (DatabaseEntityDescriptor be (ViewEntity tbl))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Text
s' -> DatabaseEntityDescriptor be (ViewEntity tbl)
vw { dbViewSchema = s' }) (Maybe Text -> f (Maybe Text)
f (DatabaseEntityDescriptor be (ViewEntity tbl) -> Maybe Text
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (ViewEntity tbl) -> Maybe Text
dbViewSchema DatabaseEntityDescriptor be (ViewEntity tbl)
vw))
  dbEntityAuto :: DatabaseEntityDefaultRequirements be (ViewEntity tbl) =>
Text -> DatabaseEntityDescriptor be (ViewEntity tbl)
dbEntityAuto Text
nm =
    Maybe Text
-> Text
-> Text
-> TableSettings tbl
-> DatabaseEntityDescriptor be (ViewEntity tbl)
forall (tbl :: (* -> *) -> *) be.
Maybe Text
-> Text
-> Text
-> TableSettings tbl
-> DatabaseEntityDescriptor be (ViewEntity tbl)
DatabaseView Maybe Text
forall a. Maybe a
Nothing Text
nm (Text -> Text
unCamelCaseSel Text
nm) TableSettings tbl
forall (table :: (* -> *) -> *).
(Generic (TableSettings table),
 GDefaultTableFieldSettings (Rep (TableSettings table) ())) =>
TableSettings table
defTblFieldSettings

instance RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor be (DomainTypeEntity ty))) where
  renamingFields :: (NonEmpty Text -> Text)
-> FieldRenamer (DatabaseEntityDescriptor be (DomainTypeEntity ty))
renamingFields NonEmpty Text -> Text
_ = (DatabaseEntityDescriptor be (DomainTypeEntity ty)
 -> DatabaseEntityDescriptor be (DomainTypeEntity ty))
-> FieldRenamer (DatabaseEntityDescriptor be (DomainTypeEntity ty))
forall entity. (entity -> entity) -> FieldRenamer entity
FieldRenamer DatabaseEntityDescriptor be (DomainTypeEntity ty)
-> DatabaseEntityDescriptor be (DomainTypeEntity ty)
forall a. a -> a
id

instance IsDatabaseEntity be (DomainTypeEntity ty) where
  data DatabaseEntityDescriptor be (DomainTypeEntity ty)
    = DatabaseDomainType !(Maybe Text) !Text
  type DatabaseEntityDefaultRequirements be (DomainTypeEntity ty) = ()
  type DatabaseEntityRegularRequirements be (DomainTypeEntity ty) = ()

  dbEntityName :: Lens' (DatabaseEntityDescriptor be (DomainTypeEntity ty)) Text
dbEntityName Text -> f Text
f (DatabaseDomainType Maybe Text
s Text
t) = Maybe Text
-> Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty)
forall be ty.
Maybe Text
-> Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty)
DatabaseDomainType Maybe Text
s (Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty))
-> f Text -> f (DatabaseEntityDescriptor be (DomainTypeEntity ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
t
  dbEntitySchema :: Traversal'
  (DatabaseEntityDescriptor be (DomainTypeEntity ty)) (Maybe Text)
dbEntitySchema Maybe Text -> f (Maybe Text)
f (DatabaseDomainType Maybe Text
s Text
t) = Maybe Text
-> Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty)
forall be ty.
Maybe Text
-> Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty)
DatabaseDomainType (Maybe Text
 -> Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty))
-> f (Maybe Text)
-> f (Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> f (Maybe Text)
f Maybe Text
s f (Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty))
-> f Text -> f (DatabaseEntityDescriptor be (DomainTypeEntity ty))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> f Text
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
  dbEntityAuto :: DatabaseEntityDefaultRequirements be (DomainTypeEntity ty) =>
Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty)
dbEntityAuto = Maybe Text
-> Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty)
forall be ty.
Maybe Text
-> Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty)
DatabaseDomainType Maybe Text
forall a. Maybe a
Nothing

-- | Represents a meta-description of a particular entityType. Mostly, a wrapper
--   around 'DatabaseEntityDescriptor be entityType', but carries around the
--   'IsDatabaseEntity' dictionary.
data DatabaseEntity be (db :: (Type -> Type) -> Type) entityType  where
    DatabaseEntity ::
      IsDatabaseEntity be entityType =>
      DatabaseEntityDescriptor be entityType ->  DatabaseEntity be db entityType

dbEntityDescriptor :: Lens' (DatabaseEntity be db entityType) (DatabaseEntityDescriptor be entityType)
dbEntityDescriptor :: forall be (db :: (* -> *) -> *) entityType (f :: * -> *).
Functor f =>
(DatabaseEntityDescriptor be entityType
 -> f (DatabaseEntityDescriptor be entityType))
-> DatabaseEntity be db entityType
-> f (DatabaseEntity be db entityType)
dbEntityDescriptor DatabaseEntityDescriptor be entityType
-> f (DatabaseEntityDescriptor be entityType)
f (DatabaseEntity DatabaseEntityDescriptor be entityType
d) = DatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
DatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
DatabaseEntity (DatabaseEntityDescriptor be entityType
 -> DatabaseEntity be db entityType)
-> f (DatabaseEntityDescriptor be entityType)
-> f (DatabaseEntity be db entityType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseEntityDescriptor be entityType
-> f (DatabaseEntityDescriptor be entityType)
f DatabaseEntityDescriptor be entityType
d

dbName :: IsDatabaseEntity be entityType => Lens' (DatabaseEntity be db entityType) Text
dbName :: forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntity be db entityType) Text
dbName = (DatabaseEntityDescriptor be entityType
 -> f (DatabaseEntityDescriptor be entityType))
-> DatabaseEntity be db entityType
-> f (DatabaseEntity be db entityType)
forall be (db :: (* -> *) -> *) entityType (f :: * -> *).
Functor f =>
(DatabaseEntityDescriptor be entityType
 -> f (DatabaseEntityDescriptor be entityType))
-> DatabaseEntity be db entityType
-> f (DatabaseEntity be db entityType)
dbEntityDescriptor ((DatabaseEntityDescriptor be entityType
  -> f (DatabaseEntityDescriptor be entityType))
 -> DatabaseEntity be db entityType
 -> f (DatabaseEntity be db entityType))
-> ((Text -> f Text)
    -> DatabaseEntityDescriptor be entityType
    -> f (DatabaseEntityDescriptor be entityType))
-> (Text -> f Text)
-> DatabaseEntity be db entityType
-> f (DatabaseEntity be db entityType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text)
-> DatabaseEntityDescriptor be entityType
-> f (DatabaseEntityDescriptor be entityType)
forall be entityType.
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntityDescriptor be entityType) Text
Lens' (DatabaseEntityDescriptor be entityType) Text
dbEntityName

dbSchema :: IsDatabaseEntity be entityType => Traversal' (DatabaseEntity be db entityType) (Maybe Text)
dbSchema :: forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
Traversal' (DatabaseEntity be db entityType) (Maybe Text)
dbSchema = (DatabaseEntityDescriptor be entityType
 -> f (DatabaseEntityDescriptor be entityType))
-> DatabaseEntity be db entityType
-> f (DatabaseEntity be db entityType)
forall be (db :: (* -> *) -> *) entityType (f :: * -> *).
Functor f =>
(DatabaseEntityDescriptor be entityType
 -> f (DatabaseEntityDescriptor be entityType))
-> DatabaseEntity be db entityType
-> f (DatabaseEntity be db entityType)
dbEntityDescriptor ((DatabaseEntityDescriptor be entityType
  -> f (DatabaseEntityDescriptor be entityType))
 -> DatabaseEntity be db entityType
 -> f (DatabaseEntity be db entityType))
-> ((Maybe Text -> f (Maybe Text))
    -> DatabaseEntityDescriptor be entityType
    -> f (DatabaseEntityDescriptor be entityType))
-> (Maybe Text -> f (Maybe Text))
-> DatabaseEntity be db entityType
-> f (DatabaseEntity be db entityType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> f (Maybe Text))
-> DatabaseEntityDescriptor be entityType
-> f (DatabaseEntityDescriptor be entityType)
forall be entityType.
IsDatabaseEntity be entityType =>
Traversal' (DatabaseEntityDescriptor be entityType) (Maybe Text)
Traversal' (DatabaseEntityDescriptor be entityType) (Maybe Text)
dbEntitySchema

dbTableFields :: Lens' (DatabaseEntity be db (TableEntity table)) (TableSettings table)
dbTableFields :: forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *)
       (f :: * -> *).
Functor f =>
(TableSettings table -> f (TableSettings table))
-> DatabaseEntity be db (TableEntity table)
-> f (DatabaseEntity be db (TableEntity table))
dbTableFields = (DatabaseEntityDescriptor be (TableEntity table)
 -> f (DatabaseEntityDescriptor be (TableEntity table)))
-> DatabaseEntity be db (TableEntity table)
-> f (DatabaseEntity be db (TableEntity table))
forall be (db :: (* -> *) -> *) entityType (f :: * -> *).
Functor f =>
(DatabaseEntityDescriptor be entityType
 -> f (DatabaseEntityDescriptor be entityType))
-> DatabaseEntity be db entityType
-> f (DatabaseEntity be db entityType)
dbEntityDescriptor ((DatabaseEntityDescriptor be (TableEntity table)
  -> f (DatabaseEntityDescriptor be (TableEntity table)))
 -> DatabaseEntity be db (TableEntity table)
 -> f (DatabaseEntity be db (TableEntity table)))
-> ((TableSettings table -> f (TableSettings table))
    -> DatabaseEntityDescriptor be (TableEntity table)
    -> f (DatabaseEntityDescriptor be (TableEntity table)))
-> (TableSettings table -> f (TableSettings table))
-> DatabaseEntity be db (TableEntity table)
-> f (DatabaseEntity be db (TableEntity table))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\TableSettings table -> f (TableSettings table)
f DatabaseTable { dbTableSchema :: forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema = Maybe Text
sch
                                                       , dbTableOrigName :: forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableOrigName = Text
nm
                                                       , dbTableCurrentName :: forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName = Text
curNm
                                                       , dbTableSettings :: forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings = TableSettings table
s } ->
                                      Maybe Text
-> Text
-> Text
-> TableSettings table
-> DatabaseEntityDescriptor be (TableEntity table)
forall (tbl :: (* -> *) -> *) be.
Table tbl =>
Maybe Text
-> Text
-> Text
-> TableSettings tbl
-> DatabaseEntityDescriptor be (TableEntity tbl)
DatabaseTable Maybe Text
sch Text
nm Text
curNm (TableSettings table
 -> DatabaseEntityDescriptor be (TableEntity table))
-> f (TableSettings table)
-> f (DatabaseEntityDescriptor be (TableEntity table))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableSettings table -> f (TableSettings table)
f TableSettings table
s)

-- | When parameterized by this entity tag, a database type will hold
--   meta-information on the Haskell mappings of database entities. Under the
--   hood, each entity type is transformed into its 'DatabaseEntityDescriptor'
--   type. For tables this includes the table name as well as the corresponding
--   'TableSettings', which provides names for each column.
type DatabaseSettings be db = db (DatabaseEntity be db)

class GAutoDbSettings x where
    autoDbSettings' :: x
instance GAutoDbSettings (x p) => GAutoDbSettings (D1 f x p) where
    autoDbSettings' :: D1 f x p
autoDbSettings' = x p -> D1 f x p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 x p
forall x. GAutoDbSettings x => x
autoDbSettings'
instance GAutoDbSettings (x p) => GAutoDbSettings (C1 f x p) where
    autoDbSettings' :: C1 f x p
autoDbSettings' = x p -> C1 f x p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 x p
forall x. GAutoDbSettings x => x
autoDbSettings'
instance (GAutoDbSettings (x p), GAutoDbSettings (y p)) => GAutoDbSettings ((x :*: y) p) where
    autoDbSettings' :: (:*:) x y p
autoDbSettings' = x p
forall x. GAutoDbSettings x => x
autoDbSettings' x p -> y p -> (:*:) x y p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: y p
forall x. GAutoDbSettings x => x
autoDbSettings'
instance ( Selector f, IsDatabaseEntity be x, DatabaseEntityDefaultRequirements be x ) =>
  GAutoDbSettings (S1 f (K1 Generic.R (DatabaseEntity be db x)) p) where
  autoDbSettings' :: S1 f (K1 R (DatabaseEntity be db x)) p
autoDbSettings' = K1 R (DatabaseEntity be db x) p
-> S1 f (K1 R (DatabaseEntity be db x)) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (DatabaseEntity be db x -> K1 R (DatabaseEntity be db x) p
forall k i c (p :: k). c -> K1 i c p
K1 (DatabaseEntityDescriptor be x -> DatabaseEntity be db x
forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
DatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
DatabaseEntity (Text -> DatabaseEntityDescriptor be x
forall be entityType.
(IsDatabaseEntity be entityType,
 DatabaseEntityDefaultRequirements be entityType) =>
Text -> DatabaseEntityDescriptor be entityType
dbEntityAuto Text
name)))
    where name :: Text
name = String -> Text
T.pack (S1 f (K1 R (DatabaseEntity be db x)) p -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t f f a -> String
selName (S1 f (K1 R (DatabaseEntity be db x)) p
forall a. HasCallStack => a
undefined :: S1 f (K1 Generic.R (DatabaseEntity be db x)) p))
instance ( Database be embedded
         , Generic (DatabaseSettings be embedded)
         , GAutoDbSettings (Rep (DatabaseSettings be embedded) ()) ) =>
    GAutoDbSettings (S1 f (K1 Generic.R (embedded (DatabaseEntity be super))) p) where
  autoDbSettings' :: S1 f (K1 R (embedded (DatabaseEntity be super))) p
autoDbSettings' =
    K1 R (embedded (DatabaseEntity be super)) p
-> S1 f (K1 R (embedded (DatabaseEntity be super))) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (embedded (DatabaseEntity be super)) p
 -> S1 f (K1 R (embedded (DatabaseEntity be super))) p)
-> (Identity (embedded (DatabaseEntity be super))
    -> K1 R (embedded (DatabaseEntity be super)) p)
-> Identity (embedded (DatabaseEntity be super))
-> S1 f (K1 R (embedded (DatabaseEntity be super))) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. embedded (DatabaseEntity be super)
-> K1 R (embedded (DatabaseEntity be super)) p
forall k i c (p :: k). c -> K1 i c p
K1 (embedded (DatabaseEntity be super)
 -> K1 R (embedded (DatabaseEntity be super)) p)
-> (Identity (embedded (DatabaseEntity be super))
    -> embedded (DatabaseEntity be super))
-> Identity (embedded (DatabaseEntity be super))
-> K1 R (embedded (DatabaseEntity be super)) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (embedded (DatabaseEntity be super))
-> embedded (DatabaseEntity be super)
forall a. Identity a -> a
runIdentity (Identity (embedded (DatabaseEntity be super))
 -> S1 f (K1 R (embedded (DatabaseEntity be super))) p)
-> Identity (embedded (DatabaseEntity be super))
-> S1 f (K1 R (embedded (DatabaseEntity be super))) p
forall a b. (a -> b) -> a -> b
$
    Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    DatabaseEntity be embedded tbl
    -> DatabaseEntity be embedded tbl
    -> Identity (DatabaseEntity be super tbl))
-> DatabaseSettings be embedded
-> DatabaseSettings be embedded
-> Identity (embedded (DatabaseEntity be super))
forall be (db :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Database be db, Applicative m) =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> embedded f
-> embedded g
-> m (embedded h)
zipTables (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @be)
              (\(DatabaseEntity DatabaseEntityDescriptor be tbl
x) DatabaseEntity be embedded tbl
_ -> DatabaseEntity be super tbl
-> Identity (DatabaseEntity be super tbl)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseEntityDescriptor be tbl -> DatabaseEntity be super tbl
forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
DatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
DatabaseEntity DatabaseEntityDescriptor be tbl
x))
              DatabaseSettings be embedded
db DatabaseSettings be embedded
db
    where db :: DatabaseSettings be embedded
db = forall be (db :: (* -> *) -> *).
(Generic (DatabaseSettings be db),
 GAutoDbSettings (Rep (DatabaseSettings be db) ())) =>
DatabaseSettings be db
defaultDbSettings @be

class GZipDatabase be f g h x y z where
  gZipDatabase :: 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))
               -> x () -> y () -> m (z ())
instance GZipDatabase be f g h x y z =>
  GZipDatabase be f g h (M1 a b x) (M1 a b y) (M1 a b z) 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))
-> M1 a b x ()
-> M1 a b y ()
-> m (M1 a b z ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
p forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine ~(M1 x ()
f) ~(M1 y ()
g) = z () -> M1 a b z ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (z () -> M1 a b z ()) -> m (z ()) -> m (M1 a b z ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> x ()
-> y ()
-> m (z ())
forall be (f :: * -> *) (g :: * -> *) (h :: * -> *) (x :: * -> *)
       (y :: * -> *) (z :: * -> *) (m :: * -> *).
(GZipDatabase be f g h x y z, 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))
-> x ()
-> y ()
-> m (z ())
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))
-> x ()
-> y ()
-> m (z ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
p f tbl -> g tbl -> m (h tbl)
forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine x ()
f y ()
g
instance ( GZipDatabase be f g h ax ay az
         , GZipDatabase be f g h bx by bz ) =>
  GZipDatabase be f g h (ax :*: bx) (ay :*: by) (az :*: bz) 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))
-> (:*:) ax bx ()
-> (:*:) ay by ()
-> m ((:*:) az bz ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
p forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine ~(ax ()
ax :*: bx ()
bx) ~(ay ()
ay :*: by ()
by) =
    (az () -> bz () -> (:*:) az bz ())
-> m (az ()) -> m (bz ()) -> m ((:*:) az bz ())
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 az () -> bz () -> (:*:) az bz ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) ((Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> ax ()
-> ay ()
-> m (az ())
forall be (f :: * -> *) (g :: * -> *) (h :: * -> *) (x :: * -> *)
       (y :: * -> *) (z :: * -> *) (m :: * -> *).
(GZipDatabase be f g h x y z, 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))
-> x ()
-> y ()
-> m (z ())
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))
-> ax ()
-> ay ()
-> m (az ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
p f tbl -> g tbl -> m (h tbl)
forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine ax ()
ax ay ()
ay) ((Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> bx ()
-> by ()
-> m (bz ())
forall be (f :: * -> *) (g :: * -> *) (h :: * -> *) (x :: * -> *)
       (y :: * -> *) (z :: * -> *) (m :: * -> *).
(GZipDatabase be f g h x y z, 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))
-> x ()
-> y ()
-> m (z ())
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))
-> bx ()
-> by ()
-> m (bz ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
p f tbl -> g tbl -> m (h tbl)
forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine bx ()
bx by ()
by)
instance (IsDatabaseEntity be tbl, DatabaseEntityRegularRequirements be tbl) =>
  GZipDatabase be f g h (K1 Generic.R (f tbl)) (K1 Generic.R (g tbl)) (K1 Generic.R (h tbl)) 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))
-> K1 R (f tbl) ()
-> K1 R (g tbl) ()
-> m (K1 R (h tbl) ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
_ forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine ~(K1 f tbl
x) ~(K1 g tbl
y) =
    h tbl -> K1 R (h tbl) ()
forall k i c (p :: k). c -> K1 i c p
K1 (h tbl -> K1 R (h tbl) ()) -> m (h tbl) -> m (K1 R (h tbl) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f tbl -> g tbl -> m (h tbl)
forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine f tbl
x g tbl
y
instance Database be db =>
    GZipDatabase be f g h (K1 Generic.R (db f)) (K1 Generic.R (db g)) (K1 Generic.R (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))
-> K1 R (db f) ()
-> K1 R (db g) ()
-> m (K1 R (db h) ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
_ forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine ~(K1 db f
x) ~(K1 db g
y) =
      db h -> K1 R (db h) ()
forall k i c (p :: k). c -> K1 i c p
K1 (db h -> K1 R (db h) ()) -> m (db h) -> m (K1 R (db h) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
forall be (db :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Database be db, Applicative m) =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
zipTables (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @be) f tbl -> g tbl -> m (h tbl)
forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine db f
x db g
y

data Lenses (t :: (Type -> Type) -> Type) (f :: Type -> Type) x
data LensFor t x where
    LensFor :: Generic t => Lens' t x -> LensFor t x

-- | A type family that we use to "tag" columns in our table datatypes.
--
--   This is what allows us to use the same table type to hold table data, describe table settings,
--   derive lenses, and provide expressions.
--
--   The basic rules are
--
-- > Columnar Identity x = x
--
--   Thus, any Beam table applied to 'Identity' will yield a simplified version of the data type, that contains
--   just what you'd expect.
--
--   The 'Nullable' type is used when referencing 'PrimaryKey's that we want to include optionally.
--   For example, if we have a table with a 'PrimaryKey', like the following
--
-- > data BeamTableT f = BeamTableT
-- >                   { _refToAnotherTable :: PrimaryKey AnotherTableT f
-- >                   , ... }
--
--   we would typically be required to provide values for the 'PrimaryKey' embedded into 'BeamTableT'. We can use
--   'Nullable' to lift this constraint.
--
-- > data BeamTableT f = BeamTableT
-- >                   { _refToAnotherTable :: PrimaryKey AnotherTableT (Nullable f)
-- >                   , ... }
--
--   Now we can use 'just_' and 'nothing_' to refer to this table optionally. The embedded 'PrimaryKey' in '_refToAnotherTable'
--   automatically has its fields converted into 'Maybe' using 'Nullable'.
--
--   The last 'Columnar' rule is
--
-- > Columnar f x = f x
--
--   Use this rule if you'd like to parameterize your table type over any other functor. For example, this is used
--   in the query modules to write expressions such as 'TableT QExpr', which returns a table whose fields have been
--   turned into query expressions.
--
--   The other rules are used within Beam to provide lenses and to expose the inner structure of the data type.
type family Columnar (f :: Type -> Type) x where
    Columnar Exposed x = Exposed x

    Columnar Identity x = x

    Columnar (Lenses t f) x = LensFor (t f) (Columnar f x)
--    Columnar (Lenses t f) x = LensFor (t f) (f x)

    Columnar (Nullable c) x = Columnar c (Maybe x)

    Columnar f x = f x

-- | A short type-alias for 'Columnar'. May shorten your schema definitions
type C f a = Columnar f a

-- | If you declare a function 'Columnar f a -> b' and try to constrain your
--   function by a type class for 'f', GHC will complain, because 'f' is
--   ambiguous in 'Columnar f a'. For example, 'Columnar Identity (Maybe a) ~
--   Maybe a' and 'Columnar (Nullable Identity) a ~ Maybe a', so given a type
--   'Columnar f a', we cannot know the type of 'f'.
--
--   Thus, if you need to know 'f', you can instead use 'Columnar''. Since its a
--   newtype, it carries around the 'f' paramater unambiguously. Internally, it
--   simply wraps 'Columnar f a'
newtype Columnar' f a = Columnar' (Columnar f a)

-- | Like 'Data.Functor.Compose', but with an intermediate 'Columnar'
newtype ComposeColumnar f g a = ComposeColumnar (f (Columnar g a))

-- | Metadata for a field of type 'ty' in 'table'.
--
--   Essentially a wrapper over the field name, but with a phantom type
--   parameter, so that it forms an appropriate column tag.
--
--   Usually you use the 'defaultDbSettings' function to generate an appropriate
--   naming convention for you, and then modify it with 'withDbModification' if
--   necessary. Under this scheme, the field n be renamed using the 'IsString'
--   instance for 'TableField', or the 'fieldNamed' function.
data TableField (table :: (Type -> Type) -> Type) ty
  = TableField
  { forall (table :: (* -> *) -> *) ty.
TableField table ty -> NonEmpty Text
_fieldPath :: NE.NonEmpty T.Text
    -- ^ The path that led to this field. Each element is the haskell
    -- name of the record field in which this table is stored.
  , forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName :: Text  -- ^ The field name
  } deriving (Int -> TableField table ty -> ShowS
[TableField table ty] -> ShowS
TableField table ty -> String
(Int -> TableField table ty -> ShowS)
-> (TableField table ty -> String)
-> ([TableField table ty] -> ShowS)
-> Show (TableField table ty)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (table :: (* -> *) -> *) ty.
Int -> TableField table ty -> ShowS
forall (table :: (* -> *) -> *) ty. [TableField table ty] -> ShowS
forall (table :: (* -> *) -> *) ty. TableField table ty -> String
$cshowsPrec :: forall (table :: (* -> *) -> *) ty.
Int -> TableField table ty -> ShowS
showsPrec :: Int -> TableField table ty -> ShowS
$cshow :: forall (table :: (* -> *) -> *) ty. TableField table ty -> String
show :: TableField table ty -> String
$cshowList :: forall (table :: (* -> *) -> *) ty. [TableField table ty] -> ShowS
showList :: [TableField table ty] -> ShowS
Show, TableField table ty -> TableField table ty -> Bool
(TableField table ty -> TableField table ty -> Bool)
-> (TableField table ty -> TableField table ty -> Bool)
-> Eq (TableField table ty)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (table :: (* -> *) -> *) ty.
TableField table ty -> TableField table ty -> Bool
$c== :: forall (table :: (* -> *) -> *) ty.
TableField table ty -> TableField table ty -> Bool
== :: TableField table ty -> TableField table ty -> Bool
$c/= :: forall (table :: (* -> *) -> *) ty.
TableField table ty -> TableField table ty -> Bool
/= :: TableField table ty -> TableField table ty -> Bool
Eq)

-- | Van Laarhoven lens to retrieve or set the field name from a 'TableField'.
fieldName :: Lens' (TableField table ty) Text
fieldName :: forall (table :: (* -> *) -> *) ty (f :: * -> *).
Functor f =>
(Text -> f Text) -> TableField table ty -> f (TableField table ty)
fieldName Text -> f Text
f (TableField NonEmpty Text
path Text
name) = NonEmpty Text -> Text -> TableField table ty
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField NonEmpty Text
path (Text -> TableField table ty) -> f Text -> f (TableField table ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
name

fieldPath :: Traversal' (TableField table ty) Text
fieldPath :: forall (table :: (* -> *) -> *) ty (f :: * -> *).
Applicative f =>
(Text -> f Text) -> TableField table ty -> f (TableField table ty)
fieldPath Text -> f Text
f (TableField NonEmpty Text
orig Text
name) = NonEmpty Text -> Text -> TableField table ty
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField (NonEmpty Text -> Text -> TableField table ty)
-> f (NonEmpty Text) -> f (Text -> TableField table ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> f Text) -> NonEmpty Text -> f (NonEmpty Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse Text -> f Text
f NonEmpty Text
orig f (Text -> TableField table ty)
-> f Text -> f (TableField table ty)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> f Text
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name

-- | Represents a table that contains metadata on its fields. In particular,
--   each field of type 'Columnar f a' is transformed into 'TableField table a'.
--   You can get or update the name of each field by using the 'fieldName' lens.
type TableSettings table = table (TableField table)

-- | The regular Haskell version of the table. Equivalent to 'tbl Identity'
type HaskellTable table = table Identity

-- | Column tag that ignores the type.
data Ignored x = Ignored
-- | A form of 'table' all fields 'Ignored'. Useful as a parameter to
--   'zipTables' when you only care about one table.
type TableSkeleton table = table Ignored

from' :: Generic x => x -> Rep x ()
from' :: forall x. Generic x => x -> Rep x ()
from' = x -> Rep x ()
forall x. x -> Rep x x
forall a x. Generic a => a -> Rep a x
from

to' :: Generic x => Rep x () -> x
to' :: forall x. Generic x => Rep x () -> x
to' = Rep x () -> x
forall a x. Generic a => Rep a x -> a
forall x. Rep x x -> x
to

type HasBeamFields table f g h = ( GZipTables f g h (Rep (table Exposed))
                                                    (Rep (table f))
                                                    (Rep (table g))
                                                    (Rep (table h))

                                 , Generic (table f)
                                 , Generic (table g)
                                 , Generic (table h)
                                 )

-- | The big Kahuna! All beam tables implement this class.
--
--   The kind of all table types is '(Type -> Type) -> Type'. This is
--   because all table types are actually /table type constructors/.
--   Every table type takes in another type constructor, called the
--   /column tag/, and uses that constructor to instantiate the column
--   types.  See the documentation for 'Columnar'.
--
--   This class is mostly Generic-derivable. You need only specify a
--   type for the table's primary key and a method to extract the
--   primary key given the table.
--
--   An example table:
--
-- > data BlogPostT f = BlogPost
-- >                  { _blogPostSlug    :: Columnar f Text
-- >                  , _blogPostBody    :: Columnar f Text
-- >                  , _blogPostDate    :: Columnar f UTCTime
-- >                  , _blogPostAuthor  :: PrimaryKey AuthorT f
-- >                  , _blogPostTagline :: Columnar f (Maybe Text)
-- >                  , _blogPostImageGallery :: PrimaryKey ImageGalleryT (Nullable f) }
-- >                    deriving Generic
-- > instance Beamable BlogPostT
-- > instance Table BlogPostT where
-- >    data PrimaryKey BlogPostT f = BlogPostId (Columnar f Text) deriving Generic
-- >    primaryKey = BlogPostId . _blogPostSlug
-- > instance Beamable (PrimaryKey BlogPostT)
--
--   We can interpret this as follows:
--
--     * The `_blogPostSlug`, `_blogPostBody`, `_blogPostDate`, and `_blogPostTagline` fields are of types 'Text', 'Text', 'UTCTime', and 'Maybe Text' respectfully.
--     * Since `_blogPostSlug`, `_blogPostBody`, `_blogPostDate`, `_blogPostAuthor` must be provided (i.e, they cannot contain 'Nothing'), they will be given SQL NOT NULL constraints.
--       `_blogPostTagline` is declared 'Maybe' so 'Nothing' will be stored as NULL in the database. `_blogPostImageGallery` will be allowed to be empty because it uses the 'Nullable' tag modifier.
--     * `blogPostAuthor` references the `AuthorT` table (not given here) and is required.
--     * `blogPostImageGallery` references the `ImageGalleryT` table (not given here), but this relation is not required (i.e., it may be 'Nothing'. See 'Nullable').
class (Typeable table, Beamable table, Beamable (PrimaryKey table)) => Table (table :: (Type -> Type) -> Type) where

    -- | A data type representing the types of primary keys for this table.
    --   In order to play nicely with the default deriving mechanism, this type must be an instance of 'Generic'.
    data PrimaryKey table (column :: Type -> Type) :: Type

    -- | Given a table, this should return the PrimaryKey from the table. By keeping this polymorphic over column,
    --   we ensure that the primary key values come directly from the table (i.e., they can't be arbitrary constants)
    primaryKey :: table column -> PrimaryKey table column

-- | Provides a number of introspection routines for the beam library. Allows us
--   to "zip" tables with different column tags together. Always instantiate an
--   empty 'Beamable' instance for tables, primary keys, and any type that you
--   would like to embed within either. See the
--   [manual](https://haskell-beam.github.io/beam/user-guide/models) for more
--   information on embedding.
class Beamable table where
    zipBeamFieldsM :: Applicative m =>
                      (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)) -> table f -> table g -> m (table h)

    default zipBeamFieldsM :: ( HasBeamFields table f g h
                              , Applicative m

                              ) => (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
                                -> table f
                                -> table g
                                -> m (table h)

    zipBeamFieldsM forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine (table f
f :: table f) table g
g =
        Rep (table h) () -> table h
forall x. Generic x => Rep x () -> x
to' (Rep (table h) () -> table h)
-> m (Rep (table h) ()) -> m (table h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Rep (table Exposed))
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> Rep (table f) ()
-> Rep (table g) ()
-> m (Rep (table h) ())
forall (m :: * -> *).
Applicative m =>
Proxy (Rep (table Exposed))
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> Rep (table f) ()
-> Rep (table g) ()
-> m (Rep (table h) ())
forall (f :: * -> *) (g :: * -> *) (h :: * -> *)
       (exposedRep :: * -> *) (fRep :: * -> *) (gRep :: * -> *)
       (hRep :: * -> *) (m :: * -> *).
(GZipTables f g h exposedRep fRep gRep hRep, Applicative m) =>
Proxy exposedRep
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> fRep ()
-> gRep ()
-> m (hRep ())
gZipTables (Proxy (Rep (table Exposed))
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep (table Exposed))) Columnar' f a -> Columnar' g a -> m (Columnar' h a)
forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine (table f -> Rep (table f) ()
forall x. Generic x => x -> Rep x ()
from' table f
f) (table g -> Rep (table g) ()
forall x. Generic x => x -> Rep x ()
from' table g
g)

    tblSkeleton :: TableSkeleton table

    default tblSkeleton :: ( Generic (TableSkeleton table)
                           , GTableSkeleton (Rep (TableSkeleton table))
                           ) => TableSkeleton table

    tblSkeleton = (Proxy (Rep (TableSkeleton table)) -> TableSkeleton table)
-> TableSkeleton table
withProxy ((Proxy (Rep (TableSkeleton table)) -> TableSkeleton table)
 -> TableSkeleton table)
-> (Proxy (Rep (TableSkeleton table)) -> TableSkeleton table)
-> TableSkeleton table
forall a b. (a -> b) -> a -> b
$ \Proxy (Rep (TableSkeleton table))
proxy -> Rep (TableSkeleton table) () -> TableSkeleton table
forall x. Generic x => Rep x () -> x
to' (Proxy (Rep (TableSkeleton table)) -> Rep (TableSkeleton table) ()
forall (x :: * -> *). GTableSkeleton x => Proxy x -> x ()
gTblSkeleton Proxy (Rep (TableSkeleton table))
proxy)
        where withProxy :: (Proxy (Rep (TableSkeleton table)) -> TableSkeleton table) -> TableSkeleton table
              withProxy :: (Proxy (Rep (TableSkeleton table)) -> TableSkeleton table)
-> TableSkeleton table
withProxy Proxy (Rep (TableSkeleton table)) -> TableSkeleton table
f = Proxy (Rep (TableSkeleton table)) -> TableSkeleton table
f Proxy (Rep (TableSkeleton table))
forall {k} (t :: k). Proxy t
Proxy

tableValuesNeeded :: Beamable table => Proxy table -> Int
tableValuesNeeded :: forall (table :: (* -> *) -> *).
Beamable table =>
Proxy table -> Int
tableValuesNeeded (Proxy table
Proxy :: Proxy table) = [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((forall a. Columnar' Ignored a -> ()) -> table Ignored -> [()]
forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (() -> Columnar' Ignored a -> ()
forall a b. a -> b -> a
const ()) (table Ignored
forall (table :: (* -> *) -> *).
Beamable table =>
TableSkeleton table
tblSkeleton :: TableSkeleton table))

allBeamValues :: Beamable table => (forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues :: forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (forall a. Columnar' f a -> b
f :: forall a. Columnar' f a -> b) (table f
tbl :: table f) =
    Writer [b] (table f) -> [b]
forall w a. Writer w a -> w
execWriter ((forall a.
 Columnar' f a
 -> Columnar' f a -> WriterT [b] Identity (Columnar' f a))
-> table f -> table f -> Writer [b] (table f)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM Columnar' f a -> Columnar' f a -> Writer [b] (Columnar' f a)
forall a.
Columnar' f a
-> Columnar' f a -> WriterT [b] Identity (Columnar' f a)
combine table f
tbl table f
tbl)
    where combine :: Columnar' f a -> Columnar' f a -> Writer [b] (Columnar' f a)
          combine :: forall a.
Columnar' f a
-> Columnar' f a -> WriterT [b] Identity (Columnar' f a)
combine Columnar' f a
x Columnar' f a
_ = do [b] -> WriterT [b] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Columnar' f a -> b
forall a. Columnar' f a -> b
f Columnar' f a
x]
                           Columnar' f a -> WriterT [b] Identity (Columnar' f a)
forall a. a -> WriterT [b] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Columnar' f a
x

changeBeamRep :: Beamable table => (forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep :: forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep forall a. Columnar' f a -> Columnar' g a
f table f
tbl = Identity (table g) -> table g
forall a. Identity a -> a
runIdentity ((forall a.
 Columnar' f a -> Columnar' f a -> Identity (Columnar' g a))
-> table f -> table f -> Identity (table g)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\Columnar' f a
x Columnar' f a
_ -> Columnar' g a -> Identity (Columnar' g a)
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Columnar' f a -> Columnar' g a
forall a. Columnar' f a -> Columnar' g a
f Columnar' f a
x)) table f
tbl table f
tbl)

alongsideTable :: Beamable tbl => tbl f -> tbl g -> tbl (Columnar' f :*: Columnar' g)
alongsideTable :: forall (tbl :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable tbl =>
tbl f -> tbl g -> tbl (Columnar' f :*: Columnar' g)
alongsideTable tbl f
a tbl g
b =
  Identity (tbl (Columnar' f :*: Columnar' g))
-> tbl (Columnar' f :*: Columnar' g)
forall a. Identity a -> a
runIdentity (Identity (tbl (Columnar' f :*: Columnar' g))
 -> tbl (Columnar' f :*: Columnar' g))
-> Identity (tbl (Columnar' f :*: Columnar' g))
-> tbl (Columnar' f :*: Columnar' g)
forall a b. (a -> b) -> a -> b
$
  (forall a.
 Columnar' f a
 -> Columnar' g a
 -> Identity (Columnar' (Columnar' f :*: Columnar' g) a))
-> tbl f -> tbl g -> Identity (tbl (Columnar' f :*: Columnar' g))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\Columnar' f a
x Columnar' g a
y -> Columnar' (Columnar' f :*: Columnar' g) a
-> Identity (Columnar' (Columnar' f :*: Columnar' g) a)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar (Columnar' f :*: Columnar' g) a
-> Columnar' (Columnar' f :*: Columnar' g) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Columnar' f a
x Columnar' f a
-> Columnar' g a -> (:*:) (Columnar' f) (Columnar' g) a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Columnar' g a
y))) tbl f
a tbl g
b

class Retaggable f x | x -> f where
  type Retag (tag :: (Type -> Type) -> Type -> Type) x :: Type

  retag :: (forall a. Columnar' f a -> Columnar' (tag f) a) -> x
        -> Retag tag x

instance Beamable tbl => Retaggable f (tbl (f :: Type -> Type)) where
  type Retag tag (tbl f) = tbl (tag f)

  retag :: forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> tbl f -> Retag tag (tbl f)
retag = (forall a. Columnar' f a -> Columnar' (tag f) a)
-> tbl f -> tbl (tag f)
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> tbl f -> Retag tag (tbl f)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep

instance (Retaggable f a, Retaggable f b) => Retaggable f (a, b) where
  type Retag tag (a, b) = (Retag tag a, Retag tag b)

  retag :: forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> (a, b) -> Retag tag (a, b)
retag forall a. Columnar' f a -> Columnar' (tag f) a
transform (a
a, b
b) = ((forall a. Columnar' f a -> Columnar' (tag f) a)
-> a -> Retag tag a
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> a -> Retag tag a
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform a
a, (forall a. Columnar' f a -> Columnar' (tag f) a)
-> b -> Retag tag b
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> b -> Retag tag b
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform b
b)

instance (Retaggable f a, Retaggable f b, Retaggable f c) =>
  Retaggable f (a, b, c) where
  type Retag tag (a, b, c) = (Retag tag a, Retag tag b, Retag tag c)

  retag :: forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> (a, b, c) -> Retag tag (a, b, c)
retag forall a. Columnar' f a -> Columnar' (tag f) a
transform (a
a, b
b, c
c) = ((forall a. Columnar' f a -> Columnar' (tag f) a)
-> a -> Retag tag a
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> a -> Retag tag a
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform a
a, (forall a. Columnar' f a -> Columnar' (tag f) a)
-> b -> Retag tag b
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> b -> Retag tag b
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform b
b, (forall a. Columnar' f a -> Columnar' (tag f) a)
-> c -> Retag tag c
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> c -> Retag tag c
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform c
c)

instance (Retaggable f a, Retaggable f b, Retaggable f c, Retaggable f d) =>
  Retaggable f (a, b, c, d) where
  type Retag tag (a, b, c, d) =
    (Retag tag a, Retag tag b, Retag tag c, Retag tag d)

  retag :: forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> (a, b, c, d) -> Retag tag (a, b, c, d)
retag forall a. Columnar' f a -> Columnar' (tag f) a
transform (a
a, b
b, c
c, d
d) =
    ((forall a. Columnar' f a -> Columnar' (tag f) a)
-> a -> Retag tag a
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> a -> Retag tag a
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform a
a, (forall a. Columnar' f a -> Columnar' (tag f) a)
-> b -> Retag tag b
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> b -> Retag tag b
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform b
b, (forall a. Columnar' f a -> Columnar' (tag f) a)
-> c -> Retag tag c
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> c -> Retag tag c
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform c
c, (forall a. Columnar' f a -> Columnar' (tag f) a)
-> d -> Retag tag d
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> d -> Retag tag d
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform d
d)

instance ( Retaggable f a, Retaggable f b, Retaggable f c, Retaggable f d
         , Retaggable f e ) =>
  Retaggable f (a, b, c, d, e) where
  type Retag tag (a, b, c, d, e) =
    (Retag tag a, Retag tag b, Retag tag c, Retag tag d, Retag tag e)

  retag :: forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> (a, b, c, d, e) -> Retag tag (a, b, c, d, e)
retag forall a. Columnar' f a -> Columnar' (tag f) a
transform (a
a, b
b, c
c, d
d, e
e) =
    ( (forall a. Columnar' f a -> Columnar' (tag f) a)
-> a -> Retag tag a
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> a -> Retag tag a
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform a
a, (forall a. Columnar' f a -> Columnar' (tag f) a)
-> b -> Retag tag b
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> b -> Retag tag b
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform b
b, (forall a. Columnar' f a -> Columnar' (tag f) a)
-> c -> Retag tag c
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> c -> Retag tag c
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform c
c, (forall a. Columnar' f a -> Columnar' (tag f) a)
-> d -> Retag tag d
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> d -> Retag tag d
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform d
d
    , (forall a. Columnar' f a -> Columnar' (tag f) a)
-> e -> Retag tag e
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> e -> Retag tag e
retag Columnar' f a -> Columnar' (tag f) a
forall a. Columnar' f a -> Columnar' (tag f) a
transform e
e)

instance ( Retaggable f' a, Retaggable f' b, Retaggable f' c, Retaggable f' d
         , Retaggable f' e, Retaggable f' f ) =>
  Retaggable f' (a, b, c, d, e, f) where
  type Retag tag (a, b, c, d, e, f) =
    ( Retag tag a, Retag tag b, Retag tag c, Retag tag d
    , Retag tag e, Retag tag f)

  retag :: forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> (a, b, c, d, e, f) -> Retag tag (a, b, c, d, e, f)
retag forall a. Columnar' f' a -> Columnar' (tag f') a
transform (a
a, b
b, c
c, d
d, e
e, f
f) =
    ( (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> a -> Retag tag a
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> a -> Retag tag a
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform a
a, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> b -> Retag tag b
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> b -> Retag tag b
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform b
b, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> c -> Retag tag c
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> c -> Retag tag c
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform c
c, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> d -> Retag tag d
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> d -> Retag tag d
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform d
d
    , (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> e -> Retag tag e
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> e -> Retag tag e
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform e
e, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> f -> Retag tag f
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> f -> Retag tag f
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform f
f )

instance ( Retaggable f' a, Retaggable f' b, Retaggable f' c, Retaggable f' d
         , Retaggable f' e, Retaggable f' f, Retaggable f' g ) =>
  Retaggable f' (a, b, c, d, e, f, g) where
  type Retag tag (a, b, c, d, e, f, g) =
    ( Retag tag a, Retag tag b, Retag tag c, Retag tag d
    , Retag tag e, Retag tag f, Retag tag g )

  retag :: forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> (a, b, c, d, e, f, g) -> Retag tag (a, b, c, d, e, f, g)
retag forall a. Columnar' f' a -> Columnar' (tag f') a
transform (a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
    ( (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> a -> Retag tag a
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> a -> Retag tag a
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform a
a, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> b -> Retag tag b
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> b -> Retag tag b
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform b
b, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> c -> Retag tag c
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> c -> Retag tag c
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform c
c, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> d -> Retag tag d
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> d -> Retag tag d
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform d
d
    , (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> e -> Retag tag e
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> e -> Retag tag e
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform e
e, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> f -> Retag tag f
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> f -> Retag tag f
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform f
f, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> g -> Retag tag g
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> g -> Retag tag g
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform g
g )

instance ( Retaggable f' a, Retaggable f' b, Retaggable f' c, Retaggable f' d
         , Retaggable f' e, Retaggable f' f, Retaggable f' g, Retaggable f' h ) =>
  Retaggable f' (a, b, c, d, e, f, g, h) where
  type Retag tag (a, b, c, d, e, f, g, h) =
    ( Retag tag a, Retag tag b, Retag tag c, Retag tag d
    , Retag tag e, Retag tag f, Retag tag g, Retag tag h )

  retag :: forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> (a, b, c, d, e, f, g, h) -> Retag tag (a, b, c, d, e, f, g, h)
retag forall a. Columnar' f' a -> Columnar' (tag f') a
transform (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) =
    ( (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> a -> Retag tag a
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> a -> Retag tag a
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform a
a, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> b -> Retag tag b
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> b -> Retag tag b
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform b
b, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> c -> Retag tag c
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> c -> Retag tag c
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform c
c, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> d -> Retag tag d
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> d -> Retag tag d
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform d
d
    , (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> e -> Retag tag e
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> e -> Retag tag e
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform e
e, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> f -> Retag tag f
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> f -> Retag tag f
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform f
f, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> g -> Retag tag g
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> g -> Retag tag g
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform g
g, (forall a. Columnar' f' a -> Columnar' (tag f') a)
-> h -> Retag tag h
forall (f :: * -> *) x (tag :: (* -> *) -> * -> *).
Retaggable f x =>
(forall a. Columnar' f a -> Columnar' (tag f) a)
-> x -> Retag tag x
forall (tag :: (* -> *) -> * -> *).
(forall a. Columnar' f' a -> Columnar' (tag f') a)
-> h -> Retag tag h
retag Columnar' f' a -> Columnar' (tag f') a
forall a. Columnar' f' a -> Columnar' (tag f') a
transform h
h )

-- | Carry a constraint instance and the value it applies to.
data WithConstraint (c :: Type -> Constraint) x where
  WithConstraint :: c x => x -> WithConstraint c x

-- | Carry a constraint instance.
data HasConstraint (c :: Type -> Constraint) x where
  HasConstraint :: c x => HasConstraint c x

class GFieldsFulfillConstraint (c :: Type -> Constraint) (exposed :: Type -> Type) withconstraint where
  gWithConstrainedFields :: Proxy c -> Proxy exposed -> withconstraint ()
instance GFieldsFulfillConstraint c exposed withconstraint =>
    GFieldsFulfillConstraint c (M1 s m exposed) (M1 s m withconstraint) where
  gWithConstrainedFields :: Proxy c -> Proxy (M1 s m exposed) -> M1 s m withconstraint ()
gWithConstrainedFields Proxy c
c Proxy (M1 s m exposed)
_ = withconstraint () -> M1 s m withconstraint ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Proxy c -> Proxy exposed -> withconstraint ()
forall (c :: * -> Constraint) (exposed :: * -> *)
       (withconstraint :: * -> *).
GFieldsFulfillConstraint c exposed withconstraint =>
Proxy c -> Proxy exposed -> withconstraint ()
gWithConstrainedFields Proxy c
c (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @exposed))
instance GFieldsFulfillConstraint c U1 U1 where
  gWithConstrainedFields :: Proxy c -> Proxy U1 -> U1 ()
gWithConstrainedFields Proxy c
_ Proxy U1
_ = U1 ()
forall k (p :: k). U1 p
U1
instance (GFieldsFulfillConstraint c aExp aC, GFieldsFulfillConstraint c bExp bC) =>
  GFieldsFulfillConstraint c (aExp :*: bExp) (aC :*: bC) where
  gWithConstrainedFields :: Proxy c -> Proxy (aExp :*: bExp) -> (:*:) aC bC ()
gWithConstrainedFields Proxy c
be Proxy (aExp :*: bExp)
_ = Proxy c -> Proxy aExp -> aC ()
forall (c :: * -> Constraint) (exposed :: * -> *)
       (withconstraint :: * -> *).
GFieldsFulfillConstraint c exposed withconstraint =>
Proxy c -> Proxy exposed -> withconstraint ()
gWithConstrainedFields Proxy c
be (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @aExp) aC () -> bC () -> (:*:) aC bC ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Proxy c -> Proxy bExp -> bC ()
forall (c :: * -> Constraint) (exposed :: * -> *)
       (withconstraint :: * -> *).
GFieldsFulfillConstraint c exposed withconstraint =>
Proxy c -> Proxy exposed -> withconstraint ()
gWithConstrainedFields Proxy c
be (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @bExp)
instance (c x) => GFieldsFulfillConstraint c (K1 Generic.R (Exposed x)) (K1 Generic.R (HasConstraint c x)) where
  gWithConstrainedFields :: Proxy c -> Proxy (K1 R (Exposed x)) -> K1 R (HasConstraint c x) ()
gWithConstrainedFields Proxy c
_ Proxy (K1 R (Exposed x))
_ = HasConstraint c x -> K1 R (HasConstraint c x) ()
forall k i c (p :: k). c -> K1 i c p
K1 HasConstraint c x
forall (c :: * -> Constraint) x. c x => HasConstraint c x
HasConstraint
instance FieldsFulfillConstraint c t =>
    GFieldsFulfillConstraint c (K1 Generic.R (t Exposed)) (K1 Generic.R (t (HasConstraint c))) where
  gWithConstrainedFields :: Proxy c
-> Proxy (K1 R (t Exposed)) -> K1 R (t (HasConstraint c)) ()
gWithConstrainedFields Proxy c
_ Proxy (K1 R (t Exposed))
_ = t (HasConstraint c) -> K1 R (t (HasConstraint c)) ()
forall k i c (p :: k). c -> K1 i c p
K1 (Rep (t (HasConstraint c)) () -> t (HasConstraint c)
forall a x. Generic a => Rep a x -> a
forall x. Rep (t (HasConstraint c)) x -> t (HasConstraint c)
to (Proxy c -> Proxy (Rep (t Exposed)) -> Rep (t (HasConstraint c)) ()
forall (c :: * -> Constraint) (exposed :: * -> *)
       (withconstraint :: * -> *).
GFieldsFulfillConstraint c exposed withconstraint =>
Proxy c -> Proxy exposed -> withconstraint ()
gWithConstrainedFields (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @c) (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(Rep (t Exposed)))))
instance FieldsFulfillConstraintNullable c t =>
    GFieldsFulfillConstraint c (K1 Generic.R (t (Nullable Exposed))) (K1 Generic.R (t (Nullable (HasConstraint c)))) where
  gWithConstrainedFields :: Proxy c
-> Proxy (K1 R (t (Nullable Exposed)))
-> K1 R (t (Nullable (HasConstraint c))) ()
gWithConstrainedFields Proxy c
_ Proxy (K1 R (t (Nullable Exposed)))
_ = t (Nullable (HasConstraint c))
-> K1 R (t (Nullable (HasConstraint c))) ()
forall k i c (p :: k). c -> K1 i c p
K1 (Rep (t (Nullable (HasConstraint c))) ()
-> t (Nullable (HasConstraint c))
forall a x. Generic a => Rep a x -> a
forall x.
Rep (t (Nullable (HasConstraint c))) x
-> t (Nullable (HasConstraint c))
to (Proxy c
-> Proxy (Rep (t (Nullable Exposed)))
-> Rep (t (Nullable (HasConstraint c))) ()
forall (c :: * -> Constraint) (exposed :: * -> *)
       (withconstraint :: * -> *).
GFieldsFulfillConstraint c exposed withconstraint =>
Proxy c -> Proxy exposed -> withconstraint ()
gWithConstrainedFields (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @c) (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(Rep (t (Nullable Exposed))))))

withConstrainedFields :: forall c tbl
                       . (FieldsFulfillConstraint c tbl, Beamable tbl) => tbl Identity -> tbl (WithConstraint c)
withConstrainedFields :: forall (c :: * -> Constraint) (tbl :: (* -> *) -> *).
(FieldsFulfillConstraint c tbl, Beamable tbl) =>
tbl Identity -> tbl (WithConstraint c)
withConstrainedFields = Identity (tbl (WithConstraint c)) -> tbl (WithConstraint c)
forall a. Identity a -> a
runIdentity (Identity (tbl (WithConstraint c)) -> tbl (WithConstraint c))
-> (tbl Identity -> Identity (tbl (WithConstraint c)))
-> tbl Identity
-> tbl (WithConstraint c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 Columnar' (HasConstraint c) a
 -> Columnar' Identity a
 -> Identity (Columnar' (WithConstraint c) a))
-> tbl (HasConstraint c)
-> tbl Identity
-> Identity (tbl (WithConstraint c))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM Columnar' (HasConstraint c) a
-> Columnar' Identity a
-> Identity (Columnar' (WithConstraint c) a)
forall a.
Columnar' (HasConstraint c) a
-> Columnar' Identity a
-> Identity (Columnar' (WithConstraint c) a)
f (forall (c :: * -> Constraint) (tbl :: (* -> *) -> *).
(Beamable tbl, FieldsFulfillConstraint c tbl) =>
tbl (HasConstraint c)
withConstraints @c @tbl)
  where f :: forall a. Columnar' (HasConstraint c) a -> Columnar' Identity a -> Identity (Columnar' (WithConstraint c) a)
        f :: forall a.
Columnar' (HasConstraint c) a
-> Columnar' Identity a
-> Identity (Columnar' (WithConstraint c) a)
f (Columnar' HasConstraint c a
Columnar (HasConstraint c) a
HasConstraint) (Columnar' Columnar Identity a
a) = Columnar' (WithConstraint c) a
-> Identity (Columnar' (WithConstraint c) a)
forall a. a -> Identity a
Identity (Columnar' (WithConstraint c) a
 -> Identity (Columnar' (WithConstraint c) a))
-> Columnar' (WithConstraint c) a
-> Identity (Columnar' (WithConstraint c) a)
forall a b. (a -> b) -> a -> b
$ Columnar (WithConstraint c) a -> Columnar' (WithConstraint c) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Columnar (WithConstraint c) a -> Columnar' (WithConstraint c) a)
-> Columnar (WithConstraint c) a -> Columnar' (WithConstraint c) a
forall a b. (a -> b) -> a -> b
$ a -> WithConstraint c a
forall (c :: * -> Constraint) x. c x => x -> WithConstraint c x
WithConstraint a
Columnar Identity a
a

withConstraints :: forall c tbl. (Beamable tbl, FieldsFulfillConstraint c tbl) => tbl (HasConstraint c)
withConstraints :: forall (c :: * -> Constraint) (tbl :: (* -> *) -> *).
(Beamable tbl, FieldsFulfillConstraint c tbl) =>
tbl (HasConstraint c)
withConstraints = Rep (tbl (HasConstraint c)) () -> tbl (HasConstraint c)
forall a x. Generic a => Rep a x -> a
forall x. Rep (tbl (HasConstraint c)) x -> tbl (HasConstraint c)
to (Rep (tbl (HasConstraint c)) () -> tbl (HasConstraint c))
-> Rep (tbl (HasConstraint c)) () -> tbl (HasConstraint c)
forall a b. (a -> b) -> a -> b
$ Proxy c
-> Proxy (Rep (tbl Exposed)) -> Rep (tbl (HasConstraint c)) ()
forall (c :: * -> Constraint) (exposed :: * -> *)
       (withconstraint :: * -> *).
GFieldsFulfillConstraint c exposed withconstraint =>
Proxy c -> Proxy exposed -> withconstraint ()
gWithConstrainedFields (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @c) (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(Rep (tbl Exposed)))

withNullableConstrainedFields :: forall c tbl
                               . (FieldsFulfillConstraintNullable c tbl, Beamable tbl) => tbl (Nullable Identity) -> tbl (Nullable (WithConstraint c))
withNullableConstrainedFields :: forall (c :: * -> Constraint) (tbl :: (* -> *) -> *).
(FieldsFulfillConstraintNullable c tbl, Beamable tbl) =>
tbl (Nullable Identity) -> tbl (Nullable (WithConstraint c))
withNullableConstrainedFields = Identity (tbl (Nullable (WithConstraint c)))
-> tbl (Nullable (WithConstraint c))
forall a. Identity a -> a
runIdentity (Identity (tbl (Nullable (WithConstraint c)))
 -> tbl (Nullable (WithConstraint c)))
-> (tbl (Nullable Identity)
    -> Identity (tbl (Nullable (WithConstraint c))))
-> tbl (Nullable Identity)
-> tbl (Nullable (WithConstraint c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 Columnar' (Nullable (HasConstraint c)) a
 -> Columnar' (Nullable Identity) a
 -> Identity (Columnar' (Nullable (WithConstraint c)) a))
-> tbl (Nullable (HasConstraint c))
-> tbl (Nullable Identity)
-> Identity (tbl (Nullable (WithConstraint c)))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM Columnar' (Nullable (HasConstraint c)) a
-> Columnar' (Nullable Identity) a
-> Identity (Columnar' (Nullable (WithConstraint c)) a)
forall a.
Columnar' (Nullable (HasConstraint c)) a
-> Columnar' (Nullable Identity) a
-> Identity (Columnar' (Nullable (WithConstraint c)) a)
f (forall (c :: * -> Constraint) (tbl :: (* -> *) -> *).
(Beamable tbl, FieldsFulfillConstraintNullable c tbl) =>
tbl (Nullable (HasConstraint c))
withNullableConstraints @c @tbl)
  where f :: forall a. Columnar' (Nullable (HasConstraint c)) a -> Columnar' (Nullable Identity) a -> Identity (Columnar' (Nullable (WithConstraint c)) a)
        f :: forall a.
Columnar' (Nullable (HasConstraint c)) a
-> Columnar' (Nullable Identity) a
-> Identity (Columnar' (Nullable (WithConstraint c)) a)
f (Columnar' HasConstraint c (Maybe a)
Columnar (Nullable (HasConstraint c)) a
HasConstraint) (Columnar' Columnar (Nullable Identity) a
a) = Columnar' (Nullable (WithConstraint c)) a
-> Identity (Columnar' (Nullable (WithConstraint c)) a)
forall a. a -> Identity a
Identity (Columnar' (Nullable (WithConstraint c)) a
 -> Identity (Columnar' (Nullable (WithConstraint c)) a))
-> Columnar' (Nullable (WithConstraint c)) a
-> Identity (Columnar' (Nullable (WithConstraint c)) a)
forall a b. (a -> b) -> a -> b
$ Columnar (Nullable (WithConstraint c)) a
-> Columnar' (Nullable (WithConstraint c)) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Columnar (Nullable (WithConstraint c)) a
 -> Columnar' (Nullable (WithConstraint c)) a)
-> Columnar (Nullable (WithConstraint c)) a
-> Columnar' (Nullable (WithConstraint c)) a
forall a b. (a -> b) -> a -> b
$ Maybe a -> WithConstraint c (Maybe a)
forall (c :: * -> Constraint) x. c x => x -> WithConstraint c x
WithConstraint Maybe a
Columnar (Nullable Identity) a
a

withNullableConstraints ::  forall c tbl. (Beamable tbl, FieldsFulfillConstraintNullable c tbl) => tbl (Nullable (HasConstraint c))
withNullableConstraints :: forall (c :: * -> Constraint) (tbl :: (* -> *) -> *).
(Beamable tbl, FieldsFulfillConstraintNullable c tbl) =>
tbl (Nullable (HasConstraint c))
withNullableConstraints = Rep (tbl (Nullable (HasConstraint c))) ()
-> tbl (Nullable (HasConstraint c))
forall a x. Generic a => Rep a x -> a
forall x.
Rep (tbl (Nullable (HasConstraint c))) x
-> tbl (Nullable (HasConstraint c))
to (Rep (tbl (Nullable (HasConstraint c))) ()
 -> tbl (Nullable (HasConstraint c)))
-> Rep (tbl (Nullable (HasConstraint c))) ()
-> tbl (Nullable (HasConstraint c))
forall a b. (a -> b) -> a -> b
$ Proxy c
-> Proxy (Rep (tbl (Nullable Exposed)))
-> Rep (tbl (Nullable (HasConstraint c))) ()
forall (c :: * -> Constraint) (exposed :: * -> *)
       (withconstraint :: * -> *).
GFieldsFulfillConstraint c exposed withconstraint =>
Proxy c -> Proxy exposed -> withconstraint ()
gWithConstrainedFields (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @c) (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(Rep (tbl (Nullable Exposed))))

type FieldsFulfillConstraint (c :: Type -> Constraint) t =
  ( Generic (t (HasConstraint c)), Generic (t Identity), Generic (t Exposed)
  , GFieldsFulfillConstraint c (Rep (t Exposed)) (Rep (t (HasConstraint c))))

type FieldsFulfillConstraintNullable (c :: Type -> Constraint) t =
  ( Generic (t (Nullable (HasConstraint c))), Generic (t (Nullable Identity)), Generic (t (Nullable Exposed))
  , GFieldsFulfillConstraint c (Rep (t (Nullable Exposed))) (Rep (t (Nullable (HasConstraint c)))))

-- | Synonym for 'primaryKey'
pk :: Table t => t f -> PrimaryKey t f
pk :: forall (t :: (* -> *) -> *) (f :: * -> *).
Table t =>
t f -> PrimaryKey t f
pk = t f -> PrimaryKey t f
forall (column :: * -> *). t column -> PrimaryKey t column
forall (table :: (* -> *) -> *) (column :: * -> *).
Table table =>
table column -> PrimaryKey table column
primaryKey

-- | Return a 'TableSettings' for the appropriate 'table' type where each column
--   has been given its default name. See the
--   [manual](https://haskell-beam.github.io/beam/user-guide/models) for
--   information on the default naming convention.
defTblFieldSettings :: ( Generic (TableSettings table)
                       , GDefaultTableFieldSettings (Rep (TableSettings table) ())) =>
                       TableSettings table
defTblFieldSettings :: forall (table :: (* -> *) -> *).
(Generic (TableSettings table),
 GDefaultTableFieldSettings (Rep (TableSettings table) ())) =>
TableSettings table
defTblFieldSettings = (Proxy (Rep (TableSettings table) ()) -> TableSettings table)
-> TableSettings table
forall (table :: (* -> *) -> *).
(Proxy (Rep (TableSettings table) ()) -> TableSettings table)
-> TableSettings table
withProxy ((Proxy (Rep (TableSettings table) ()) -> TableSettings table)
 -> TableSettings table)
-> (Proxy (Rep (TableSettings table) ()) -> TableSettings table)
-> TableSettings table
forall a b. (a -> b) -> a -> b
$ \Proxy (Rep (TableSettings table) ())
proxy -> Rep (TableSettings table) () -> TableSettings table
forall x. Generic x => Rep x () -> x
to' (Proxy (Rep (TableSettings table) ())
-> Rep (TableSettings table) ()
forall x. GDefaultTableFieldSettings x => Proxy x -> x
gDefTblFieldSettings Proxy (Rep (TableSettings table) ())
proxy)
    where withProxy :: (Proxy (Rep (TableSettings table) ()) -> TableSettings table) -> TableSettings table
          withProxy :: forall (table :: (* -> *) -> *).
(Proxy (Rep (TableSettings table) ()) -> TableSettings table)
-> TableSettings table
withProxy Proxy (Rep (TableSettings table) ()) -> TableSettings table
f = Proxy (Rep (TableSettings table) ()) -> TableSettings table
f Proxy (Rep (TableSettings table) ())
forall {k} (t :: k). Proxy t
Proxy

class GZipTables f g h (exposedRep :: Type -> Type) fRep gRep hRep where
    gZipTables :: Applicative m => Proxy exposedRep
                                -> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
                                -> fRep ()
                                -> gRep ()
                                -> m (hRep ())

instance ( GZipTables f g h exp1 f1 g1 h1
         , GZipTables f g h exp2 f2 g2 h2
         ) => GZipTables f g h (exp1 :*: exp2) (f1 :*: f2) (g1 :*: g2) (h1 :*: h2)
   where

        gZipTables :: forall (m :: * -> *).
Applicative m =>
Proxy (exp1 :*: exp2)
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> (:*:) f1 f2 ()
-> (:*:) g1 g2 ()
-> m ((:*:) h1 h2 ())
gZipTables Proxy (exp1 :*: exp2)
_ forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine ~(f1 ()
f1 :*: f2 ()
f2) ~(g1 ()
g1 :*: g2 ()
g2) =
            h1 () -> h2 () -> (:*:) h1 h2 ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (h1 () -> h2 () -> (:*:) h1 h2 ())
-> m (h1 ()) -> m (h2 () -> (:*:) h1 h2 ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy exp1
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> f1 ()
-> g1 ()
-> m (h1 ())
forall (m :: * -> *).
Applicative m =>
Proxy exp1
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> f1 ()
-> g1 ()
-> m (h1 ())
forall (f :: * -> *) (g :: * -> *) (h :: * -> *)
       (exposedRep :: * -> *) (fRep :: * -> *) (gRep :: * -> *)
       (hRep :: * -> *) (m :: * -> *).
(GZipTables f g h exposedRep fRep gRep hRep, Applicative m) =>
Proxy exposedRep
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> fRep ()
-> gRep ()
-> m (hRep ())
gZipTables (Proxy exp1
forall {k} (t :: k). Proxy t
Proxy :: Proxy exp1) Columnar' f a -> Columnar' g a -> m (Columnar' h a)
forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine f1 ()
f1 g1 ()
g1
                  m (h2 () -> (:*:) h1 h2 ()) -> m (h2 ()) -> m ((:*:) h1 h2 ())
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy exp2
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> f2 ()
-> g2 ()
-> m (h2 ())
forall (m :: * -> *).
Applicative m =>
Proxy exp2
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> f2 ()
-> g2 ()
-> m (h2 ())
forall (f :: * -> *) (g :: * -> *) (h :: * -> *)
       (exposedRep :: * -> *) (fRep :: * -> *) (gRep :: * -> *)
       (hRep :: * -> *) (m :: * -> *).
(GZipTables f g h exposedRep fRep gRep hRep, Applicative m) =>
Proxy exposedRep
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> fRep ()
-> gRep ()
-> m (hRep ())
gZipTables (Proxy exp2
forall {k} (t :: k). Proxy t
Proxy :: Proxy exp2) Columnar' f a -> Columnar' g a -> m (Columnar' h a)
forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine f2 ()
f2 g2 ()
g2

instance GZipTables f g h exp fRep gRep hRep =>
    GZipTables f g h (M1 x y exp) (M1 x y fRep) (M1 x y gRep) (M1 x y hRep) where
        gZipTables :: forall (m :: * -> *).
Applicative m =>
Proxy (M1 x y exp)
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> M1 x y fRep ()
-> M1 x y gRep ()
-> m (M1 x y hRep ())
gZipTables Proxy (M1 x y exp)
_ forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine ~(M1 fRep ()
f) ~(M1 gRep ()
g) = hRep () -> M1 x y hRep ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (hRep () -> M1 x y hRep ()) -> m (hRep ()) -> m (M1 x y hRep ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy exp
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> fRep ()
-> gRep ()
-> m (hRep ())
forall (m :: * -> *).
Applicative m =>
Proxy exp
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> fRep ()
-> gRep ()
-> m (hRep ())
forall (f :: * -> *) (g :: * -> *) (h :: * -> *)
       (exposedRep :: * -> *) (fRep :: * -> *) (gRep :: * -> *)
       (hRep :: * -> *) (m :: * -> *).
(GZipTables f g h exposedRep fRep gRep hRep, Applicative m) =>
Proxy exposedRep
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> fRep ()
-> gRep ()
-> m (hRep ())
gZipTables (Proxy exp
forall {k} (t :: k). Proxy t
Proxy :: Proxy exp) Columnar' f a -> Columnar' g a -> m (Columnar' h a)
forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine fRep ()
f gRep ()
g

instance ( fa ~ Columnar f a
         , ga ~ Columnar g a
         , ha ~ Columnar h a
         , ha ~ Columnar h a) =>
    GZipTables f g h (K1 Generic.R (Exposed a)) (K1 Generic.R fa) (K1 Generic.R ga) (K1 Generic.R ha) where
        gZipTables :: forall (m :: * -> *).
Applicative m =>
Proxy (K1 R (Exposed a))
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> K1 R fa ()
-> K1 R ga ()
-> m (K1 R ha ())
gZipTables Proxy (K1 R (Exposed a))
_ forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine ~(K1 fa
f) ~(K1 ga
g) = (\(Columnar' Columnar h a
h) -> ha -> K1 R ha ()
forall k i c (p :: k). c -> K1 i c p
K1 ha
Columnar h a
h) (Columnar' h a -> K1 R ha ())
-> m (Columnar' h a) -> m (K1 R ha ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Columnar' f a -> Columnar' g a -> m (Columnar' h a)
forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine (Columnar f a -> Columnar' f a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' fa
Columnar f a
f :: Columnar' f a) (Columnar g a -> Columnar' g a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ga
Columnar g a
g :: Columnar' g a)

instance ( Beamable tbl
         ) => GZipTables f g h (K1 Generic.R (tbl Exposed)) (K1 Generic.R (tbl f))
                                                            (K1 Generic.R (tbl g))
                                                            (K1 Generic.R (tbl h))
   where
    gZipTables :: forall (m :: * -> *).
Applicative m =>
Proxy (K1 R (tbl Exposed))
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> K1 R (tbl f) ()
-> K1 R (tbl g) ()
-> m (K1 R (tbl h) ())
gZipTables Proxy (K1 R (tbl Exposed))
_ forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine ~(K1 tbl f
f) ~(K1 tbl g
g) = tbl h -> K1 R (tbl h) ()
forall k i c (p :: k). c -> K1 i c p
K1 (tbl h -> K1 R (tbl h) ()) -> m (tbl h) -> m (K1 R (tbl h) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM Columnar' f a -> Columnar' g a -> m (Columnar' h a)
forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine tbl f
f tbl g
g


instance GZipTables f g h U1 U1 U1 U1 where
  gZipTables :: forall (m :: * -> *).
Applicative m =>
Proxy U1
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> U1 ()
-> U1 ()
-> m (U1 ())
gZipTables Proxy U1
_ forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
_ U1 ()
_ U1 ()
_ = U1 () -> m (U1 ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 ()
forall k (p :: k). U1 p
U1

instance  ( Beamable tbl
          ) => GZipTables f g h (K1 Generic.R (tbl (Nullable Exposed)))
                                (K1 Generic.R (tbl (Nullable f)))
                                (K1 Generic.R (tbl (Nullable g)))
                                (K1 Generic.R (tbl (Nullable h)))
   where

    gZipTables :: forall (m :: * -> *).
Applicative m =>
Proxy (K1 R (tbl (Nullable Exposed)))
-> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> K1 R (tbl (Nullable f)) ()
-> K1 R (tbl (Nullable g)) ()
-> m (K1 R (tbl (Nullable h)) ())
gZipTables Proxy (K1 R (tbl (Nullable Exposed)))
_ forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine ~(K1 tbl (Nullable f)
f) ~(K1 tbl (Nullable g)
g) =  tbl (Nullable h) -> K1 R (tbl (Nullable h)) ()
forall k i c (p :: k). c -> K1 i c p
K1 (tbl (Nullable h) -> K1 R (tbl (Nullable h)) ())
-> m (tbl (Nullable h)) -> m (K1 R (tbl (Nullable h)) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a.
 Columnar' (Nullable f) a
 -> Columnar' (Nullable g) a -> m (Columnar' (Nullable h) a))
-> tbl (Nullable f) -> tbl (Nullable g) -> m (tbl (Nullable h))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM ((forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> forall a.
   Columnar' (Nullable f) a
   -> Columnar' (Nullable g) a -> m (Columnar' (Nullable h) a)
forall (m :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> forall a.
   Columnar' (Nullable f) a
   -> Columnar' (Nullable g) a -> m (Columnar' (Nullable h) a)
adapt Columnar' f a -> Columnar' g a -> m (Columnar' h a)
forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
combine) tbl (Nullable f)
f tbl (Nullable g)
g
      where
        adapt :: Applicative m => (forall a . Columnar' f a            -> Columnar' g a            -> m (Columnar' h a)           )
                               -> (forall a . Columnar' (Nullable f) a -> Columnar' (Nullable g) a -> m (Columnar' (Nullable h) a))
        adapt :: forall (m :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> forall a.
   Columnar' (Nullable f) a
   -> Columnar' (Nullable g) a -> m (Columnar' (Nullable h) a)
adapt forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
func Columnar' (Nullable f) a
x Columnar' (Nullable g) a
y = Columnar' h (Maybe a) -> Columnar' (Nullable h) a
forall (w :: * -> *) a.
Columnar' w (Maybe a) -> Columnar' (Nullable w) a
toNullable (Columnar' h (Maybe a) -> Columnar' (Nullable h) a)
-> m (Columnar' h (Maybe a)) -> m (Columnar' (Nullable h) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Columnar' f (Maybe a)
-> Columnar' g (Maybe a) -> m (Columnar' h (Maybe a))
forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)
func ( Columnar' (Nullable f) a -> Columnar' f (Maybe a)
forall (w :: * -> *) a.
Columnar' (Nullable w) a -> Columnar' w (Maybe a)
fromNullable Columnar' (Nullable f) a
x ) ( Columnar' (Nullable g) a -> Columnar' g (Maybe a)
forall (w :: * -> *) a.
Columnar' (Nullable w) a -> Columnar' w (Maybe a)
fromNullable Columnar' (Nullable g) a
y )

        fromNullable :: Columnar' (Nullable w) a -> Columnar' w (Maybe a)
        fromNullable :: forall (w :: * -> *) a.
Columnar' (Nullable w) a -> Columnar' w (Maybe a)
fromNullable ~(Columnar' Columnar (Nullable w) a
x) = Columnar w (Maybe a) -> Columnar' w (Maybe a)
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' Columnar w (Maybe a)
Columnar (Nullable w) a
x

        toNullable   :: Columnar' w (Maybe a) -> Columnar' (Nullable w) a
        toNullable :: forall (w :: * -> *) a.
Columnar' w (Maybe a) -> Columnar' (Nullable w) a
toNullable ~(Columnar' Columnar w (Maybe a)
x) = Columnar (Nullable w) a -> Columnar' (Nullable w) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' Columnar w (Maybe a)
Columnar (Nullable w) a
x

class GDefaultTableFieldSettings x where
    gDefTblFieldSettings :: Proxy x -> x
instance GDefaultTableFieldSettings (p x) => GDefaultTableFieldSettings (D1 f p x) where
    gDefTblFieldSettings :: Proxy (D1 f p x) -> D1 f p x
gDefTblFieldSettings (Proxy (D1 f p x)
_ :: Proxy (D1 f p x)) = p x -> D1 f p x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (p x -> D1 f p x) -> p x -> D1 f p x
forall a b. (a -> b) -> a -> b
$ Proxy (p x) -> p x
forall x. GDefaultTableFieldSettings x => Proxy x -> x
gDefTblFieldSettings (Proxy (p x)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (p x))
instance GDefaultTableFieldSettings (p x) => GDefaultTableFieldSettings (C1 f p x) where
    gDefTblFieldSettings :: Proxy (C1 f p x) -> C1 f p x
gDefTblFieldSettings (Proxy (C1 f p x)
_ :: Proxy (C1 f p x)) = p x -> C1 f p x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (p x -> C1 f p x) -> p x -> C1 f p x
forall a b. (a -> b) -> a -> b
$ Proxy (p x) -> p x
forall x. GDefaultTableFieldSettings x => Proxy x -> x
gDefTblFieldSettings (Proxy (p x)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (p x))
instance (GDefaultTableFieldSettings (a p), GDefaultTableFieldSettings (b p)) => GDefaultTableFieldSettings ((a :*: b) p) where
    gDefTblFieldSettings :: Proxy ((:*:) a b p) -> (:*:) a b p
gDefTblFieldSettings (Proxy ((:*:) a b p)
_ :: Proxy ((a :*: b) p)) = Proxy (a p) -> a p
forall x. GDefaultTableFieldSettings x => Proxy x -> x
gDefTblFieldSettings (Proxy (a p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (a p)) a p -> b p -> (:*:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Proxy (b p) -> b p
forall x. GDefaultTableFieldSettings x => Proxy x -> x
gDefTblFieldSettings (Proxy (b p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (b p))

instance Selector f  =>
    GDefaultTableFieldSettings (S1 f (K1 Generic.R (TableField table field)) p) where
    gDefTblFieldSettings :: Proxy (S1 f (K1 R (TableField table field)) p)
-> S1 f (K1 R (TableField table field)) p
gDefTblFieldSettings (Proxy (S1 f (K1 R (TableField table field)) p)
_ :: Proxy (S1 f (K1 Generic.R (TableField table field)) p)) = K1 R (TableField table field) p
-> S1 f (K1 R (TableField table field)) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (TableField table field -> K1 R (TableField table field) p
forall k i c (p :: k). c -> K1 i c p
K1 TableField table field
s)
        where s :: TableField table field
s = NonEmpty Text -> Text -> TableField table field
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
rawSelName) Text
name
              name :: Text
name = Text -> Text
unCamelCaseSel Text
rawSelName
              rawSelName :: Text
rawSelName = String -> Text
T.pack (M1 S f (K1 R (TableField table field)) () -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t f f a -> String
selName (M1 S f (K1 R (TableField table field)) ()
forall a. HasCallStack => a
undefined :: S1 f (K1 Generic.R (TableField table field)) ()))

instance ( TypeError ('Text "All Beamable types must be record types, so appropriate names can be given to columns")) => GDefaultTableFieldSettings (K1 r f p) where
  gDefTblFieldSettings :: Proxy (K1 r f p) -> K1 r f p
gDefTblFieldSettings Proxy (K1 r f p)
_ = String -> K1 r f p
forall a. HasCallStack => String -> a
error String
"impossible"

-- | Type-level representation of the naming strategy to use for defaulting
--   Needed because primary keys should be named after the default naming of
--   their corresponding table, not the names of the record selectors in the
--   primary key (if any).
data SubTableStrategy
  = PrimaryKeyStrategy
  | BeamableStrategy
  | RecursiveKeyStrategy

type family ChooseSubTableStrategy (tbl :: (Type -> Type) -> Type) (sub :: (Type -> Type) -> Type) :: SubTableStrategy where
  ChooseSubTableStrategy tbl (PrimaryKey tbl) = 'RecursiveKeyStrategy
  ChooseSubTableStrategy tbl (PrimaryKey rel) = 'PrimaryKeyStrategy
  ChooseSubTableStrategy tbl sub = 'BeamableStrategy

-- TODO is this necessary
type family CheckNullable (f :: Type -> Type) :: Constraint where
  CheckNullable (Nullable f) = ()
  CheckNullable f = TypeError ('Text "Recursive references without Nullable constraint form an infinite loop." ':$$:
                               'Text "Hint: Only embed nullable 'PrimaryKey tbl' within the definition of 'tbl'." ':$$:
                               'Text "      For example, replace 'PrimaryKey tbl f' with 'PrimaryKey tbl (Nullable f)'")


class SubTableStrategyImpl (strategy :: SubTableStrategy) (f :: Type -> Type) sub where
  namedSubTable :: Proxy strategy -> sub f

-- The defaulting with @TableField rel@ is necessary to avoid infinite loops
instance ( Table rel, Generic (rel (TableField rel))
         , TagReducesTo f (TableField tbl)
         , GDefaultTableFieldSettings (Rep (rel (TableField rel)) ()) ) =>
  SubTableStrategyImpl 'PrimaryKeyStrategy f (PrimaryKey rel) where
  namedSubTable :: Proxy 'PrimaryKeyStrategy -> PrimaryKey rel f
namedSubTable Proxy 'PrimaryKeyStrategy
_ = rel f -> PrimaryKey rel f
forall (column :: * -> *). rel column -> PrimaryKey rel column
forall (table :: (* -> *) -> *) (column :: * -> *).
Table table =>
table column -> PrimaryKey table column
primaryKey rel f
tbl
    where tbl :: rel f
tbl = (forall a. Columnar' (TableField rel) a -> Columnar' f a)
-> rel (TableField rel) -> rel f
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (TableField NonEmpty Text
path Text
nm) :: Columnar' (TableField rel) a) ->
                                  let c :: Columnar' (TableField tbl) a
c = Columnar (TableField tbl) a -> Columnar' (TableField tbl) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (NonEmpty Text -> Text -> TableField tbl a
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField NonEmpty Text
path Text
nm) :: Columnar' (TableField tbl) a
                                  in Identity (Columnar' f a) -> Columnar' f a
forall a. Identity a -> a
runIdentity ((Columnar' (TableField tbl) a
 -> Identity (Columnar' (TableField tbl) a))
-> Columnar' f a -> Identity (Columnar' f a)
forall (m :: * -> *) a' a.
Functor m =>
(Columnar' (TableField tbl) a'
 -> m (Columnar' (TableField tbl) a'))
-> Columnar' f a -> m (Columnar' f a)
forall (f :: * -> *) (f' :: * -> *) (m :: * -> *) a' a.
(TagReducesTo f f', Functor m) =>
(Columnar' f' a' -> m (Columnar' f' a'))
-> Columnar' f a -> m (Columnar' f a)
reduceTag (\Columnar' (TableField tbl) a
_ -> Columnar' (TableField tbl) a
-> Identity (Columnar' (TableField tbl) a)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Columnar' (TableField tbl) a
c) Columnar' f a
forall a. HasCallStack => a
undefined)) (rel (TableField rel) -> rel f) -> rel (TableField rel) -> rel f
forall a b. (a -> b) -> a -> b
$
                Rep (rel (TableField rel)) () -> rel (TableField rel)
forall x. Generic x => Rep x () -> x
to' (Rep (rel (TableField rel)) () -> rel (TableField rel))
-> Rep (rel (TableField rel)) () -> rel (TableField rel)
forall a b. (a -> b) -> a -> b
$ Proxy (Rep (rel (TableField rel)) ())
-> Rep (rel (TableField rel)) ()
forall x. GDefaultTableFieldSettings x => Proxy x -> x
gDefTblFieldSettings (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Rep (rel (TableField rel)) ()))
instance ( Generic (sub f)
         , GDefaultTableFieldSettings (Rep (sub f) ()) ) =>
         SubTableStrategyImpl 'BeamableStrategy f sub where
  namedSubTable :: Proxy 'BeamableStrategy -> sub f
namedSubTable Proxy 'BeamableStrategy
_ = Rep (sub f) () -> sub f
forall x. Generic x => Rep x () -> x
to' (Rep (sub f) () -> sub f) -> Rep (sub f) () -> sub f
forall a b. (a -> b) -> a -> b
$ Proxy (Rep (sub f) ()) -> Rep (sub f) ()
forall x. GDefaultTableFieldSettings x => Proxy x -> x
gDefTblFieldSettings (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Rep (sub f) ()))
instance ( CheckNullable f, SubTableStrategyImpl 'PrimaryKeyStrategy f (PrimaryKey rel) ) =>
         SubTableStrategyImpl 'RecursiveKeyStrategy f (PrimaryKey rel) where
  namedSubTable :: Proxy 'RecursiveKeyStrategy -> PrimaryKey rel f
namedSubTable Proxy 'RecursiveKeyStrategy
_ = Proxy 'PrimaryKeyStrategy -> PrimaryKey rel f
forall (strategy :: SubTableStrategy) (f :: * -> *)
       (sub :: (* -> *) -> *).
SubTableStrategyImpl strategy f sub =>
Proxy strategy -> sub f
namedSubTable (forall {k} (t :: k). Proxy t
forall (t :: SubTableStrategy). Proxy t
Proxy @'PrimaryKeyStrategy)

instance {-# OVERLAPPING #-}
         ( Selector f'
         , ChooseSubTableStrategy tbl sub ~ strategy
         , SubTableStrategyImpl strategy f sub
         , TagReducesTo f (TableField tbl)
         , Beamable sub ) =>
         GDefaultTableFieldSettings (S1 f' (K1 Generic.R (sub f)) p) where
  gDefTblFieldSettings :: Proxy (S1 f' (K1 R (sub f)) p) -> S1 f' (K1 R (sub f)) p
gDefTblFieldSettings Proxy (S1 f' (K1 R (sub f)) p)
_ = K1 R (sub f) p -> S1 f' (K1 R (sub f)) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (sub f) p -> S1 f' (K1 R (sub f)) p)
-> (sub f -> K1 R (sub f) p) -> sub f -> S1 f' (K1 R (sub f)) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sub f -> K1 R (sub f) p
forall k i c (p :: k). c -> K1 i c p
K1 (sub f -> S1 f' (K1 R (sub f)) p)
-> sub f -> S1 f' (K1 R (sub f)) p
forall a b. (a -> b) -> a -> b
$ sub f
settings'
    where tbl :: sub f
          tbl :: sub f
tbl = Proxy strategy -> sub f
forall (strategy :: SubTableStrategy) (f :: * -> *)
       (sub :: (* -> *) -> *).
SubTableStrategyImpl strategy f sub =>
Proxy strategy -> sub f
namedSubTable (forall {k} (t :: k). Proxy t
forall (t :: SubTableStrategy). Proxy t
Proxy @strategy)

          origSelName :: Text
origSelName = String -> Text
T.pack (S1 f' (K1 R (sub f)) p -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t f' f a -> String
selName (S1 f' (K1 R (sub f)) p
forall a. HasCallStack => a
undefined :: S1 f' (K1 Generic.R (sub f)) p))
          relName :: Text
relName = Text -> Text
unCamelCaseSel Text
origSelName

          settings' :: sub f
          settings' :: sub f
settings' = (forall a. Columnar' f a -> Columnar' f a) -> sub f -> sub f
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep ((Columnar' (TableField tbl) (ZonkAny 0)
 -> Identity (Columnar' (TableField tbl) (ZonkAny 0)))
-> Columnar' f a -> Identity (Columnar' f a)
forall (m :: * -> *) a' a.
Functor m =>
(Columnar' (TableField tbl) a'
 -> m (Columnar' (TableField tbl) a'))
-> Columnar' f a -> m (Columnar' f a)
forall (f :: * -> *) (f' :: * -> *) (m :: * -> *) a' a.
(TagReducesTo f f', Functor m) =>
(Columnar' f' a' -> m (Columnar' f' a'))
-> Columnar' f a -> m (Columnar' f a)
reduceTag ((Columnar' (TableField tbl) (ZonkAny 0)
  -> Identity (Columnar' (TableField tbl) (ZonkAny 0)))
 -> Columnar' f a -> Identity (Columnar' f a))
-> (Columnar' (TableField tbl) (ZonkAny 0)
    -> Columnar' (TableField tbl) (ZonkAny 0))
-> Columnar' f a
-> Columnar' f a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \(Columnar' (TableField NonEmpty Text
path Text
nm)) -> Columnar (TableField tbl) (ZonkAny 0)
-> Columnar' (TableField tbl) (ZonkAny 0)
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (NonEmpty Text -> Text -> TableField tbl (ZonkAny 0)
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
origSelName NonEmpty Text -> NonEmpty Text -> NonEmpty Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty Text
path) (Text
relName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"__" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm))) sub f
tbl

type family ReplaceBaseTag tag f where
  ReplaceBaseTag tag (Nullable f) = Nullable (ReplaceBaseTag tag f)
  ReplaceBaseTag tag x = tag

-- | Class to automatically unwrap nested Nullables
class TagReducesTo f f' | f -> f' where
  reduceTag :: Functor m =>
               (Columnar' f' a' -> m (Columnar' f' a'))
            -> Columnar' f a -> m (Columnar' f a)
instance TagReducesTo (TableField tbl) (TableField tbl) where
  reduceTag :: forall (m :: * -> *) a' a.
Functor m =>
(Columnar' (TableField tbl) a'
 -> m (Columnar' (TableField tbl) a'))
-> Columnar' (TableField tbl) a -> m (Columnar' (TableField tbl) a)
reduceTag Columnar' (TableField tbl) a' -> m (Columnar' (TableField tbl) a')
f ~(Columnar' (TableField NonEmpty Text
path Text
nm)) =
    (\(Columnar' (TableField NonEmpty Text
path' Text
nm')) -> Columnar (TableField tbl) a -> Columnar' (TableField tbl) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (NonEmpty Text -> Text -> TableField tbl a
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField NonEmpty Text
path' Text
nm')) (Columnar' (TableField tbl) a' -> Columnar' (TableField tbl) a)
-> m (Columnar' (TableField tbl) a')
-> m (Columnar' (TableField tbl) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Columnar' (TableField tbl) a' -> m (Columnar' (TableField tbl) a')
f (Columnar (TableField tbl) a' -> Columnar' (TableField tbl) a'
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (NonEmpty Text -> Text -> TableField tbl a'
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField NonEmpty Text
path Text
nm))
instance TagReducesTo f f' => TagReducesTo (Nullable f) f' where
  reduceTag :: forall (m :: * -> *) a' a.
Functor m =>
(Columnar' f' a' -> m (Columnar' f' a'))
-> Columnar' (Nullable f) a -> m (Columnar' (Nullable f) a)
reduceTag Columnar' f' a' -> m (Columnar' f' a')
fn ~(Columnar' Columnar (Nullable f) a
x :: Columnar' (Nullable f) a) =
    (\(Columnar' Columnar f (Maybe a)
x' :: Columnar' f (Maybe a')) -> Columnar (Nullable f) a -> Columnar' (Nullable f) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' Columnar f (Maybe a)
Columnar (Nullable f) a
x') (Columnar' f (Maybe a) -> Columnar' (Nullable f) a)
-> m (Columnar' f (Maybe a)) -> m (Columnar' (Nullable f) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          (Columnar' f' a' -> m (Columnar' f' a'))
-> Columnar' f (Maybe a) -> m (Columnar' f (Maybe a))
forall (m :: * -> *) a' a.
Functor m =>
(Columnar' f' a' -> m (Columnar' f' a'))
-> Columnar' f a -> m (Columnar' f a)
forall (f :: * -> *) (f' :: * -> *) (m :: * -> *) a' a.
(TagReducesTo f f', Functor m) =>
(Columnar' f' a' -> m (Columnar' f' a'))
-> Columnar' f a -> m (Columnar' f a)
reduceTag Columnar' f' a' -> m (Columnar' f' a')
fn (Columnar f (Maybe a) -> Columnar' f (Maybe a)
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' Columnar f (Maybe a)
Columnar (Nullable f) a
x :: Columnar' f (Maybe a))

class GTableSkeleton x where
    gTblSkeleton :: Proxy x -> x ()

instance GTableSkeleton p => GTableSkeleton (M1 t f p) where
    gTblSkeleton :: Proxy (M1 t f p) -> M1 t f p ()
gTblSkeleton (Proxy (M1 t f p)
_ :: Proxy (M1 t f p)) = p () -> M1 t f p ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Proxy p -> p ()
forall (x :: * -> *). GTableSkeleton x => Proxy x -> x ()
gTblSkeleton (Proxy p
forall {k} (t :: k). Proxy t
Proxy :: Proxy p))

instance GTableSkeleton U1 where
    gTblSkeleton :: Proxy U1 -> U1 ()
gTblSkeleton Proxy U1
_ = U1 ()
forall k (p :: k). U1 p
U1

instance (GTableSkeleton a, GTableSkeleton b) =>
    GTableSkeleton (a :*: b) where
        gTblSkeleton :: Proxy (a :*: b) -> (:*:) a b ()
gTblSkeleton Proxy (a :*: b)
_ = Proxy a -> a ()
forall (x :: * -> *). GTableSkeleton x => Proxy x -> x ()
gTblSkeleton (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) a () -> b () -> (:*:) a b ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Proxy b -> b ()
forall (x :: * -> *). GTableSkeleton x => Proxy x -> x ()
gTblSkeleton (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)

instance GTableSkeleton (K1 Generic.R (Ignored field)) where
    gTblSkeleton :: Proxy (K1 R (Ignored field)) -> K1 R (Ignored field) ()
gTblSkeleton Proxy (K1 R (Ignored field))
_ = Ignored field -> K1 R (Ignored field) ()
forall k i c (p :: k). c -> K1 i c p
K1 Ignored field
forall x. Ignored x
Ignored

instance ( Beamable tbl
         ) => GTableSkeleton (K1 Generic.R (tbl Ignored))
   where
    gTblSkeleton :: Proxy (K1 R (tbl Ignored)) -> K1 R (tbl Ignored) ()
gTblSkeleton Proxy (K1 R (tbl Ignored))
_ = tbl Ignored -> K1 R (tbl Ignored) ()
forall k i c (p :: k). c -> K1 i c p
K1 (tbl Ignored
forall (table :: (* -> *) -> *).
Beamable table =>
TableSkeleton table
tblSkeleton :: TableSkeleton tbl)

instance ( Beamable tbl
         ) => GTableSkeleton (K1 Generic.R (tbl (Nullable Ignored)))
   where
    gTblSkeleton :: Proxy (K1 R (tbl (Nullable Ignored)))
-> K1 R (tbl (Nullable Ignored)) ()
gTblSkeleton Proxy (K1 R (tbl (Nullable Ignored)))
_ = tbl (Nullable Ignored) -> K1 R (tbl (Nullable Ignored)) ()
forall k i c (p :: k). c -> K1 i c p
K1 (tbl (Nullable Ignored) -> K1 R (tbl (Nullable Ignored)) ())
-> (Identity (tbl (Nullable Ignored)) -> tbl (Nullable Ignored))
-> Identity (tbl (Nullable Ignored))
-> K1 R (tbl (Nullable Ignored)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (tbl (Nullable Ignored)) -> tbl (Nullable Ignored)
forall a. Identity a -> a
runIdentity
                   (Identity (tbl (Nullable Ignored))
 -> K1 R (tbl (Nullable Ignored)) ())
-> Identity (tbl (Nullable Ignored))
-> K1 R (tbl (Nullable Ignored)) ()
forall a b. (a -> b) -> a -> b
$ (forall a.
 Columnar' Ignored a
 -> Columnar' Ignored a
 -> Identity (Columnar' (Nullable Ignored) a))
-> tbl Ignored -> tbl Ignored -> Identity (tbl (Nullable Ignored))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM Columnar' Ignored a
-> Columnar' Ignored a -> Identity (Columnar' (Nullable Ignored) a)
forall a.
Columnar' Ignored a
-> Columnar' Ignored a -> Identity (Columnar' (Nullable Ignored) a)
transform
                                    (tbl Ignored
forall (table :: (* -> *) -> *).
Beamable table =>
TableSkeleton table
tblSkeleton :: TableSkeleton tbl)
                                    (tbl Ignored
forall (table :: (* -> *) -> *).
Beamable table =>
TableSkeleton table
tblSkeleton :: TableSkeleton tbl)
        where
          transform :: Columnar' Ignored a
                    -> Columnar' Ignored a
                    -> Identity (Columnar' (Nullable Ignored) a)
          transform :: forall a.
Columnar' Ignored a
-> Columnar' Ignored a -> Identity (Columnar' (Nullable Ignored) a)
transform Columnar' Ignored a
_ Columnar' Ignored a
_ = Columnar' (Nullable Ignored) a
-> Identity (Columnar' (Nullable Ignored) a)
forall a. a -> Identity a
Identity (Columnar (Nullable Ignored) a -> Columnar' (Nullable Ignored) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' Ignored (Maybe a)
Columnar (Nullable Ignored) a
forall x. Ignored x
Ignored)


-- * Internal functions

unCamelCase :: T.Text -> [T.Text]
unCamelCase :: Text -> [Text]
unCamelCase Text
"" = []
unCamelCase Text
s
    | (Text
comp, Text
next) <- (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isUpper Text
s, Bool -> Bool
not (Text -> Bool
T.null Text
comp) =
          let next' :: Text
next' = Text -> ((Char, Text) -> Text) -> Maybe (Char, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty ((Char -> Text -> Text) -> (Char, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
T.cons ((Char, Text) -> Text)
-> ((Char, Text) -> (Char, Text)) -> (Char, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> (Char, Text) -> (Char, Text)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Char -> Char
toLower) (Text -> Maybe (Char, Text)
T.uncons Text
next)
          in Text -> Text
T.toLower Text
compText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text -> [Text]
unCamelCase Text
next'
    | Bool
otherwise =
          let (Text
comp, Text
next) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isUpper Text
s
              next' :: Text
next' = Text -> ((Char, Text) -> Text) -> Maybe (Char, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty ((Char -> Text -> Text) -> (Char, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
T.cons ((Char, Text) -> Text)
-> ((Char, Text) -> (Char, Text)) -> (Char, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> (Char, Text) -> (Char, Text)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Char -> Char
toLower) (Text -> Maybe (Char, Text)
T.uncons Text
next)
          in Text -> Text
T.toLower Text
compText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text -> [Text]
unCamelCase Text
next'

-- | Camel casing magic for standard beam record field names.
--
--   All leading underscores are ignored. If what remains is camel-cased beam
--   will convert it to use underscores instead. If there are any underscores in
--   what remains, then the entire name (minus the leading underscares). If the
--   field name is solely underscores, beam will assume you know what you're
--   doing and include the full original name as the field name
unCamelCaseSel :: Text -> Text
unCamelCaseSel :: Text -> Text
unCamelCaseSel Text
original =
  let symbolLeft :: Text
symbolLeft = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'_') Text
original
  in if Text -> Bool
T.null Text
symbolLeft
     then Text
original
     else if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'_') Text
symbolLeft
          then Text
symbolLeft
          else case Text -> [Text]
unCamelCase Text
symbolLeft of
                 [] -> Text
symbolLeft
                 [Text
xs] -> Text
xs
                 Text
_:[Text]
xs -> Text -> [Text] -> Text
T.intercalate Text
"_" [Text]
xs

-- | Produce the beam default field name for the given path
defaultFieldName :: NE.NonEmpty Text -> Text
defaultFieldName :: NonEmpty Text -> Text
defaultFieldName NonEmpty Text
comps = NonEmpty Text -> Text
forall m. Monoid m => NonEmpty m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Text -> NonEmpty Text -> NonEmpty Text
forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse (String -> Text
T.pack String
"__") (Text -> Text
unCamelCaseSel (Text -> Text) -> NonEmpty Text -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Text
comps))