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

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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Schema.PrimaryKey
  ( PrimaryKey
  , primaryKeyDescription
  , primaryKeyFieldNames
  , primaryKeyToSql
  , primaryKey
  , PrimaryKeyPart
  , compositePrimaryKey
  , primaryKeyPart
  , mapPrimaryKeyParts
  , mkPrimaryKeyExpr
  , primaryKeyEquals
  , primaryKeyIn
  )
where

import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty ((:|)), toList)

import qualified Orville.PostgreSQL.Expr as Expr
import qualified Orville.PostgreSQL.Internal.Extra.NonEmpty as ExtraNonEmpty
import Orville.PostgreSQL.Marshall.FieldDefinition (FieldDefinition, FieldName, NotNull, fieldColumnName, fieldEquals, fieldIn, fieldName, fieldNameToString, fieldValueToSqlValue)
import qualified Orville.PostgreSQL.Raw.SqlValue as SqlValue

{- |
  A Haskell description of the 'FieldDefinition's that make up the primary
  key of a SQL table. This type supports composite primary keys as well
  as singular ones.

@since 1.0.0.0
-}
data PrimaryKey key
  = PrimaryKey (PrimaryKeyPart key) [PrimaryKeyPart key]

{- |
  A 'PrimaryKeyPart' describes one field of a composite primary key. Values
  are built using 'primaryKeyPart' and then used with 'compositePrimaryKey'
  to build a 'PrimaryKey'.

@since 1.0.0.0
-}
data PrimaryKeyPart key
  = forall part. PrimaryKeyPart (key -> part) (FieldDefinition NotNull part)

{- |
  'primaryKeyDescription' builds a user-readable representation of the
  primary key for use in error messages and such. It is a comma-delimited
  list of the names of the fields that make up the primary key.

@since 1.0.0.0
-}
primaryKeyDescription :: PrimaryKey key -> String
primaryKeyDescription :: forall key. PrimaryKey key -> String
primaryKeyDescription =
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", "
    ([String] -> String)
-> (PrimaryKey key -> [String]) -> PrimaryKey key -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldName -> String) -> [FieldName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FieldName -> String
fieldNameToString
    ([FieldName] -> [String])
-> (PrimaryKey key -> [FieldName]) -> PrimaryKey key -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty FieldName -> [FieldName]
forall a. NonEmpty a -> [a]
toList
    (NonEmpty FieldName -> [FieldName])
-> (PrimaryKey key -> NonEmpty FieldName)
-> PrimaryKey key
-> [FieldName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimaryKey key -> NonEmpty FieldName
forall key. PrimaryKey key -> NonEmpty FieldName
primaryKeyFieldNames

{- |
  Retrieves the names of the fields that are part of the primary key.

@since 1.0.0.0
-}
primaryKeyFieldNames :: PrimaryKey key -> NonEmpty FieldName
primaryKeyFieldNames :: forall key. PrimaryKey key -> NonEmpty FieldName
primaryKeyFieldNames =
  let
    partName :: (part -> key) -> FieldDefinition NotNull a -> FieldName
    partName :: forall part key a.
(part -> key) -> FieldDefinition NotNull a -> FieldName
partName part -> key
_ FieldDefinition NotNull a
field =
      FieldDefinition NotNull a -> FieldName
forall nullability a. FieldDefinition nullability a -> FieldName
fieldName FieldDefinition NotNull a
field
  in
    (forall part.
 (key -> part) -> FieldDefinition NotNull part -> FieldName)
-> PrimaryKey key -> NonEmpty FieldName
forall key a.
(forall part. (key -> part) -> FieldDefinition NotNull part -> a)
-> PrimaryKey key -> NonEmpty a
mapPrimaryKeyParts (key -> part) -> FieldDefinition NotNull part -> FieldName
forall part.
(key -> part) -> FieldDefinition NotNull part -> FieldName
forall part key a.
(part -> key) -> FieldDefinition NotNull a -> FieldName
partName

{- |
  'primaryKeyToSql' converts a Haskell value for a primary key into the
  (possibly multiple) SQL values that represent the primary key in the
  database.

@since 1.0.0.0
-}
primaryKeyToSql :: PrimaryKey key -> key -> NonEmpty SqlValue.SqlValue
primaryKeyToSql :: forall key. PrimaryKey key -> key -> NonEmpty SqlValue
primaryKeyToSql PrimaryKey key
keyDef key
key =
  (forall part.
 (key -> part) -> FieldDefinition NotNull part -> SqlValue)
-> PrimaryKey key -> NonEmpty SqlValue
forall key a.
(forall part. (key -> part) -> FieldDefinition NotNull part -> a)
-> PrimaryKey key -> NonEmpty a
mapPrimaryKeyParts (key -> (key -> part) -> FieldDefinition NotNull part -> SqlValue
forall key part.
key -> (key -> part) -> FieldDefinition NotNull part -> SqlValue
partSqlValue key
key) PrimaryKey key
keyDef

{- |
  'partSqlValue' is an internal helper function that builds the
  'SqlValue.SqlValue' for one part of a (possible composite) primary key.

@since 1.0.0.0
-}
partSqlValue :: key -> (key -> part) -> FieldDefinition NotNull part -> SqlValue.SqlValue
partSqlValue :: forall key part.
key -> (key -> part) -> FieldDefinition NotNull part -> SqlValue
partSqlValue key
key key -> part
getPart FieldDefinition NotNull part
partField =
  FieldDefinition NotNull part -> part -> SqlValue
forall nullability a.
FieldDefinition nullability a -> a -> SqlValue
fieldValueToSqlValue FieldDefinition NotNull part
partField (key -> part
getPart key
key)

{- |
  'primaryKey' constructs a single-field primary key from the 'FieldDefinition'
  that corresponds to the primary key's column. This is generally used while
  building a 'Orville.PostgreSQL.TableDefinition'.

@since 1.0.0.0
-}
primaryKey :: FieldDefinition NotNull key -> PrimaryKey key
primaryKey :: forall key. FieldDefinition NotNull key -> PrimaryKey key
primaryKey FieldDefinition NotNull key
fieldDef =
  PrimaryKeyPart key -> [PrimaryKeyPart key] -> PrimaryKey key
forall key.
PrimaryKeyPart key -> [PrimaryKeyPart key] -> PrimaryKey key
PrimaryKey ((key -> key) -> FieldDefinition NotNull key -> PrimaryKeyPart key
forall key part.
(key -> part) -> FieldDefinition NotNull part -> PrimaryKeyPart key
PrimaryKeyPart key -> key
forall a. a -> a
id FieldDefinition NotNull key
fieldDef) []

{- |
  'compositePrimaryKey' constructs a multi-field primary key from the given
  parts, each of which corresponds to one field in the primary key. You should
  use this while building a 'Orville.PostgreSQL.TableDefinition' for a table
  that you want to have a multi-column primary key. See 'primaryKeyPart' for
  how to build the parts to be passed as parameters. Note: there is no special
  significance to the first argument other than requiring that there is at
  least one field in the primary key.

@since 1.0.0.0
-}
compositePrimaryKey ::
  PrimaryKeyPart key ->
  [PrimaryKeyPart key] ->
  PrimaryKey key
compositePrimaryKey :: forall key.
PrimaryKeyPart key -> [PrimaryKeyPart key] -> PrimaryKey key
compositePrimaryKey =
  PrimaryKeyPart key -> [PrimaryKeyPart key] -> PrimaryKey key
forall key.
PrimaryKeyPart key -> [PrimaryKeyPart key] -> PrimaryKey key
PrimaryKey

{- |
  'primaryKeyPart' constructs a building block for a composite primary key
  based on a 'FieldDefinition' and an accessor function to extract the value for
  that field from the Haskell @key@ type that represents the overall composite
  key. 'PrimaryKeyPart' values built using this function are usually then
  passed in a list to 'compositePrimaryKey' to build a 'PrimaryKey'.

@since 1.0.0.0
-}
primaryKeyPart ::
  (key -> part) ->
  FieldDefinition NotNull part ->
  PrimaryKeyPart key
primaryKeyPart :: forall key part.
(key -> part) -> FieldDefinition NotNull part -> PrimaryKeyPart key
primaryKeyPart =
  (key -> part) -> FieldDefinition NotNull part -> PrimaryKeyPart key
forall key part.
(key -> part) -> FieldDefinition NotNull part -> PrimaryKeyPart key
PrimaryKeyPart

{- |
  'mapPrimaryKeyParts' provides a way to access the innards of a 'PrimaryKey'
  definition to extract information. The given function will be called on
  each part of the primary key in order and the list of results is returned.
  Note that single-field and multi-field primary keys are treated the same by
  this function, with the single-field case simply behaving as a composite key
  with just one part.

@since 1.0.0.0
-}
mapPrimaryKeyParts ::
  ( forall part.
    (key -> part) ->
    FieldDefinition NotNull part ->
    a
  ) ->
  PrimaryKey key ->
  NonEmpty a
mapPrimaryKeyParts :: forall key a.
(forall part. (key -> part) -> FieldDefinition NotNull part -> a)
-> PrimaryKey key -> NonEmpty a
mapPrimaryKeyParts forall part. (key -> part) -> FieldDefinition NotNull part -> a
f (PrimaryKey PrimaryKeyPart key
first [PrimaryKeyPart key]
rest) =
  let
    doPart :: PrimaryKeyPart key -> a
doPart (PrimaryKeyPart key -> part
getPart FieldDefinition NotNull part
field) =
      (key -> part) -> FieldDefinition NotNull part -> a
forall part. (key -> part) -> FieldDefinition NotNull part -> a
f key -> part
getPart FieldDefinition NotNull part
field
  in
    (PrimaryKeyPart key -> a)
-> NonEmpty (PrimaryKeyPart key) -> NonEmpty a
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimaryKeyPart key -> a
doPart (PrimaryKeyPart key
first PrimaryKeyPart key
-> [PrimaryKeyPart key] -> NonEmpty (PrimaryKeyPart key)
forall a. a -> [a] -> NonEmpty a
:| [PrimaryKeyPart key]
rest)

{- |
  Builds a 'Expr.PrimaryKeyExpr' that is suitable to be used when creating
  a table to define the primary key on the table.

@since 1.0.0.0
-}
mkPrimaryKeyExpr :: PrimaryKey key -> Expr.PrimaryKeyExpr
mkPrimaryKeyExpr :: forall key. PrimaryKey key -> PrimaryKeyExpr
mkPrimaryKeyExpr PrimaryKey key
keyDef =
  let
    names :: NonEmpty ColumnName
names =
      (forall part.
 (key -> part) -> FieldDefinition NotNull part -> ColumnName)
-> PrimaryKey key -> NonEmpty ColumnName
forall key a.
(forall part. (key -> part) -> FieldDefinition NotNull part -> a)
-> PrimaryKey key -> NonEmpty a
mapPrimaryKeyParts (\key -> part
_ FieldDefinition NotNull part
field -> FieldDefinition NotNull part -> ColumnName
forall nullability a. FieldDefinition nullability a -> ColumnName
fieldColumnName FieldDefinition NotNull part
field) PrimaryKey key
keyDef
  in
    NonEmpty ColumnName -> PrimaryKeyExpr
Expr.primaryKeyExpr NonEmpty ColumnName
names

{- |
  'primaryKeyEquals' builds a 'Expr.BooleanExpr' that will match the row where
  the primary key is equal to the given value. For single-field primary keys,
  this is equivalent to 'fieldEquals', but 'primaryKeyEquals' also handles
  composite primary keys.

@since 1.0.0.0
-}
primaryKeyEquals :: PrimaryKey key -> key -> Expr.BooleanExpr
primaryKeyEquals :: forall key. PrimaryKey key -> key -> BooleanExpr
primaryKeyEquals PrimaryKey key
keyDef key
key =
  (BooleanExpr -> BooleanExpr -> BooleanExpr)
-> NonEmpty BooleanExpr -> BooleanExpr
forall a. (a -> a -> a) -> NonEmpty a -> a
ExtraNonEmpty.foldl1'
    BooleanExpr -> BooleanExpr -> BooleanExpr
Expr.andExpr
    ((forall part.
 (key -> part) -> FieldDefinition NotNull part -> BooleanExpr)
-> PrimaryKey key -> NonEmpty BooleanExpr
forall key a.
(forall part. (key -> part) -> FieldDefinition NotNull part -> a)
-> PrimaryKey key -> NonEmpty a
mapPrimaryKeyParts (key -> (key -> part) -> FieldDefinition NotNull part -> BooleanExpr
forall key a nullability.
key -> (key -> a) -> FieldDefinition nullability a -> BooleanExpr
partEquals key
key) PrimaryKey key
keyDef)

{- |
  'primaryKeyIn' builds a 'Expr.BooleanExpr' that will match rows where the
  primary key is contained in the given list. For single-field primary keys,
  this is equivalent to 'fieldIn', but 'primaryKeyIn' also handles composite
  primary keys.

@since 1.0.0.0
-}
primaryKeyIn :: PrimaryKey key -> NonEmpty key -> Expr.BooleanExpr
primaryKeyIn :: forall key. PrimaryKey key -> NonEmpty key -> BooleanExpr
primaryKeyIn PrimaryKey key
keyDef NonEmpty key
keys =
  case PrimaryKey key
keyDef of
    PrimaryKey (PrimaryKeyPart key -> part
getPart FieldDefinition NotNull part
field) [] ->
      FieldDefinition NotNull part -> NonEmpty part -> BooleanExpr
forall nullability a.
FieldDefinition nullability a -> NonEmpty a -> BooleanExpr
fieldIn FieldDefinition NotNull part
field ((key -> part) -> NonEmpty key -> NonEmpty part
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap key -> part
getPart NonEmpty key
keys)
    PrimaryKey key
_ ->
      (BooleanExpr -> BooleanExpr -> BooleanExpr)
-> NonEmpty BooleanExpr -> BooleanExpr
forall a. (a -> a -> a) -> NonEmpty a -> a
ExtraNonEmpty.foldl1'
        BooleanExpr -> BooleanExpr -> BooleanExpr
Expr.orExpr
        ((key -> BooleanExpr) -> NonEmpty key -> NonEmpty BooleanExpr
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrimaryKey key -> key -> BooleanExpr
forall key. PrimaryKey key -> key -> BooleanExpr
primaryKeyEquals PrimaryKey key
keyDef) NonEmpty key
keys)

{- |
  INTERNAL: builds the where condition for a single part of the key

@since 1.0.0.0
-}
partEquals :: key -> (key -> a) -> FieldDefinition nullability a -> Expr.BooleanExpr
partEquals :: forall key a nullability.
key -> (key -> a) -> FieldDefinition nullability a -> BooleanExpr
partEquals key
key key -> a
getPart FieldDefinition nullability a
partField =
  FieldDefinition nullability a -> a -> BooleanExpr
forall nullability a.
FieldDefinition nullability a -> a -> BooleanExpr
fieldEquals FieldDefinition nullability a
partField (key -> a
getPart key
key)