PrimaryKey.hs

{-# 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 =
  List.intercalate ", "
    . map fieldNameToString
    . toList
    . 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 =
  let
    partName :: (part -> key) -> FieldDefinition NotNull a -> FieldName
    partName _ field =
      fieldName field
  in
    mapPrimaryKeyParts 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 keyDef key =
  mapPrimaryKeyParts (partSqlValue 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 key getPart partField =
  fieldValueToSqlValue partField (getPart 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 fieldDef =
  PrimaryKey (PrimaryKeyPart id 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 =
  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 =
  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 f (PrimaryKey first rest) =
  let
    doPart (PrimaryKeyPart getPart field) =
      f getPart field
  in
    fmap doPart (first :| 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 keyDef =
  let
    names =
      mapPrimaryKeyParts (\_ field -> fieldColumnName field) keyDef
  in
    Expr.primaryKeyExpr 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 keyDef key =
  ExtraNonEmpty.foldl1'
    Expr.andExpr
    (mapPrimaryKeyParts (partEquals 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 keyDef keys =
  case keyDef of
    PrimaryKey (PrimaryKeyPart getPart field) [] ->
      fieldIn field (fmap getPart keys)
    _ ->
      ExtraNonEmpty.foldl1'
        Expr.orExpr
        (fmap (primaryKeyEquals keyDef) 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 key getPart partField =
  fieldEquals partField (getPart key)