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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Internal.IndexDefinition
  ( IndexDefinition
  , indexCreationStrategy
  , setIndexCreationStrategy
  , uniqueIndex
  , uniqueNamedIndex
  , nonUniqueIndex
  , nonUniqueNamedIndex
  , mkIndexDefinition
  , mkNamedIndexDefinition
  , IndexMigrationKey (AttributeBasedIndexKey, NamedIndexKey)
  , AttributeBasedIndexMigrationKey (AttributeBasedIndexMigrationKey, indexKeyUniqueness, indexKeyColumns)
  , NamedIndexMigrationKey
  , indexMigrationKey
  , indexCreateExpr
  , IndexCreationStrategy (Transactional, Concurrent)
  )
where

import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NEL

import qualified Orville.PostgreSQL.Expr as Expr
import qualified Orville.PostgreSQL.Marshall.FieldDefinition as FieldDefinition

{- |
  Defines an index that can be added to a 'Orville.PostgreSQL.TableDefinition'.
  Use one of the constructor functions below (such as 'uniqueIndex') to
  construct the index definition you wish to have and then use
  'Orville.PostgreSQL.addTableIndexes' to add them to your table definition.
  Orville will then add the index next time you run auto-migrations.

@since 1.0.0.0
-}
data IndexDefinition = IndexDefinition
  { IndexDefinition
-> IndexCreationStrategy -> Qualified TableName -> CreateIndexExpr
i_indexCreateExpr ::
      IndexCreationStrategy ->
      Expr.Qualified Expr.TableName ->
      Expr.CreateIndexExpr
  , IndexDefinition -> IndexMigrationKey
i_indexMigrationKey :: IndexMigrationKey
  , IndexDefinition -> IndexCreationStrategy
i_indexCreationStrategy :: IndexCreationStrategy
  }

{- |
  Sets the 'IndexCreationStrategy' to be used when creating the index described
  by the 'IndexDefinition'. By default, all indexes are created using the
  'Transactional' strategy, but some tables are too large for this to be
  feasible. See the 'Concurrent' creation strategy for how to work around this.

@since 1.0.0.0
-}
setIndexCreationStrategy ::
  IndexCreationStrategy ->
  IndexDefinition ->
  IndexDefinition
setIndexCreationStrategy :: IndexCreationStrategy -> IndexDefinition -> IndexDefinition
setIndexCreationStrategy IndexCreationStrategy
strategy IndexDefinition
indexDef =
  IndexDefinition
indexDef
    { i_indexCreationStrategy :: IndexCreationStrategy
i_indexCreationStrategy = IndexCreationStrategy
strategy
    }

{- |
  Gets the 'IndexCreationStrategy' to be used when creating the index described
  by the 'IndexDefinition'. By default, all indexes are created using the
  'Transactional' strategy.

@since 1.0.0.0
-}
indexCreationStrategy ::
  IndexDefinition ->
  IndexCreationStrategy
indexCreationStrategy :: IndexDefinition -> IndexCreationStrategy
indexCreationStrategy =
  IndexDefinition -> IndexCreationStrategy
i_indexCreationStrategy

{- |
  Defines how an 'IndexDefinition' will be executed to add an index to a table.
  By default, all indexes are created using the 'Transactional' strategy.

@since 1.0.0.0
-}
data IndexCreationStrategy
  = -- |
    --       The default strategy. The index will be added as part of a
    --       database transaction along with all the other DDL being executed
    --       to migrate the database schema. If any migration should fail, the
    --       index creation will be rolled back as part of the transaction.
    --       This is how schema migrations work in general in Orville.
    Transactional
  | -- |
    --       Creates the index using the @CONCURRENTLY@ keyword in PostgreSQL.
    --       Index creation will not lock the table during creation, allowing
    --       the application to access the table normally while the index is
    --       created. Concurrent index creation cannot be done in a
    --       transaction, so indexes created using @CONCURRENTLY@ are created
    --       outside the normal schema transaction. Index creation may fail
    --       when using the 'Concurrent' strategy. Orville has no special
    --       provision to detect or recover from this failure currently. You
    --       should manually check that index creation has succeeded. If
    --       necessary, you can manually drop the index to cause Orville to
    --       recreate it the next time migrations are run. Note that while the
    --       table will not be locked, index migration will still block
    --       application startup by default. See the information about schema
    --       migration options in "Orville.PostgreSQL.AutoMigration" for
    --       details about how to work around this if it is a problem for you.
    --       Also, it a good idea to read the PostgreSQL docs about creating
    --       indexes concurrently before you use this strategy. See
    --       https://www.postgresql.org/docs/current/sql-createindex.html#SQL-CREATEINDEX-CONCURRENTLY.
    Concurrent
  deriving (IndexCreationStrategy -> IndexCreationStrategy -> Bool
(IndexCreationStrategy -> IndexCreationStrategy -> Bool)
-> (IndexCreationStrategy -> IndexCreationStrategy -> Bool)
-> Eq IndexCreationStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexCreationStrategy -> IndexCreationStrategy -> Bool
== :: IndexCreationStrategy -> IndexCreationStrategy -> Bool
$c/= :: IndexCreationStrategy -> IndexCreationStrategy -> Bool
/= :: IndexCreationStrategy -> IndexCreationStrategy -> Bool
Eq, Int -> IndexCreationStrategy -> ShowS
[IndexCreationStrategy] -> ShowS
IndexCreationStrategy -> String
(Int -> IndexCreationStrategy -> ShowS)
-> (IndexCreationStrategy -> String)
-> ([IndexCreationStrategy] -> ShowS)
-> Show IndexCreationStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexCreationStrategy -> ShowS
showsPrec :: Int -> IndexCreationStrategy -> ShowS
$cshow :: IndexCreationStrategy -> String
show :: IndexCreationStrategy -> String
$cshowList :: [IndexCreationStrategy] -> ShowS
showList :: [IndexCreationStrategy] -> ShowS
Show)

{- |
  Orville uses 'IndexMigrationKey' values while performing auto migrations to
  determine whether an index needs to be added or dropped. For most use cases
  the constructor functions that build an 'IndexDefinition' will create this
  automatically for you.

@since 1.0.0.0
-}
data IndexMigrationKey
  = AttributeBasedIndexKey AttributeBasedIndexMigrationKey
  | NamedIndexKey NamedIndexMigrationKey
  deriving (IndexMigrationKey -> IndexMigrationKey -> Bool
(IndexMigrationKey -> IndexMigrationKey -> Bool)
-> (IndexMigrationKey -> IndexMigrationKey -> Bool)
-> Eq IndexMigrationKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexMigrationKey -> IndexMigrationKey -> Bool
== :: IndexMigrationKey -> IndexMigrationKey -> Bool
$c/= :: IndexMigrationKey -> IndexMigrationKey -> Bool
/= :: IndexMigrationKey -> IndexMigrationKey -> Bool
Eq, Eq IndexMigrationKey
Eq IndexMigrationKey
-> (IndexMigrationKey -> IndexMigrationKey -> Ordering)
-> (IndexMigrationKey -> IndexMigrationKey -> Bool)
-> (IndexMigrationKey -> IndexMigrationKey -> Bool)
-> (IndexMigrationKey -> IndexMigrationKey -> Bool)
-> (IndexMigrationKey -> IndexMigrationKey -> Bool)
-> (IndexMigrationKey -> IndexMigrationKey -> IndexMigrationKey)
-> (IndexMigrationKey -> IndexMigrationKey -> IndexMigrationKey)
-> Ord IndexMigrationKey
IndexMigrationKey -> IndexMigrationKey -> Bool
IndexMigrationKey -> IndexMigrationKey -> Ordering
IndexMigrationKey -> IndexMigrationKey -> IndexMigrationKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IndexMigrationKey -> IndexMigrationKey -> Ordering
compare :: IndexMigrationKey -> IndexMigrationKey -> Ordering
$c< :: IndexMigrationKey -> IndexMigrationKey -> Bool
< :: IndexMigrationKey -> IndexMigrationKey -> Bool
$c<= :: IndexMigrationKey -> IndexMigrationKey -> Bool
<= :: IndexMigrationKey -> IndexMigrationKey -> Bool
$c> :: IndexMigrationKey -> IndexMigrationKey -> Bool
> :: IndexMigrationKey -> IndexMigrationKey -> Bool
$c>= :: IndexMigrationKey -> IndexMigrationKey -> Bool
>= :: IndexMigrationKey -> IndexMigrationKey -> Bool
$cmax :: IndexMigrationKey -> IndexMigrationKey -> IndexMigrationKey
max :: IndexMigrationKey -> IndexMigrationKey -> IndexMigrationKey
$cmin :: IndexMigrationKey -> IndexMigrationKey -> IndexMigrationKey
min :: IndexMigrationKey -> IndexMigrationKey -> IndexMigrationKey
Ord)

{- |
  An 'IndexMigrationKey' using 'AttributeBasedIndexMigrationKey' will cause
  Orville to compare the structure of the indexes found in the database to the
  index structure it wants to create. If no matching index is found it will
  create a new index.

@since 1.0.0.0
-}
data AttributeBasedIndexMigrationKey = AttributeBasedIndexMigrationKey
  { AttributeBasedIndexMigrationKey -> IndexUniqueness
indexKeyUniqueness :: Expr.IndexUniqueness
  , AttributeBasedIndexMigrationKey -> [FieldName]
indexKeyColumns :: [FieldDefinition.FieldName]
  }
  deriving (AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
(AttributeBasedIndexMigrationKey
 -> AttributeBasedIndexMigrationKey -> Bool)
-> (AttributeBasedIndexMigrationKey
    -> AttributeBasedIndexMigrationKey -> Bool)
-> Eq AttributeBasedIndexMigrationKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
== :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
$c/= :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
/= :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
Eq, Eq AttributeBasedIndexMigrationKey
Eq AttributeBasedIndexMigrationKey
-> (AttributeBasedIndexMigrationKey
    -> AttributeBasedIndexMigrationKey -> Ordering)
-> (AttributeBasedIndexMigrationKey
    -> AttributeBasedIndexMigrationKey -> Bool)
-> (AttributeBasedIndexMigrationKey
    -> AttributeBasedIndexMigrationKey -> Bool)
-> (AttributeBasedIndexMigrationKey
    -> AttributeBasedIndexMigrationKey -> Bool)
-> (AttributeBasedIndexMigrationKey
    -> AttributeBasedIndexMigrationKey -> Bool)
-> (AttributeBasedIndexMigrationKey
    -> AttributeBasedIndexMigrationKey
    -> AttributeBasedIndexMigrationKey)
-> (AttributeBasedIndexMigrationKey
    -> AttributeBasedIndexMigrationKey
    -> AttributeBasedIndexMigrationKey)
-> Ord AttributeBasedIndexMigrationKey
AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Ordering
AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Ordering
compare :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Ordering
$c< :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
< :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
$c<= :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
<= :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
$c> :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
> :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
$c>= :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
>= :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey -> Bool
$cmax :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey
max :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey
$cmin :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey
min :: AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey
-> AttributeBasedIndexMigrationKey
Ord, Int -> AttributeBasedIndexMigrationKey -> ShowS
[AttributeBasedIndexMigrationKey] -> ShowS
AttributeBasedIndexMigrationKey -> String
(Int -> AttributeBasedIndexMigrationKey -> ShowS)
-> (AttributeBasedIndexMigrationKey -> String)
-> ([AttributeBasedIndexMigrationKey] -> ShowS)
-> Show AttributeBasedIndexMigrationKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttributeBasedIndexMigrationKey -> ShowS
showsPrec :: Int -> AttributeBasedIndexMigrationKey -> ShowS
$cshow :: AttributeBasedIndexMigrationKey -> String
show :: AttributeBasedIndexMigrationKey -> String
$cshowList :: [AttributeBasedIndexMigrationKey] -> ShowS
showList :: [AttributeBasedIndexMigrationKey] -> ShowS
Show)

{- |
  An 'IndexMigrationKey' using 'NamedIndexMigrationKey' will cause Orville to
  compare the only the names of indexes found in the database when determine
  whether to create the index. If an index with a matching name is found no
  index will be created. If no matching index name is found a new index will be
  created. This is often required when you create indexes using custom SQL
  where Orville is not able to do an accurate structural comparison of the
  desired index structure against the existing indexes.

@since 1.0.0.0
-}
type NamedIndexMigrationKey = String

{- |
  Gets the 'IndexMigrationKey' for the 'IndexDefinition'

@since 1.0.0.0
-}
indexMigrationKey :: IndexDefinition -> IndexMigrationKey
indexMigrationKey :: IndexDefinition -> IndexMigrationKey
indexMigrationKey = IndexDefinition -> IndexMigrationKey
i_indexMigrationKey

{- |
  Gets the SQL expression that will be used to add the index to the specified
  table.

@since 1.0.0.0
-}
indexCreateExpr :: IndexDefinition -> Expr.Qualified Expr.TableName -> Expr.CreateIndexExpr
indexCreateExpr :: IndexDefinition -> Qualified TableName -> CreateIndexExpr
indexCreateExpr IndexDefinition
indexDef =
  IndexDefinition
-> IndexCreationStrategy -> Qualified TableName -> CreateIndexExpr
i_indexCreateExpr
    IndexDefinition
indexDef
    (IndexDefinition -> IndexCreationStrategy
i_indexCreationStrategy IndexDefinition
indexDef)

{- |
  Constructs an 'IndexDefinition' for a non-unique index on the given columns.

@since 1.0.0.0
-}
nonUniqueIndex :: NonEmpty FieldDefinition.FieldName -> IndexDefinition
nonUniqueIndex :: NonEmpty FieldName -> IndexDefinition
nonUniqueIndex =
  IndexUniqueness -> NonEmpty FieldName -> IndexDefinition
mkIndexDefinition IndexUniqueness
Expr.NonUniqueIndex

{- |
  Constructs an 'IndexDefinition' for a non-unique index with given SQL and
  index name.

@since 1.0.0.0
-}
nonUniqueNamedIndex :: String -> Expr.IndexBodyExpr -> IndexDefinition
nonUniqueNamedIndex :: String -> IndexBodyExpr -> IndexDefinition
nonUniqueNamedIndex =
  IndexUniqueness -> String -> IndexBodyExpr -> IndexDefinition
mkNamedIndexDefinition IndexUniqueness
Expr.NonUniqueIndex

{- |
  Constructs an 'IndexDefinition' for a @UNIQUE@ index on the given columns.

@since 1.0.0.0
-}
uniqueIndex :: NonEmpty FieldDefinition.FieldName -> IndexDefinition
uniqueIndex :: NonEmpty FieldName -> IndexDefinition
uniqueIndex =
  IndexUniqueness -> NonEmpty FieldName -> IndexDefinition
mkIndexDefinition IndexUniqueness
Expr.UniqueIndex

{- |
  Constructs an 'IndexDefinition' for a @UNIQUE@ index with given SQL and index
  name.

@since 1.0.0.0
-}
uniqueNamedIndex :: String -> Expr.IndexBodyExpr -> IndexDefinition
uniqueNamedIndex :: String -> IndexBodyExpr -> IndexDefinition
uniqueNamedIndex =
  IndexUniqueness -> String -> IndexBodyExpr -> IndexDefinition
mkNamedIndexDefinition IndexUniqueness
Expr.UniqueIndex

{- |
  Constructs an 'IndexDefinition' for an index on the given columns with the
  given uniqueness.

@since 1.0.0.0
-}
mkIndexDefinition ::
  Expr.IndexUniqueness ->
  NonEmpty FieldDefinition.FieldName ->
  IndexDefinition
mkIndexDefinition :: IndexUniqueness -> NonEmpty FieldName -> IndexDefinition
mkIndexDefinition IndexUniqueness
uniqueness NonEmpty FieldName
fieldNames =
  let
    expr :: IndexCreationStrategy -> Qualified TableName -> CreateIndexExpr
expr IndexCreationStrategy
strategy Qualified TableName
tableName =
      IndexUniqueness
-> Maybe ConcurrentlyExpr
-> Qualified TableName
-> NonEmpty ColumnName
-> CreateIndexExpr
Expr.createIndexExpr
        IndexUniqueness
uniqueness
        (IndexCreationStrategy -> Maybe ConcurrentlyExpr
mkMaybeConcurrently IndexCreationStrategy
strategy)
        Qualified TableName
tableName
        ((FieldName -> ColumnName)
-> NonEmpty FieldName -> NonEmpty ColumnName
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldName -> ColumnName
FieldDefinition.fieldNameToColumnName NonEmpty FieldName
fieldNames)

    migrationKey :: AttributeBasedIndexMigrationKey
migrationKey =
      AttributeBasedIndexMigrationKey
        { indexKeyUniqueness :: IndexUniqueness
indexKeyUniqueness = IndexUniqueness
uniqueness
        , indexKeyColumns :: [FieldName]
indexKeyColumns = NonEmpty FieldName -> [FieldName]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty FieldName
fieldNames
        }
  in
    IndexDefinition
      { i_indexCreateExpr :: IndexCreationStrategy -> Qualified TableName -> CreateIndexExpr
i_indexCreateExpr = IndexCreationStrategy -> Qualified TableName -> CreateIndexExpr
expr
      , i_indexMigrationKey :: IndexMigrationKey
i_indexMigrationKey = AttributeBasedIndexMigrationKey -> IndexMigrationKey
AttributeBasedIndexKey AttributeBasedIndexMigrationKey
migrationKey
      , i_indexCreationStrategy :: IndexCreationStrategy
i_indexCreationStrategy = IndexCreationStrategy
Transactional
      }

{- |
  Constructs an 'IndexDefinition' for an index with the given uniqueness, given
  name, and given SQL.

@since 1.0.0.0
-}
mkNamedIndexDefinition ::
  Expr.IndexUniqueness ->
  String ->
  Expr.IndexBodyExpr ->
  IndexDefinition
mkNamedIndexDefinition :: IndexUniqueness -> String -> IndexBodyExpr -> IndexDefinition
mkNamedIndexDefinition IndexUniqueness
uniqueness String
indexName IndexBodyExpr
bodyExpr =
  let
    expr :: IndexCreationStrategy -> Qualified TableName -> CreateIndexExpr
expr IndexCreationStrategy
strategy Qualified TableName
tableName =
      IndexUniqueness
-> Maybe ConcurrentlyExpr
-> Qualified TableName
-> IndexName
-> IndexBodyExpr
-> CreateIndexExpr
Expr.createNamedIndexExpr
        IndexUniqueness
uniqueness
        (IndexCreationStrategy -> Maybe ConcurrentlyExpr
mkMaybeConcurrently IndexCreationStrategy
strategy)
        Qualified TableName
tableName
        (String -> IndexName
Expr.indexName String
indexName)
        IndexBodyExpr
bodyExpr
  in
    IndexDefinition
      { i_indexCreateExpr :: IndexCreationStrategy -> Qualified TableName -> CreateIndexExpr
i_indexCreateExpr = IndexCreationStrategy -> Qualified TableName -> CreateIndexExpr
expr
      , i_indexMigrationKey :: IndexMigrationKey
i_indexMigrationKey = String -> IndexMigrationKey
NamedIndexKey String
indexName
      , i_indexCreationStrategy :: IndexCreationStrategy
i_indexCreationStrategy = IndexCreationStrategy
Transactional
      }

{- |
  Internal helper to determine whether @CONCURRENTLY@ should be included in
  the SQL to create the index.

@since 1.0.0.0
-}
mkMaybeConcurrently :: IndexCreationStrategy -> Maybe Expr.ConcurrentlyExpr
mkMaybeConcurrently :: IndexCreationStrategy -> Maybe ConcurrentlyExpr
mkMaybeConcurrently IndexCreationStrategy
strategy =
  case IndexCreationStrategy
strategy of
    IndexCreationStrategy
Transactional -> Maybe ConcurrentlyExpr
forall a. Maybe a
Nothing
    IndexCreationStrategy
Concurrent -> ConcurrentlyExpr -> Maybe ConcurrentlyExpr
forall a. a -> Maybe a
Just ConcurrentlyExpr
Expr.concurrently