{-# LANGUAGE
ConstraintKinds
, DeriveGeneric
, FlexibleContexts
, FlexibleInstances
, GADTs
, GeneralizedNewtypeDeriving
, LambdaCase
, MultiParamTypeClasses
, OverloadedStrings
, StandaloneDeriving
, TypeFamilies
, TypeInType
, TypeOperators
, RankNTypes
, UndecidableInstances
#-}
module Squeal.PostgreSQL.Query
(
Query (UnsafeQuery, renderQuery)
, union
, unionAll
, intersect
, intersectAll
, except
, exceptAll
, select
, selectDistinct
, selectStar
, selectDistinctStar
, selectDotStar
, selectDistinctDotStar
, values
, values_
, TableExpression (..)
, renderTableExpression
, from
, where_
, groupBy
, having
, orderBy
, limit
, offset
, PGjson_each
, PGjsonb_each
, jsonEach
, jsonbEach
, jsonEachAsText
, jsonbEachAsText
, jsonPopulateRecordAs
, jsonbPopulateRecordAs
, jsonPopulateRecordSetAs
, jsonbPopulateRecordSetAs
, jsonToRecordAs
, jsonbToRecordAs
, jsonToRecordSetAs
, jsonbToRecordSetAs
, FromClause (..)
, table
, subquery
, view
, crossJoin
, innerJoin
, leftOuterJoin
, rightOuterJoin
, fullOuterJoin
, By (By1, By2)
, renderBy
, GroupByClause (NoGroups, Group)
, renderGroupByClause
, HavingClause (NoHaving, Having)
, renderHavingClause
, SortExpression (..)
, renderSortExpression
) where
import Control.DeepSeq
import Data.ByteString (ByteString)
import Data.Monoid hiding (All)
import Data.String
import Data.Word
import Generics.SOP hiding (from)
import GHC.TypeLits
import qualified GHC.Generics as GHC
import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Schema
newtype Query
(schema :: SchemaType)
(params :: [NullityType])
(columns :: RelationType)
= UnsafeQuery { renderQuery :: ByteString }
deriving (GHC.Generic,Show,Eq,Ord,NFData)
instance RenderSQL (Query schema params columns) where renderSQL = renderQuery
union
:: Query schema params columns
-> Query schema params columns
-> Query schema params columns
q1 `union` q2 = UnsafeQuery $
parenthesized (renderQuery q1)
<+> "UNION"
<+> parenthesized (renderQuery q2)
unionAll
:: Query schema params columns
-> Query schema params columns
-> Query schema params columns
q1 `unionAll` q2 = UnsafeQuery $
parenthesized (renderQuery q1)
<+> "UNION" <+> "ALL"
<+> parenthesized (renderQuery q2)
intersect
:: Query schema params columns
-> Query schema params columns
-> Query schema params columns
q1 `intersect` q2 = UnsafeQuery $
parenthesized (renderQuery q1)
<+> "INTERSECT"
<+> parenthesized (renderQuery q2)
intersectAll
:: Query schema params columns
-> Query schema params columns
-> Query schema params columns
q1 `intersectAll` q2 = UnsafeQuery $
parenthesized (renderQuery q1)
<+> "INTERSECT" <+> "ALL"
<+> parenthesized (renderQuery q2)
except
:: Query schema params columns
-> Query schema params columns
-> Query schema params columns
q1 `except` q2 = UnsafeQuery $
parenthesized (renderQuery q1)
<+> "EXCEPT"
<+> parenthesized (renderQuery q2)
exceptAll
:: Query schema params columns
-> Query schema params columns
-> Query schema params columns
q1 `exceptAll` q2 = UnsafeQuery $
parenthesized (renderQuery q1)
<+> "EXCEPT" <+> "ALL"
<+> parenthesized (renderQuery q2)
select
:: SListI columns
=> NP (Aliased (Expression schema relations grouping params)) (column ': columns)
-> TableExpression schema params relations grouping
-> Query schema params (column ': columns)
select list rels = UnsafeQuery $
"SELECT"
<+> renderCommaSeparated (renderAliasedAs renderExpression) list
<+> renderTableExpression rels
selectDistinct
:: SListI columns
=> NP (Aliased (Expression schema relations 'Ungrouped params)) (column ': columns)
-> TableExpression schema params relations 'Ungrouped
-> Query schema params (column ': columns)
selectDistinct list rels = UnsafeQuery $
"SELECT DISTINCT"
<+> renderCommaSeparated (renderAliasedAs renderExpression) list
<+> renderTableExpression rels
selectStar
:: HasUnique relation relations columns
=> TableExpression schema params relations 'Ungrouped
-> Query schema params columns
selectStar rels = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression rels
selectDistinctStar
:: HasUnique relation relations columns
=> TableExpression schema params relations 'Ungrouped
-> Query schema params columns
selectDistinctStar rels = UnsafeQuery $
"SELECT DISTINCT" <+> "*" <+> renderTableExpression rels
selectDotStar
:: Has relation relations columns
=> Alias relation
-> TableExpression schema params relations 'Ungrouped
-> Query schema params columns
selectDotStar rel relations = UnsafeQuery $
"SELECT" <+> renderAlias rel <> ".*" <+> renderTableExpression relations
selectDistinctDotStar
:: Has relation relations columns
=> Alias relation
-> TableExpression schema params relations 'Ungrouped
-> Query schema params columns
selectDistinctDotStar rel relations = UnsafeQuery $
"SELECT DISTINCT" <+> renderAlias rel <> ".*"
<+> renderTableExpression relations
values
:: SListI cols
=> NP (Aliased (Expression schema '[] 'Ungrouped params)) cols
-> [NP (Aliased (Expression schema '[] 'Ungrouped params)) cols]
-> Query schema params cols
values rw rws = UnsafeQuery $ "SELECT * FROM"
<+> parenthesized (
"VALUES"
<+> commaSeparated
( parenthesized
. renderCommaSeparated renderValuePart <$> rw:rws )
) <+> "AS t"
<+> parenthesized (renderCommaSeparated renderAliasPart rw)
where
renderAliasPart, renderValuePart
:: Aliased (Expression schema '[] 'Ungrouped params) ty -> ByteString
renderAliasPart (_ `As` name) = renderAlias name
renderValuePart (value `As` _) = renderExpression value
values_
:: SListI cols
=> NP (Aliased (Expression schema '[] 'Ungrouped params)) cols
-> Query schema params cols
values_ rw = values rw []
data TableExpression
(schema :: SchemaType)
(params :: [NullityType])
(relations :: RelationsType)
(grouping :: Grouping)
= TableExpression
{ fromClause :: FromClause schema params relations
, whereClause :: [Condition schema relations 'Ungrouped params]
, groupByClause :: GroupByClause relations grouping
, havingClause :: HavingClause schema relations grouping params
, orderByClause :: [SortExpression schema relations grouping params]
, limitClause :: [Word64]
, offsetClause :: [Word64]
}
renderTableExpression
:: TableExpression schema params relations grouping
-> ByteString
renderTableExpression
(TableExpression frm' whs' grps' hvs' srts' lims' offs') = mconcat
[ "FROM ", renderFromClause frm'
, renderWheres whs'
, renderGroupByClause grps'
, renderHavingClause hvs'
, renderOrderByClause srts'
, renderLimits lims'
, renderOffsets offs'
]
where
renderWheres = \case
[] -> ""
wh:[] -> " WHERE" <+> renderExpression wh
wh:whs -> " WHERE" <+> renderExpression (foldr (.&&) wh whs)
renderOrderByClause = \case
[] -> ""
srts -> " ORDER BY"
<+> commaSeparated (renderSortExpression <$> srts)
renderLimits = \case
[] -> ""
lims -> " LIMIT" <+> fromString (show (minimum lims))
renderOffsets = \case
[] -> ""
offs -> " OFFSET" <+> fromString (show (sum offs))
from
:: FromClause schema params relations
-> TableExpression schema params relations 'Ungrouped
from rels = TableExpression rels [] NoGroups NoHaving [] [] []
where_
:: Condition schema relations 'Ungrouped params
-> TableExpression schema params relations grouping
-> TableExpression schema params relations grouping
where_ wh rels = rels {whereClause = wh : whereClause rels}
groupBy
:: SListI bys
=> NP (By relations) bys
-> TableExpression schema params relations 'Ungrouped
-> TableExpression schema params relations ('Grouped bys)
groupBy bys rels = TableExpression
{ fromClause = fromClause rels
, whereClause = whereClause rels
, groupByClause = Group bys
, havingClause = Having []
, orderByClause = []
, limitClause = limitClause rels
, offsetClause = offsetClause rels
}
having
:: Condition schema relations ('Grouped bys) params
-> TableExpression schema params relations ('Grouped bys)
-> TableExpression schema params relations ('Grouped bys)
having hv rels = rels
{ havingClause = case havingClause rels of Having hvs -> Having (hv:hvs) }
orderBy
:: [SortExpression schema relations grouping params]
-> TableExpression schema params relations grouping
-> TableExpression schema params relations grouping
orderBy srts rels = rels {orderByClause = orderByClause rels ++ srts}
limit
:: Word64
-> TableExpression schema params relations grouping
-> TableExpression schema params relations grouping
limit lim rels = rels {limitClause = lim : limitClause rels}
offset
:: Word64
-> TableExpression schema params relations grouping
-> TableExpression schema params relations grouping
offset off rels = rels {offsetClause = off : offsetClause rels}
type PGjson_each_variant val tab =
'[ tab ::: '[ "key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull val ] ]
type PGjson_each tab = PGjson_each_variant 'PGjson tab
type PGjsonb_each tab = PGjson_each_variant 'PGjsonb tab
type PGjson_each_text tab = PGjson_each_variant 'PGtext tab
type PGjsonb_each_text tab = PGjson_each_variant 'PGtext tab
unsafeAliasedFromClauseExpression
:: Aliased (Expression schema' relations' grouping' params') ty'
-> FromClause schema params relations
unsafeAliasedFromClauseExpression aliasedExpr = UnsafeFromClause
(renderAliasedAs renderExpression aliasedExpr)
jsonEach
:: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjson)
-> FromClause schema params (PGjson_each tab)
jsonEach (As jexpr jname) = unsafeAliasedFromClauseExpression
(As (unsafeFunction "json_each" jexpr) jname)
jsonbEach
:: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjsonb)
-> FromClause schema params (PGjsonb_each tab)
jsonbEach (As jexpr jname) = unsafeAliasedFromClauseExpression
(As (unsafeFunction "jsonb_each" jexpr) jname)
jsonEachAsText
:: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjson)
-> FromClause schema params (PGjson_each_text tab)
jsonEachAsText (As jexpr jname) = unsafeAliasedFromClauseExpression
(As (unsafeFunction "json_each" jexpr) jname)
jsonbEachAsText
:: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjsonb)
-> FromClause schema params (PGjsonb_each_text tab)
jsonbEachAsText (As jexpr jname) = unsafeAliasedFromClauseExpression
(As (unsafeFunction "jsonb_each" jexpr) jname)
nullRow
:: Has tab schema ('Table table)
=> Alias tab
-> Expression schema relations grouping params
(nullity ('PGcomposite (RelationToRowType (TableToRelation table))))
nullRow tab = UnsafeExpression ("null::"<+>renderAlias tab)
jsonPopulateRecordAs
:: (KnownSymbol alias, Has tab schema ('Table table))
=> Alias tab
-> Expression schema '[] 'Ungrouped params (nullity 'PGjson)
-> Alias alias
-> FromClause schema params '[alias ::: TableToRelation table]
jsonPopulateRecordAs tableName expr alias = unsafeAliasedFromClauseExpression
(unsafeVariadicFunction "json_populate_record"
(nullRow tableName :* expr :* Nil) `As` alias)
jsonbPopulateRecordAs
:: (KnownSymbol alias, Has tab schema ('Table table))
=> Alias tab
-> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)
-> Alias alias
-> FromClause schema params '[alias ::: TableToRelation table]
jsonbPopulateRecordAs tableName expr alias = unsafeAliasedFromClauseExpression
(unsafeVariadicFunction "jsonb_populate_record"
(nullRow tableName :* expr :* Nil) `As` alias)
jsonPopulateRecordSetAs
:: (KnownSymbol alias, Has tab schema ('Table table))
=> Alias tab
-> Expression schema '[] 'Ungrouped params (nullity 'PGjson)
-> Alias alias
-> FromClause schema params '[alias ::: TableToRelation table]
jsonPopulateRecordSetAs tableName expr alias = unsafeAliasedFromClauseExpression
(unsafeVariadicFunction "json_populate_record_set"
(nullRow tableName :* expr :* Nil) `As` alias)
jsonbPopulateRecordSetAs
:: (KnownSymbol alias, Has tab schema ('Table table))
=> Alias tab
-> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)
-> Alias alias
-> FromClause schema params '[alias ::: TableToRelation table]
jsonbPopulateRecordSetAs tableName expr alias = unsafeAliasedFromClauseExpression
(unsafeVariadicFunction "jsonb_populate_record_set"
(nullRow tableName :* expr :* Nil) `As` alias)
renderTableTypeExpression
:: All Top types
=> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)
-> ByteString
renderTableTypeExpression (hc `As` tab)
= (renderAlias tab <>)
. parenthesized
. commaSeparated
. flip appEndo []
. hcfoldMap
(Proxy :: Proxy Top)
(\(ty `As` name) -> Endo
((renderAlias name <+> renderTypeExpression ty):))
$ hc
unsafeTableAliasedFromClauseExpression
:: All Top types
=> Expression schema' relations' grouping' params' ty'
-> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)
-> FromClause schema params '[alias ::: types]
unsafeTableAliasedFromClauseExpression expr types = UnsafeFromClause
(renderExpression expr
<+> "AS"
<+> renderTableTypeExpression types)
jsonToRecordAs
:: All Top types
=> Expression schema '[] 'Ungrouped params (nullity 'PGjson)
-> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)
-> FromClause schema params '[tab ::: types]
jsonToRecordAs expr types =
unsafeTableAliasedFromClauseExpression
(unsafeFunction "json_to_record" expr)
types
jsonbToRecordAs
:: All Top types
=> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)
-> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)
-> FromClause schema params '[tab ::: types]
jsonbToRecordAs expr types =
unsafeTableAliasedFromClauseExpression
(unsafeFunction "jsonb_to_record" expr)
types
jsonToRecordSetAs
:: All Top types
=> Expression schema '[] 'Ungrouped params (nullity 'PGjson)
-> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)
-> FromClause schema params '[tab ::: types]
jsonToRecordSetAs expr types =
unsafeTableAliasedFromClauseExpression
(unsafeFunction "json_to_recordset" expr)
types
jsonbToRecordSetAs
:: All Top types
=> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)
-> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)
-> FromClause schema params '[tab ::: types]
jsonbToRecordSetAs expr types =
unsafeTableAliasedFromClauseExpression
(unsafeFunction "jsonb_to_recordset" expr)
types
newtype FromClause schema params relations
= UnsafeFromClause { renderFromClause :: ByteString }
deriving (GHC.Generic,Show,Eq,Ord,NFData)
table
:: Has tab schema ('Table table)
=> Aliased Alias (alias ::: tab)
-> FromClause schema params '[alias ::: TableToRelation table]
table (tab `As` alias) = UnsafeFromClause $
renderAlias tab <+> "AS" <+> renderAlias alias
subquery
:: Aliased (Query schema params) rel
-> FromClause schema params '[rel]
subquery = UnsafeFromClause . renderAliasedAs (parenthesized . renderQuery)
view
:: Has view schema ('View rel)
=> Aliased Alias (alias ::: view)
-> FromClause schema params '[alias ::: rel]
view (vw `As` alias) = UnsafeFromClause $
renderAlias vw <+> "AS" <+> renderAlias alias
crossJoin
:: FromClause schema params right
-> FromClause schema params left
-> FromClause schema params (Join left right)
crossJoin right left = UnsafeFromClause $
renderFromClause left <+> "CROSS JOIN" <+> renderFromClause right
innerJoin
:: FromClause schema params right
-> Condition schema (Join left right) 'Ungrouped params
-> FromClause schema params left
-> FromClause schema params (Join left right)
innerJoin right on left = UnsafeFromClause $
renderFromClause left <+> "INNER JOIN" <+> renderFromClause right
<+> "ON" <+> renderExpression on
leftOuterJoin
:: FromClause schema params right
-> Condition schema (Join left right) 'Ungrouped params
-> FromClause schema params left
-> FromClause schema params (Join left (NullifyRelations right))
leftOuterJoin right on left = UnsafeFromClause $
renderFromClause left <+> "LEFT OUTER JOIN" <+> renderFromClause right
<+> "ON" <+> renderExpression on
rightOuterJoin
:: FromClause schema params right
-> Condition schema (Join left right) 'Ungrouped params
-> FromClause schema params left
-> FromClause schema params (Join (NullifyRelations left) right)
rightOuterJoin right on left = UnsafeFromClause $
renderFromClause left <+> "RIGHT OUTER JOIN" <+> renderFromClause right
<+> "ON" <+> renderExpression on
fullOuterJoin
:: FromClause schema params right
-> Condition schema (Join left right) 'Ungrouped params
-> FromClause schema params left
-> FromClause schema params
(Join (NullifyRelations left) (NullifyRelations right))
fullOuterJoin right on left = UnsafeFromClause $
renderFromClause left <+> "FULL OUTER JOIN" <+> renderFromClause right
<+> "ON" <+> renderExpression on
data By
(relations :: RelationsType)
(by :: (Symbol,Symbol)) where
By1
:: (HasUnique relation relations columns, Has column columns ty)
=> Alias column
-> By relations '(relation, column)
By2
:: (Has relation relations columns, Has column columns ty)
=> Alias relation
-> Alias column
-> By relations '(relation, column)
deriving instance Show (By relations by)
deriving instance Eq (By relations by)
deriving instance Ord (By relations by)
instance (HasUnique rel rels cols, Has col cols ty, by ~ '(rel, col))
=> IsLabel col (By rels by) where fromLabel = By1 fromLabel
instance (HasUnique rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)])
=> IsLabel col (NP (By rels) bys) where fromLabel = By1 fromLabel :* Nil
instance (Has rel rels cols, Has col cols ty, by ~ '(rel, col))
=> IsQualified rel col (By rels by) where (!) = By2
instance (Has rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)])
=> IsQualified rel col (NP (By rels) bys) where
rel ! col = By2 rel col :* Nil
renderBy :: By relations by -> ByteString
renderBy = \case
By1 column -> renderAlias column
By2 rel column -> renderAlias rel <> "." <> renderAlias column
data GroupByClause relations grouping where
NoGroups :: GroupByClause relations 'Ungrouped
Group
:: SListI bys
=> NP (By relations) bys
-> GroupByClause relations ('Grouped bys)
renderGroupByClause :: GroupByClause relations grouping -> ByteString
renderGroupByClause = \case
NoGroups -> ""
Group Nil -> ""
Group bys -> " GROUP BY" <+> renderCommaSeparated renderBy bys
data HavingClause schema relations grouping params where
NoHaving :: HavingClause schema relations 'Ungrouped params
Having
:: [Condition schema relations ('Grouped bys) params]
-> HavingClause schema relations ('Grouped bys) params
deriving instance Show (HavingClause schema relations grouping params)
deriving instance Eq (HavingClause schema relations grouping params)
deriving instance Ord (HavingClause schema relations grouping params)
renderHavingClause :: HavingClause schema relations grouping params -> ByteString
renderHavingClause = \case
NoHaving -> ""
Having [] -> ""
Having conditions ->
" HAVING" <+> commaSeparated (renderExpression <$> conditions)
data SortExpression schema relations grouping params where
Asc
:: Expression schema relations grouping params ('NotNull ty)
-> SortExpression schema relations grouping params
Desc
:: Expression schema relations grouping params ('NotNull ty)
-> SortExpression schema relations grouping params
AscNullsFirst
:: Expression schema relations grouping params ('Null ty)
-> SortExpression schema relations grouping params
AscNullsLast
:: Expression schema relations grouping params ('Null ty)
-> SortExpression schema relations grouping params
DescNullsFirst
:: Expression schema relations grouping params ('Null ty)
-> SortExpression schema relations grouping params
DescNullsLast
:: Expression schema relations grouping params ('Null ty)
-> SortExpression schema relations grouping params
deriving instance Show (SortExpression schema relations grouping params)
renderSortExpression :: SortExpression schema relations grouping params -> ByteString
renderSortExpression = \case
Asc expression -> renderExpression expression <+> "ASC"
Desc expression -> renderExpression expression <+> "DESC"
AscNullsFirst expression -> renderExpression expression
<+> "ASC NULLS FIRST"
DescNullsFirst expression -> renderExpression expression
<+> "DESC NULLS FIRST"
AscNullsLast expression -> renderExpression expression <+> "ASC NULLS LAST"
DescNullsLast expression -> renderExpression expression <+> "DESC NULLS LAST"