{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
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
data PrimaryKey key
= PrimaryKey (PrimaryKeyPart key) [PrimaryKeyPart key]
data PrimaryKeyPart key
= forall part. PrimaryKeyPart (key -> part) (FieldDefinition NotNull part)
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
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 :: 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 :: 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 :: 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 ::
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 ::
(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 ::
( 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)
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 :: 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 :: 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)
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)