@@ -1,14 +1,13 @@
11{-|
22Module: Squeal.PostgreSQL.Expression
33Description: Squeal expressions
4−Copyright: (c) Eitan Chatav, 2017
4+Copyright: (c) Eitan Chatav, 2019
55Maintainer: eitan@morphism.tech
66Stability: experimental
77
88Squeal expressions are the atoms used to build statements.
99-}
1010
11−{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
1211{-# LANGUAGE
1312 AllowAmbiguousTypes
1413 , ConstraintKinds
@@ -34,358 +33,214 @@ Squeal expressions are the atoms used to build statements.
3433module Squeal.PostgreSQL.Expression
3534 ( -- * Expression
3635 Expression (..)
36+ , Expr
37+ , type (-->)
38+ , FunctionDB
39+ , unsafeFunction
40+ , function
41+ , unsafeLeftOp
42+ , leftOp
43+ , unsafeRightOp
44+ , rightOp
3745 , Operator
38− , (:-->)
39− , HasParameter (parameter)
40− , param
41− -- ** Null
42− , null_
43− , notNull
44− , coalesce
45− , fromNull
46− , isNull
47− , isNotNull
48− , matchNull
49− , nullIf
50− -- ** Collections
51− , array
52− , cardinality
53− , index
54− , row
55− , field
56− -- ** Functions
46+ , OperatorDB
5747 , unsafeBinaryOp
58− , unsafeUnaryOpL
59− , unsafeFunction
60− , unsafeVariadicFunction
61− , atan2_
62− , cast
63− , quot_
64− , rem_
65− , trunc
66− , round_
67− , ceiling_
68− , greatest
69− , least
70− -- ** Conditions
71− , true
72− , false
73− , not_
74− , (.&&)
75− , (.||)
76− , Condition
77− , caseWhenThenElse
78− , ifThenElse
79− , (.==)
80− , (./=)
81− , (.>=)
82− , (.<)
83− , (.<=)
84− , (.>)
85− , between
86− , notBetween
87− , betweenSymmetric
88− , notBetweenSymmetric
89− , isDistinctFrom
90− , isNotDistinctFrom
91− , isTrue
92− , isNotTrue
93− , isFalse
94− , isNotFalse
95− , isUnknown
96− , isNotUnknown
97− -- ** Time
98− , currentDate
99− , currentTime
100− , currentTimestamp
101− , localTime
102− , localTimestamp
103− , TimeOp (..)
104− , makeDate
105− , makeTime
106− , makeTimestamp
107− , makeTimestamptz
108− -- ** Text
109− , lower
110− , upper
111− , charLength
112− , like
113− , ilike
114− -- ** Json
115− -- *** Json and Jsonb operators
116− , (.->)
117− , (.->>)
118− , (.#>)
119− , (.#>>)
120− -- *** Jsonb operators
121− , (.@>)
122− , (.<@)
123− , (.?)
124− , (.?|)
125− , (.?&)
126− , (.-.)
127− , (#-.)
128− -- *** Functions
129− , jsonLit
130− , jsonbLit
131− , toJson
132− , toJsonb
133− , arrayToJson
134− , rowToJson
135− , jsonBuildArray
136− , jsonbBuildArray
137− , jsonBuildObject
138− , jsonbBuildObject
139− , jsonObject
140− , jsonbObject
141− , jsonZipObject
142− , jsonbZipObject
143− , jsonArrayLength
144− , jsonbArrayLength
145− , jsonExtractPath
146− , jsonbExtractPath
147− , jsonExtractPathAsText
148− , jsonbExtractPathAsText
149− , jsonTypeof
150− , jsonbTypeof
151− , jsonStripNulls
152− , jsonbStripNulls
153− , jsonbSet
154− , jsonbInsert
155− , jsonbPretty
156− -- ** Text Search
157− , (@@)
158− , (.&)
159− , (.|)
160− , (.!)
161− , (<->)
162− -- ** Aggregation
163− , Aggregate (..)
164− , Distinction (..)
165− , PGAvg
166− -- * Window Functions
167− , WindowDefinition (..)
168− , partitionBy
169− , WindowFunction (..)
170− , rank
171− , rowNumber
172− , denseRank
173− , percentRank
174− , cumeDist
175− , ntile
176− , lag
177− , lead
178− , firstValue
179− , lastValue
180− , nthValue
181− -- * Sorting
182− , SortExpression (..)
183− , OrderBy (..)
184− -- * Types
185− , TypeExpression (..)
186− , PGTyped (..)
187− , typedef
188− , typetable
189− , typeview
190− , bool
191− , int2
192− , smallint
193− , int4
194− , int
195− , integer
196− , int8
197− , bigint
198− , numeric
199− , float4
200− , real
201− , float8
202− , doublePrecision
203− , money
204− , text
205− , char
206− , character
207− , varchar
208− , characterVarying
209− , bytea
210− , timestamp
211− , timestampWithTimeZone
212− , date
213− , time
214− , timeWithTimeZone
215− , interval
216− , uuid
217− , inet
218− , json
219− , jsonb
220− , vararray
221− , fixarray
222− , tsvector
223− , tsquery
224− , arrayToTSvector
225− , tsvectorLength
226− , numnode
227− , plainToTSquery
228− , phraseToTSquery
229− , websearchToTSquery
230− , queryTree
231− , toTSquery
232− , toTSvector
48+ , binaryOp
49+ , FunctionVar
50+ , unsafeFunctionVar
51+ , type (--->)
52+ , FunctionNDB
53+ , unsafeFunctionN
54+ , functionN
55+ , PGSubset (..)
56+ , PGIntersect (..)
23357 -- * Re-export
23458 , (&)
235− , NP (..)
236− , (:*:) (..)
23759 , K (..)
60+ , unK
23861 ) where
23962
24063import Control.Category
24164import Control.DeepSeq
24265import Data.ByteString (ByteString)
243−import Data.ByteString.Lazy (toStrict)
24466import Data.Function ((&))
24567import Data.Semigroup hiding (All)
246−import qualified Data.Aeson as JSON
24768import Data.String
248−import Data.Word
24969import Generics.SOP hiding (All, from)
250−import GHC.Generics ((:*:) (..))
25170import GHC.OverloadedLabels
25271import GHC.TypeLits
25372import Numeric
25473import Prelude hiding (id, (.))
25574
256−import qualified Data.ByteString as ByteString
25775import qualified GHC.Generics as GHC
258−import qualified Generics.SOP as SOP
25976
77+import Squeal.PostgreSQL.Alias
78+import Squeal.PostgreSQL.List
26079import Squeal.PostgreSQL.Render
26180import Squeal.PostgreSQL.Schema
26281
82+-- $setup
83+-- >>> import Squeal.PostgreSQL
84+
26385{-----------------------------------------
26486column expressions
26587-----------------------------------------}
26688
26789{- | `Expression`s are used in a variety of contexts,
268−such as in the target list of the `Squeal.PostgreSQL.Query.select` command,
90+such as in the target `Squeal.PostgreSQL.Query.List` of the
91+`Squeal.PostgreSQL.Query.select` command,
26992as new column values in `Squeal.PostgreSQL.Manipulation.insertRow` or
27093`Squeal.PostgreSQL.Manipulation.update`,
271−or in search `Condition`s in a number of commands.
94+or in search `Squeal.PostgreSQL.Logic.Condition`s in a number of commands.
27295
27396The expression syntax allows the calculation of
27497values from primitive expression using arithmetic, logical,
27598and other operations.
99+
100+The type parameters of `Expression` are
101+
102+* @outer :: @ `FromType`, the @from@ clauses of any outer queries in which
103+ the `Expression` is a correlated subquery expression;
104+* @commons :: @ `FromType`, the `Squeal.PostgreSQL.Query.CommonTableExpression`s
105+ that are in scope for the `Expression`;
106+* @grp :: @ `Grouping`, the `Grouping` of the @from@ clause which may limit
107+ which columns may be referenced by alias;
108+* @schemas :: @ `SchemasType`, the schemas of your database that are in
109+ scope for the `Expression`;
110+* @from :: @ `FromType`, the @from@ clause which the `Expression` may use
111+ to reference columns by alias;
112+* @ty :: @ `NullityType`, the type of the `Expression`.
276113-}
277114newtype Expression
278115 (outer :: FromType)
279− (grp :: Grouping)
280116 (commons :: FromType)
117+ (grp :: Grouping)
281118 (schemas :: SchemasType)
282119 (params :: [NullityType])
283120 (from :: FromType)
284121 (ty :: NullityType)
285122 = UnsafeExpression { renderExpression :: ByteString }
286123 deriving (GHC.Generic,Show,Eq,Ord,NFData)
287−instance RenderSQL (Expression outer grp commons schemas params from ty) where
124+instance RenderSQL (Expression outer commons grp schemas params from ty) where
288125 renderSQL = renderExpression
289126
127+-- | An `Expr` is a closed `Expression`.
128+-- It is a F@RankNType@ but don't be scared.
129+-- Think of it as an expression which sees no
130+-- namespaces, so you can't use parameters
131+-- or alias references. It can be used as
132+-- a simple piece of more complex `Expression`s.
290133type Expr x
291− = forall outer grp commons schemas params from
292− . Expression outer grp commons schemas params from x
134+ = forall outer commons grp schemas params from
135+ . Expression outer commons grp schemas params from x
136+ -- ^ cannot reference aliases
293137
138+-- | A @RankNType@ for binary operators.
294139type Operator x1 x2 y
295− = forall outer grp commons schemas params from
296− . Expression outer grp commons schemas params from x1
297− -> Expression outer grp commons schemas params from x2
298− -> Expression outer grp commons schemas params from y
299−
300−type (:-->) x y
301− = forall outer grp commons schemas params from
302− . Expression outer grp commons schemas params from x
303− -> Expression outer grp commons schemas params from y
304−
305−type FunctionHet xs y
306− = forall outer grp commons schemas params from
307− . NP (Expression outer grp commons schemas params from) xs
308− -> Expression outer grp commons schemas params from y
309−
310−type FunctionHom x y
311− = forall outer grp commons schemas params from
312− . [Expression outer grp commons schemas params from x]
313− -> Expression outer grp commons schemas params from x
314− -> Expression outer grp commons schemas params from y
315−
316−unsafeFunctionHom :: ByteString -> FunctionHom x y
317−unsafeFunctionHom fun xs x = UnsafeExpression $ fun <> parenthesized
140+ = forall outer commons grp schemas params from
141+ . Expression outer commons grp schemas params from x1
142+ -- ^ left input
143+ -> Expression outer commons grp schemas params from x2
144+ -- ^ right input
145+ -> Expression outer commons grp schemas params from y
146+ -- ^ output
147+
148+type OperatorDB schemas x1 x2 y
149+ = forall outer commons grp params from
150+ . Expression outer commons grp schemas params from x1
151+ -- ^ left input
152+ -> Expression outer commons grp schemas params from x2
153+ -- ^ right input
154+ -> Expression outer commons grp schemas params from y
155+ -- ^ output
156+
157+-- | A @RankNType@ for functions with a single argument.
158+-- These could be either function calls or unary operators.
159+-- This is a subtype of the usual Haskell function type `Prelude.->`,
160+-- indeed a subcategory as it is closed under the usual
161+-- `Prelude..` and `Prelude.id`.
162+type (-->) x y
163+ = forall outer commons grp schemas params from
164+ . Expression outer commons grp schemas params from x
165+ -- ^ input
166+ -> Expression outer commons grp schemas params from y
167+ -- ^ output
168+
169+type FunctionDB schemas x y
170+ = forall outer commons grp params from
171+ . Expression outer commons grp schemas params from x
172+ -- ^ input
173+ -> Expression outer commons grp schemas params from y
174+ -- ^ output
175+
176+{- | A @RankNType@ for functions with a fixed-length list of heterogeneous arguments.
177+Use the `*:` operator to end your argument lists, like so.
178+
179+>>> printSQL (unsafeFunctionN "fun" (true :* false :* localTime *: true))
180+fun(TRUE, FALSE, LOCALTIME, TRUE)
181+-}
182+type (--->) xs y
183+ = forall outer commons grp schemas params from
184+ . NP (Expression outer commons grp schemas params from) xs
185+ -- ^ inputs
186+ -> Expression outer commons grp schemas params from y
187+ -- ^ output
188+
189+type FunctionNDB schemas xs y
190+ = forall outer commons grp params from
191+ . NP (Expression outer commons grp schemas params from) xs
192+ -- ^ inputs
193+ -> Expression outer commons grp schemas params from y
194+ -- ^ output
195+
196+{- | A @RankNType@ for functions with a variable-length list of
197+homogeneous arguments and at least 1 more argument.
198+-}
199+type FunctionVar x0 x1 y
200+ = forall outer commons grp schemas params from
201+ . [Expression outer commons grp schemas params from x0]
202+ -- ^ inputs
203+ -> Expression outer commons grp schemas params from x1
204+ -- ^ must have at least 1 input
205+ -> Expression outer commons grp schemas params from y
206+ -- ^ output
207+
208+{- | >>> printSQL (unsafeFunctionVar "greatest" [true, null_] false)
209+greatest(TRUE, NULL, FALSE)
210+-}
211+unsafeFunctionVar :: ByteString -> FunctionVar x0 x1 y
212+unsafeFunctionVar fun xs x = UnsafeExpression $ fun <> parenthesized
318213 (commaSeparated (renderSQL <$> xs) <> ", " <> renderSQL x)
319214
320−{- | A `HasParameter` constraint is used to indicate a value that is
321−supplied externally to a SQL statement.
322−`Squeal.PostgreSQL.PQ.manipulateParams`,
323−`Squeal.PostgreSQL.PQ.queryParams` and
324−`Squeal.PostgreSQL.PQ.traversePrepared` support specifying data values
325−separately from the SQL command string, in which case `param`s are used to
326−refer to the out-of-line data values.
327−-}
328−class KnownNat n => HasParameter
329− (n :: Nat)
330− (params :: [NullityType])
331− (ty :: NullityType)
332− | n params -> ty where
333− -- | `parameter` takes a `Nat` using type application and a `TypeExpression`.
334− --
335− -- >>> let expr = parameter @1 int4 :: Expression outer grp '[] schemas '[ 'Null 'PGint4] from ('Null 'PGint4)
336− -- >>> printSQL expr
337− -- ($1 :: int4)
338− parameter
339− :: TypeExpression schemas ty
340− -> Expression outer grp commons schemas params from ty
341− parameter ty = UnsafeExpression $ parenthesized $
342− "$" <> renderNat @n <+> "::"
343− <+> renderSQL ty
344−instance {-# OVERLAPPING #-} HasParameter 1 (ty1:tys) ty1
345−instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)
346− => HasParameter n (ty' : params) ty
347−
348−-- | `param` takes a `Nat` using type application and for basic types,
349−-- infers a `TypeExpression`.
350−--
351−-- >>> let expr = param @1 :: Expression outer grp commons schemas '[ 'Null 'PGint4] from ('Null 'PGint4)
352−-- >>> printSQL expr
353−-- ($1 :: int4)
354−param
355− :: forall n outer commons schemas params from grp ty
356− . (PGTyped schemas ty, HasParameter n params ty)
357− => Expression outer grp commons schemas params from ty -- ^ param
358−param = parameter @n (pgtype @schemas)
359−
360215instance (HasUnique tab (Join outer from) row, Has col row ty)
361− => IsLabel col (Expression outer 'Ungrouped commons schemas params from ty) where
216+ => IsLabel col (Expression outer commons 'Ungrouped schemas params from ty) where
362217 fromLabel = UnsafeExpression $ renderSQL (Alias @col)
363218instance (HasUnique tab (Join outer from) row, Has col row ty, tys ~ '[ty])
364− => IsLabel col (NP (Expression outer 'Ungrouped commons schemas params from) tys) where
219+ => IsLabel col (NP (Expression outer commons 'Ungrouped schemas params from) tys) where
365220 fromLabel = fromLabel @col :* Nil
366221instance (HasUnique tab (Join outer from) row, Has col row ty, column ~ (col ::: ty))
367222 => IsLabel col
368− (Aliased (Expression outer 'Ungrouped commons schemas params from) column) where
223+ (Aliased (Expression outer commons 'Ungrouped schemas params from) column) where
369224 fromLabel = fromLabel @col `As` Alias
370225instance (HasUnique tab (Join outer from) row, Has col row ty, columns ~ '[col ::: ty])
371226 => IsLabel col
372− (NP (Aliased (Expression outer 'Ungrouped commons schemas params from)) columns) where
227+ (NP (Aliased (Expression outer commons 'Ungrouped schemas params from)) columns) where
373228 fromLabel = fromLabel @col :* Nil
374229
375230instance (Has tab (Join outer from) row, Has col row ty)
376− => IsQualified tab col (Expression outer 'Ungrouped commons schemas params from ty) where
231+ => IsQualified tab col (Expression outer commons 'Ungrouped schemas params from ty) where
377232 tab ! col = UnsafeExpression $
378233 renderSQL tab <> "." <> renderSQL col
379234instance (Has tab (Join outer from) row, Has col row ty, tys ~ '[ty])
380− => IsQualified tab col (NP (Expression outer 'Ungrouped commons schemas params from) tys) where
235+ => IsQualified tab col (NP (Expression outer commons 'Ungrouped schemas params from) tys) where
381236 tab ! col = tab ! col :* Nil
382237instance (Has tab (Join outer from) row, Has col row ty, column ~ (col ::: ty))
383238 => IsQualified tab col
384− (Aliased (Expression outer 'Ungrouped commons schemas params from) column) where
239+ (Aliased (Expression outer commons 'Ungrouped schemas params from) column) where
385240 tab ! col = tab ! col `As` col
386241instance (Has tab (Join outer from) row, Has col row ty, columns ~ '[col ::: ty])
387242 => IsQualified tab col
388− (NP (Aliased (Expression outer 'Ungrouped commons schemas params from)) columns) where
243+ (NP (Aliased (Expression outer commons 'Ungrouped schemas params from)) columns) where
389244 tab ! col = tab ! col :* Nil
390245
391246instance
@@ -393,7 +248,7 @@ instance
393248 , Has col row ty
394249 , GroupedBy tab col bys
395250 ) => IsLabel col
396− (Expression outer ('Grouped bys) commons schemas params from ty) where
251+ (Expression outer commons ('Grouped bys) schemas params from ty) where
397252 fromLabel = UnsafeExpression $ renderSQL (Alias @col)
398253instance
399254 ( HasUnique tab (Join outer from) row
@@ -401,7 +256,7 @@ instance
401256 , GroupedBy tab col bys
402257 , tys ~ '[ty]
403258 ) => IsLabel col
404− (NP (Expression outer ('Grouped bys) commons schemas params from) tys) where
259+ (NP (Expression outer commons ('Grouped bys) schemas params from) tys) where
405260 fromLabel = fromLabel @col :* Nil
406261instance
407262 ( HasUnique tab (Join outer from) row
@@ -409,7 +264,7 @@ instance
409264 , GroupedBy tab col bys
410265 , column ~ (col ::: ty)
411266 ) => IsLabel col
412− (Aliased (Expression outer ('Grouped bys) commons schemas params from) column) where
267+ (Aliased (Expression outer commons ('Grouped bys) schemas params from) column) where
413268 fromLabel = fromLabel @col `As` Alias
414269instance
415270 ( HasUnique tab (Join outer from) row
@@ -417,7 +272,7 @@ instance
417272 , GroupedBy tab col bys
418273 , columns ~ '[col ::: ty]
419274 ) => IsLabel col
420− (NP (Aliased (Expression outer ('Grouped bys) commons schemas params from)) columns) where
275+ (NP (Aliased (Expression outer commons ('Grouped bys) schemas params from)) columns) where
421276 fromLabel = fromLabel @col :* Nil
422277
423278instance
@@ -425,7 +280,7 @@ instance
425280 , Has col row ty
426281 , GroupedBy tab col bys
427282 ) => IsQualified tab col
428− (Expression outer ('Grouped bys) commons schemas params from ty) where
283+ (Expression outer commons ('Grouped bys) schemas params from ty) where
429284 tab ! col = UnsafeExpression $
430285 renderSQL tab <> "." <> renderSQL col
431286instance
@@ -434,7 +289,7 @@ instance
434289 , GroupedBy tab col bys
435290 , tys ~ '[ty]
436291 ) => IsQualified tab col
437− (NP (Expression outer ('Grouped bys) commons schemas params from) tys) where
292+ (NP (Expression outer commons ('Grouped bys) schemas params from) tys) where
438293 tab ! col = tab ! col :* Nil
439294instance
440295 ( Has tab (Join outer from) row
@@ -442,7 +297,7 @@ instance
442297 , GroupedBy tab col bys
443298 , column ~ (col ::: ty)
444299 ) => IsQualified tab col
445− (Aliased (Expression outer ('Grouped bys) commons schemas params from) column) where
300+ (Aliased (Expression outer commons ('Grouped bys) schemas params from) column) where
446301 tab ! col = tab ! col `As` col
447302instance
448303 ( Has tab (Join outer from) row
@@ -450,223 +305,78 @@ instance
450305 , GroupedBy tab col bys
451306 , columns ~ '[col ::: ty]
452307 ) => IsQualified tab col
453− (NP (Aliased (Expression outer ('Grouped bys) commons schemas params from)) columns) where
308+ (NP (Aliased (Expression outer commons ('Grouped bys) schemas params from)) columns) where
454309 tab ! col = tab ! col :* Nil
455310
456−-- | analagous to `Nothing`
457−--
458−-- >>> printSQL null_
459−-- NULL
460−null_ :: Expr ('Null ty)
461−null_ = UnsafeExpression "NULL"
462−
463−-- | analagous to `Just`
464−--
465−-- >>> printSQL $ notNull true
466−-- TRUE
467−notNull :: 'NotNull ty :--> 'Null ty
468−notNull = UnsafeExpression . renderSQL
469−
470−-- | return the leftmost value which is not NULL
471−--
472−-- >>> printSQL $ coalesce [null_, true] false
473−-- COALESCE(NULL, TRUE, FALSE)
474−coalesce
475− :: [Expression outer grp commons schemas params from ('Null ty)]
476− -- ^ @NULL@s may be present
477− -> Expression outer grp commons schemas params from ('NotNull ty)
478− -- ^ @NULL@ is absent
479− -> Expression outer grp commons schemas params from ('NotNull ty)
480−coalesce nullxs notNullx = UnsafeExpression $
481− "COALESCE" <> parenthesized (commaSeparated
482− ((renderSQL <$> nullxs) <> [renderSQL notNullx]))
483−
484−-- | analagous to `Data.Maybe.fromMaybe` using @COALESCE@
485−--
486−-- >>> printSQL $ fromNull true null_
487−-- COALESCE(NULL, TRUE)
488−fromNull
489− :: Expression outer grp commons schemas params from ('NotNull ty)
490− -- ^ what to convert @NULL@ to
491− -> Expression outer grp commons schemas params from ('Null ty)
492− -> Expression outer grp commons schemas params from ('NotNull ty)
493−fromNull notNullx nullx = coalesce [nullx] notNullx
494−
495−-- | >>> printSQL $ null_ & isNull
496−-- NULL IS NULL
497−isNull
498− :: Expression outer grp commons schemas params from ('Null ty)
499− -- ^ possibly @NULL@
500− -> Condition outer grp commons schemas params from
501−isNull x = UnsafeExpression $ renderSQL x <+> "IS NULL"
502−
503−-- | >>> printSQL $ null_ & isNotNull
504−-- NULL IS NOT NULL
505−isNotNull
506− :: Expression outer grp commons schemas params from ('Null ty)
507− -- ^ possibly @NULL@
508− -> Condition outer grp commons schemas params from
509−isNotNull x = UnsafeExpression $ renderSQL x <+> "IS NOT NULL"
510−
511−-- | analagous to `maybe` using @IS NULL@
512−--
513−-- >>> printSQL $ matchNull true not_ null_
514−-- CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END
515−matchNull
516− :: Expression outer grp commons schemas params from (nullty)
517− -- ^ what to convert @NULL@ to
518− -> ( Expression outer grp commons schemas params from ('NotNull ty)
519− -> Expression outer grp commons schemas params from (nullty) )
520− -- ^ function to perform when @NULL@ is absent
521− -> Expression outer grp commons schemas params from ('Null ty)
522− -> Expression outer grp commons schemas params from (nullty)
523−matchNull y f x = ifThenElse (isNull x) y
524− (f (UnsafeExpression (renderSQL x)))
525−
526−{-| right inverse to `fromNull`, if its arguments are equal then
527−`nullIf` gives @NULL@.
528−
529−>>> :set -XTypeApplications -XDataKinds
530−>>> let expr = nullIf false (param @1) :: Expression outer grp commons schemas '[ 'NotNull 'PGbool] from ('Null 'PGbool)
531−>>> printSQL expr
532−NULL IF (FALSE, ($1 :: bool))
533−-}
534−nullIf
535− :: Expression outer grp commons schemas params from ('NotNull ty)
536− -- ^ @NULL@ is absent
537− -> Expression outer grp commons schemas params from ('NotNull ty)
538− -- ^ @NULL@ is absent
539− -> Expression outer grp commons schemas params from ('Null ty)
540−nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized
541− (renderSQL x <> ", " <> renderSQL y)
542−
543−-- | >>> printSQL $ array [null_, false, true]
544−-- ARRAY[NULL, FALSE, TRUE]
545−array
546− :: [Expression outer grp commons schemas params from ty]
547− -- ^ array elements
548− -> Expression outer grp commons schemas params from (null ('PGvararray ty))
549−array xs = UnsafeExpression $
550− "ARRAY[" <> commaSeparated (renderSQL <$> xs) <> "]"
551−
552−-- | >>> printSQL $ cardinality (array [null_, false, true])
553−-- cardinality(ARRAY[NULL, FALSE, TRUE])
554−cardinality :: null ('PGvararray ty) :--> null 'PGint8
555−cardinality = unsafeFunction "cardinality"
556−
557−-- | >>> printSQL $ array [null_, false, true] & index 2
558−-- (ARRAY[NULL, FALSE, TRUE])[2]
559−index
560− :: Word64 -- ^ index
561− -> null ('PGvararray ty) :--> NullifyType ty
562−index n expr = UnsafeExpression $
563− parenthesized (renderSQL expr) <> "[" <> fromString (show n) <> "]"
564−
565311instance (KnownSymbol label, label `In` labels) => IsPGlabel label
566− (Expression outer grp commons schemas params from (null ('PGenum labels))) where
312+ (Expression outer commons grp schemas params from (null ('PGenum labels))) where
567313 label = UnsafeExpression $ renderSQL (PGlabel @label)
568314
569−-- | A row constructor is an expression that builds a row value
570−-- (also called a composite value) using values for its member fields.
571−--
572−-- >>> :{
573−-- type Complex = 'PGcomposite
574−-- '[ "real" ::: 'NotNull 'PGfloat8
575−-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
576−-- :}
577−--
578−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression outer grp commons schemas params from ('NotNull Complex)
579−-- >>> printSQL i
580−-- ROW(0, 1)
581−row
582− :: SListI row
583− => NP (Aliased (Expression outer grp commons schemas params from)) row
584− -- ^ zero or more expressions for the row field values
585− -> Expression outer grp commons schemas params from (null ('PGcomposite row))
586−row exprs = UnsafeExpression $ "ROW" <> parenthesized
587− (renderCommaSeparated (\ (expr `As` _) -> renderSQL expr) exprs)
588−
589−-- | >>> :{
590−-- type Complex = 'PGcomposite
591−-- '[ "real" ::: 'NotNull 'PGfloat8
592−-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
593−-- type Schema = '["complex" ::: 'Typedef Complex]
594−-- :}
595−--
596−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression outer grp '[] (Public Schema) from params ('NotNull Complex)
597−-- >>> printSQL $ i & field #complex #imaginary
598−-- (ROW(0, 1)::"complex")."imaginary"
599−field
600− :: ( Has sch schemas schema
601− , Has tydef schema ('Typedef ('PGcomposite row))
602− , Has field row ty)
603− => QualifiedAlias sch tydef -- ^ row type
604− -> Alias field -- ^ field name
605− -> Expression outer grp commons schemas params from ('NotNull ('PGcomposite row))
606− -> Expression outer grp commons schemas params from ty
607−field td fld expr = UnsafeExpression $
608− parenthesized (renderSQL expr <> "::" <> renderSQL td)
609− <> "." <> renderSQL fld
610−
611−instance Semigroup
612− (Expression outer grp commons schemas params from (null ('PGvararray ty))) where
613− (<>) = unsafeBinaryOp "||"
614−
615−instance Monoid
616− (Expression outer grp commons schemas params from (null ('PGvararray ty))) where
617− mempty = array []
618− mappend = (<>)
619−
620−-- | >>> let expr = greatest [param @1] currentTimestamp :: Expression outer grp commons schemas '[ 'NotNull 'PGtimestamptz] from ('NotNull 'PGtimestamptz)
621−-- >>> printSQL expr
622−-- GREATEST(($1 :: timestamp with time zone), CURRENT_TIMESTAMP)
623−greatest :: FunctionHom ty ty
624−greatest = unsafeFunctionHom "GREATEST"
625−
626−-- | >>> printSQL $ least [null_] currentTimestamp
627−-- LEAST(NULL, CURRENT_TIMESTAMP)
628−least :: FunctionHom ty ty
629−least = unsafeFunctionHom "LEAST"
630−
631315-- | >>> printSQL $ unsafeBinaryOp "OR" true false
632316-- (TRUE OR FALSE)
633−unsafeBinaryOp :: ByteString {- ^ operator -} -> Operator ty0 ty1 ty2
317+unsafeBinaryOp :: ByteString -> Operator ty0 ty1 ty2
634318unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $
635319 renderSQL x <+> op <+> renderSQL y
636320
637−-- | >>> printSQL $ unsafeUnaryOpL "NOT" true
638−-- (NOT TRUE)
639−unsafeUnaryOpL :: ByteString {- ^ operator -} -> x :--> y
640−unsafeUnaryOpL op x = UnsafeExpression $ parenthesized $ op <+> renderSQL x
321+binaryOp
322+ :: forall op sch schemas schema x y z.
323+ ( Has sch schemas schema
324+ , Has op schema ('Operator ('BinaryOp x y z)) )
325+ => OperatorDB schemas x y z
326+binaryOp = unsafeBinaryOp $ renderSymbol @op
641327
642−unsafeUnaryOpR :: ByteString {- ^ operator -} -> x :--> y
643−unsafeUnaryOpR op x = UnsafeExpression $ parenthesized $ renderSQL x <+> op
328+-- | >>> printSQL $ unsafeLeftOp "NOT" true
329+-- (NOT TRUE)
330+unsafeLeftOp :: ByteString -> x --> y
331+unsafeLeftOp op x = UnsafeExpression $ parenthesized $ op <+> renderSQL x
332+
333+leftOp
334+ :: forall op sch schemas schema x y.
335+ ( Has sch schemas schema
336+ , Has op schema ('Operator ('LeftOp x y)) )
337+ => FunctionDB schemas x y
338+leftOp = unsafeLeftOp $ renderSymbol @op
339+
340+-- | >>> printSQL $ true & unsafeRightOp "IS NOT TRUE"
341+-- (TRUE IS NOT TRUE)
342+unsafeRightOp :: ByteString -> x --> y
343+unsafeRightOp op x = UnsafeExpression $ parenthesized $ renderSQL x <+> op
344+
345+rightOp
346+ :: forall op sch schemas schema x y.
347+ ( Has sch schemas schema
348+ , Has op schema ('Operator ('RightOp x y)) )
349+ => FunctionDB schemas x y
350+rightOp = unsafeRightOp $ renderSymbol @op
644351
645352-- | >>> printSQL $ unsafeFunction "f" true
646353-- f(TRUE)
647−unsafeFunction :: ByteString {- ^ function -} -> x :--> y
354+unsafeFunction :: ByteString -> x --> y
648355unsafeFunction fun x = UnsafeExpression $
649356 fun <> parenthesized (renderSQL x)
650357
651−unsafeFunctionHet
652− :: SListI xs
653− => ByteString {- ^ function -}
654− -> FunctionHet xs y
655−unsafeFunctionHet fun xs = UnsafeExpression $
358+function
359+ :: (Has sch schemas schema, Has fun schema ('Function ('[x] :=> 'Returns y)))
360+ => QualifiedAlias sch fun
361+ -> FunctionDB schemas x y
362+function = unsafeFunction . renderSQL
363+
364+-- | >>> printSQL $ unsafeFunctionN "f" (currentTime :* localTimestamp :* false *: literal 'a')
365+-- f(CURRENT_TIME, LOCALTIMESTAMP, FALSE, E'a')
366+unsafeFunctionN :: SListI xs => ByteString -> xs ---> y
367+unsafeFunctionN fun xs = UnsafeExpression $
656368 fun <> parenthesized (renderCommaSeparated renderSQL xs)
657369
658−-- | Helper for defining variadic functions.
659−unsafeVariadicFunction
660− :: SListI elems
661− => ByteString
662− -- ^ function
663− -> NP (Expression outer grp commons schemas params from) elems
664− -> Expression outer grp commons schemas params from ret
665−unsafeVariadicFunction fun x = UnsafeExpression $
666− fun <> parenthesized (commaSeparated (hcollapse (hmap (K . renderSQL) x)))
370+functionN
371+ :: ( Has sch schemas schema
372+ , Has fun schema ('Function (xs :=> 'Returns y))
373+ , SListI xs )
374+ => QualifiedAlias sch fun
375+ -> FunctionNDB schemas xs y
376+functionN = unsafeFunctionN . renderSQL
667377
668378instance ty `In` PGNum
669− => Num (Expression outer grp commons schemas params from (null ty)) where
379+ => Num (Expression outer commons grp schemas params from (null ty)) where
670380 (+) = unsafeBinaryOp "+"
671381 (-) = unsafeBinaryOp "-"
672382 (*) = unsafeBinaryOp "*"
@@ -678,7 +388,7 @@ instance ty `In` PGNum
678388 . show
679389
680390instance (ty `In` PGNum, ty `In` PGFloating) => Fractional
681− (Expression outer grp commons schemas params from (null ty)) where
391+ (Expression outer commons grp schemas params from (null ty)) where
682392 (/) = unsafeBinaryOp "/"
683393 fromRational
684394 = UnsafeExpression
@@ -688,7 +398,7 @@ instance (ty `In` PGNum, ty `In` PGFloating) => Fractional
688398 . fromRat @Double
689399
690400instance (ty `In` PGNum, ty `In` PGFloating) => Floating
691− (Expression outer grp commons schemas params from (null ty)) where
401+ (Expression outer commons grp schemas params from (null ty)) where
692402 pi = UnsafeExpression "pi()"
693403 exp = unsafeFunction "exp"
694404 log = unsafeFunction "ln"
@@ -709,1768 +419,54 @@ instance (ty `In` PGNum, ty `In` PGFloating) => Floating
709419 acosh x = log (x + sqrt (x*x - 1))
710420 atanh x = log ((1 + x) / (1 - x)) / 2
711421
712−-- | >>> :{
713−-- let
714−-- expression :: Expr (null 'PGfloat4)
715−-- expression = atan2_ (pi *: 2)
716−-- in printSQL expression
717−-- :}
718−-- atan2(pi(), 2)
719−atan2_
720− :: float `In` PGFloating
721− => FunctionHet '[ null float, null float] (null float)
722−atan2_ = unsafeFunctionHet "atan2"
723−
724−-- When a `cast` is applied to an `Expression` of a known type, it
725−-- represents a run-time type conversion. The cast will succeed only if a
726−-- suitable type conversion operation has been defined.
727−--
728−-- | >>> printSQL $ true & cast int4
729−-- (TRUE :: int4)
730−cast
731− :: TypeExpression schemas ty1
732− -- ^ type to cast as
733− -> Expression outer grp commons schemas params from ty0
734− -- ^ value to convert
735− -> Expression outer grp commons schemas params from ty1
736−cast ty x = UnsafeExpression $ parenthesized $
737− renderSQL x <+> "::" <+> renderSQL ty
738−
739−-- | integer division, truncates the result
740−--
741−-- >>> :{
742−-- let
743−-- expression :: Expression outer grp commons schemas params from (null 'PGint2)
744−-- expression = 5 `quot_` 2
745−-- in printSQL expression
746−-- :}
747−-- (5 / 2)
748−quot_
749− :: int `In` PGIntegral
750− => Operator (null int) (null int) (null int)
751−quot_ = unsafeBinaryOp "/"
752−
753−-- | remainder upon integer division
754−--
755−-- >>> :{
756−-- let
757−-- expression :: Expression outer grp commons schemas params from (null 'PGint2)
758−-- expression = 5 `rem_` 2
759−-- in printSQL expression
760−-- :}
761−-- (5 % 2)
762−rem_
763− :: int `In` PGIntegral
764− => Operator (null int) (null int) (null int)
765−rem_ = unsafeBinaryOp "%"
766−
767−-- | >>> :{
768−-- let
769−-- expression :: Expression outer grp commons schemas params from (null 'PGfloat4)
770−-- expression = trunc pi
771−-- in printSQL expression
772−-- :}
773−-- trunc(pi())
774−trunc :: frac `In` PGFloating => null frac :--> null frac
775−trunc = unsafeFunction "trunc"
776−
777−-- | >>> :{
778−-- let
779−-- expression :: Expression outer grp commons schemas params from (null 'PGfloat4)
780−-- expression = round_ pi
781−-- in printSQL expression
782−-- :}
783−-- round(pi())
784−round_ :: frac `In` PGFloating => null frac :--> null frac
785−round_ = unsafeFunction "round"
786−
787−-- | >>> :{
788−-- let
789−-- expression :: Expression outer grp commons schemas params from (null 'PGfloat4)
790−-- expression = ceiling_ pi
791−-- in printSQL expression
792−-- :}
793−-- ceiling(pi())
794−ceiling_ :: frac `In` PGFloating => null frac :--> null frac
795−ceiling_ = unsafeFunction "ceiling"
796−
797−-- | A `Condition` is an `Expression`, which can evaluate
798−-- to `true`, `false` or `null_`. This is because SQL uses
799−-- a three valued logic.
800−type Condition outer grp commons schemas params from =
801− Expression outer grp commons schemas params from ('Null 'PGbool)
802−
803−-- | >>> printSQL true
804−-- TRUE
805−true :: Expr (null 'PGbool)
806−true = UnsafeExpression "TRUE"
807−
808−-- | >>> printSQL false
809−-- FALSE
810−false :: Expr (null 'PGbool)
811−false = UnsafeExpression "FALSE"
812−
813−-- | >>> printSQL $ not_ true
814−-- (NOT TRUE)
815−not_ :: null 'PGbool :--> null 'PGbool
816−not_ = unsafeUnaryOpL "NOT"
817−
818−-- | >>> printSQL $ true .&& false
819−-- (TRUE AND FALSE)
820−(.&&) :: Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
821−infixr 3 .&&
822−(.&&) = unsafeBinaryOp "AND"
823−
824−-- | >>> printSQL $ true .|| false
825−-- (TRUE OR FALSE)
826−(.||) :: Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
827−infixr 2 .||
828−(.||) = unsafeBinaryOp "OR"
829−
830−-- | >>> :{
831−-- let
832−-- expression :: Expression outer grp commons schemas params from (null 'PGint2)
833−-- expression = caseWhenThenElse [(true, 1), (false, 2)] 3
834−-- in printSQL expression
835−-- :}
836−-- CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END
837−caseWhenThenElse
838− :: [ ( Condition outer grp commons schemas params from
839− , Expression outer grp commons schemas params from ty
840− ) ]
841− -- ^ whens and thens
842− -> Expression outer grp commons schemas params from ty
843− -- ^ else
844− -> Expression outer grp commons schemas params from ty
845−caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
846− [ "CASE"
847− , mconcat
848− [ mconcat
849− [ " WHEN ", renderSQL when_
850− , " THEN ", renderSQL then_
851− ]
852− | (when_,then_) <- whenThens
853− ]
854− , " ELSE ", renderSQL else_
855− , " END"
856− ]
857−
858−-- | >>> :{
859−-- let
860−-- expression :: Expression outer grp commons schemas params from (null 'PGint2)
861−-- expression = ifThenElse true 1 0
862−-- in printSQL expression
863−-- :}
864−-- CASE WHEN TRUE THEN 1 ELSE 0 END
865−ifThenElse
866− :: Condition outer grp commons schemas params from
867− -> Expression outer grp commons schemas params from ty -- ^ then
868− -> Expression outer grp commons schemas params from ty -- ^ else
869− -> Expression outer grp commons schemas params from ty
870−ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
871−
872−-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`
873−-- will produce @NULL@s if one of their arguments is @NULL@.
874−--
875−-- >>> printSQL $ true .== null_
876−-- (TRUE = NULL)
877−(.==) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
878−(.==) = unsafeBinaryOp "="
879−infix 4 .==
880−
881−-- | >>> printSQL $ true ./= null_
882−-- (TRUE <> NULL)
883−(./=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
884−(./=) = unsafeBinaryOp "<>"
885−infix 4 ./=
886−
887−-- | >>> printSQL $ true .>= null_
888−-- (TRUE >= NULL)
889−(.>=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
890−(.>=) = unsafeBinaryOp ">="
891−infix 4 .>=
892−
893−-- | >>> printSQL $ true .< null_
894−-- (TRUE < NULL)
895−(.<) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
896−(.<) = unsafeBinaryOp "<"
897−infix 4 .<
898−
899−-- | >>> printSQL $ true .<= null_
900−-- (TRUE <= NULL)
901−(.<=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
902−(.<=) = unsafeBinaryOp "<="
903−infix 4 .<=
904−
905−-- | >>> printSQL $ true .> null_
906−-- (TRUE > NULL)
907−(.>) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
908−(.>) = unsafeBinaryOp ">"
909−infix 4 .>
910−
911−{- | between
912−>>> printSQL $ true `between` (null_, false)
913−TRUE BETWEEN NULL AND FALSE
914−-}
915−between
916− :: Expression outer grp commons schemas params from (null ty)
917− -> ( Expression outer grp commons schemas params from (null ty)
918− , Expression outer grp commons schemas params from (null ty) ) -- ^ bounds
919− -> Condition outer grp commons schemas params from
920−between a (x,y) = UnsafeExpression $ renderSQL a <+> "BETWEEN"
921− <+> renderSQL x <+> "AND" <+> renderSQL y
922−
923−{- | not between
924−>>> printSQL $ true `notBetween` (null_, false)
925−TRUE NOT BETWEEN NULL AND FALSE
926−-}
927−notBetween
928− :: Expression outer grp commons schemas params from (null ty)
929− -> ( Expression outer grp commons schemas params from (null ty)
930− , Expression outer grp commons schemas params from (null ty) ) -- ^ bounds
931− -> Condition outer grp commons schemas params from
932−notBetween a (x,y) = UnsafeExpression $ renderSQL a <+> "NOT BETWEEN"
933− <+> renderSQL x <+> "AND" <+> renderSQL y
934−
935−{- | between, after sorting the comparison values
936−>>> printSQL $ true `betweenSymmetric` (null_, false)
937−TRUE BETWEEN SYMMETRIC NULL AND FALSE
938−-}
939−betweenSymmetric
940− :: Expression outer grp commons schemas params from (null ty)
941− -> ( Expression outer grp commons schemas params from (null ty)
942− , Expression outer grp commons schemas params from (null ty) ) -- ^ bounds
943− -> Condition outer grp commons schemas params from
944−betweenSymmetric a (x,y) = UnsafeExpression $ renderSQL a
945− <+> "BETWEEN SYMMETRIC" <+> renderSQL x <+> "AND" <+> renderSQL y
946−
947−{- | not between, after sorting the comparison values
948−>>> printSQL $ true `notBetweenSymmetric` (null_, false)
949−TRUE NOT BETWEEN SYMMETRIC NULL AND FALSE
950−-}
951−notBetweenSymmetric
952− :: Expression outer grp commons schemas params from (null ty)
953− -> ( Expression outer grp commons schemas params from (null ty)
954− , Expression outer grp commons schemas params from (null ty) ) -- ^ bounds
955− -> Condition outer grp commons schemas params from
956−notBetweenSymmetric a (x,y) = UnsafeExpression $ renderSQL a
957− <+> "NOT BETWEEN SYMMETRIC" <+> renderSQL x <+> "AND" <+> renderSQL y
958−
959−{- | not equal, treating null like an ordinary value
960−>>> printSQL $ true `isDistinctFrom` null_
961−(TRUE IS DISTINCT FROM NULL)
962−-}
963−isDistinctFrom :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
964−isDistinctFrom = unsafeBinaryOp "IS DISTINCT FROM"
965−
966−{- | equal, treating null like an ordinary value
967−>>> printSQL $ true `isNotDistinctFrom` null_
968−(TRUE IS NOT DISTINCT FROM NULL)
969−-}
970−isNotDistinctFrom :: Operator (null0 ty) (null1 ty) ('NotNull 'PGbool)
971−isNotDistinctFrom = unsafeBinaryOp "IS NOT DISTINCT FROM"
972−
973−{- | is true
974−>>> printSQL $ true & isTrue
975−(TRUE IS TRUE)
976−-}
977−isTrue :: null 'PGbool :--> 'NotNull 'PGbool
978−isTrue = unsafeUnaryOpR "IS TRUE"
979−
980−{- | is false or unknown
981−>>> printSQL $ true & isNotTrue
982−(TRUE IS NOT TRUE)
983−-}
984−isNotTrue :: null 'PGbool :--> 'NotNull 'PGbool
985−isNotTrue = unsafeUnaryOpR "IS NOT TRUE"
986−
987−{- | is false
988−>>> printSQL $ true & isFalse
989−(TRUE IS FALSE)
990−-}
991−isFalse :: null 'PGbool :--> 'NotNull 'PGbool
992−isFalse = unsafeUnaryOpR "IS FALSE"
993−
994−{- | is true or unknown
995−>>> printSQL $ true & isNotFalse
996−(TRUE IS NOT FALSE)
997−-}
998−isNotFalse :: null 'PGbool :--> 'NotNull 'PGbool
999−isNotFalse = unsafeUnaryOpR "IS NOT FALSE"
1000−
1001−{- | is unknown
1002−>>> printSQL $ true & isUnknown
1003−(TRUE IS UNKNOWN)
1004−-}
1005−isUnknown :: null 'PGbool :--> 'NotNull 'PGbool
1006−isUnknown = unsafeUnaryOpR "IS UNKNOWN"
1007−
1008−{- | is true or false
1009−>>> printSQL $ true & isNotUnknown
1010−(TRUE IS NOT UNKNOWN)
1011−-}
1012−isNotUnknown :: null 'PGbool :--> 'NotNull 'PGbool
1013−isNotUnknown = unsafeUnaryOpR "IS NOT UNKNOWN"
1014−
1015−-- | >>> printSQL currentDate
1016−-- CURRENT_DATE
1017−currentDate :: Expr (null 'PGdate)
1018−currentDate = UnsafeExpression "CURRENT_DATE"
1019−
1020−-- | >>> printSQL currentTime
1021−-- CURRENT_TIME
1022−currentTime :: Expr (null 'PGtimetz)
1023−currentTime = UnsafeExpression "CURRENT_TIME"
1024−
1025−-- | >>> printSQL currentTimestamp
1026−-- CURRENT_TIMESTAMP
1027−currentTimestamp :: Expr (null 'PGtimestamptz)
1028−currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"
1029−
1030−-- | >>> printSQL localTime
1031−-- LOCALTIME
1032−localTime :: Expr (null 'PGtime)
1033−localTime = UnsafeExpression "LOCALTIME"
1034−
1035−-- | >>> printSQL localTimestamp
1036−-- LOCALTIMESTAMP
1037−localTimestamp :: Expr (null 'PGtimestamp)
1038−localTimestamp = UnsafeExpression "LOCALTIMESTAMP"
1039−
1040−{-----------------------------------------
1041−text
1042−-----------------------------------------}
1043−
1044−escape :: Char -> String
1045−escape = \case
1046− '\NUL' -> "\\0"
1047− '\'' -> "''"
1048− '"' -> "\\\""
1049− '\b' -> "\\b"
1050− '\n' -> "\\n"
1051− '\r' -> "\\r"
1052− '\t' -> "\\t"
1053− '\\' -> "\\\\"
1054− c -> [c]
422+-- | Contained by operators
423+class PGSubset ty where
424+ (@>) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
425+ (@>) = unsafeBinaryOp "@>"
426+ (<@) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
427+ (<@) = unsafeBinaryOp "<@"
428+instance PGSubset 'PGjsonb
429+instance PGSubset 'PGtsquery
430+instance PGSubset ('PGvararray ty)
431+instance PGSubset ('PGrange ty)
432+
433+class PGIntersect ty where
434+ (@&&) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
435+ (@&&) = unsafeBinaryOp "&&"
436+instance PGIntersect ('PGvararray ty)
437+instance PGIntersect ('PGrange ty)
1055438
1056439instance IsString
1057− (Expression outer grp commons schemas params from (null 'PGtext)) where
440+ (Expression outer commons grp schemas params from (null 'PGtext)) where
1058441 fromString str = UnsafeExpression $
1059442 "E\'" <> fromString (escape =<< str) <> "\'"
1060443instance IsString
1061− (Expression outer grp commons schemas params from (null 'PGtsvector)) where
1062− fromString str = cast tsvector . UnsafeExpression $
444+ (Expression outer commons grp schemas params from (null 'PGtsvector)) where
445+ fromString str = UnsafeExpression . parenthesized . (<> " :: tsvector") $
1063446 "E\'" <> fromString (escape =<< str) <> "\'"
1064447instance IsString
1065− (Expression outer grp commons schemas params from (null 'PGtsquery)) where
1066− fromString str = cast tsquery . UnsafeExpression $
448+ (Expression outer commons grp schemas params from (null 'PGtsquery)) where
449+ fromString str = UnsafeExpression . parenthesized . (<> " :: tsquery") $
1067450 "E\'" <> fromString (escape =<< str) <> "\'"
1068451
1069452instance Semigroup
1070− (Expression outer grp commons schemas params from (null 'PGtext)) where
453+ (Expression outer commons grp schemas params from (null ('PGvararray ty))) where
1071454 (<>) = unsafeBinaryOp "||"
1072455instance Semigroup
1073− (Expression outer grp commons schemas params from (null 'PGtsvector)) where
456+ (Expression outer commons grp schemas params from (null 'PGjsonb)) where
457+ (<>) = unsafeBinaryOp "||"
458+instance Semigroup
459+ (Expression outer commons grp schemas params from (null 'PGtext)) where
460+ (<>) = unsafeBinaryOp "||"
461+instance Semigroup
462+ (Expression outer commons grp schemas params from (null 'PGtsvector)) where
1074463 (<>) = unsafeBinaryOp "||"
1075464
1076465instance Monoid
1077− (Expression outer grp commons schemas params from (null 'PGtext)) where
466+ (Expression outer commons grp schemas params from (null 'PGtext)) where
1078467 mempty = fromString ""
1079468 mappend = (<>)
1080469instance Monoid
1081− (Expression outer grp commons schemas params from (null 'PGtsvector)) where
470+ (Expression outer commons grp schemas params from (null 'PGtsvector)) where
1082471 mempty = fromString ""
1083472 mappend = (<>)
1084−
1085−-- | >>> printSQL $ lower "ARRRGGG"
1086−-- lower(E'ARRRGGG')
1087−lower :: null 'PGtext :--> null 'PGtext
1088−lower = unsafeFunction "lower"
1089−
1090−-- | >>> printSQL $ upper "eeee"
1091−-- upper(E'eeee')
1092−upper :: null 'PGtext :--> null 'PGtext
1093−upper = unsafeFunction "upper"
1094−
1095−-- | >>> printSQL $ charLength "four"
1096−-- char_length(E'four')
1097−charLength :: null 'PGtext :--> null 'PGint4
1098−charLength = unsafeFunction "char_length"
1099−
1100−-- | The `like` expression returns true if the @string@ matches
1101−-- the supplied @pattern@. If @pattern@ does not contain percent signs
1102−-- or underscores, then the pattern only represents the string itself;
1103−-- in that case `like` acts like the equals operator. An underscore (_)
1104−-- in pattern stands for (matches) any single character; a percent sign (%)
1105−-- matches any sequence of zero or more characters.
1106−--
1107−-- >>> printSQL $ "abc" `like` "a%"
1108−-- (E'abc' LIKE E'a%')
1109−like :: Operator (null 'PGtext) (null 'PGtext) ('Null 'PGbool)
1110−like = unsafeBinaryOp "LIKE"
1111−
1112−-- | The key word ILIKE can be used instead of LIKE to make the
1113−-- match case-insensitive according to the active locale.
1114−--
1115−-- >>> printSQL $ "abc" `ilike` "a%"
1116−-- (E'abc' ILIKE E'a%')
1117−ilike :: Operator (null 'PGtext) (null 'PGtext) ('Null 'PGbool)
1118−ilike = unsafeBinaryOp "ILIKE"
1119−
1120−{-----------------------------------------
1121− -- json and jsonb support
1122−
1123−See https://www.postgresql.org/docs/10/static/functions-json.html -- most
1124−comments lifted directly from this page.
1125−
1126−Table 9.44: json and jsonb operators
1127−-----------------------------------------}
1128−
1129−-- | Get JSON value (object field or array element) at a key.
1130−(.->)
1131− :: (json `In` PGJsonType, key `In` PGJsonKey)
1132− => Operator (null json) (null key) ('Null json)
1133−infixl 8 .->
1134−(.->) = unsafeBinaryOp "->"
1135−
1136−-- | Get JSON value (object field or array element) at a key, as text.
1137−(.->>)
1138− :: (json `In` PGJsonType, key `In` PGJsonKey)
1139− => Operator (null json) (null key) ('Null 'PGtext)
1140−infixl 8 .->>
1141−(.->>) = unsafeBinaryOp "->>"
1142−
1143−-- | Get JSON value at a specified path.
1144−(.#>)
1145− :: (json `In` PGJsonType, PGTextArray "(.#>)" path)
1146− => Operator (null json) (null path) ('Null json)
1147−infixl 8 .#>
1148−(.#>) = unsafeBinaryOp "#>"
1149−
1150−-- | Get JSON value at a specified path as text.
1151−(.#>>)
1152− :: (json `In` PGJsonType, PGTextArray "(.#>>)" path)
1153− => Operator (null json) (null path) ('Null 'PGtext)
1154−infixl 8 .#>>
1155−(.#>>) = unsafeBinaryOp "#>>"
1156−
1157−-- Additional jsonb operators
1158−
1159−-- | Does the left JSON value contain the right JSON path/value entries at the
1160−-- top level?
1161−(.@>)
1162− :: Operator (null 'PGjsonb) (null 'PGjsonb) ('Null 'PGbool)
1163−infixl 9 .@>
1164−(.@>) = unsafeBinaryOp "@>"
1165−
1166−-- | Are the left JSON path/value entries contained at the top level within the
1167−-- right JSON value?
1168−(.<@) :: Operator (null 'PGjsonb) (null 'PGjsonb) ('Null 'PGbool)
1169−infixl 9 .<@
1170−(.<@) = unsafeBinaryOp "<@"
1171−
1172−-- | Does the string exist as a top-level key within the JSON value?
1173−(.?) :: Operator (null 'PGjsonb) (null 'PGtext) ('Null 'PGbool)
1174−infixl 9 .?
1175−(.?) = unsafeBinaryOp "?"
1176−
1177−-- | Do any of these array strings exist as top-level keys?
1178−(.?|) :: Operator
1179− (null 'PGjsonb)
1180− (null ('PGvararray ('NotNull 'PGtext)))
1181− ('Null 'PGbool)
1182−infixl 9 .?|
1183−(.?|) = unsafeBinaryOp "?|"
1184−
1185−-- | Do all of these array strings exist as top-level keys?
1186−(.?&) :: Operator
1187− (null 'PGjsonb)
1188− (null ('PGvararray ('NotNull 'PGtext)))
1189− ('Null 'PGbool)
1190−infixl 9 .?&
1191−(.?&) = unsafeBinaryOp "?&"
1192−
1193−-- | Concatenate two jsonb values into a new jsonb value.
1194−instance Semigroup
1195− (Expression outer grp commons schemas params from (null 'PGjsonb)) where
1196− (<>) = unsafeBinaryOp "||"
1197−
1198−-- | Delete a key or keys from a JSON object, or remove an array element.
1199−--
1200−-- If the right operand is..
1201−--
1202−-- @ text @: Delete key/value pair or string element from left operand. Key/value pairs
1203−-- are matched based on their key value.
1204−--
1205−-- @ text[] @: Delete multiple key/value pairs or string elements
1206−-- from left operand. Key/value pairs are matched based on their key value.
1207−--
1208−-- @ integer @: Delete the array element with specified index (Negative integers
1209−-- count from the end). Throws an error if top level container is not an array.
1210−(.-.)
1211− :: (key `In` '[ 'PGtext, 'PGvararray ('NotNull 'PGtext), 'PGint4, 'PGint2 ]) -- hlint error without parens here
1212− => Operator (null 'PGjsonb) (null key) (null 'PGjsonb)
1213−infixl 6 .-.
1214−(.-.) = unsafeBinaryOp "-"
1215−
1216−-- | Delete the field or element with specified path (for JSON arrays, negative
1217−-- integers count from the end)
1218−(#-.)
1219− :: PGTextArray "(#-.)" arrayty
1220− => Operator (null 'PGjsonb) (null arrayty)(null 'PGjsonb)
1221−infixl 6 #-.
1222−(#-.) = unsafeBinaryOp "#-"
1223−
1224−{-----------------------------------------
1225−Table 9.45: JSON creation functions
1226−-----------------------------------------}
1227−
1228−-- | Literal binary JSON
1229−jsonbLit :: JSON.ToJSON x => x -> Expr (null 'PGjsonb)
1230−jsonbLit = cast jsonb . UnsafeExpression
1231− . singleQuotedUtf8 . toStrict . JSON.encode
1232−
1233−-- | Literal JSON
1234−jsonLit :: JSON.ToJSON x => x -> Expr (null 'PGjson)
1235−jsonLit = cast json . UnsafeExpression
1236− . singleQuotedUtf8 . toStrict . JSON.encode
1237−
1238−-- | Returns the value as json. Arrays and composites are converted
1239−-- (recursively) to arrays and objects; otherwise, if there is a cast from the
1240−-- type to json, the cast function will be used to perform the conversion;
1241−-- otherwise, a scalar value is produced. For any scalar type other than a
1242−-- number, a Boolean, or a null value, the text representation will be used, in
1243−-- such a fashion that it is a valid json value.
1244−toJson :: null ty :--> null 'PGjson
1245−toJson = unsafeFunction "to_json"
1246−
1247−-- | Returns the value as jsonb. Arrays and composites are converted
1248−-- (recursively) to arrays and objects; otherwise, if there is a cast from the
1249−-- type to json, the cast function will be used to perform the conversion;
1250−-- otherwise, a scalar value is produced. For any scalar type other than a
1251−-- number, a Boolean, or a null value, the text representation will be used, in
1252−-- such a fashion that it is a valid jsonb value.
1253−toJsonb :: null ty :--> null 'PGjsonb
1254−toJsonb = unsafeFunction "to_jsonb"
1255−
1256−-- | Returns the array as a JSON array. A PostgreSQL multidimensional array
1257−-- becomes a JSON array of arrays.
1258−arrayToJson
1259− :: PGArray "arrayToJson" arr
1260− => null arr :--> null 'PGjson
1261−arrayToJson = unsafeFunction "array_to_json"
1262−
1263−-- | Returns the row as a JSON object.
1264−rowToJson :: null ('PGcomposite ty) :--> null 'PGjson
1265−rowToJson = unsafeFunction "row_to_json"
1266−
1267−-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic
1268−-- argument list.
1269−jsonBuildArray
1270− :: SListI elems
1271− => NP (Expression outer grp commons schemas params from) elems
1272− -> Expression outer grp commons schemas params from (null 'PGjson)
1273−jsonBuildArray = unsafeVariadicFunction "json_build_array"
1274−
1275−-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a
1276−-- variadic argument list.
1277−jsonbBuildArray
1278− :: SListI elems
1279− => NP (Expression outer grp commons schemas params from) elems
1280− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1281−jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"
1282−
1283−unsafeRowFunction
1284− :: SOP.SListI elems
1285− => NP (Aliased (Expression outer grp commons schemas params from)) elems
1286− -> [ByteString]
1287−unsafeRowFunction =
1288− (`appEndo` []) . hcfoldMap (Proxy :: SOP.Proxy SOP.Top)
1289− (\(col `As` name) -> Endo $ \xs ->
1290− renderAliasString name : renderSQL col : xs)
1291− where
1292− renderAliasString :: KnownSymbol alias => Alias alias -> ByteString
1293− renderAliasString = singleQuotedText . fromString . symbolVal
1294−
1295−-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic
1296−-- argument list. The elements of the argument list must alternate between text
1297−-- and values.
1298−jsonBuildObject
1299− :: SOP.SListI elems
1300− => NP (Aliased (Expression outer grp commons schemas params from)) elems
1301− -> Expression outer grp commons schemas params from (null 'PGjson)
1302−jsonBuildObject
1303− = unsafeFunction "json_build_object"
1304− . UnsafeExpression
1305− . commaSeparated
1306− . unsafeRowFunction
1307−
1308−-- | Builds a possibly-heterogeneously-typed (binary) JSON object out of a
1309−-- variadic argument list. The elements of the argument list must alternate
1310−-- between text and values.
1311−jsonbBuildObject
1312− :: SOP.SListI elems
1313− => NP (Aliased (Expression outer grp commons schemas params from)) elems
1314− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1315−jsonbBuildObject
1316− = unsafeFunction "jsonb_build_object"
1317− . UnsafeExpression
1318− . commaSeparated
1319− . unsafeRowFunction
1320−
1321−-- | Builds a JSON object out of a text array. The array must have either
1322−-- exactly one dimension with an even number of members, in which case they are
1323−-- taken as alternating key/value pairs, or two dimensions such that each inner
1324−-- array has exactly two elements, which are taken as a key/value pair.
1325−jsonObject
1326− :: PGArrayOf "jsonObject" arr ('NotNull 'PGtext)
1327− => null arr :--> null 'PGjson
1328−jsonObject = unsafeFunction "json_object"
1329−
1330−-- | Builds a binary JSON object out of a text array. The array must have either
1331−-- exactly one dimension with an even number of members, in which case they are
1332−-- taken as alternating key/value pairs, or two dimensions such that each inner
1333−-- array has exactly two elements, which are taken as a key/value pair.
1334−jsonbObject
1335− :: PGArrayOf "jsonbObject" arr ('NotNull 'PGtext)
1336− => null arr :--> null 'PGjsonb
1337−jsonbObject = unsafeFunction "jsonb_object"
1338−
1339−-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
1340−-- keys and one for values, that are zipped pairwise to create a JSON object.
1341−jsonZipObject
1342− :: ( PGArrayOf "jsonZipObject" keysArray ('NotNull 'PGtext)
1343− , PGArrayOf "jsonZipObject" valuesArray ('NotNull 'PGtext))
1344− => Expression outer grp commons schemas params from (null keysArray)
1345− -> Expression outer grp commons schemas params from (null valuesArray)
1346− -> Expression outer grp commons schemas params from (null 'PGjson)
1347−jsonZipObject ks vs =
1348− unsafeVariadicFunction "json_object" (ks :* vs :* Nil)
1349−
1350−-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
1351−-- keys and one for values, that are zipped pairwise to create a binary JSON
1352−-- object.
1353−jsonbZipObject
1354− :: ( PGArrayOf "jsonbZipObject" keysArray ('NotNull 'PGtext)
1355− , PGArrayOf "jsonbZipObject" valuesArray ('NotNull 'PGtext))
1356− => Expression outer grp commons schemas params from (null keysArray)
1357− -> Expression outer grp commons schemas params from (null valuesArray)
1358− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1359−jsonbZipObject ks vs =
1360− unsafeVariadicFunction "jsonb_object" (ks :* vs :* Nil)
1361−
1362−{-----------------------------------------
1363−Table 9.46: JSON processing functions
1364−-----------------------------------------}
1365−
1366−-- | Returns the number of elements in the outermost JSON array.
1367−jsonArrayLength :: null 'PGjson :--> null 'PGint4
1368−jsonArrayLength = unsafeFunction "json_array_length"
1369−
1370−-- | Returns the number of elements in the outermost binary JSON array.
1371−jsonbArrayLength :: null 'PGjsonb :--> null 'PGint4
1372−jsonbArrayLength = unsafeFunction "jsonb_array_length"
1373−
1374−-- | Returns JSON value pointed to by the given path (equivalent to #>
1375−-- operator).
1376−jsonExtractPath
1377− :: SListI elems
1378− => Expression outer grp commons schemas params from (null 'PGjson)
1379− -> NP (Expression outer grp commons schemas params from) elems
1380− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1381−jsonExtractPath x xs =
1382− unsafeVariadicFunction "json_extract_path" (x :* xs)
1383−
1384−-- | Returns JSON value pointed to by the given path (equivalent to #>
1385−-- operator).
1386−jsonbExtractPath
1387− :: SListI elems
1388− => Expression outer grp commons schemas params from (null 'PGjsonb)
1389− -> NP (Expression outer grp commons schemas params from) elems
1390− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1391−jsonbExtractPath x xs =
1392− unsafeVariadicFunction "jsonb_extract_path" (x :* xs)
1393−
1394−-- | Returns JSON value pointed to by the given path (equivalent to #>
1395−-- operator), as text.
1396−jsonExtractPathAsText
1397− :: SListI elems
1398− => Expression outer grp commons schemas params from (null 'PGjson)
1399− -> NP (Expression outer grp commons schemas params from) elems
1400− -> Expression outer grp commons schemas params from (null 'PGjson)
1401−jsonExtractPathAsText x xs =
1402− unsafeVariadicFunction "json_extract_path_text" (x :* xs)
1403−
1404−-- | Returns JSON value pointed to by the given path (equivalent to #>
1405−-- operator), as text.
1406−jsonbExtractPathAsText
1407− :: SListI elems
1408− => Expression outer grp commons schemas params from (null 'PGjsonb)
1409− -> NP (Expression outer grp commons schemas params from) elems
1410− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1411−jsonbExtractPathAsText x xs =
1412− unsafeVariadicFunction "jsonb_extract_path_text" (x :* xs)
1413−
1414−-- | Returns the type of the outermost JSON value as a text string. Possible
1415−-- types are object, array, string, number, boolean, and null.
1416−jsonTypeof :: null 'PGjson :--> null 'PGtext
1417−jsonTypeof = unsafeFunction "json_typeof"
1418−
1419−-- | Returns the type of the outermost binary JSON value as a text string.
1420−-- Possible types are object, array, string, number, boolean, and null.
1421−jsonbTypeof :: null 'PGjsonb :--> null 'PGtext
1422−jsonbTypeof = unsafeFunction "jsonb_typeof"
1423−
1424−-- | Returns its argument with all object fields that have null values omitted.
1425−-- Other null values are untouched.
1426−jsonStripNulls :: null 'PGjson :--> null 'PGjson
1427−jsonStripNulls = unsafeFunction "json_strip_nulls"
1428−
1429−-- | Returns its argument with all object fields that have null values omitted.
1430−-- Other null values are untouched.
1431−jsonbStripNulls :: null 'PGjsonb :--> null 'PGjsonb
1432−jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
1433−
1434−-- | @ jsonbSet target path new_value create_missing @
1435−--
1436−-- Returns target with the section designated by path replaced by new_value,
1437−-- or with new_value added if create_missing is true ( default is true) and the
1438−-- item designated by path does not exist. As with the path orientated
1439−-- operators, negative integers that appear in path count from the end of JSON
1440−-- arrays.
1441−jsonbSet
1442− :: PGTextArray "jsonbSet" arr
1443− => Expression outer grp commons schemas params from (null 'PGjsonb)
1444− -> Expression outer grp commons schemas params from (null arr)
1445− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1446− -> Maybe (Expression outer grp commons schemas params from (null 'PGbool))
1447− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1448−jsonbSet tgt path val createMissing = case createMissing of
1449− Just m -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* m :* Nil)
1450− Nothing -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* Nil)
1451−
1452−-- | @ jsonbInsert target path new_value insert_after @
1453−--
1454−-- Returns target with new_value inserted. If target section designated by
1455−-- path is in a JSONB array, new_value will be inserted before target or after
1456−-- if insert_after is true (default is false). If target section designated by
1457−-- path is in JSONB object, new_value will be inserted only if target does not
1458−-- exist. As with the path orientated operators, negative integers that appear
1459−-- in path count from the end of JSON arrays.
1460−jsonbInsert
1461− :: PGTextArray "jsonbInsert" arr
1462− => Expression outer grp commons schemas params from (null 'PGjsonb)
1463− -> Expression outer grp commons schemas params from (null arr)
1464− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1465− -> Maybe (Expression outer grp commons schemas params from (null 'PGbool))
1466− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1467−jsonbInsert tgt path val insertAfter = case insertAfter of
1468− Just i -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* i :* Nil)
1469− Nothing -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* Nil)
1470−
1471−-- | Returns its argument as indented JSON text.
1472−jsonbPretty :: null 'PGjsonb :--> null 'PGtext
1473−jsonbPretty = unsafeFunction "jsonb_pretty"
1474−
1475−(@@) :: Operator (null 'PGtsvector) (null 'PGtsquery) ('Null 'PGbool)
1476−(@@) = unsafeBinaryOp "@@"
1477−
1478−(.&) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
1479−(.&) = unsafeBinaryOp "&&"
1480−
1481−(.|) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
1482−(.|) = unsafeBinaryOp "||"
1483−
1484−(.!) :: null 'PGtsquery :--> null 'PGtsquery
1485−(.!) = unsafeUnaryOpL "!!"
1486−
1487−(<->) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
1488−(<->) = unsafeBinaryOp "<->"
1489−
1490−arrayToTSvector
1491− :: null ('PGvararray ('NotNull 'PGtext))
1492− :--> null 'PGtsvector
1493−arrayToTSvector = unsafeFunction "array_to_tsvector"
1494−
1495−tsvectorLength :: null 'PGtsvector :--> null 'PGint4
1496−tsvectorLength = unsafeFunction "length"
1497−
1498−numnode :: null 'PGtsquery :--> null 'PGint4
1499−numnode = unsafeFunction "numnode"
1500−
1501−plainToTSquery
1502− :: FunctionHet '[null 'PGtext, null 'PGtext] (null 'PGtsquery)
1503−plainToTSquery = unsafeFunctionHet "plainto_tsquery"
1504−
1505−phraseToTSquery
1506− :: FunctionHet '[null 'PGtext, null 'PGtext] (null 'PGtsquery)
1507−phraseToTSquery = unsafeFunctionHet "phraseto_tsquery"
1508−
1509−websearchToTSquery
1510− :: FunctionHet '[null 'PGtext, null 'PGtext] (null 'PGtsquery)
1511−websearchToTSquery = unsafeFunctionHet "websearch_to_tsquery"
1512−
1513−queryTree :: null 'PGtsquery :--> null 'PGtext
1514−queryTree = unsafeFunction "query_tree"
1515−
1516−toTSquery
1517− :: FunctionHet '[null 'PGtext, null 'PGtext] (null 'PGtsquery)
1518−toTSquery = unsafeFunctionHet "to_tsquery"
1519−
1520−toTSvector
1521− :: ty `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
1522− => FunctionHet '[null 'PGtext, null ty] (null 'PGtsquery)
1523−toTSvector = unsafeFunctionHet "to_tsvector"
1524−
1525−{-----------------------------------------
1526−aggregation
1527−-----------------------------------------}
1528−
1529−{- |
1530−`Aggregate` functions compute a single result from a set of input values.
1531−`Aggregate` functions can be used as `GroupedBy` `Expression`s as well
1532−as `WindowFunction`s.
1533−-}
1534−class Aggregate expr1 expr2 aggr
1535− | aggr -> expr1, aggr -> expr2 where
1536−
1537− -- | A special aggregation that does not require an input
1538− --
1539− -- >>> :{
1540− -- let
1541− -- expression :: Expression '[] ('Grouped bys) commons schemas params from ('NotNull 'PGint8)
1542− -- expression = countStar
1543− -- in printSQL expression
1544− -- :}
1545− -- count(*)
1546− countStar :: aggr ('NotNull 'PGint8)
1547−
1548− -- | >>> :{
1549− -- let
1550− -- expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: null ty]] ('NotNull 'PGint8)
1551− -- expression = count (All #col)
1552− -- in printSQL expression
1553− -- :}
1554− -- count(ALL "col")
1555− count
1556− :: expr1 ty
1557− -- ^ what to count
1558− -> aggr ('NotNull 'PGint8)
1559−
1560− -- | >>> :{
1561− -- let
1562− -- expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: 'Null 'PGnumeric]] ('NotNull 'PGnumeric)
1563− -- expression = sum_ (Distinct #col)
1564− -- in printSQL expression
1565− -- :}
1566− -- sum(DISTINCT "col")
1567− sum_
1568− :: ty `In` PGNum
1569− => expr1 (null ty)
1570− -> aggr ('NotNull ty)
1571−
1572− -- | input values, including nulls, concatenated into an array
1573− arrayAgg
1574− :: expr1 ty
1575− -> aggr ('Null ('PGvararray ty))
1576−
1577− -- | aggregates values as a JSON array
1578− jsonAgg
1579− :: expr1 ty
1580− -> aggr ('Null 'PGjson)
1581−
1582− -- | aggregates values as a JSON array
1583− jsonbAgg
1584− :: expr1 ty
1585− -> aggr ('Null 'PGjsonb)
1586−
1587− {- |
1588− the bitwise AND of all non-null input values, or null if none
1589− >>> :{
1590− let
1591− expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: null 'PGint4]] ('Null 'PGint4)
1592− expression = bitAnd (Distinct #col)
1593− in printSQL expression
1594− :}
1595− bit_and(DISTINCT "col")
1596− -}
1597− bitAnd
1598− :: int `In` PGIntegral
1599− => expr1 (null int)
1600− -- ^ what to aggregate
1601− -> aggr ('Null int)
1602−
1603− {- |
1604− the bitwise OR of all non-null input values, or null if none
1605−
1606− >>> :{
1607− let
1608− expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: null 'PGint4]] ('Null 'PGint4)
1609− expression = bitOr (All #col)
1610− in printSQL expression
1611− :}
1612− bit_or(ALL "col")
1613− -}
1614− bitOr
1615− :: int `In` PGIntegral
1616− => expr1 (null int)
1617− -- ^ what to aggregate
1618− -> aggr ('Null int)
1619−
1620− {- |
1621− true if all input values are true, otherwise false
1622−
1623− >>> :{
1624− let
1625− winFun :: WindowFunction '[] 'Ungrouped commons schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
1626− winFun = boolAnd #col
1627− in printSQL winFun
1628− :}
1629− bool_and("col")
1630− -}
1631− boolAnd
1632− :: expr1 (null 'PGbool)
1633− -- ^ what to aggregate
1634− -> aggr ('Null 'PGbool)
1635−
1636− {- |
1637− true if at least one input value is true, otherwise false
1638−
1639− >>> :{
1640− let
1641− expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
1642− expression = boolOr (All #col)
1643− in printSQL expression
1644− :}
1645− bool_or(ALL "col")
1646− -}
1647− boolOr
1648− :: expr1(null 'PGbool)
1649− -- ^ what to aggregate
1650− -> aggr ('Null 'PGbool)
1651−
1652− {- |
1653− equivalent to `boolAnd`
1654−
1655− >>> :{
1656− let
1657− expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
1658− expression = every (Distinct #col)
1659− in printSQL expression
1660− :}
1661− every(DISTINCT "col")
1662− -}
1663− every
1664− :: expr1 (null 'PGbool)
1665− -- ^ what to aggregate
1666− -> aggr ('Null 'PGbool)
1667−
1668− {- |maximum value of expression across all input values-}
1669− max_
1670− :: expr1 (null ty)
1671− -- ^ what to maximize
1672− -> aggr ('Null ty)
1673−
1674− -- | minimum value of expression across all input values
1675− min_
1676− :: expr1 (null ty)
1677− -- ^ what to minimize
1678− -> aggr ('Null ty)
1679−
1680− -- | the average (arithmetic mean) of all input values
1681− avg
1682− :: expr1 (null ty)
1683− -- ^ what to average
1684− -> aggr ('Null (PGAvg ty))
1685−
1686− {- | correlation coefficient
1687− >>> :{
1688− let
1689− expression :: Expression '[] ('Grouped g) c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1690− expression = corr (All (#y :*: #x))
1691− in printSQL expression
1692− :}
1693− corr(ALL "y", "x")
1694− -}
1695− corr
1696− :: expr2 (null 'PGfloat8)
1697− -> aggr ('Null 'PGfloat8)
1698−
1699− {- | population covariance
1700− >>> :{
1701− let
1702− expression :: Expression '[] ('Grouped g) c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1703− expression = covarPop (All (#y :*: #x))
1704− in printSQL expression
1705− :}
1706− covar_pop(ALL "y", "x")
1707− -}
1708− covarPop
1709− :: expr2 (null 'PGfloat8)
1710− -> aggr ('Null 'PGfloat8)
1711−
1712− {- | sample covariance
1713− >>> :{
1714− let
1715− winFun :: WindowFunction '[] 'Ungrouped c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1716− winFun = covarSamp (#y :*: #x)
1717− in printSQL winFun
1718− :}
1719− covar_samp("y", "x")
1720− -}
1721− covarSamp
1722− :: expr2 (null 'PGfloat8)
1723− -> aggr ('Null 'PGfloat8)
1724−
1725− {- | average of the independent variable (sum(X)/N)
1726− >>> :{
1727− let
1728− expression :: Expression '[] ('Grouped g) c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1729− expression = regrAvgX (All (#y :*: #x))
1730− in printSQL expression
1731− :}
1732− regr_avgx(ALL "y", "x")
1733− -}
1734− regrAvgX
1735− :: expr2 (null 'PGfloat8)
1736− -> aggr ('Null 'PGfloat8)
1737−
1738− {- | average of the dependent variable (sum(Y)/N)
1739− >>> :{
1740− let
1741− winFun :: WindowFunction '[] 'Ungrouped c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1742− winFun = regrAvgY (#y :*: #x)
1743− in printSQL winFun
1744− :}
1745− regr_avgy("y", "x")
1746− -}
1747− regrAvgY
1748− :: expr2 (null 'PGfloat8)
1749− -> aggr ('Null 'PGfloat8)
1750−
1751− {- | number of input rows in which both expressions are nonnull
1752− >>> :{
1753− let
1754− winFun :: WindowFunction '[] 'Ungrouped c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGint8)
1755− winFun = regrCount (#y :*: #x)
1756− in printSQL winFun
1757− :}
1758− regr_count("y", "x")
1759− -}
1760− regrCount
1761− :: expr2 (null 'PGfloat8)
1762− -> aggr ('Null 'PGint8)
1763−
1764− {- | y-intercept of the least-squares-fit linear equation determined by the (X, Y) pairs
1765− >>> :{
1766− let
1767− expression :: Expression '[] ('Grouped g) c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1768− expression = regrIntercept (All (#y :*: #x))
1769− in printSQL expression
1770− :}
1771− regr_intercept(ALL "y", "x")
1772− -}
1773− regrIntercept
1774− :: expr2 (null 'PGfloat8)
1775− -> aggr ('Null 'PGfloat8)
1776−
1777− -- | @regr_r2(Y, X)@, square of the correlation coefficient
1778− regrR2
1779− :: expr2 (null 'PGfloat8)
1780− -> aggr ('Null 'PGfloat8)
1781−
1782− -- | @regr_slope(Y, X)@, slope of the least-squares-fit linear equation
1783− -- determined by the (X, Y) pairs
1784− regrSlope
1785− :: expr2 (null 'PGfloat8)
1786− -> aggr ('Null 'PGfloat8)
1787−
1788− -- | @regr_sxx(Y, X)@, sum(X^2) - sum(X)^2/N
1789− -- (“sum of squares” of the independent variable)
1790− regrSxx
1791− :: expr2 (null 'PGfloat8)
1792− -> aggr ('Null 'PGfloat8)
1793−
1794− -- | @regr_sxy(Y, X)@, sum(X*Y) - sum(X) * sum(Y)/N
1795− -- (“sum of products” of independent times dependent variable)
1796− regrSxy
1797− :: expr2 (null 'PGfloat8)
1798− -> aggr ('Null 'PGfloat8)
1799−
1800− -- | @regr_syy(Y, X)@, sum(Y^2) - sum(Y)^2/N
1801− -- (“sum of squares” of the dependent variable)
1802− regrSyy
1803− :: expr2 (null 'PGfloat8)
1804− -> aggr ('Null 'PGfloat8)
1805−
1806− -- | historical alias for `stddevSamp`
1807− stddev
1808− :: expr1 (null ty)
1809− -> aggr ('Null (PGAvg ty))
1810−
1811− -- | population standard deviation of the input values
1812− stddevPop
1813− :: expr1 (null ty)
1814− -> aggr ('Null (PGAvg ty))
1815−
1816− -- | sample standard deviation of the input values
1817− stddevSamp
1818− :: expr1 (null ty)
1819− -> aggr ('Null (PGAvg ty))
1820−
1821− -- | historical alias for `varSamp`
1822− variance
1823− :: expr1 (null ty)
1824− -> aggr ('Null (PGAvg ty))
1825−
1826− -- | population variance of the input values
1827− -- (square of the population standard deviation)
1828− varPop
1829− :: expr1 (null ty)
1830− -> aggr ('Null (PGAvg ty))
1831−
1832− -- | sample variance of the input values
1833− -- (square of the sample standard deviation)
1834− varSamp
1835− :: expr1 (null ty)
1836− -> aggr ('Null (PGAvg ty))
1837−
1838−{- |
1839−`Distinction`s are used for the input of `Aggregate` `Expression`s.
1840−`All` invokes the aggregate once for each input row.
1841−`Distinct` invokes the aggregate once for each distinct value of the expression
1842−(or distinct set of values, for multiple expressions) found in the input
1843−-}
1844−data Distinction expr ty
1845− = All (expr ty)
1846− | Distinct (expr ty)
1847− deriving (GHC.Generic,Show,Eq,Ord)
1848−instance NFData (Distinction (Expression outer grp commons schemas params from) ty)
1849−instance RenderSQL (Distinction (Expression outer grp commons schemas params from) ty) where
1850− renderSQL = \case
1851− All x -> "ALL" <+> renderSQL x
1852− Distinct x -> "DISTINCT" <+> renderSQL x
1853−instance RenderSQL
1854− (Distinction
1855− ( Expression outer grp commons schemas params from
1856− :*:
1857− Expression outer grp commons schemas params from) xty ) where
1858− renderSQL = \case
1859− All (x :*: x') ->
1860− "ALL" <+> renderSQL x <> ", " <> renderSQL x'
1861− Distinct (x :*: x') ->
1862− "DISTINCT" <+> renderSQL x <> ", " <> renderSQL x'
1863−
1864−instance Aggregate
1865− (Distinction (Expression outer 'Ungrouped commons schemas params from))
1866− (Distinction (Expression outer 'Ungrouped commons schemas params from :*: Expression outer 'Ungrouped commons schemas params from))
1867− (Expression outer ('Grouped bys) commons schemas params from) where
1868− countStar = UnsafeExpression "count(*)"
1869− count = unsafeAggregate1 "count"
1870− sum_ = unsafeAggregate1 "sum"
1871− arrayAgg = unsafeAggregate1 "array_agg"
1872− jsonAgg = unsafeAggregate1 "json_agg"
1873− jsonbAgg = unsafeAggregate1 "jsonb_agg"
1874− bitAnd = unsafeAggregate1 "bit_and"
1875− bitOr = unsafeAggregate1 "bit_or"
1876− boolAnd = unsafeAggregate1 "bool_and"
1877− boolOr = unsafeAggregate1 "bool_or"
1878− every = unsafeAggregate1 "every"
1879− max_ = unsafeAggregate1 "max"
1880− min_ = unsafeAggregate1 "min"
1881− avg = unsafeAggregate1 "avg"
1882− corr = unsafeAggregate2 "corr"
1883− covarPop = unsafeAggregate2 "covar_pop"
1884− covarSamp = unsafeAggregate2 "covar_samp"
1885− regrAvgX = unsafeAggregate2 "regr_avgx"
1886− regrAvgY = unsafeAggregate2 "regr_avgy"
1887− regrCount = unsafeAggregate2 "regr_count"
1888− regrIntercept = unsafeAggregate2 "regr_intercept"
1889− regrR2 = unsafeAggregate2 "regr_r2"
1890− regrSlope = unsafeAggregate2 "regr_slope"
1891− regrSxx = unsafeAggregate2 "regr_sxx"
1892− regrSxy = unsafeAggregate2 "regr_sxy"
1893− regrSyy = unsafeAggregate2 "regr_syy"
1894− stddev = unsafeAggregate1 "stddev"
1895− stddevPop = unsafeAggregate1 "stddev_pop"
1896− stddevSamp = unsafeAggregate1 "stddev_samp"
1897− variance = unsafeAggregate1 "variance"
1898− varPop = unsafeAggregate1 "var_pop"
1899− varSamp = unsafeAggregate1 "var_samp"
1900−instance Aggregate
1901− (Expression outer grp commons schemas params from)
1902− (Expression outer grp commons schemas params from :*: Expression outer grp commons schemas params from)
1903− (WindowFunction outer grp commons schemas params from) where
1904− countStar = UnsafeWindowFunction "count(*)"
1905− count = unsafeWindowFunction1 "count"
1906− sum_ = unsafeWindowFunction1 "sum"
1907− arrayAgg = unsafeWindowFunction1 "array_agg"
1908− jsonAgg = unsafeWindowFunction1 "json_agg"
1909− jsonbAgg = unsafeWindowFunction1 "jsonb_agg"
1910− bitAnd = unsafeWindowFunction1 "bit_and"
1911− bitOr = unsafeWindowFunction1 "bit_or"
1912− boolAnd = unsafeWindowFunction1 "bool_and"
1913− boolOr = unsafeWindowFunction1 "bool_or"
1914− every = unsafeWindowFunction1 "every"
1915− max_ = unsafeWindowFunction1 "max"
1916− min_ = unsafeWindowFunction1 "min"
1917− avg = unsafeWindowFunction1 "avg"
1918− corr = unsafeWindowFunction2 "corr"
1919− covarPop = unsafeWindowFunction2 "covar_pop"
1920− covarSamp = unsafeWindowFunction2 "covar_samp"
1921− regrAvgX = unsafeWindowFunction2 "regr_avgx"
1922− regrAvgY = unsafeWindowFunction2 "regr_avgy"
1923− regrCount = unsafeWindowFunction2 "regr_count"
1924− regrIntercept = unsafeWindowFunction2 "regr_intercept"
1925− regrR2 = unsafeWindowFunction2 "regr_r2"
1926− regrSlope = unsafeWindowFunction2 "regr_slope"
1927− regrSxx = unsafeWindowFunction2 "regr_sxx"
1928− regrSxy = unsafeWindowFunction2 "regr_sxy"
1929− regrSyy = unsafeWindowFunction2 "regr_syy"
1930− stddev = unsafeWindowFunction1 "stddev"
1931− stddevPop = unsafeWindowFunction1 "stddev_pop"
1932− stddevSamp = unsafeWindowFunction1 "stddev_samp"
1933− variance = unsafeWindowFunction1 "variance"
1934− varPop = unsafeWindowFunction1 "var_pop"
1935− varSamp = unsafeWindowFunction1 "var_samp"
1936−
1937−-- | escape hatch to define aggregate functions
1938−unsafeAggregate1
1939− :: ByteString -- ^ aggregate function
1940− -> Distinction (Expression outer 'Ungrouped commons schemas params from) xty
1941− -> Expression outer ('Grouped bys) commons schemas params from yty
1942−unsafeAggregate1 fun x = UnsafeExpression $ mconcat
1943− [fun, "(", renderSQL x, ")"]
1944−
1945−-- | escape hatch to define aggregate binary functions
1946−unsafeAggregate2
1947− :: ByteString -- ^ aggregate function
1948− -> Distinction (Expression outer 'Ungrouped commons schemas params from :*: Expression outer 'Ungrouped commons schemas params from) xty
1949− -> Expression outer ('Grouped bys) commons schemas params from yty
1950−unsafeAggregate2 fun xx = UnsafeExpression $ mconcat
1951− [fun, "(", renderSQL xx, ")"]
1952−
1953−-- | A type family that calculates `PGAvg` type of a `PGType`.
1954−type family PGAvg ty where
1955− PGAvg 'PGint2 = 'PGnumeric
1956− PGAvg 'PGint4 = 'PGnumeric
1957− PGAvg 'PGint8 = 'PGnumeric
1958− PGAvg 'PGnumeric = 'PGnumeric
1959− PGAvg 'PGfloat4 = 'PGfloat8
1960− PGAvg 'PGfloat8 = 'PGfloat8
1961− PGAvg 'PGinterval = 'PGinterval
1962− PGAvg pg = TypeError
1963− ('Text "Squeal type error: No average for " ':<>: 'ShowType pg)
1964−
1965−{-----------------------------------------
1966−type expressions
1967−-----------------------------------------}
1968−
1969−-- | `TypeExpression`s are used in `cast`s and
1970−-- `Squeal.PostgreSQL.Definition.createTable` commands.
1971−newtype TypeExpression (schemas :: SchemasType) (ty :: NullityType)
1972− = UnsafeTypeExpression { renderTypeExpression :: ByteString }
1973− deriving (GHC.Generic,Show,Eq,Ord,NFData)
1974−instance RenderSQL (TypeExpression schemas ty) where
1975− renderSQL = renderTypeExpression
1976−
1977−-- | The enum or composite type in a `Typedef` can be expressed by its alias.
1978−typedef
1979− :: (Has sch schemas schema, Has td schema ('Typedef ty))
1980− => QualifiedAlias sch td
1981− -> TypeExpression schemas (null ty)
1982−typedef = UnsafeTypeExpression . renderSQL
1983−
1984−-- | The composite type corresponding to a `Table` definition can be expressed
1985−-- by its alias.
1986−typetable
1987− :: (Has sch schemas schema, Has tab schema ('Table table))
1988− => QualifiedAlias sch tab
1989− -> TypeExpression schemas (null ('PGcomposite (TableToRow table)))
1990−typetable = UnsafeTypeExpression . renderSQL
1991−
1992−-- | The composite type corresponding to a `View` definition can be expressed
1993−-- by its alias.
1994−typeview
1995− :: (Has sch schemas schema, Has vw schema ('View view))
1996− => QualifiedAlias sch vw
1997− -> TypeExpression schemas (null ('PGcomposite view))
1998−typeview = UnsafeTypeExpression . renderSQL
1999−
2000−-- | logical Boolean (true/false)
2001−bool :: TypeExpression schemas (null 'PGbool)
2002−bool = UnsafeTypeExpression "bool"
2003−-- | signed two-byte integer
2004−int2, smallint :: TypeExpression schemas (null 'PGint2)
2005−int2 = UnsafeTypeExpression "int2"
2006−smallint = UnsafeTypeExpression "smallint"
2007−-- | signed four-byte integer
2008−int4, int, integer :: TypeExpression schemas (null 'PGint4)
2009−int4 = UnsafeTypeExpression "int4"
2010−int = UnsafeTypeExpression "int"
2011−integer = UnsafeTypeExpression "integer"
2012−-- | signed eight-byte integer
2013−int8, bigint :: TypeExpression schemas (null 'PGint8)
2014−int8 = UnsafeTypeExpression "int8"
2015−bigint = UnsafeTypeExpression "bigint"
2016−-- | arbitrary precision numeric type
2017−numeric :: TypeExpression schemas (null 'PGnumeric)
2018−numeric = UnsafeTypeExpression "numeric"
2019−-- | single precision floating-point number (4 bytes)
2020−float4, real :: TypeExpression schemas (null 'PGfloat4)
2021−float4 = UnsafeTypeExpression "float4"
2022−real = UnsafeTypeExpression "real"
2023−-- | double precision floating-point number (8 bytes)
2024−float8, doublePrecision :: TypeExpression schemas (null 'PGfloat8)
2025−float8 = UnsafeTypeExpression "float8"
2026−doublePrecision = UnsafeTypeExpression "double precision"
2027−-- | currency amount
2028−money :: TypeExpression schema (null 'PGmoney)
2029−money = UnsafeTypeExpression "money"
2030−-- | variable-length character string
2031−text :: TypeExpression schemas (null 'PGtext)
2032−text = UnsafeTypeExpression "text"
2033−-- | fixed-length character string
2034−char, character
2035− :: forall n schemas null. (KnownNat n, 1 <= n)
2036− => TypeExpression schemas (null ('PGchar n))
2037−char = UnsafeTypeExpression $ "char(" <> renderNat @n <> ")"
2038−character = UnsafeTypeExpression $ "character(" <> renderNat @n <> ")"
2039−-- | variable-length character string
2040−varchar, characterVarying
2041− :: forall n schemas null. (KnownNat n, 1 <= n)
2042− => TypeExpression schemas (null ('PGvarchar n))
2043−varchar = UnsafeTypeExpression $ "varchar(" <> renderNat @n <> ")"
2044−characterVarying = UnsafeTypeExpression $
2045− "character varying(" <> renderNat @n <> ")"
2046−-- | binary data ("byte array")
2047−bytea :: TypeExpression schemas (null 'PGbytea)
2048−bytea = UnsafeTypeExpression "bytea"
2049−-- | date and time (no time zone)
2050−timestamp :: TypeExpression schemas (null 'PGtimestamp)
2051−timestamp = UnsafeTypeExpression "timestamp"
2052−-- | date and time, including time zone
2053−timestampWithTimeZone :: TypeExpression schemas (null 'PGtimestamptz)
2054−timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"
2055−-- | calendar date (year, month, day)
2056−date :: TypeExpression schemas (null 'PGdate)
2057−date = UnsafeTypeExpression "date"
2058−-- | time of day (no time zone)
2059−time :: TypeExpression schemas (null 'PGtime)
2060−time = UnsafeTypeExpression "time"
2061−-- | time of day, including time zone
2062−timeWithTimeZone :: TypeExpression schemas (null 'PGtimetz)
2063−timeWithTimeZone = UnsafeTypeExpression "time with time zone"
2064−-- | time span
2065−interval :: TypeExpression schemas (null 'PGinterval)
2066−interval = UnsafeTypeExpression "interval"
2067−-- | universally unique identifier
2068−uuid :: TypeExpression schemas (null 'PGuuid)
2069−uuid = UnsafeTypeExpression "uuid"
2070−-- | IPv4 or IPv6 host address
2071−inet :: TypeExpression schemas (null 'PGinet)
2072−inet = UnsafeTypeExpression "inet"
2073−-- | textual JSON data
2074−json :: TypeExpression schemas (null 'PGjson)
2075−json = UnsafeTypeExpression "json"
2076−-- | binary JSON data, decomposed
2077−jsonb :: TypeExpression schemas (null 'PGjsonb)
2078−jsonb = UnsafeTypeExpression "jsonb"
2079−-- | variable length array
2080−vararray
2081− :: TypeExpression schemas pg
2082− -> TypeExpression schemas (null ('PGvararray pg))
2083−vararray ty = UnsafeTypeExpression $ renderSQL ty <> "[]"
2084−-- | fixed length array
2085−--
2086−-- >>> renderSQL (fixarray @'[2] json)
2087−-- "json[2]"
2088−fixarray
2089− :: forall dims schemas null pg. SOP.All KnownNat dims
2090− => TypeExpression schemas pg
2091− -> TypeExpression schemas (null ('PGfixarray dims pg))
2092−fixarray ty = UnsafeTypeExpression $
2093− renderSQL ty <> renderDims @dims
2094− where
2095− renderDims :: forall ns. SOP.All KnownNat ns => ByteString
2096− renderDims =
2097− ("[" <>)
2098− . (<> "]")
2099− . ByteString.intercalate "]["
2100− . hcollapse
2101− $ hcmap (SOP.Proxy @KnownNat)
2102− (K . fromString . show . natVal)
2103− (hpure SOP.Proxy :: NP SOP.Proxy ns)
2104−tsvector :: TypeExpression schemas (null 'PGtsvector)
2105−tsvector = UnsafeTypeExpression "tsvector"
2106−tsquery :: TypeExpression schemas (null 'PGtsquery)
2107−tsquery = UnsafeTypeExpression "tsquery"
2108−
2109−-- | `pgtype` is a demoted version of a `PGType`
2110−class PGTyped schemas (ty :: NullityType) where
2111− pgtype :: TypeExpression schemas ty
2112−instance PGTyped schemas (null 'PGbool) where pgtype = bool
2113−instance PGTyped schemas (null 'PGint2) where pgtype = int2
2114−instance PGTyped schemas (null 'PGint4) where pgtype = int4
2115−instance PGTyped schemas (null 'PGint8) where pgtype = int8
2116−instance PGTyped schemas (null 'PGnumeric) where pgtype = numeric
2117−instance PGTyped schemas (null 'PGfloat4) where pgtype = float4
2118−instance PGTyped schemas (null 'PGfloat8) where pgtype = float8
2119−instance PGTyped schemas (null 'PGmoney) where pgtype = money
2120−instance PGTyped schemas (null 'PGtext) where pgtype = text
2121−instance (KnownNat n, 1 <= n)
2122− => PGTyped schemas (null ('PGchar n)) where pgtype = char @n
2123−instance (KnownNat n, 1 <= n)
2124− => PGTyped schemas (null ('PGvarchar n)) where pgtype = varchar @n
2125−instance PGTyped schemas (null 'PGbytea) where pgtype = bytea
2126−instance PGTyped schemas (null 'PGtimestamp) where pgtype = timestamp
2127−instance PGTyped schemas (null 'PGtimestamptz) where pgtype = timestampWithTimeZone
2128−instance PGTyped schemas (null 'PGdate) where pgtype = date
2129−instance PGTyped schemas (null 'PGtime) where pgtype = time
2130−instance PGTyped schemas (null 'PGtimetz) where pgtype = timeWithTimeZone
2131−instance PGTyped schemas (null 'PGinterval) where pgtype = interval
2132−instance PGTyped schemas (null 'PGuuid) where pgtype = uuid
2133−instance PGTyped schemas (null 'PGjson) where pgtype = json
2134−instance PGTyped schemas (null 'PGjsonb) where pgtype = jsonb
2135−instance PGTyped schemas ty
2136− => PGTyped schemas (null ('PGvararray ty)) where
2137− pgtype = vararray (pgtype @schemas @ty)
2138−instance (SOP.All KnownNat dims, PGTyped schemas ty)
2139− => PGTyped schemas (null ('PGfixarray dims ty)) where
2140− pgtype = fixarray @dims (pgtype @schemas @ty)
2141−instance PGTyped schemas (null 'PGtsvector) where pgtype = tsvector
2142−instance PGTyped schemas (null 'PGtsquery) where pgtype = tsquery
2143−
2144−{-----------------------------------------
2145−Sorting
2146−-----------------------------------------}
2147−
2148−-- | `SortExpression`s are used by `orderBy` to optionally sort the results
2149−-- of a `Squeal.PostgreSQL.Query.Query`. `Asc` or `Desc`
2150−-- set the sort direction of a `NotNull` result
2151−-- column to ascending or descending. Ascending order puts smaller values
2152−-- first, where "smaller" is defined in terms of the `.<` operator. Similarly,
2153−-- descending order is determined with the `.>` operator. `AscNullsFirst`,
2154−-- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to
2155−-- determine whether nulls appear before or after non-null values in the sort
2156−-- ordering of a `Null` result column.
2157−data SortExpression outer grp commons schemas params from where
2158− Asc
2159− :: Expression outer grp commons schemas params from ('NotNull ty)
2160− -> SortExpression outer grp commons schemas params from
2161− Desc
2162− :: Expression outer grp commons schemas params from ('NotNull ty)
2163− -> SortExpression outer grp commons schemas params from
2164− AscNullsFirst
2165− :: Expression outer grp commons schemas params from ('Null ty)
2166− -> SortExpression outer grp commons schemas params from
2167− AscNullsLast
2168− :: Expression outer grp commons schemas params from ('Null ty)
2169− -> SortExpression outer grp commons schemas params from
2170− DescNullsFirst
2171− :: Expression outer grp commons schemas params from ('Null ty)
2172− -> SortExpression outer grp commons schemas params from
2173− DescNullsLast
2174− :: Expression outer grp commons schemas params from ('Null ty)
2175− -> SortExpression outer grp commons schemas params from
2176−deriving instance Show (SortExpression outer grp commons schemas params from)
2177−
2178−{- |
2179−The `orderBy` clause causes the result rows of a `Squeal.PostgreSQL.Query.TableExpression`
2180−to be sorted according to the specified `SortExpression`(s).
2181−If two rows are equal according to the leftmost expression,
2182−they are compared according to the next expression and so on.
2183−If they are equal according to all specified expressions,
2184−they are returned in an implementation-dependent order.
2185−
2186−You can also control the order in which rows are processed by window functions
2187−using `orderBy` within `Squeal.PostgreSQL.Query.Over`.
2188−-}
2189−class OrderBy expr where
2190− orderBy
2191− :: [SortExpression outer grp commons schemas params from]
2192− -> expr outer grp commons schemas params from
2193− -> expr outer grp commons schemas params from
2194−
2195−-- | Render a `SortExpression`.
2196−instance RenderSQL (SortExpression outer grp commons schemas params from) where
2197− renderSQL = \case
2198− Asc expression -> renderSQL expression <+> "ASC"
2199− Desc expression -> renderSQL expression <+> "DESC"
2200− AscNullsFirst expression -> renderSQL expression
2201− <+> "ASC NULLS FIRST"
2202− DescNullsFirst expression -> renderSQL expression
2203− <+> "DESC NULLS FIRST"
2204− AscNullsLast expression -> renderSQL expression <+> "ASC NULLS LAST"
2205− DescNullsLast expression -> renderSQL expression <+> "DESC NULLS LAST"
2206−
2207−-- | A `WindowDefinition` is a set of table rows that are somehow related
2208−-- to the current row
2209−data WindowDefinition outer grp commons schemas params from where
2210− WindowDefinition
2211− :: SListI bys
2212− => NP (Expression outer grp commons schemas params from) bys
2213− -> [SortExpression outer grp commons schemas params from]
2214− -> WindowDefinition outer grp commons schemas params from
2215−
2216−instance OrderBy WindowDefinition where
2217− orderBy sortsR (WindowDefinition parts sortsL)
2218− = WindowDefinition parts (sortsL ++ sortsR)
2219−
2220−instance RenderSQL (WindowDefinition outer commons schemas from grp params) where
2221− renderSQL (WindowDefinition part ord) =
2222− renderPartitionByClause part <> renderOrderByClause ord
2223− where
2224− renderPartitionByClause = \case
2225− Nil -> ""
2226− parts -> "PARTITION" <+> "BY" <+> renderCommaSeparated renderExpression parts
2227− renderOrderByClause = \case
2228− [] -> ""
2229− srts -> " ORDER" <+> "BY"
2230− <+> commaSeparated (renderSQL <$> srts)
2231−
2232−{- |
2233−The `partitionBy` clause within `Squeal.PostgreSQL.Query.Over` divides the rows into groups,
2234−or partitions, that share the same values of the `partitionBy` `Expression`(s).
2235−For each row, the window function is computed across the rows that fall into
2236−the same partition as the current row.
2237−-}
2238−partitionBy
2239− :: SListI bys
2240− => NP (Expression outer grp commons schemas params from) bys
2241− -> WindowDefinition outer grp commons schemas params from
2242−partitionBy bys = WindowDefinition bys []
2243−
2244−{- |
2245−A window function performs a calculation across a set of table rows
2246−that are somehow related to the current row. This is comparable to the type
2247−of calculation that can be done with an aggregate function.
2248−However, window functions do not cause rows to become grouped into a single
2249−output row like non-window aggregate calls would.
2250−Instead, the rows retain their separate identities.
2251−Behind the scenes, the window function is able to access more than
2252−just the current row of the query result.
2253−-}
2254−newtype WindowFunction
2255− (outer :: FromType)
2256− (grp :: Grouping)
2257− (commons :: FromType)
2258− (schemas :: SchemasType)
2259− (params :: [NullityType])
2260− (from :: FromType)
2261− (ty :: NullityType)
2262− = UnsafeWindowFunction { renderWindowFunction :: ByteString }
2263− deriving (GHC.Generic,Show,Eq,Ord,NFData)
2264−
2265−instance RenderSQL (WindowFunction outer grp commons schemas params from ty) where
2266− renderSQL = renderWindowFunction
2267−
2268−unsafeWindowFunction1
2269− :: ByteString
2270− -> Expression outer grp commons schemas params from ty0
2271− -> WindowFunction outer grp commons schemas params from ty1
2272−unsafeWindowFunction1 fun x
2273− = UnsafeWindowFunction $ fun <> parenthesized (renderSQL x)
2274−
2275−unsafeWindowFunction2
2276− :: ByteString
2277− -> (Expression outer grp commons schemas params from :*: Expression outer grp commons schemas params from) ty0
2278− -> WindowFunction outer grp commons schemas params from ty1
2279−unsafeWindowFunction2 fun (x :*: x')
2280− = UnsafeWindowFunction $ fun <> parenthesized (renderSQL x <> ", " <> renderSQL x')
2281−
2282−{- | rank of the current row with gaps; same as `rowNumber` of its first peer
2283−>>> printSQL rank
2284−rank()
2285−-}
2286−rank :: WindowFunction outer grp commons schemas params from ('NotNull 'PGint8)
2287−rank = UnsafeWindowFunction "rank()"
2288−
2289−{- | number of the current row within its partition, counting from 1
2290−>>> printSQL rowNumber
2291−row_number()
2292−-}
2293−rowNumber :: WindowFunction outer grp commons schemas params from ('NotNull 'PGint8)
2294−rowNumber = UnsafeWindowFunction "row_number()"
2295−
2296−{- | rank of the current row without gaps; this function counts peer groups
2297−>>> printSQL denseRank
2298−dense_rank()
2299−-}
2300−denseRank :: WindowFunction outer grp commons schemas params from ('NotNull 'PGint8)
2301−denseRank = UnsafeWindowFunction "dense_rank()"
2302−
2303−{- | relative rank of the current row: (rank - 1) / (total partition rows - 1)
2304−>>> printSQL percentRank
2305−percent_rank()
2306−-}
2307−percentRank :: WindowFunction outer grp commons schemas params from ('NotNull 'PGfloat8)
2308−percentRank = UnsafeWindowFunction "percent_rank()"
2309−
2310−{- | cumulative distribution: (number of partition rows
2311−preceding or peer with current row) / total partition rows
2312−>>> printSQL cumeDist
2313−cume_dist()
2314−-}
2315−cumeDist :: WindowFunction outer grp commons schemas params from ('NotNull 'PGfloat8)
2316−cumeDist = UnsafeWindowFunction "cume_dist()"
2317−
2318−{- | integer ranging from 1 to the argument value,
2319−dividing the partition as equally as possible
2320−-}
2321−ntile
2322− :: Expression outer grp commons schemas params from ('NotNull 'PGint4)
2323− -- ^ num buckets
2324− -> WindowFunction outer grp commons schemas params from ('NotNull 'PGint4)
2325−ntile = unsafeWindowFunction1 "ntile"
2326−
2327−{- | returns value evaluated at the row that is offset rows before the current
2328−row within the partition; if there is no such row, instead return default
2329−(which must be of the same type as value). Both offset and default are
2330−evaluated with respect to the current row.
2331−-}
2332−lag
2333− :: Expression outer grp commons schemas params from ty
2334− -- ^ value
2335− -> Expression outer grp commons schemas params from ('NotNull 'PGint4)
2336− -- ^ offset
2337− -> Expression outer grp commons schemas params from ty
2338− -- ^ default
2339− -> WindowFunction outer grp commons schemas params from ty
2340−lag value offset def = UnsafeWindowFunction $ "lag"
2341− <> parenthesized
2342− (commaSeparated ([renderSQL value, renderSQL offset, renderSQL def]))
2343−
2344−{- | returns value evaluated at the row that is offset rows after the current
2345−row within the partition; if there is no such row, instead return default
2346−(which must be of the same type as value). Both offset and default are
2347−evaluated with respect to the current row.
2348−-}
2349−lead
2350− :: Expression outer grp commons schemas params from ty
2351− -- ^ value
2352− -> Expression outer grp commons schemas params from ('NotNull 'PGint4)
2353− -- ^ offset
2354− -> Expression outer grp commons schemas params from ty
2355− -- ^ default
2356− -> WindowFunction outer grp commons schemas params from ty
2357−lead value offset def = UnsafeWindowFunction $ "lag"
2358− <> parenthesized
2359− (commaSeparated ([renderSQL value, renderSQL offset, renderSQL def]))
2360−
2361−{- | returns value evaluated at the row that is the
2362−first row of the window frame
2363−-}
2364−firstValue
2365− :: Expression outer grp commons schemas params from ty
2366− -- ^ value
2367− -> WindowFunction outer grp commons schemas params from ty
2368−firstValue = unsafeWindowFunction1 "first_value"
2369−
2370−{- | returns value evaluated at the row that is the
2371−last row of the window frame
2372−-}
2373−lastValue
2374− :: Expression outer grp commons schemas params from ty
2375− -- ^ value
2376− -> WindowFunction outer grp commons schemas params from ty
2377−lastValue = unsafeWindowFunction1 "last_value"
2378−
2379−{- | returns value evaluated at the row that is the nth
2380−row of the window frame (counting from 1); null if no such row
2381−-}
2382−nthValue
2383− :: Expression outer grp commons schemas params from (null ty)
2384− -- ^ value
2385− -> Expression outer grp commons schemas params from ('NotNull 'PGint4)
2386− -- ^ nth
2387− -> WindowFunction outer grp commons schemas params from ('Null ty)
2388−nthValue value nth = UnsafeWindowFunction $ "nth_value"
2389− <> parenthesized (commaSeparated [renderSQL value, renderSQL nth])
2390−
2391−{-|
2392−Create date from year, month and day fields
2393−
2394−>>> printSQL (makeDate (1984 :* 7 *: 3))
2395−make_date(1984, 7, 3)
2396−-}
2397−makeDate :: FunctionHet
2398− '[ null 'PGint4, null 'PGint4, null 'PGint4 ]
2399− ( null 'PGdate )
2400−makeDate = unsafeFunctionHet "make_date"
2401−
2402−{-|
2403−Create time from hour, minute and seconds fields
2404−
2405−>>> printSQL (makeTime (8 :* 15 *: 23.5))
2406−make_time(8, 15, 23.5)
2407−-}
2408−makeTime :: FunctionHet
2409− '[ null 'PGint4, null 'PGint4, null 'PGfloat8 ]
2410− ( null 'PGtime )
2411−makeTime = unsafeFunctionHet "make_time"
2412−
2413−{-|
2414−Create timestamp from year, month, day, hour, minute and seconds fields
2415−
2416−>>> printSQL (makeTimestamp (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
2417−make_timestamp(2013, 7, 15, 8, 15, 23.5)
2418−-}
2419−makeTimestamp :: FunctionHet
2420− '[ null 'PGint4, null 'PGint4, null 'PGint4
2421− , null 'PGint4, null 'PGint4, null 'PGfloat8 ]
2422− ( null 'PGtimestamp )
2423−makeTimestamp = unsafeFunctionHet "make_timestamp"
2424−
2425−{-|
2426−Create timestamp with time zone from
2427−year, month, day, hour, minute and seconds fields;
2428−the current time zone is used
2429−
2430−>>> printSQL (makeTimestamptz (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
2431−make_timestamptz(2013, 7, 15, 8, 15, 23.5)
2432−-}
2433−makeTimestamptz :: FunctionHet
2434− '[ null 'PGint4, null 'PGint4, null 'PGint4
2435− , null 'PGint4, null 'PGint4, null 'PGfloat8 ]
2436− ( null 'PGtimestamptz )
2437−makeTimestamptz = unsafeFunctionHet "make_timestamptz"
2438−
2439−{-|
2440−Affine space operations on time types.
2441−-}
2442−class TimeOp time diff | time -> diff where
2443− {-|
2444− >>> printSQL (makeDate (1984 :* 7 *: 3) !+ 365)
2445− (make_date(1984, 7, 3) + 365)
2446− -}
2447− (!+) :: Operator (null time) (null diff) (null time)
2448− (!+) = unsafeBinaryOp "+"
2449− {-|
2450− >>> printSQL (365 +! makeDate (1984 :* 7 *: 3))
2451− (365 + make_date(1984, 7, 3))
2452− -}
2453− (+!) :: Operator (null diff) (null time) (null time)
2454− (+!) = unsafeBinaryOp "+"
2455− {-|
2456− >>> printSQL (makeDate (1984 :* 7 *: 3) !- 365)
2457− (make_date(1984, 7, 3) - 365)
2458− -}
2459− (!-) :: Operator (null time) (null diff) (null time)
2460− (!-) = unsafeBinaryOp "-"
2461− {-|
2462− >>> printSQL (makeDate (1984 :* 7 *: 3) !-! currentDate)
2463− (make_date(1984, 7, 3) - CURRENT_DATE)
2464− -}
2465− (!-!) :: Operator (null time) (null time) (null diff)
2466− (!-!) = unsafeBinaryOp "-"
2467−instance TimeOp 'PGtimestamp 'PGinterval
2468−instance TimeOp 'PGtimestamptz 'PGinterval
2469−instance TimeOp 'PGtime 'PGinterval
2470−instance TimeOp 'PGtimetz 'PGinterval
2471−instance TimeOp 'PGinterval 'PGinterval
2472−instance TimeOp 'PGdate 'PGint4
2473−infixl 6 !+
2474−infixl 6 +!
2475−infixl 6 !-
2476−infixl 6 !-!