{-# LANGUAGE TemplateHaskell #-}
module Database.Relational.Schema.PostgreSQL (
module Database.Relational.Schema.PostgreSQL.Config,
Column,
normalizeColumn, notNull, getType,
columnQuerySQL,
primaryKeyLengthQuerySQL, primaryKeyQuerySQL
) where
import Prelude hiding (or)
import Language.Haskell.TH (TypeQ)
import Data.Int (Int16, Int32, Int64)
import Data.Char (toLower)
import Data.List (foldl1')
import Data.Map (Map, fromList)
import qualified Data.Map as Map
import Data.Time
(DiffTime, NominalDiffTime,
LocalTime, ZonedTime, Day, TimeOfDay)
import Database.Relational
(Query, relationalQuery, Relation, query, query', relation', relation, union,
wheres, (.=.), (.>.), not', in', values, (!), fst', snd',
placeholder, asc, value, unsafeProjectSql, (><))
import Database.Relational.Schema.PostgreSQL.Config
import Database.Relational.Schema.PostgreSQL.PgNamespace (pgNamespace)
import qualified Database.Relational.Schema.PostgreSQL.PgNamespace as Namespace
import Database.Relational.Schema.PostgreSQL.PgClass (pgClass)
import qualified Database.Relational.Schema.PostgreSQL.PgClass as Class
import Database.Relational.Schema.PostgreSQL.PgConstraint (PgConstraint, pgConstraint)
import qualified Database.Relational.Schema.PostgreSQL.PgConstraint as Constraint
import Database.Relational.Schema.PostgreSQL.PgAttribute (PgAttribute, pgAttribute)
import qualified Database.Relational.Schema.PostgreSQL.PgAttribute as Attr
import Database.Relational.Schema.PostgreSQL.PgType (PgType(..), pgType)
import qualified Database.Relational.Schema.PostgreSQL.PgType as Type
import Control.Applicative ((<|>))
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault =
[(String, TypeQ)] -> Map String TypeQ
forall k a. Ord k => [(k, a)] -> Map k a
fromList [("bool", [t| Bool |]),
("char", [t| Char |]),
("name", [t| String |]),
("int8", [t| Int64 |]),
("int2", [t| Int16 |]),
("int4", [t| Int32 |]),
("text", [t| String |]),
("oid", [t| Int32 |]),
("float4", [t| Float |]),
("float8", [t| Double |]),
("abstime", [t| LocalTime |]),
("reltime", [t| NominalDiffTime |]),
("tinterval", [t| DiffTime |]),
("bpchar", [t| String |]),
("varchar", [t| String |]),
("uuid", [t| String |]),
("date", [t| Day |]),
("time", [t| TimeOfDay |]),
("timestamp", [t| LocalTime |]),
("timestamptz", [t| ZonedTime |]),
("interval", [t| DiffTime |]),
("timetz", [t| ZonedTime |])
]
normalizeColumn :: String -> String
normalizeColumn :: String -> String
normalizeColumn = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
type Column = (PgAttribute, PgType)
notNull :: Column -> Bool
notNull :: Column -> Bool
notNull = PgAttribute -> Bool
Attr.attnotnull (PgAttribute -> Bool) -> (Column -> PgAttribute) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> PgAttribute
forall a b. (a, b) -> a
fst
getType :: Map String TypeQ
-> Column
-> Maybe (String, TypeQ)
getType :: Map String TypeQ -> Column -> Maybe (String, TypeQ)
getType mapFromSql :: Map String TypeQ
mapFromSql column :: Column
column@(pgAttr :: PgAttribute
pgAttr, pgTyp :: PgType
pgTyp) = do
TypeQ
typ <- (String -> Map String TypeQ -> Maybe TypeQ
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key Map String TypeQ
mapFromSql
Maybe TypeQ -> Maybe TypeQ -> Maybe TypeQ
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
String -> Map String TypeQ -> Maybe TypeQ
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key Map String TypeQ
mapFromSqlDefault)
(String, TypeQ) -> Maybe (String, TypeQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
normalizeColumn (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ PgAttribute -> String
Attr.attname PgAttribute
pgAttr,
TypeQ -> TypeQ
mayNull TypeQ
typ)
where key :: String
key = PgType -> String
Type.typname PgType
pgTyp
mayNull :: TypeQ -> TypeQ
mayNull typ :: TypeQ
typ = if Column -> Bool
notNull Column
column
then TypeQ
typ
else [t| Maybe $typ |]
relOidRelation :: Relation (String, String) Int32
relOidRelation :: Relation (String, String) Int32
relOidRelation = SimpleQuery (String, String) Int32
-> Relation (String, String) Int32
forall p r. SimpleQuery p r -> Relation p r
relation' (SimpleQuery (String, String) Int32
-> Relation (String, String) Int32)
-> SimpleQuery (String, String) Int32
-> Relation (String, String) Int32
forall a b. (a -> b) -> a -> b
$ do
Record Flat PgNamespace
nsp <- Relation () PgNamespace
-> Orderings Flat QueryCore (Record Flat PgNamespace)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () PgNamespace
pgNamespace
Record Flat PgClass
cls <- Relation () PgClass
-> Orderings Flat QueryCore (Record Flat PgClass)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () PgClass
pgClass
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgClass
cls Record Flat PgClass -> Pi PgClass Int32 -> Record Flat Int32
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgClass Int32
Class.relnamespace' Record Flat Int32 -> Record Flat Int32 -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat PgNamespace
nsp Record Flat PgNamespace
-> Pi PgNamespace Int32 -> Record Flat Int32
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgNamespace Int32
Namespace.oid'
(nspP :: PlaceHolders String
nspP, ()) <- (Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ())
forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder (\ph :: Record Flat String
ph -> Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgNamespace
nsp Record Flat PgNamespace
-> Pi PgNamespace String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgNamespace String
Namespace.nspname' Record Flat String -> Record Flat String -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
ph)
(relP :: PlaceHolders String
relP, ()) <- (Record Flat String -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders String, ())
forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder (\ph :: Record Flat String
ph -> Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgClass
cls Record Flat PgClass -> Pi PgClass String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgClass String
Class.relname' Record Flat String -> Record Flat String -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat String
ph)
(PlaceHolders (String, String), Record Flat Int32)
-> SimpleQuery (String, String) Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders String
nspP PlaceHolders String
-> PlaceHolders String -> PlaceHolders (String, String)
forall (p :: * -> *) a b.
ProductIsoApplicative p =>
p a -> p b -> p (a, b)
>< PlaceHolders String
relP, Record Flat PgClass
cls Record Flat PgClass -> Pi PgClass Int32 -> Record Flat Int32
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgClass Int32
Class.oid')
attributeRelation :: Relation (String, String) PgAttribute
attributeRelation :: Relation (String, String) PgAttribute
attributeRelation = SimpleQuery (String, String) PgAttribute
-> Relation (String, String) PgAttribute
forall p r. SimpleQuery p r -> Relation p r
relation' (SimpleQuery (String, String) PgAttribute
-> Relation (String, String) PgAttribute)
-> SimpleQuery (String, String) PgAttribute
-> Relation (String, String) PgAttribute
forall a b. (a -> b) -> a -> b
$ do
(ph :: PlaceHolders (String, String)
ph, reloid :: Record Flat Int32
reloid) <- Relation (String, String) Int32
-> SimpleQuery (String, String) Int32
forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query' Relation (String, String) Int32
relOidRelation
Record Flat PgAttribute
att <- Relation () PgAttribute
-> Orderings Flat QueryCore (Record Flat PgAttribute)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () PgAttribute
pgAttribute
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgAttribute
att Record Flat PgAttribute
-> Pi PgAttribute Int32 -> Record Flat Int32
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgAttribute Int32
Attr.attrelid' Record Flat Int32 -> Record Flat Int32 -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat Int32
reloid
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgAttribute
att Record Flat PgAttribute
-> Pi PgAttribute Int16 -> Record Flat Int16
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgAttribute Int16
Attr.attnum' Record Flat Int16 -> Record Flat Int16 -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.>. Int16 -> Record Flat Int16
forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value 0
(PlaceHolders (String, String), Record Flat PgAttribute)
-> SimpleQuery (String, String) PgAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders (String, String)
ph, Record Flat PgAttribute
att)
columnRelation :: Relation (String, String) Column
columnRelation :: Relation (String, String) Column
columnRelation = SimpleQuery (String, String) Column
-> Relation (String, String) Column
forall p r. SimpleQuery p r -> Relation p r
relation' (SimpleQuery (String, String) Column
-> Relation (String, String) Column)
-> SimpleQuery (String, String) Column
-> Relation (String, String) Column
forall a b. (a -> b) -> a -> b
$ do
(ph :: PlaceHolders (String, String)
ph, att :: Record Flat PgAttribute
att) <- Relation (String, String) PgAttribute
-> SimpleQuery (String, String) PgAttribute
forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query' Relation (String, String) PgAttribute
attributeRelation
Record Flat PgType
typ <- Relation () PgType -> Orderings Flat QueryCore (Record Flat PgType)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () PgType
pgType
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgAttribute
att Record Flat PgAttribute
-> Pi PgAttribute Int32 -> Record Flat Int32
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgAttribute Int32
Attr.atttypid' Record Flat Int32 -> Record Flat Int32 -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat PgType
typ Record Flat PgType -> Pi PgType Int32 -> Record Flat Int32
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgType Int32
Type.oid'
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgType
typ Record Flat PgType -> Pi PgType Char -> Record Flat Char
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgType Char
Type.typtype' Record Flat Char -> Record Flat Char -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Char -> Record Flat Char
forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value 'b'
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Predicate Flat -> Predicate Flat
forall c.
OperatorContext c =>
Record c (Maybe Bool) -> Record c (Maybe Bool)
not' (Predicate Flat -> Predicate Flat)
-> Predicate Flat -> Predicate Flat
forall a b. (a -> b) -> a -> b
$ Record Flat PgType
typ Record Flat PgType -> Pi PgType Char -> Record Flat Char
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgType Char
Type.typcategory' Record Flat Char -> RecordList (Record Flat) Char -> Predicate Flat
forall c t.
OperatorContext c =>
Record c t -> RecordList (Record c) t -> Record c (Maybe Bool)
`in'`
String -> RecordList (Record Flat) Char
forall t c.
(LiteralSQL t, OperatorContext c) =>
[t] -> RecordList (Record c) t
values
[ 'C'
, 'P'
, 'X'
]
Record Flat Int16 -> Orderings Flat QueryCore ()
forall (m :: * -> *) c t. Monad m => Record c t -> Orderings c m ()
asc (Record Flat Int16 -> Orderings Flat QueryCore ())
-> Record Flat Int16 -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgAttribute
att Record Flat PgAttribute
-> Pi PgAttribute Int16 -> Record Flat Int16
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgAttribute Int16
Attr.attnum'
(PlaceHolders (String, String), Record Flat Column)
-> SimpleQuery (String, String) Column
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders (String, String)
ph, Record Flat PgAttribute
att Record Flat PgAttribute -> Record Flat PgType -> Record Flat Column
forall (p :: * -> *) a b.
ProductIsoApplicative p =>
p a -> p b -> p (a, b)
>< Record Flat PgType
typ)
columnQuerySQL :: Query (String, String) Column
columnQuerySQL :: Query (String, String) Column
columnQuerySQL = Relation (String, String) Column -> Query (String, String) Column
forall p r. Relation p r -> Query p r
relationalQuery Relation (String, String) Column
columnRelation
primaryKeyLengthRelation :: Relation (String, String) Int32
primaryKeyLengthRelation :: Relation (String, String) Int32
primaryKeyLengthRelation = SimpleQuery (String, String) Int32
-> Relation (String, String) Int32
forall p r. SimpleQuery p r -> Relation p r
relation' (SimpleQuery (String, String) Int32
-> Relation (String, String) Int32)
-> SimpleQuery (String, String) Int32
-> Relation (String, String) Int32
forall a b. (a -> b) -> a -> b
$ do
(ph :: PlaceHolders (String, String)
ph, reloid :: Record Flat Int32
reloid) <- Relation (String, String) Int32
-> SimpleQuery (String, String) Int32
forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query' Relation (String, String) Int32
relOidRelation
Record Flat PgConstraint
con <- Relation () PgConstraint
-> Orderings Flat QueryCore (Record Flat PgConstraint)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () PgConstraint
pgConstraint
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgConstraint
con Record Flat PgConstraint
-> Pi PgConstraint Int32 -> Record Flat Int32
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgConstraint Int32
Constraint.conrelid' Record Flat Int32 -> Record Flat Int32 -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat Int32
reloid
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgConstraint
con Record Flat PgConstraint
-> Pi PgConstraint Char -> Record Flat Char
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgConstraint Char
Constraint.contype' Record Flat Char -> Record Flat Char -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Char -> Record Flat Char
forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value 'p'
(PlaceHolders (String, String), Record Flat Int32)
-> SimpleQuery (String, String) Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders (String, String)
ph, String -> Record Flat Int32
forall c t. SqlContext c => String -> Record c t
unsafeProjectSql "array_length (conkey, 1)")
primaryKeyLengthQuerySQL :: Query (String, String) Int32
primaryKeyLengthQuerySQL :: Query (String, String) Int32
primaryKeyLengthQuerySQL = Relation (String, String) Int32 -> Query (String, String) Int32
forall p r. Relation p r -> Query p r
relationalQuery Relation (String, String) Int32
primaryKeyLengthRelation
constraintColRelation :: Int32 -> Relation () (PgConstraint, (Int16, Int32))
constraintColRelation :: Int32 -> Relation () (PgConstraint, (Int16, Int32))
constraintColRelation i :: Int32
i = QuerySimple (Record Flat (PgConstraint, (Int16, Int32)))
-> Relation () (PgConstraint, (Int16, Int32))
forall r. QuerySimple (Record Flat r) -> Relation () r
relation (QuerySimple (Record Flat (PgConstraint, (Int16, Int32)))
-> Relation () (PgConstraint, (Int16, Int32)))
-> QuerySimple (Record Flat (PgConstraint, (Int16, Int32)))
-> Relation () (PgConstraint, (Int16, Int32))
forall a b. (a -> b) -> a -> b
$ do
Record Flat PgConstraint
con <- Relation () PgConstraint
-> Orderings Flat QueryCore (Record Flat PgConstraint)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () PgConstraint
pgConstraint
Record Flat (PgConstraint, (Int16, Int32))
-> QuerySimple (Record Flat (PgConstraint, (Int16, Int32)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Record Flat (PgConstraint, (Int16, Int32))
-> QuerySimple (Record Flat (PgConstraint, (Int16, Int32))))
-> Record Flat (PgConstraint, (Int16, Int32))
-> QuerySimple (Record Flat (PgConstraint, (Int16, Int32)))
forall a b. (a -> b) -> a -> b
$ Record Flat PgConstraint
con Record Flat PgConstraint
-> Record Flat (Int16, Int32)
-> Record Flat (PgConstraint, (Int16, Int32))
forall (p :: * -> *) a b.
ProductIsoApplicative p =>
p a -> p b -> p (a, b)
>< (String -> Record Flat Int16
forall c t. SqlContext c => String -> Record c t
unsafeProjectSql ("conkey[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ "]") Record Flat Int16
-> Record Flat Int32 -> Record Flat (Int16, Int32)
forall (p :: * -> *) a b.
ProductIsoApplicative p =>
p a -> p b -> p (a, b)
>< Int32 -> Record Flat Int32
forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value Int32
i)
constraintColExpandRelation :: Int32 -> Relation () (PgConstraint, (Int16, Int32))
constraintColExpandRelation :: Int32 -> Relation () (PgConstraint, (Int16, Int32))
constraintColExpandRelation n :: Int32
n =
(Relation () (PgConstraint, (Int16, Int32))
-> Relation () (PgConstraint, (Int16, Int32))
-> Relation () (PgConstraint, (Int16, Int32)))
-> [Relation () (PgConstraint, (Int16, Int32))]
-> Relation () (PgConstraint, (Int16, Int32))
forall a. (a -> a -> a) -> [a] -> a
foldl1' Relation () (PgConstraint, (Int16, Int32))
-> Relation () (PgConstraint, (Int16, Int32))
-> Relation () (PgConstraint, (Int16, Int32))
forall a. Relation () a -> Relation () a -> Relation () a
union [Int32 -> Relation () (PgConstraint, (Int16, Int32))
constraintColRelation Int32
i | Int32
i <- [1..Int32
n] ]
primaryKeyRelation :: Int32 -> Relation (String, String) String
primaryKeyRelation :: Int32 -> Relation (String, String) String
primaryKeyRelation n :: Int32
n = SimpleQuery (String, String) String
-> Relation (String, String) String
forall p r. SimpleQuery p r -> Relation p r
relation' (SimpleQuery (String, String) String
-> Relation (String, String) String)
-> SimpleQuery (String, String) String
-> Relation (String, String) String
forall a b. (a -> b) -> a -> b
$ do
(ph :: PlaceHolders (String, String)
ph, att :: Record Flat PgAttribute
att) <- Relation (String, String) PgAttribute
-> SimpleQuery (String, String) PgAttribute
forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query' Relation (String, String) PgAttribute
attributeRelation
Record Flat (PgConstraint, (Int16, Int32))
conEx <- Relation () (PgConstraint, (Int16, Int32))
-> QuerySimple (Record Flat (PgConstraint, (Int16, Int32)))
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query (Int32 -> Relation () (PgConstraint, (Int16, Int32))
constraintColExpandRelation Int32
n)
let con :: Record Flat PgConstraint
con = Record Flat (PgConstraint, (Int16, Int32))
conEx Record Flat (PgConstraint, (Int16, Int32))
-> Pi (PgConstraint, (Int16, Int32)) PgConstraint
-> Record Flat PgConstraint
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi (PgConstraint, (Int16, Int32)) PgConstraint
forall a b. (PersistableWidth a, PersistableWidth b) => Pi (a, b) a
fst'
col' :: Record Flat (Int16, Int32)
col' = Record Flat (PgConstraint, (Int16, Int32))
conEx Record Flat (PgConstraint, (Int16, Int32))
-> Pi (PgConstraint, (Int16, Int32)) (Int16, Int32)
-> Record Flat (Int16, Int32)
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi (PgConstraint, (Int16, Int32)) (Int16, Int32)
forall a b. (PersistableWidth a, PersistableWidth b) => Pi (a, b) b
snd'
keyIx :: Record Flat Int16
keyIx = Record Flat (Int16, Int32)
col' Record Flat (Int16, Int32)
-> Pi (Int16, Int32) Int16 -> Record Flat Int16
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi (Int16, Int32) Int16
forall a b. (PersistableWidth a, PersistableWidth b) => Pi (a, b) a
fst'
keyN :: Record Flat Int32
keyN = Record Flat (Int16, Int32)
col' Record Flat (Int16, Int32)
-> Pi (Int16, Int32) Int32 -> Record Flat Int32
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi (Int16, Int32) Int32
forall a b. (PersistableWidth a, PersistableWidth b) => Pi (a, b) b
snd'
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgConstraint
con Record Flat PgConstraint
-> Pi PgConstraint Int32 -> Record Flat Int32
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgConstraint Int32
Constraint.conrelid' Record Flat Int32 -> Record Flat Int32 -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat PgAttribute
att Record Flat PgAttribute
-> Pi PgAttribute Int32 -> Record Flat Int32
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgAttribute Int32
Attr.attrelid'
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat Int16
keyIx Record Flat Int16 -> Record Flat Int16 -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat PgAttribute
att Record Flat PgAttribute
-> Pi PgAttribute Int16 -> Record Flat Int16
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgAttribute Int16
Attr.attnum'
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat PgConstraint
con Record Flat PgConstraint
-> Pi PgConstraint Char -> Record Flat Char
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgConstraint Char
Constraint.contype' Record Flat Char -> Record Flat Char -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Char -> Record Flat Char
forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value 'p'
Record Flat Int32 -> Orderings Flat QueryCore ()
forall (m :: * -> *) c t. Monad m => Record c t -> Orderings c m ()
asc (Record Flat Int32 -> Orderings Flat QueryCore ())
-> Record Flat Int32 -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat Int32
keyN
(PlaceHolders (String, String), Record Flat String)
-> SimpleQuery (String, String) String
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders (String, String)
ph, Record Flat PgAttribute
att Record Flat PgAttribute
-> Pi PgAttribute String -> Record Flat String
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Pi PgAttribute String
Attr.attname')
primaryKeyQuerySQL :: Int32 -> Query (String, String) String
primaryKeyQuerySQL :: Int32 -> Query (String, String) String
primaryKeyQuerySQL = Relation (String, String) String -> Query (String, String) String
forall p r. Relation p r -> Query p r
relationalQuery (Relation (String, String) String -> Query (String, String) String)
-> (Int32 -> Relation (String, String) String)
-> Int32
-> Query (String, String) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Relation (String, String) String
primaryKeyRelation