Add initial support for identity columns

- Expr support for column identity is added for columns that should be
generated always or only by default

  - There is some oddity here. The specification for creating an
identity column is to add a constraint. However when looking up in the
catalog identity information is not held with other constraints.

- Field definitions can be marked as identity

- Support for identity at the field definition limits to non-nullable
fields, as is the case in PostgreSQL.

- AutoMigration support for marking column identity

There is additional work needed for full support. This is left for the
future. Particularly, identity columns can take options for the
underlying sequence. However, supporting that will require being able
to look up said sequence using a catalog table not currently
supported: pg_depend.

orville-postgresql/src/Orville/PostgreSQL.hs

@@ -247,6 +247,8 @@ module Orville.PostgreSQL
   , FieldDefinition.getFieldDefinition
   , FieldDefinition.getAlias
   , FieldDefinition.buildAliasedFieldDefinition
+  , FieldDefinition.markAsIdentity
+  , FieldDefinition.unmarkIdentity
   , Marshall.AliasName
   , Marshall.stringToAliasName
   , Marshall.aliasNameToString

orville-postgresql/src/Orville/PostgreSQL/AutoMigration.hs

@@ -56,6 +56,7 @@ import qualified Orville.PostgreSQL as Orville
 import qualified Orville.PostgreSQL.Expr as Expr
 import qualified Orville.PostgreSQL.Internal.IndexDefinition as IndexDefinition
 import qualified Orville.PostgreSQL.Internal.MigrationLock as MigrationLock
+import qualified Orville.PostgreSQL.Marshall as Marshall
 import qualified Orville.PostgreSQL.PgCatalog as PgCatalog
 import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
 import qualified Orville.PostgreSQL.Schema as Schema
@@ -953,8 +954,28 @@ mkAddAlterColumnActions relationDesc fieldDef =
                           ( Just (Expr.alterColumnDropDefault columnName)
                           , Just (Expr.alterColumnSetDefault columnName newDefault)
                           )
+
+              alterIdentity =
+                case (Marshall.fieldColumnIdentity fieldDef, PgCatalog.pgAttributeIdentity attr) of
+                  (Nothing, Nothing) -> mempty
+                  (Just Marshall.GeneratedAlways, Just Marshall.GeneratedAlways) -> mempty
+                  (Just Marshall.GeneratedByDefault, Just Marshall.GeneratedByDefault) -> mempty
+                  (Nothing, Just _) ->
+                    pure $ Expr.alterColumnDropIdentity columnName Nothing
+                  (Just Marshall.GeneratedAlways, Nothing) ->
+                    pure $ Expr.alterColumnAddIdentity columnName Expr.alwaysColumnIdentityGeneration
+                  (Just Marshall.GeneratedAlways, Just _existing) ->
+                    [Expr.alterColumnDropIdentity columnName Nothing, Expr.alterColumnAddIdentity columnName Expr.alwaysColumnIdentityGeneration]
+                  (Just Marshall.GeneratedByDefault, Nothing) ->
+                    pure $ Expr.alterColumnAddIdentity columnName Expr.byDefaultColumnIdentityGeneration
+                  (Just Marshall.GeneratedByDefault, Just _existing) ->
+                    [Expr.alterColumnDropIdentity columnName Nothing, Expr.alterColumnAddIdentity columnName Expr.byDefaultColumnIdentityGeneration]
             in
-              Maybe.maybeToList dropDefault <> alterType <> Maybe.maybeToList setDefault <> alterNullability
+              Maybe.maybeToList dropDefault
+                <> alterType
+                <> Maybe.maybeToList setDefault
+                <> alterNullability
+                <> alterIdentity
       _ ->
         -- Either the column doesn't exist in the table _OR_ it's a system
         -- column. If it's a system column, attempting to add it will result

orville-postgresql/src/Orville/PostgreSQL/Expr/ColumnDefinition.hs

@@ -15,11 +15,13 @@ module Orville.PostgreSQL.Expr.ColumnDefinition
   , nullConstraint
   , ColumnDefault
   , columnDefault
+  , identityColumnConstraint
+  , ColumnIdentityGeneration
+  , alwaysColumnIdentityGeneration
+  , byDefaultColumnIdentityGeneration
   )
 where
 
-import qualified Data.Maybe as Maybe
-
 import Orville.PostgreSQL.Expr.DataType (DataType)
 import Orville.PostgreSQL.Expr.Name (ColumnName)
 import Orville.PostgreSQL.Expr.ValueExpression (ValueExpression)
@@ -51,20 +53,26 @@ columnDefinition ::
   ColumnName ->
   -- | The SQL type of the column.
   DataType ->
-  -- | The constraint on the column, if any.
-  Maybe ColumnConstraint ->
+  -- | The constraints on the column, if any.
+  [ColumnConstraint] ->
   -- | The default value for the column, if any.
   Maybe ColumnDefault ->
   ColumnDefinition
-columnDefinition columnName dataType maybeColumnConstraint maybeColumnDefault =
-  ColumnDefinition
-    . RawSql.intercalate RawSql.space
-    $ Maybe.catMaybes
-      [ Just $ RawSql.toRawSql columnName
-      , Just $ RawSql.toRawSql dataType
-      , fmap RawSql.toRawSql maybeColumnConstraint
-      , fmap RawSql.toRawSql maybeColumnDefault
-      ]
+columnDefinition columnName dataType columnConstraints maybeColumnDefault =
+  let
+    constraintRawSql =
+      RawSql.intercalate RawSql.space columnConstraints
+  in
+    ColumnDefinition $
+      RawSql.toRawSql columnName
+        <> RawSql.space
+        <> RawSql.toRawSql dataType
+        <> RawSql.space
+        <> constraintRawSql
+        <> case maybeColumnDefault of
+          Nothing -> mempty
+          Just colDefault ->
+            RawSql.space <> RawSql.toRawSql colDefault
 
 {- | Represent constraints, such as nullability, on a column. E.G.
 
@@ -99,6 +107,50 @@ nullConstraint :: ColumnConstraint
 nullConstraint =
   ColumnConstraint (RawSql.fromString "NULL")
 
+{- | Represent the generation definition of an identity column. E.G.
+
+> ALWAYS
+
+'ColumnIdentityGeneration' provides a 'RawSql.SqlExpression' instance. See
+'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
+SQL.
+
+@since 1.1.0.0
+-}
+newtype ColumnIdentityGeneration
+  = ColumnIdentityGeneration RawSql.RawSql
+  deriving
+    ( -- | @since 1.1.0.0
+      RawSql.SqlExpression
+    )
+
+{- | Express that a column is an identity column.
+
+@since 1.1.0.0
+-}
+identityColumnConstraint ::
+  ColumnIdentityGeneration ->
+  ColumnConstraint
+identityColumnConstraint identityGeneration =
+  ColumnConstraint $
+    RawSql.fromString "GENERATE "
+      <> RawSql.toRawSql identityGeneration
+      <> RawSql.fromString " AS IDENTITY"
+
+{- | The @ALWAYS@ generation for an identity column
+
+@since 1.1.0.0
+-}
+alwaysColumnIdentityGeneration :: ColumnIdentityGeneration
+alwaysColumnIdentityGeneration = ColumnIdentityGeneration $ RawSql.fromString "ALWAYS"
+
+{- | The @BY DEFAULT@ generation for an identity column
+
+@since 1.1.0.0
+-}
+byDefaultColumnIdentityGeneration :: ColumnIdentityGeneration
+byDefaultColumnIdentityGeneration = ColumnIdentityGeneration $ RawSql.fromString "BY DEFAULT"
+
 {- | Represents the default value of a column. E.G.
 
 > now()

orville-postgresql/src/Orville/PostgreSQL/Expr/TableDefinition.hs

@@ -23,6 +23,8 @@ module Orville.PostgreSQL.Expr.TableDefinition
   , alterColumnType
   , alterColumnSetDefault
   , alterColumnDropDefault
+  , alterColumnAddIdentity
+  , alterColumnDropIdentity
   , UsingClause
   , usingCast
   , alterColumnNullability
@@ -39,7 +41,7 @@ where
 import Data.List.NonEmpty (NonEmpty)
 import Data.Maybe (catMaybes, maybeToList)
 
-import Orville.PostgreSQL.Expr.ColumnDefinition (ColumnDefinition)
+import Orville.PostgreSQL.Expr.ColumnDefinition (ColumnDefinition, ColumnIdentityGeneration)
 import Orville.PostgreSQL.Expr.DataType (DataType)
 import Orville.PostgreSQL.Expr.IfExists (IfExists)
 import Orville.PostgreSQL.Expr.Name (ColumnName, ConstraintName, QualifiedOrUnqualified, TableName)
@@ -365,6 +367,38 @@ alterColumnSetDefault columnName defaultValue =
       , RawSql.toRawSql defaultValue
       ]
 
+{- | Constructs an 'AlterTableAction' that will use @ADD GENERATED .. AS IDENTITY@ to set the
+   specified column to be an identity column.
+
+  @since 1.1.0.0
+-}
+alterColumnAddIdentity ::
+  ColumnName ->
+  ColumnIdentityGeneration ->
+  AlterTableAction
+alterColumnAddIdentity columnName columnIdentityGeneration =
+  AlterTableAction $
+    RawSql.fromString "ALTER COLUMN "
+      <> RawSql.toRawSql columnName
+      <> RawSql.fromString " ADD GENERATED "
+      <> RawSql.toRawSql columnIdentityGeneration
+      <> RawSql.fromString " AS IDENTITY"
+
+{- | Constructs an 'AlterTableAction' that will drop the identity requirement of a column
+
+  @since 1.1.0.0
+-}
+alterColumnDropIdentity ::
+  ColumnName ->
+  Maybe IfExists ->
+  AlterTableAction
+alterColumnDropIdentity columnName maybeIfExists =
+  AlterTableAction $
+    RawSql.fromString "ALTER COLUMN "
+      <> RawSql.toRawSql columnName
+      <> RawSql.fromString " DROP IDENTITY"
+      <> maybe mempty (\i -> RawSql.space <> RawSql.toRawSql i) maybeIfExists
+
 {- | Type to represent a @DROP TABLE@ statement. E.G.
 
 > DROP TABLE FOO

orville-postgresql/src/Orville/PostgreSQL/Marshall/FieldDefinition.hs

@@ -104,6 +104,10 @@ module Orville.PostgreSQL.Marshall.FieldDefinition
   , getFieldDefinition
   , getAlias
   , buildAliasedFieldDefinition
+  , ColumnIdentity (GeneratedAlways, GeneratedByDefault)
+  , markAsIdentity
+  , unmarkIdentity
+  , fieldColumnIdentity
   )
 where
 
@@ -141,6 +145,8 @@ data FieldDefinition nullability a = FieldDefinition
   , i_fieldDefaultValue :: Maybe (DefaultValue.DefaultValue a)
   , i_fieldDescription :: Maybe String
   , i_fieldTableConstraints :: [FieldName -> ConstraintDefinition.ConstraintDefinition]
+  , i_fieldIdentity :: IdentityGADT nullability
+  , i_fieldColumnConstraints :: [Expr.ColumnConstraint]
   }
 
 {- | Constructs the 'Expr.ValueExpression' for a field for use in SQL expressions
@@ -414,22 +420,26 @@ fieldColumnDefinition fieldDef =
   Expr.columnDefinition
     (fieldNameToColumnName $ fieldName fieldDef)
     (SqlType.sqlTypeExpr $ fieldType fieldDef)
-    (Just $ fieldColumnConstraint fieldDef)
+    (fieldColumnConstraints fieldDef)
     (fmap (Expr.columnDefault . DefaultValue.defaultValueExpression) $ i_fieldDefaultValue fieldDef)
 
-{- | INTERNAL - Builds the appropriate ColumnConstraint for a field. Currently
-  this only handles nullability, but if we add support for more constraints
-  directly on columns it may end up handling those as well.
+{- | INTERNAL - Builds the appropriate [ColumnConstraint] for a field.
 
 @since 1.0.0.0
 -}
-fieldColumnConstraint :: FieldDefinition nullabily a -> Expr.ColumnConstraint
-fieldColumnConstraint fieldDef =
+fieldColumnConstraints :: FieldDefinition nullabily a -> [Expr.ColumnConstraint]
+fieldColumnConstraints fieldDef =
   case fieldNullability fieldDef of
-    NotNullField _ ->
-      Expr.notNullConstraint
+    NotNullField nnf ->
+      case i_fieldIdentity nnf of
+        IsIdentityGADT GeneratedAlways ->
+          [Expr.notNullConstraint, Expr.identityColumnConstraint Expr.alwaysColumnIdentityGeneration]
+        IsIdentityGADT GeneratedByDefault ->
+          [Expr.notNullConstraint, Expr.identityColumnConstraint Expr.byDefaultColumnIdentityGeneration]
+        AllowedIdentityButNotSetGADT ->
+          pure Expr.notNullConstraint
     NullableField _ ->
-      Expr.nullConstraint
+      pure Expr.nullConstraint
 
 {- | The type in considered internal because it requires GADTs to make use of
   it meaningfully. The 'FieldNullability' type is used as the public interface
@@ -671,6 +681,8 @@ fieldOfType sqlType name =
     , i_fieldDefaultValue = Nothing
     , i_fieldDescription = Nothing
     , i_fieldTableConstraints = mempty
+    , i_fieldIdentity = AllowedIdentityButNotSetGADT
+    , i_fieldColumnConstraints = mempty
     }
 
 {- | Makes a 'NotNull' field 'Nullable' by wrapping the Haskell type of the field
@@ -701,6 +713,8 @@ nullableField field =
       , i_fieldDefaultValue = fmap DefaultValue.coerceDefaultValue (i_fieldDefaultValue field)
       , i_fieldDescription = fieldDescription field
       , i_fieldTableConstraints = i_fieldTableConstraints field
+      , i_fieldIdentity = NotIdentityGADT
+      , i_fieldColumnConstraints = i_fieldColumnConstraints field
       }
 
 {- | Adds a 'Maybe' wrapper to a field that is already nullable. (If your field is
@@ -734,6 +748,8 @@ asymmetricNullableField field =
       , i_fieldDefaultValue = fmap DefaultValue.coerceDefaultValue (i_fieldDefaultValue field)
       , i_fieldDescription = fieldDescription field
       , i_fieldTableConstraints = i_fieldTableConstraints field
+      , i_fieldIdentity = i_fieldIdentity field
+      , i_fieldColumnConstraints = i_fieldColumnConstraints field
       }
 
 {- | Applies a 'SqlType.SqlType' conversion to a 'FieldDefinition'. You can
@@ -799,6 +815,22 @@ removeDefaultValue fieldDef =
     { i_fieldDefaultValue = Nothing
     }
 
+{- | Use the supplied options to mark a column as an identity column.
+
+@since 1.1.0.0
+-}
+markAsIdentity :: ColumnIdentity -> FieldDefinition NotNull a -> FieldDefinition NotNull a
+markAsIdentity identityGen fieldDef =
+  fieldDef
+    { i_fieldIdentity = IsIdentityGADT identityGen
+    }
+
+unmarkIdentity :: FieldDefinition NotNull a -> FieldDefinition NotNull a
+unmarkIdentity fieldDef =
+  fieldDef
+    { i_fieldIdentity = AllowedIdentityButNotSetGADT
+    }
+
 {- | Adds a prefix, followed by an underscore, to a field's name.
 
 @since 1.0.0.0
@@ -1102,3 +1134,36 @@ getFieldDefinition = i_fieldDef
 buildAliasedFieldDefinition :: FieldDefinition nullability a -> AliasName -> AliasedFieldDefinition nullability a
 buildAliasedFieldDefinition f ma =
   AliasedFieldDefinition ma f
+
+{- | INTERNAL: This type is an internal tracking of if a column is an identity column. We tie this to
+   the nullability because a nullable column is not allowed to be an identity column.
+
+@since 1.1.0.0
+-}
+data IdentityGADT nullability where
+  IsIdentityGADT :: ColumnIdentity -> IdentityGADT NotNull
+  AllowedIdentityButNotSetGADT :: IdentityGADT NotNull
+  NotIdentityGADT :: IdentityGADT Nullable
+
+{- | Get the 'ColumnIdentity' of a 'FieldDefinition'.
+
+@since 1.1.0.0
+-}
+fieldColumnIdentity :: FieldDefinition nullability a -> Maybe ColumnIdentity
+fieldColumnIdentity fieldDef =
+  case i_fieldIdentity fieldDef of
+    AllowedIdentityButNotSetGADT -> Nothing
+    NotIdentityGADT -> Nothing
+    IsIdentityGADT colId -> Just colId
+
+{- |
+
+@since 1.1.0.0
+-}
+data ColumnIdentity
+  = GeneratedAlways
+  | GeneratedByDefault
+  deriving
+    ( -- | @since 1.1.0.0
+      Eq
+    )