{-# 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
    , DatabaseModification, EntityModification(..)
    , FieldModification(..)
    , dbModification, tableModification, withDbModification
    , withTableModification, modifyTable, modifyEntityName
    , setEntityName, modifyTableFields, fieldNamed
    , modifyEntitySchema, setEntitySchema
    , defaultDbSettings

    , 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 )
    where

import           Database.Beam.Backend.Types

import           Control.Applicative (liftA2)
import           Control.Arrow (first)
import           Control.Monad.Identity
import           Control.Monad.Writer hiding ((<>))

import           Data.Char (isUpper, toLower)
import           Data.Foldable (fold)
import qualified Data.List.NonEmpty as NE
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           GHC.Types

import           Lens.Micro hiding (to)
import qualified Lens.Micro as Lens

-- | 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
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 ())
gZipDatabase (Proxy f
forall k (t :: k). Proxy t
Proxy @f, Proxy g
forall k (t :: k). Proxy t
Proxy @g, Proxy h
h, Proxy be
be) forall tbl.
(IsDatabaseEntity be tbl,
 DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine (db f -> Rep (db f) ()
forall a x. Generic a => a -> Rep a x
from db f
f) (db g -> Rep (db g) ()
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 :: (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 :: 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
mconcat :: [EntityModification f be e] -> EntityModification f be e
$cmconcat :: forall (f :: * -> *) be e.
[EntityModification f be e] -> EntityModification f be e
mappend :: EntityModification f be e
-> EntityModification f be e -> EntityModification f be e
$cmappend :: forall (f :: * -> *) be e.
EntityModification f be e
-> EntityModification f be e -> EntityModification f be e
mempty :: EntityModification f be e
$cmempty :: forall (f :: * -> *) be e. EntityModification f be e
$cp1Monoid :: forall (f :: * -> *) be e. Semigroup (EntityModification f be e)
Monoid, b -> EntityModification f be e -> EntityModification f be e
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
stimes :: b -> 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
sconcat :: NonEmpty (EntityModification f be e) -> EntityModification f be e
$csconcat :: forall (f :: * -> *) be e.
NonEmpty (EntityModification f be e) -> EntityModification f be e
<> :: EntityModification f be e
-> 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
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 :: 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)
zipTables (Proxy be
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 (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 :: 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 (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 x) (Columnar' _ :: Columnar' Ignored x) ->
                                      Columnar' (FieldModification f) a
-> Identity (Columnar' (FieldModification f) 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 = modifyTable (\_ -> "Table_1") (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 :: 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)
zipTables (Proxy be
forall k (t :: k). Proxy t
Proxy @be) (\entity be db tbl
tbl (EntityModification entityFn) -> entity be db tbl -> Identity (entity be db tbl)
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 :: 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 (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 fieldFn :: FieldModification f a)) ->
                                  Columnar' f a -> Identity (Columnar' f 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 :: (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 :: (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
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 :: (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)
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 :: 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 :: 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)

-- | Construct an 'EntityModification' to rename the fields of a 'TableEntity'
modifyTableFields :: tbl (FieldModification (TableField tbl)) -> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
modifyTableFields :: 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)
R:DatabaseEntityDescriptorbeTableEntity be tbl
tbl { dbTableSettings :: TableSettings tbl
dbTableSettings = tbl (FieldModification (TableField tbl))
-> TableSettings tbl -> TableSettings tbl
forall (tbl :: (* -> *) -> *) (f :: * -> *).
Beamable tbl =>
tbl (FieldModification f) -> tbl f -> tbl f
withTableModification tbl (FieldModification (TableField tbl))
modFields (DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity tbl)
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 :: 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.
Lens' (TableField table ty) Text
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 { 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 :: 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 path _) = 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 Any be tbl
    -> EntityModification Any be tbl
    -> Identity (EntityModification (DatabaseEntity be db) be tbl))
-> db (EntityModification Any be)
-> db (EntityModification Any 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)
zipTables (Proxy be
forall k (t :: k). Proxy t
Proxy @be) (\EntityModification Any be tbl
_ EntityModification Any be tbl
_ -> EntityModification (DatabaseEntity be db) be tbl
-> Identity (EntityModification (DatabaseEntity be db) be tbl)
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))
              (forall a. HasCallStack => a
forall (f :: * -> *). db (EntityModification f be)
undefined :: DatabaseModification f be db)
              (forall a. HasCallStack => a
forall (f :: * -> *). db (EntityModification f be)
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 (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 x) (Columnar' _ :: Columnar' Ignored x) ->
                       Columnar' (FieldModification f) a
-> Identity (Columnar' (FieldModification f) 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 (f :: * -> *) a.
RenamableField f =>
Proxy f
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar f a
-> Columnar f a
renameField (Proxy f
forall k (t :: k). Proxy t
Proxy @f) (Proxy a
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)
R:DatabaseEntityDescriptorbeTableEntity be tbl
tbl { dbTableSettings :: TableSettings tbl
dbTableSettings =
              (forall a.
 Columnar' (TableField tbl) a -> Columnar' (TableField tbl) a)
-> TableSettings tbl -> TableSettings tbl
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' 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 (f :: * -> *) a.
RenamableField f =>
Proxy f
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar f a
-> Columnar f a
renameField (Proxy (TableField tbl)
forall k (t :: k). Proxy t
Proxy @(TableField tbl))
                                                      (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
                                                      NonEmpty Text -> Text
renamer Columnar (TableField tbl) a
tblField)
                                 :: Columnar' (TableField tbl) a) (TableSettings tbl -> TableSettings tbl)
-> TableSettings tbl -> TableSettings tbl
forall a b. (a -> b) -> a -> b
$
              DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity tbl)
tbl }

instance Beamable tbl => IsDatabaseEntity be (TableEntity tbl) where
  data DatabaseEntityDescriptor be (TableEntity tbl) where
    DatabaseTable
      :: Table tbl =>
       { DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema      :: Maybe Text
       , DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableOrigName    :: Text
       , DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName :: Text
       , 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 :: (Text -> f Text)
-> DatabaseEntityDescriptor be (TableEntity tbl)
-> f (DatabaseEntityDescriptor be (TableEntity tbl))
dbEntityName Text -> f Text
f DatabaseEntityDescriptor be (TableEntity tbl)
tbl = (Text -> DatabaseEntityDescriptor be (TableEntity tbl))
-> f Text -> f (DatabaseEntityDescriptor be (TableEntity tbl))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
t' -> DatabaseEntityDescriptor be (TableEntity tbl)
R:DatabaseEntityDescriptorbeTableEntity be tbl
tbl { dbTableCurrentName :: Text
dbTableCurrentName = Text
t' }) (Text -> f Text
f (DatabaseEntityDescriptor be (TableEntity tbl) -> Text
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor be (TableEntity tbl)
tbl))
  dbEntitySchema :: (Maybe Text -> f (Maybe Text))
-> DatabaseEntityDescriptor be (TableEntity tbl)
-> f (DatabaseEntityDescriptor be (TableEntity tbl))
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Text
s' -> DatabaseEntityDescriptor be (TableEntity tbl)
R:DatabaseEntityDescriptorbeTableEntity be tbl
tbl { dbTableSchema :: Maybe Text
dbTableSchema = Maybe Text
s'}) (Maybe Text -> f (Maybe Text)
f (DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor be (TableEntity tbl)
tbl))
  dbEntityAuto :: 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)
R:DatabaseEntityDescriptorbeViewEntity be tbl
vw { dbViewSettings :: TableSettings tbl
dbViewSettings =
             (forall a.
 Columnar' (TableField tbl) a -> Columnar' (TableField tbl) a)
-> TableSettings tbl -> TableSettings tbl
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' 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 (f :: * -> *) a.
RenamableField f =>
Proxy f
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar f a
-> Columnar f a
renameField (Proxy (TableField tbl)
forall k (t :: k). Proxy t
Proxy @(TableField tbl))
                                                     (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
                                                     NonEmpty Text -> Text
renamer Columnar (TableField tbl) a
tblField)
                                :: Columnar' (TableField tbl) a) (TableSettings tbl -> TableSettings tbl)
-> TableSettings tbl -> TableSettings tbl
forall a b. (a -> b) -> a -> b
$
             DatabaseEntityDescriptor be (ViewEntity tbl) -> TableSettings tbl
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (ViewEntity tbl) -> TableSettings tbl
dbViewSettings DatabaseEntityDescriptor be (ViewEntity tbl)
vw }

instance Beamable tbl => IsDatabaseEntity be (ViewEntity tbl) where
  data DatabaseEntityDescriptor be (ViewEntity tbl) where
    DatabaseView
      :: { DatabaseEntityDescriptor be (ViewEntity tbl) -> Maybe Text
dbViewSchema :: Maybe Text
         , DatabaseEntityDescriptor be (ViewEntity tbl) -> Text
dbViewOrigName :: Text
         , DatabaseEntityDescriptor be (ViewEntity tbl) -> Text
dbViewCurrentName :: Text
         , 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 :: (Text -> f Text)
-> DatabaseEntityDescriptor be (ViewEntity tbl)
-> f (DatabaseEntityDescriptor be (ViewEntity tbl))
dbEntityName Text -> f Text
f DatabaseEntityDescriptor be (ViewEntity tbl)
vw = (Text -> DatabaseEntityDescriptor be (ViewEntity tbl))
-> f Text -> f (DatabaseEntityDescriptor be (ViewEntity tbl))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
t' -> DatabaseEntityDescriptor be (ViewEntity tbl)
R:DatabaseEntityDescriptorbeViewEntity be tbl
vw { dbViewCurrentName :: Text
dbViewCurrentName = Text
t' }) (Text -> f Text
f (DatabaseEntityDescriptor be (ViewEntity tbl) -> Text
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (ViewEntity tbl) -> Text
dbViewCurrentName DatabaseEntityDescriptor be (ViewEntity tbl)
vw))
  dbEntitySchema :: (Maybe Text -> f (Maybe Text))
-> DatabaseEntityDescriptor be (ViewEntity tbl)
-> f (DatabaseEntityDescriptor be (ViewEntity tbl))
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Text
s' -> DatabaseEntityDescriptor be (ViewEntity tbl)
R:DatabaseEntityDescriptorbeViewEntity be tbl
vw { dbViewSchema :: Maybe Text
dbViewSchema = Maybe Text
s' }) (Maybe Text -> f (Maybe Text)
f (DatabaseEntityDescriptor be (ViewEntity tbl) -> Maybe Text
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (ViewEntity tbl) -> Maybe Text
dbViewSchema DatabaseEntityDescriptor be (ViewEntity tbl)
vw))
  dbEntityAuto :: 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 :: (Text -> f Text)
-> DatabaseEntityDescriptor be (DomainTypeEntity ty)
-> f (DatabaseEntityDescriptor be (DomainTypeEntity ty))
dbEntityName Text -> f Text
f (DatabaseDomainType s 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 :: (Maybe Text -> f (Maybe Text))
-> DatabaseEntityDescriptor be (DomainTypeEntity ty)
-> f (DatabaseEntityDescriptor be (DomainTypeEntity ty))
dbEntitySchema Maybe Text -> f (Maybe Text)
f (DatabaseDomainType s 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
  dbEntityAuto :: 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 :: SimpleGetter (DatabaseEntity be db entityType) (DatabaseEntityDescriptor be entityType)
dbEntityDescriptor :: Getting
  r
  (DatabaseEntity be db entityType)
  (DatabaseEntityDescriptor be entityType)
dbEntityDescriptor = (DatabaseEntity be db entityType
 -> DatabaseEntityDescriptor be entityType)
-> SimpleGetter
     (DatabaseEntity be db entityType)
     (DatabaseEntityDescriptor be entityType)
forall s a. (s -> a) -> SimpleGetter s a
Lens.to (\(DatabaseEntity DatabaseEntityDescriptor be entityType
e) -> DatabaseEntityDescriptor be entityType
e)

-- | 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
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))

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 :: (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 ())
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 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 :: (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 (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 ())
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 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 ())
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 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 :: (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

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 'justRef' and 'nothingRef' 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
  { 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.
  , 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
showList :: [TableField table ty] -> ShowS
$cshowList :: forall (table :: (* -> *) -> *) ty. [TableField table ty] -> ShowS
show :: TableField table ty -> String
$cshow :: forall (table :: (* -> *) -> *) ty. TableField table ty -> String
showsPrec :: Int -> TableField table ty -> ShowS
$cshowsPrec :: forall (table :: (* -> *) -> *) ty.
Int -> 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
/= :: 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
Eq)

-- | Van Laarhoven lens to retrieve or set the field name from a 'TableField'.
fieldName :: Lens' (TableField table ty) Text
fieldName :: (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 :: (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)
traverse Text -> f Text
f NonEmpty Text
orig f (Text -> TableField table ty)
-> f Text -> f (TableField table ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> f Text
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' :: x -> Rep x ()
from' = x -> Rep x ()
forall a x. Generic a => a -> Rep a x
from

to' :: Generic x => Rep x () -> x
to' :: Rep x () -> x
to' = Rep x () -> x
forall a x. Generic a => Rep a x -> a
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 (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))) 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 :: Proxy table -> Int
tableValuesNeeded (Proxy table
Proxy :: Proxy table) = [()] -> 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 a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (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 (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' 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 :: Columnar' f a -> Columnar' f a -> Writer [b] (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 -> Writer [b] (Columnar' f 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 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 (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 (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 :: 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 (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 (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 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 -> 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 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
retag 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
retag 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 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
retag 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
retag 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
retag 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 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
retag 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
retag 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
retag 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
retag 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 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
retag 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
retag 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
retag 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
retag 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
retag 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 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
retag 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
retag 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
retag 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
retag 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
retag 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
retag 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 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
retag 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
retag 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
retag 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
retag 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
retag 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
retag 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
retag 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 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
retag 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
retag 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
retag 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
retag 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
retag 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
retag 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
retag 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
retag 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 (Proxy exposed
forall k (t :: k). 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 (Proxy aExp
forall k (t :: k). 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 (Proxy bExp
forall k (t :: k). 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
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 (Proxy c
forall k (t :: k). Proxy t
Proxy @c) (Proxy (Rep (t Exposed))
forall k (t :: k). 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
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 (Proxy c
forall k (t :: k). Proxy t
Proxy @c) (Proxy (Rep (t (Nullable Exposed)))
forall k (t :: k). Proxy t
Proxy @(Rep (t (Nullable Exposed))))))

withConstrainedFields :: forall c tbl
                       . (FieldsFulfillConstraint c tbl, Beamable tbl) => tbl Identity -> tbl (WithConstraint c)
withConstrainedFields :: 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 (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' (HasConstraint c) a
-> Columnar' Identity a
-> Identity (Columnar' (WithConstraint c) a)
f ((Beamable tbl, FieldsFulfillConstraint c tbl) =>
tbl (HasConstraint c)
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 :: Columnar' (HasConstraint c) a
-> Columnar' Identity a
-> Identity (Columnar' (WithConstraint c) a)
f (Columnar' 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 :: tbl (HasConstraint c)
withConstraints = Rep (tbl (HasConstraint c)) () -> tbl (HasConstraint c)
forall a x. Generic a => Rep a x -> a
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 (Proxy c
forall k (t :: k). Proxy t
Proxy @c) (Proxy (Rep (tbl Exposed))
forall k (t :: k). Proxy t
Proxy @(Rep (tbl Exposed)))

withNullableConstrainedFields :: forall c tbl
                               . (FieldsFulfillConstraintNullable c tbl, Beamable tbl) => tbl (Nullable Identity) -> tbl (Nullable (WithConstraint c))
withNullableConstrainedFields :: 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 (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' (Nullable (HasConstraint c)) a
-> Columnar' (Nullable Identity) a
-> Identity (Columnar' (Nullable (WithConstraint c)) a)
f ((Beamable tbl, FieldsFulfillConstraintNullable c tbl) =>
tbl (Nullable (HasConstraint c))
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 :: Columnar' (Nullable (HasConstraint c)) a
-> Columnar' (Nullable Identity) a
-> Identity (Columnar' (Nullable (WithConstraint c)) a)
f (Columnar' 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 :: tbl (Nullable (HasConstraint c))
withNullableConstraints = Rep (tbl (Nullable (HasConstraint c))) ()
-> tbl (Nullable (HasConstraint c))
forall a x. Generic a => Rep a x -> a
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 (Proxy c
forall k (t :: k). Proxy t
Proxy @c) (Proxy (Rep (tbl (Nullable Exposed)))
forall k (t :: k). 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 :: t f -> PrimaryKey t f
pk = t f -> PrimaryKey t f
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 :: 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 :: (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 :: 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 (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) 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 (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 (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) 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 :: 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 (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) 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 :: 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 :: 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 (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)
combine tbl f
f tbl g
g


instance GZipTables f g h U1 U1 U1 U1 where
  gZipTables :: 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 (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 :: 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 (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 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 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 :: 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 :: 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 (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
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 (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 path 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 (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 (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 (Proxy (Rep (rel (TableField rel)) ())
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 (Proxy (Rep (sub f) ())
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 (Proxy 'PrimaryKeyStrategy
forall k (t :: k). 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 (Proxy strategy
forall k (t :: k). 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
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) Any
 -> Identity (Columnar' (TableField tbl) Any))
-> Columnar' f a -> Identity (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) Any
  -> Identity (Columnar' (TableField tbl) Any))
 -> Columnar' f a -> Identity (Columnar' f a))
-> (Columnar' (TableField tbl) Any
    -> Columnar' (TableField tbl) Any)
-> Columnar' f a
-> Columnar' f a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \(Columnar' (TableField path nm)) -> Columnar (TableField tbl) Any -> Columnar' (TableField tbl) Any
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (NonEmpty Text -> Text -> TableField tbl Any
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField (Text -> NonEmpty Text
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 :: (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 path nm)) =
    (\(Columnar' (TableField path' 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 :: (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 (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 (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' 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 :: 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' 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 (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 (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 (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))