{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}

{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.Schema.TableDefinition
  ( TableDefinition
  , HasKey
  , NoKey
  , mkTableDefinition
  , mkTableDefinitionWithoutKey
  , dropColumns
  , columnsToDrop
  , tableIdentifier
  , tableName
  , setTableSchema
  , tableConstraints
  , addTableConstraints
  , tableIndexes
  , addTableIndexes
  , tablePrimaryKey
  , tableMarshaller
  , mapTableMarshaller
  , mkInsertExpr
  , mkCreateTableExpr
  , mkTableColumnDefinitions
  , mkTablePrimaryKeyExpr
  , mkInsertColumnList
  , mkInsertSource
  , mkTableReturningClause
  )
where

import Data.List.NonEmpty (NonEmpty, toList)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

import Orville.PostgreSQL.Execution.ReturningOption (ReturningOption (WithReturning, WithoutReturning))
import qualified Orville.PostgreSQL.Expr as Expr
import Orville.PostgreSQL.Internal.IndexDefinition (IndexDefinition, IndexMigrationKey, indexMigrationKey)
import Orville.PostgreSQL.Marshall.FieldDefinition (fieldColumnDefinition, fieldColumnName, fieldValueToSqlValue)
import Orville.PostgreSQL.Marshall.SqlMarshaller (AnnotatedSqlMarshaller, MarshallerField (Natural, Synthetic), ReadOnlyColumnOption (ExcludeReadOnlyColumns, IncludeReadOnlyColumns), SqlMarshaller, annotateSqlMarshaller, annotateSqlMarshallerEmptyAnnotation, collectFromField, foldMarshallerFields, mapSqlMarshaller, marshallerDerivedColumns, marshallerTableConstraints, unannotatedSqlMarshaller)
import Orville.PostgreSQL.Raw.SqlValue (SqlValue)
import Orville.PostgreSQL.Schema.ConstraintDefinition (ConstraintDefinition, TableConstraints, addConstraint, constraintSqlExpr, emptyTableConstraints, tableConstraintDefinitions)
import Orville.PostgreSQL.Schema.PrimaryKey (PrimaryKey, mkPrimaryKeyExpr, primaryKeyFieldNames)
import Orville.PostgreSQL.Schema.TableIdentifier (TableIdentifier, setTableIdSchema, tableIdQualifiedName, unqualifiedNameToTableId)

{- |
  Contains the definition of a SQL table for Orville to use for generating
  queries and marshalling Haskell values to and from the database.

  * @key@ is a Haskell type used to indicate whether the table has a primary
    key and what the type of the key is if so. See 'HasKey' and 'NoKey' for
    values to be used in this parameter.

  * @writeEntity@ is the Haskell type for values that Orville will write
    to the database for you (i.e. both inserts and updates).

  * @readEntity@ is the Haskell type for values that Orville will decode
    from the result set when entities are queried from this table.

@since 1.0.0.0
-}
data TableDefinition key writeEntity readEntity = TableDefinition
  { forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableIdentifier
i_tableIdentifier :: TableIdentifier
  , forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TablePrimaryKey key
i_tablePrimaryKey :: TablePrimaryKey key
  , forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
i_tableMarshaller :: AnnotatedSqlMarshaller writeEntity readEntity
  , forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Set String
i_tableColumnsToDrop :: Set.Set String
  , forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
i_tableConstraintsFromTable :: TableConstraints
  , forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
i_tableIndexes :: Map.Map IndexMigrationKey IndexDefinition
  }

{- |
  'HasKey' is a type with no constructors. It is used only at the type level
  as the @key@ parameter to the 'TableDefinition' type to indicate that the
  table has a primary key and what the Haskell type of the primary key is.

@since 1.0.0.0
-}
data HasKey key

{- |
  'NoKey' is a type with no constructors. It is used only at the type level
  as the @key@ parameter to the 'TableDefinition' type to indicate that the
  table does not have a primary key.

@since 1.0.0.0
-}
data NoKey

{- |
  INTERNAL: Use at the value level to track whether the 'TableDefinition' has a
  primary key. The @key@ parameter matches the @key@ parameter of
  'TableDefinition'

@since 1.0.0.0
-}
data TablePrimaryKey key where
  TableHasKey :: PrimaryKey keyType -> TablePrimaryKey (HasKey keyType)
  TableHasNoKey :: TablePrimaryKey NoKey

{- |
  Constructs a new 'TableDefinition' with the basic fields required for
  operation. For convenience, this function accepts a 'PrimaryKey' even though
  this is not required for all Orville operations to work. If you need to
  create a table without any primary key, see 'mkTableDefinitionWithoutKey'.

@since 1.0.0.0
-}
mkTableDefinition ::
  -- | The name of the table
  String ->
  -- | Definition of the table's primary key
  PrimaryKey key ->
  -- | A 'SqlMarshaller' to marshall table entities to and from the database
  SqlMarshaller writeEntity readEntity ->
  TableDefinition (HasKey key) writeEntity readEntity
mkTableDefinition :: forall key writeEntity readEntity.
String
-> PrimaryKey key
-> SqlMarshaller writeEntity readEntity
-> TableDefinition (HasKey key) writeEntity readEntity
mkTableDefinition String
name PrimaryKey key
primaryKey SqlMarshaller writeEntity readEntity
marshaller =
  TableDefinition
    { i_tableIdentifier :: TableIdentifier
i_tableIdentifier = String -> TableIdentifier
unqualifiedNameToTableId String
name
    , i_tablePrimaryKey :: TablePrimaryKey (HasKey key)
i_tablePrimaryKey = PrimaryKey key -> TablePrimaryKey (HasKey key)
forall keyType.
PrimaryKey keyType -> TablePrimaryKey (HasKey keyType)
TableHasKey PrimaryKey key
primaryKey
    , i_tableMarshaller :: AnnotatedSqlMarshaller writeEntity readEntity
i_tableMarshaller = [FieldName]
-> SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall writeEntity readEntity.
[FieldName]
-> SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
annotateSqlMarshaller (NonEmpty FieldName -> [FieldName]
forall a. NonEmpty a -> [a]
toList (NonEmpty FieldName -> [FieldName])
-> NonEmpty FieldName -> [FieldName]
forall a b. (a -> b) -> a -> b
$ PrimaryKey key -> NonEmpty FieldName
forall key. PrimaryKey key -> NonEmpty FieldName
primaryKeyFieldNames PrimaryKey key
primaryKey) SqlMarshaller writeEntity readEntity
marshaller
    , i_tableColumnsToDrop :: Set String
i_tableColumnsToDrop = Set String
forall a. Set a
Set.empty
    , i_tableConstraintsFromTable :: TableConstraints
i_tableConstraintsFromTable = TableConstraints
emptyTableConstraints
    , i_tableIndexes :: Map IndexMigrationKey IndexDefinition
i_tableIndexes = Map IndexMigrationKey IndexDefinition
forall k a. Map k a
Map.empty
    }

{- |
  Constructs a new 'TableDefinition' with the minimal fields required for
  operation. Note: tables created via this function will not have a primary
  key. Certain Orville functions require a primary key. Attempting to call
  functions requiring a primary key will fail to compile when using a table
  that has no key.

@since 1.0.0.0
-}
mkTableDefinitionWithoutKey ::
  -- | The name of the table
  String ->
  -- | A 'SqlMarshaller' to marshall table entities to and from the database
  SqlMarshaller writeEntity readEntity ->
  TableDefinition NoKey writeEntity readEntity
mkTableDefinitionWithoutKey :: forall writeEntity readEntity.
String
-> SqlMarshaller writeEntity readEntity
-> TableDefinition NoKey writeEntity readEntity
mkTableDefinitionWithoutKey String
name SqlMarshaller writeEntity readEntity
marshaller =
  TableDefinition
    { i_tableIdentifier :: TableIdentifier
i_tableIdentifier = String -> TableIdentifier
unqualifiedNameToTableId String
name
    , i_tablePrimaryKey :: TablePrimaryKey NoKey
i_tablePrimaryKey = TablePrimaryKey NoKey
TableHasNoKey
    , i_tableMarshaller :: AnnotatedSqlMarshaller writeEntity readEntity
i_tableMarshaller = SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
annotateSqlMarshallerEmptyAnnotation SqlMarshaller writeEntity readEntity
marshaller
    , i_tableColumnsToDrop :: Set String
i_tableColumnsToDrop = Set String
forall a. Set a
Set.empty
    , i_tableConstraintsFromTable :: TableConstraints
i_tableConstraintsFromTable = TableConstraints
emptyTableConstraints
    , i_tableIndexes :: Map IndexMigrationKey IndexDefinition
i_tableIndexes = Map IndexMigrationKey IndexDefinition
forall k a. Map k a
Map.empty
    }

{- |
  Annotates a 'TableDefinition' with a direction to drop columns if they are
  found in the database. Orville does not drop columns during auto-migration
  unless they are explicitly requested to be dropped via 'dropColumns'.

  If you remove a reference to a column from the table's 'SqlMarshaller'
  without adding the column's name to 'dropColumns', Orville will operate as if
  the column does not exist without actually dropping the column. This is often
  useful if you're not sure you want to lose the data in the column, or if you
  have zero down-time deployments, which requires the column not be referenced
  by deployed code before it can be dropped.

@since 1.0.0.0
-}
dropColumns ::
  -- | Columns that should be dropped from the table
  [String] ->
  TableDefinition key writeEntity readEntity ->
  TableDefinition key writeEntity readEntity
dropColumns :: forall key writeEntity readEntity.
[String]
-> TableDefinition key writeEntity readEntity
-> TableDefinition key writeEntity readEntity
dropColumns [String]
columns TableDefinition key writeEntity readEntity
tableDef =
  TableDefinition key writeEntity readEntity
tableDef
    { i_tableColumnsToDrop :: Set String
i_tableColumnsToDrop = TableDefinition key writeEntity readEntity -> Set String
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Set String
i_tableColumnsToDrop TableDefinition key writeEntity readEntity
tableDef Set String -> Set String -> Set String
forall a. Semigroup a => a -> a -> a
<> [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
columns
    }

{- |
  Returns the set of columns that have been marked as dropped by 'dropColumns'.

@since 1.0.0.0
-}
columnsToDrop :: TableDefinition key writeEntity readEntity -> Set.Set String
columnsToDrop :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Set String
columnsToDrop =
  TableDefinition key writeEntity readEntity -> Set String
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Set String
i_tableColumnsToDrop

{- |
  Returns the table's 'TableIdentifier'.

@since 1.0.0.0
-}
tableIdentifier :: TableDefinition key writeEntity readEntity -> TableIdentifier
tableIdentifier :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableIdentifier
tableIdentifier =
  TableDefinition key writeEntity readEntity -> TableIdentifier
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableIdentifier
i_tableIdentifier

{- |
  Returns the table's name as an expression that can be used to build SQL
  statements. If the table has a schema name set, the name will be qualified
  with it.

@since 1.0.0.0
-}
tableName :: TableDefinition key writeEntity readEntity -> Expr.Qualified Expr.TableName
tableName :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Qualified TableName
tableName =
  TableIdentifier -> Qualified TableName
tableIdQualifiedName (TableIdentifier -> Qualified TableName)
-> (TableDefinition key writeEntity readEntity -> TableIdentifier)
-> TableDefinition key writeEntity readEntity
-> Qualified TableName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableDefinition key writeEntity readEntity -> TableIdentifier
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableIdentifier
i_tableIdentifier

{- |
  Sets the table's schema to the name in the given 'String', which will be
  treated as a SQL identifier. If a table has a schema name set, it will be
  included as a qualifier on the table name for all queries involving the
  table.

@since 1.0.0.0
-}
setTableSchema ::
  String ->
  TableDefinition key writeEntity readEntity ->
  TableDefinition key writeEntity readEntity
setTableSchema :: forall key writeEntity readEntity.
String
-> TableDefinition key writeEntity readEntity
-> TableDefinition key writeEntity readEntity
setTableSchema String
schemaName TableDefinition key writeEntity readEntity
tableDef =
  TableDefinition key writeEntity readEntity
tableDef
    { i_tableIdentifier :: TableIdentifier
i_tableIdentifier = String -> TableIdentifier -> TableIdentifier
setTableIdSchema String
schemaName (TableDefinition key writeEntity readEntity -> TableIdentifier
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableIdentifier
i_tableIdentifier TableDefinition key writeEntity readEntity
tableDef)
    }

{- |
  Retrieves all the table constraints that have been added to the table either
  via 'addTableConstraints' or that are found on
  'Orville.PostgreSQL.FieldDefinition's included with this table's
  'SqlMarshaller'.

@since 1.0.0.0
-}
tableConstraints ::
  TableDefinition key writeEntity readEntity ->
  TableConstraints
tableConstraints :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
tableConstraints =
  TableDefinition key writeEntity readEntity -> TableConstraints
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
tableConstraintsFromMarshaller
    (TableDefinition key writeEntity readEntity -> TableConstraints)
-> (TableDefinition key writeEntity readEntity -> TableConstraints)
-> TableDefinition key writeEntity readEntity
-> TableConstraints
forall a. Semigroup a => a -> a -> a
<> TableDefinition key writeEntity readEntity -> TableConstraints
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
tableConstraintsFromTable

{- |
  Retrieves all the table constraints that have been added to the table via
  'addTableConstraints'. This does NOT include any table constraints from the
  table's 'SqlMarshaller'.

@since 1.0.0.0
-}
tableConstraintsFromTable ::
  TableDefinition key writeEntity readEntity ->
  TableConstraints
tableConstraintsFromTable :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
tableConstraintsFromTable =
  TableDefinition key writeEntity readEntity -> TableConstraints
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
i_tableConstraintsFromTable

{- |
  Retrieves all the table constraints that were included in the table's
  'SqlMarshaller' when it was created. This does NOT include any table
  constraints added via 'addTableConstraints'.

@since 1.0.0.0
-}
tableConstraintsFromMarshaller ::
  TableDefinition key writeEntity readEntity ->
  TableConstraints
tableConstraintsFromMarshaller :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
tableConstraintsFromMarshaller =
  SqlMarshaller writeEntity readEntity -> TableConstraints
forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity -> TableConstraints
marshallerTableConstraints
    (SqlMarshaller writeEntity readEntity -> TableConstraints)
-> (TableDefinition key writeEntity readEntity
    -> SqlMarshaller writeEntity readEntity)
-> TableDefinition key writeEntity readEntity
-> TableConstraints
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
unannotatedSqlMarshaller
    (AnnotatedSqlMarshaller writeEntity readEntity
 -> SqlMarshaller writeEntity readEntity)
-> (TableDefinition key writeEntity readEntity
    -> AnnotatedSqlMarshaller writeEntity readEntity)
-> TableDefinition key writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
i_tableMarshaller

{- |
  Adds the given table constraints to the table definition. It's also possible
  to add constraints that apply to only one column, adding them to the
  'Orville.PostgreSQL.FieldDefinition's that are included in the table's
  'SqlMarshaller'.

  If you wish to constrain multiple columns with a single constraint (e.g. a
  multi-column unique constraint), you must use 'addTableConstraints'.

  Note: If multiple constraints are added with the same
  'Orville.PostgreSQL.Schema.ConstraintMigrationKey', only the last one that is
  added will be part of the 'TableDefinition'. Any previously-added constraint
  with the same key is replaced by the new one.

@since 1.0.0.0
-}
addTableConstraints ::
  [ConstraintDefinition] ->
  TableDefinition key writeEntity readEntity ->
  TableDefinition key writeEntity readEntity
addTableConstraints :: forall key writeEntity readEntity.
[ConstraintDefinition]
-> TableDefinition key writeEntity readEntity
-> TableDefinition key writeEntity readEntity
addTableConstraints [ConstraintDefinition]
constraintDefs TableDefinition key writeEntity readEntity
tableDef =
  TableDefinition key writeEntity readEntity
tableDef
    { i_tableConstraintsFromTable :: TableConstraints
i_tableConstraintsFromTable =
        (ConstraintDefinition -> TableConstraints -> TableConstraints)
-> TableConstraints -> [ConstraintDefinition] -> TableConstraints
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          ConstraintDefinition -> TableConstraints -> TableConstraints
addConstraint
          (TableDefinition key writeEntity readEntity -> TableConstraints
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
i_tableConstraintsFromTable TableDefinition key writeEntity readEntity
tableDef)
          [ConstraintDefinition]
constraintDefs
    }

{- |
  Retrieves all the table indexes that have been added to the table via
  'addTableIndexes'.

@since 1.0.0.0
-}
tableIndexes ::
  TableDefinition key writeEntity readEntity ->
  Map.Map IndexMigrationKey IndexDefinition
tableIndexes :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
tableIndexes =
  TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
i_tableIndexes

{- |
  Adds the given table indexes to the table definition.

  Note: If multiple indexes are added with the same 'IndexMigrationKey', only
  the last one that is added will be part of the 'TableDefinition'. Any
  previously-added index with the same key is replaced by the new one.

@since 1.0.0.0
-}
addTableIndexes ::
  [IndexDefinition] ->
  TableDefinition key writeEntity readEntity ->
  TableDefinition key writeEntity readEntity
addTableIndexes :: forall key writeEntity readEntity.
[IndexDefinition]
-> TableDefinition key writeEntity readEntity
-> TableDefinition key writeEntity readEntity
addTableIndexes [IndexDefinition]
indexDefs TableDefinition key writeEntity readEntity
tableDef =
  let
    addIndex :: IndexDefinition
-> Map IndexMigrationKey IndexDefinition
-> Map IndexMigrationKey IndexDefinition
addIndex IndexDefinition
index Map IndexMigrationKey IndexDefinition
indexMap =
      IndexMigrationKey
-> IndexDefinition
-> Map IndexMigrationKey IndexDefinition
-> Map IndexMigrationKey IndexDefinition
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (IndexDefinition -> IndexMigrationKey
indexMigrationKey IndexDefinition
index) IndexDefinition
index Map IndexMigrationKey IndexDefinition
indexMap
  in
    TableDefinition key writeEntity readEntity
tableDef
      { i_tableIndexes :: Map IndexMigrationKey IndexDefinition
i_tableIndexes = (IndexDefinition
 -> Map IndexMigrationKey IndexDefinition
 -> Map IndexMigrationKey IndexDefinition)
-> Map IndexMigrationKey IndexDefinition
-> [IndexDefinition]
-> Map IndexMigrationKey IndexDefinition
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IndexDefinition
-> Map IndexMigrationKey IndexDefinition
-> Map IndexMigrationKey IndexDefinition
addIndex (TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> Map IndexMigrationKey IndexDefinition
i_tableIndexes TableDefinition key writeEntity readEntity
tableDef) [IndexDefinition]
indexDefs
      }

{- |
  Returns the primary key for the table, as defined at construction via
  'mkTableDefinition'.

@since 1.0.0.0
-}
tablePrimaryKey :: TableDefinition (HasKey key) writeEntity readEntity -> PrimaryKey key
tablePrimaryKey :: forall key writeEntity readEntity.
TableDefinition (HasKey key) writeEntity readEntity
-> PrimaryKey key
tablePrimaryKey TableDefinition (HasKey key) writeEntity readEntity
def =
  case TableDefinition (HasKey key) writeEntity readEntity
-> TablePrimaryKey (HasKey key)
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TablePrimaryKey key
i_tablePrimaryKey TableDefinition (HasKey key) writeEntity readEntity
def of
    TableHasKey PrimaryKey keyType
primaryKey -> PrimaryKey key
PrimaryKey keyType
primaryKey

{- |
  Returns the marshaller for the table, as defined at construction via
  'mkTableDefinition'.

@since 1.0.0.0
-}
tableMarshaller :: TableDefinition key writeEntity readEntity -> AnnotatedSqlMarshaller writeEntity readEntity
tableMarshaller :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
tableMarshaller = TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
i_tableMarshaller

{- |
  Applies the provided function to the underlying 'SqlMarshaller' of the
  'TableDefinition'.

@since 1.0.0.0
-}
mapTableMarshaller ::
  (SqlMarshaller readEntityA writeEntityA -> SqlMarshaller readEntityB writeEntityB) ->
  TableDefinition key readEntityA writeEntityA ->
  TableDefinition key readEntityB writeEntityB
mapTableMarshaller :: forall readEntityA writeEntityA readEntityB writeEntityB key.
(SqlMarshaller readEntityA writeEntityA
 -> SqlMarshaller readEntityB writeEntityB)
-> TableDefinition key readEntityA writeEntityA
-> TableDefinition key readEntityB writeEntityB
mapTableMarshaller SqlMarshaller readEntityA writeEntityA
-> SqlMarshaller readEntityB writeEntityB
f TableDefinition key readEntityA writeEntityA
tableDef =
  TableDefinition key readEntityA writeEntityA
tableDef {i_tableMarshaller :: AnnotatedSqlMarshaller readEntityB writeEntityB
i_tableMarshaller = (SqlMarshaller readEntityA writeEntityA
 -> SqlMarshaller readEntityB writeEntityB)
-> AnnotatedSqlMarshaller readEntityA writeEntityA
-> AnnotatedSqlMarshaller readEntityB writeEntityB
forall readEntityA writeEntityA readEntityB writeEntityB.
(SqlMarshaller readEntityA writeEntityA
 -> SqlMarshaller readEntityB writeEntityB)
-> AnnotatedSqlMarshaller readEntityA writeEntityA
-> AnnotatedSqlMarshaller readEntityB writeEntityB
mapSqlMarshaller SqlMarshaller readEntityA writeEntityA
-> SqlMarshaller readEntityB writeEntityB
f (AnnotatedSqlMarshaller readEntityA writeEntityA
 -> AnnotatedSqlMarshaller readEntityB writeEntityB)
-> AnnotatedSqlMarshaller readEntityA writeEntityA
-> AnnotatedSqlMarshaller readEntityB writeEntityB
forall a b. (a -> b) -> a -> b
$ TableDefinition key readEntityA writeEntityA
-> AnnotatedSqlMarshaller readEntityA writeEntityA
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
i_tableMarshaller TableDefinition key readEntityA writeEntityA
tableDef}

{- |
  Builds a 'Expr.CreateTableExpr' that will create a SQL table matching the
  given 'TableDefinition' when it is executed.

@since 1.0.0.0
-}
mkCreateTableExpr ::
  TableDefinition key writeEntity readEntity ->
  Expr.CreateTableExpr
mkCreateTableExpr :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> CreateTableExpr
mkCreateTableExpr TableDefinition key writeEntity readEntity
tableDef =
  Qualified TableName
-> [ColumnDefinition]
-> Maybe PrimaryKeyExpr
-> [TableConstraint]
-> CreateTableExpr
Expr.createTableExpr
    (TableDefinition key writeEntity readEntity -> Qualified TableName
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Qualified TableName
tableName TableDefinition key writeEntity readEntity
tableDef)
    (TableDefinition key writeEntity readEntity -> [ColumnDefinition]
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> [ColumnDefinition]
mkTableColumnDefinitions TableDefinition key writeEntity readEntity
tableDef)
    (TableDefinition key writeEntity readEntity -> Maybe PrimaryKeyExpr
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Maybe PrimaryKeyExpr
mkTablePrimaryKeyExpr TableDefinition key writeEntity readEntity
tableDef)
    ((ConstraintDefinition -> TableConstraint)
-> [ConstraintDefinition] -> [TableConstraint]
forall a b. (a -> b) -> [a] -> [b]
map ConstraintDefinition -> TableConstraint
constraintSqlExpr ([ConstraintDefinition] -> [TableConstraint])
-> (TableDefinition key writeEntity readEntity
    -> [ConstraintDefinition])
-> TableDefinition key writeEntity readEntity
-> [TableConstraint]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableConstraints -> [ConstraintDefinition]
tableConstraintDefinitions (TableConstraints -> [ConstraintDefinition])
-> (TableDefinition key writeEntity readEntity -> TableConstraints)
-> TableDefinition key writeEntity readEntity
-> [ConstraintDefinition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableDefinition key writeEntity readEntity -> TableConstraints
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TableConstraints
tableConstraints (TableDefinition key writeEntity readEntity -> [TableConstraint])
-> TableDefinition key writeEntity readEntity -> [TableConstraint]
forall a b. (a -> b) -> a -> b
$ TableDefinition key writeEntity readEntity
tableDef)

{- |
  Builds the 'Expr.ColumnDefinitions' for all the fields described by the
  table definition's 'SqlMarshaller'.

@since 1.0.0.0
-}
mkTableColumnDefinitions ::
  TableDefinition key writeEntity readEntity ->
  [Expr.ColumnDefinition]
mkTableColumnDefinitions :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> [ColumnDefinition]
mkTableColumnDefinitions TableDefinition key writeEntity readEntity
tableDef =
  SqlMarshaller writeEntity readEntity
-> [ColumnDefinition]
-> (MarshallerField writeEntity
    -> [ColumnDefinition] -> [ColumnDefinition])
-> [ColumnDefinition]
forall writeEntity readEntity result.
SqlMarshaller writeEntity readEntity
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFields
    (AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
unannotatedSqlMarshaller (AnnotatedSqlMarshaller writeEntity readEntity
 -> SqlMarshaller writeEntity readEntity)
-> AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
forall a b. (a -> b) -> a -> b
$ TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
tableMarshaller TableDefinition key writeEntity readEntity
tableDef)
    []
    (ReadOnlyColumnOption
-> (forall nullability a.
    FieldDefinition nullability a -> ColumnDefinition)
-> MarshallerField writeEntity
-> [ColumnDefinition]
-> [ColumnDefinition]
forall result entity.
ReadOnlyColumnOption
-> (forall nullability a. FieldDefinition nullability a -> result)
-> MarshallerField entity
-> [result]
-> [result]
collectFromField ReadOnlyColumnOption
IncludeReadOnlyColumns FieldDefinition nullability a -> ColumnDefinition
forall nullability a.
FieldDefinition nullability a -> ColumnDefinition
fieldColumnDefinition)

{- |
  Builds the 'Expr.PrimaryKeyExpr' for this table, or none if this table has no
  primary key.

@since 1.0.0.0
-}
mkTablePrimaryKeyExpr ::
  TableDefinition key writeEntity readEntity ->
  Maybe Expr.PrimaryKeyExpr
mkTablePrimaryKeyExpr :: forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Maybe PrimaryKeyExpr
mkTablePrimaryKeyExpr TableDefinition key writeEntity readEntity
tableDef =
  case TableDefinition key writeEntity readEntity -> TablePrimaryKey key
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> TablePrimaryKey key
i_tablePrimaryKey TableDefinition key writeEntity readEntity
tableDef of
    TableHasKey PrimaryKey keyType
primaryKey ->
      PrimaryKeyExpr -> Maybe PrimaryKeyExpr
forall a. a -> Maybe a
Just (PrimaryKeyExpr -> Maybe PrimaryKeyExpr)
-> PrimaryKeyExpr -> Maybe PrimaryKeyExpr
forall a b. (a -> b) -> a -> b
$ PrimaryKey keyType -> PrimaryKeyExpr
forall key. PrimaryKey key -> PrimaryKeyExpr
mkPrimaryKeyExpr PrimaryKey keyType
primaryKey
    TablePrimaryKey key
TableHasNoKey ->
      Maybe PrimaryKeyExpr
forall a. Maybe a
Nothing

{- |
  When 'WithReturning' is given, builds a 'Expr.ReturningExpr' that will
  return all the columns in the given 'TableDefinition'.

@since 1.0.0.0
-}
mkTableReturningClause ::
  ReturningOption returningClause ->
  TableDefinition key writeEntity readEntty ->
  Maybe Expr.ReturningExpr
mkTableReturningClause :: forall returningClause key writeEntity readEntty.
ReturningOption returningClause
-> TableDefinition key writeEntity readEntty -> Maybe ReturningExpr
mkTableReturningClause ReturningOption returningClause
returningOption TableDefinition key writeEntity readEntty
tableDef =
  case ReturningOption returningClause
returningOption of
    ReturningOption returningClause
WithoutReturning ->
      Maybe ReturningExpr
forall a. Maybe a
Nothing
    ReturningOption returningClause
WithReturning ->
      ReturningExpr -> Maybe ReturningExpr
forall a. a -> Maybe a
Just
        (ReturningExpr -> Maybe ReturningExpr)
-> (TableDefinition key writeEntity readEntty -> ReturningExpr)
-> TableDefinition key writeEntity readEntty
-> Maybe ReturningExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectList -> ReturningExpr
Expr.returningExpr
        (SelectList -> ReturningExpr)
-> (TableDefinition key writeEntity readEntty -> SelectList)
-> TableDefinition key writeEntity readEntty
-> ReturningExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DerivedColumn] -> SelectList
Expr.selectDerivedColumns
        ([DerivedColumn] -> SelectList)
-> (TableDefinition key writeEntity readEntty -> [DerivedColumn])
-> TableDefinition key writeEntity readEntty
-> SelectList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlMarshaller writeEntity readEntty -> [DerivedColumn]
forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity -> [DerivedColumn]
marshallerDerivedColumns
        (SqlMarshaller writeEntity readEntty -> [DerivedColumn])
-> (TableDefinition key writeEntity readEntty
    -> SqlMarshaller writeEntity readEntty)
-> TableDefinition key writeEntity readEntty
-> [DerivedColumn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedSqlMarshaller writeEntity readEntty
-> SqlMarshaller writeEntity readEntty
forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
unannotatedSqlMarshaller
        (AnnotatedSqlMarshaller writeEntity readEntty
 -> SqlMarshaller writeEntity readEntty)
-> (TableDefinition key writeEntity readEntty
    -> AnnotatedSqlMarshaller writeEntity readEntty)
-> TableDefinition key writeEntity readEntty
-> SqlMarshaller writeEntity readEntty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableDefinition key writeEntity readEntty
-> AnnotatedSqlMarshaller writeEntity readEntty
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
tableMarshaller
        (TableDefinition key writeEntity readEntty -> Maybe ReturningExpr)
-> TableDefinition key writeEntity readEntty -> Maybe ReturningExpr
forall a b. (a -> b) -> a -> b
$ TableDefinition key writeEntity readEntty
tableDef

{- |
  Builds an 'Expr.InsertExpr' that will insert the given entities into the SQL
  table when it is executed. A @RETURNING@ clause will either be included to
  return the inserted rows or not, depending on the 'ReturningOption' given.

@since 1.0.0.0
-}
mkInsertExpr ::
  ReturningOption returningClause ->
  TableDefinition key writeEntity readEntity ->
  NonEmpty writeEntity ->
  Expr.InsertExpr
mkInsertExpr :: forall returningClause key writeEntity readEntity.
ReturningOption returningClause
-> TableDefinition key writeEntity readEntity
-> NonEmpty writeEntity
-> InsertExpr
mkInsertExpr ReturningOption returningClause
returningOption TableDefinition key writeEntity readEntity
tableDef NonEmpty writeEntity
entities =
  let
    marshaller :: SqlMarshaller writeEntity readEntity
marshaller =
      AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
unannotatedSqlMarshaller (AnnotatedSqlMarshaller writeEntity readEntity
 -> SqlMarshaller writeEntity readEntity)
-> AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
forall a b. (a -> b) -> a -> b
$ TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
tableMarshaller TableDefinition key writeEntity readEntity
tableDef

    insertColumnList :: InsertColumnList
insertColumnList =
      SqlMarshaller writeEntity readEntity -> InsertColumnList
forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity -> InsertColumnList
mkInsertColumnList SqlMarshaller writeEntity readEntity
marshaller

    insertSource :: InsertSource
insertSource =
      SqlMarshaller writeEntity readEntity
-> NonEmpty writeEntity -> InsertSource
forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity
-> NonEmpty writeEntity -> InsertSource
mkInsertSource SqlMarshaller writeEntity readEntity
marshaller NonEmpty writeEntity
entities
  in
    Qualified TableName
-> Maybe InsertColumnList
-> InsertSource
-> Maybe ReturningExpr
-> InsertExpr
Expr.insertExpr
      (TableDefinition key writeEntity readEntity -> Qualified TableName
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Qualified TableName
tableName TableDefinition key writeEntity readEntity
tableDef)
      (InsertColumnList -> Maybe InsertColumnList
forall a. a -> Maybe a
Just InsertColumnList
insertColumnList)
      InsertSource
insertSource
      (ReturningOption returningClause
-> TableDefinition key writeEntity readEntity
-> Maybe ReturningExpr
forall returningClause key writeEntity readEntty.
ReturningOption returningClause
-> TableDefinition key writeEntity readEntty -> Maybe ReturningExpr
mkTableReturningClause ReturningOption returningClause
returningOption TableDefinition key writeEntity readEntity
tableDef)

{- |
  Builds an 'Expr.InsertColumnList' that specifies the columns for an
  insert statement in the order that they appear in the given 'SqlMarshaller'.

  In normal circumstances you will want to build the complete insert statement
  via 'mkInsertExpr', but this is exported in case you are composing SQL
  yourself and need the column list of an insert as a fragment.

@since 1.0.0.0
-}
mkInsertColumnList ::
  SqlMarshaller writeEntity readEntity ->
  Expr.InsertColumnList
mkInsertColumnList :: forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity -> InsertColumnList
mkInsertColumnList SqlMarshaller writeEntity readEntity
marshaller =
  [ColumnName] -> InsertColumnList
Expr.insertColumnList ([ColumnName] -> InsertColumnList)
-> [ColumnName] -> InsertColumnList
forall a b. (a -> b) -> a -> b
$
    SqlMarshaller writeEntity readEntity
-> [ColumnName]
-> (MarshallerField writeEntity -> [ColumnName] -> [ColumnName])
-> [ColumnName]
forall writeEntity readEntity result.
SqlMarshaller writeEntity readEntity
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFields SqlMarshaller writeEntity readEntity
marshaller [] (ReadOnlyColumnOption
-> (forall nullability a.
    FieldDefinition nullability a -> ColumnName)
-> MarshallerField writeEntity
-> [ColumnName]
-> [ColumnName]
forall result entity.
ReadOnlyColumnOption
-> (forall nullability a. FieldDefinition nullability a -> result)
-> MarshallerField entity
-> [result]
-> [result]
collectFromField ReadOnlyColumnOption
ExcludeReadOnlyColumns FieldDefinition nullability a -> ColumnName
forall nullability a. FieldDefinition nullability a -> ColumnName
fieldColumnName)

{- |
  Builds an 'Expr.InsertSource' that will insert the given entities with their
  values specified in the order that the fields appear in the given
  'SqlMarshaller' (which matches the order of column names produced by
  'mkInsertColumnList').

  In normal circumstances you will want to build the complete insert statement
  via 'mkInsertExpr', but this is exported in case you are composing SQL
  yourself and need the column list of an insert as a fragment.

@since 1.0.0.0
-}
mkInsertSource ::
  SqlMarshaller writeEntity readEntity ->
  NonEmpty writeEntity ->
  Expr.InsertSource
mkInsertSource :: forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity
-> NonEmpty writeEntity -> InsertSource
mkInsertSource SqlMarshaller writeEntity readEntity
marshaller NonEmpty writeEntity
entities =
  let
    encodeRow :: writeEntity -> [SqlValue]
encodeRow =
      SqlMarshaller writeEntity readEntity
-> (writeEntity -> [SqlValue])
-> (MarshallerField writeEntity
    -> (writeEntity -> [SqlValue]) -> writeEntity -> [SqlValue])
-> writeEntity
-> [SqlValue]
forall writeEntity readEntity result.
SqlMarshaller writeEntity readEntity
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFields SqlMarshaller writeEntity readEntity
marshaller ([SqlValue] -> writeEntity -> [SqlValue]
forall a b. a -> b -> a
const []) MarshallerField writeEntity
-> (writeEntity -> [SqlValue]) -> writeEntity -> [SqlValue]
forall entity.
MarshallerField entity
-> (entity -> [SqlValue]) -> entity -> [SqlValue]
collectSqlValue
  in
    [[SqlValue]] -> InsertSource
Expr.insertSqlValues ([[SqlValue]] -> InsertSource) -> [[SqlValue]] -> InsertSource
forall a b. (a -> b) -> a -> b
$ (writeEntity -> [SqlValue]) -> [writeEntity] -> [[SqlValue]]
forall a b. (a -> b) -> [a] -> [b]
map writeEntity -> [SqlValue]
encodeRow (NonEmpty writeEntity -> [writeEntity]
forall a. NonEmpty a -> [a]
toList NonEmpty writeEntity
entities)

{- |
  An internal helper function that collects the 'SqlValue' encoded value for a
  field from a Haskell entity, adding it a list of 'SqlValue's that is being
  built.

@since 1.0.0.0
-}
collectSqlValue ::
  MarshallerField entity ->
  (entity -> [SqlValue]) ->
  entity ->
  [SqlValue]
collectSqlValue :: forall entity.
MarshallerField entity
-> (entity -> [SqlValue]) -> entity -> [SqlValue]
collectSqlValue MarshallerField entity
entry entity -> [SqlValue]
encodeRest entity
entity =
  case MarshallerField entity
entry of
    Natural FieldDefinition nullability a
fieldDef (Just entity -> a
accessor) ->
      FieldDefinition nullability a -> a -> SqlValue
forall nullability a.
FieldDefinition nullability a -> a -> SqlValue
fieldValueToSqlValue FieldDefinition nullability a
fieldDef (entity -> a
accessor entity
entity) SqlValue -> [SqlValue] -> [SqlValue]
forall a. a -> [a] -> [a]
: (entity -> [SqlValue]
encodeRest entity
entity)
    Natural FieldDefinition nullability a
_ Maybe (entity -> a)
Nothing ->
      entity -> [SqlValue]
encodeRest entity
entity
    Synthetic SyntheticField a
_ ->
      entity -> [SqlValue]
encodeRest entity
entity