@@ -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
@@ -35,409 +34,213 @@ module Squeal.PostgreSQL.Expression
3534 ( -- * Expression
3635 Expression (..)
3736 , Expr
37+ , type (-->)
38+ , FunctionDB
39+ , unsafeFunction
40+ , function
41+ , unsafeLeftOp
42+ , leftOp
43+ , unsafeRightOp
44+ , rightOp
3845 , Operator
46+ , OperatorDB
3947 , unsafeBinaryOp
40− , (:-->)
41− , unsafeUnaryOpL
42− , unsafeUnaryOpR
43− , unsafeFunction
44− , FunctionHom
45− , unsafeFunctionHom
46− , FunctionHet
47− , unsafeFunctionHet
48− , HasParameter (parameter)
49− , param
50− -- ** Null
51− , null_
52− , notNull
53− , coalesce
54− , fromNull
55− , isNull
56− , isNotNull
57− , matchNull
58− , nullIf
59− -- ** Collections
60− , array
61− , array1
62− , array2
63− , cardinality
64− , index
65− , row
66− , field
48+ , binaryOp
49+ , FunctionVar
50+ , unsafeFunctionVar
51+ , type (--->)
52+ , FunctionNDB
53+ , unsafeFunctionN
54+ , functionN
6755 , PGSubset (..)
68− -- ** Functions
69− , atan2_
70− , cast
71− , quot_
72− , rem_
73− , trunc
74− , round_
75− , ceiling_
76− , greatest
77− , least
78− , litChar
79− -- ** Conditions
80− , true
81− , false
82− , not_
83− , (.&&)
84− , (.||)
85− , Condition
86− , caseWhenThenElse
87− , ifThenElse
88− , (.==)
89− , (./=)
90− , (.>=)
91− , (.<)
92− , (.<=)
93− , (.>)
94− , between
95− , notBetween
96− , betweenSymmetric
97− , notBetweenSymmetric
98− , isDistinctFrom
99− , isNotDistinctFrom
100− , isTrue
101− , isNotTrue
102− , isFalse
103− , isNotFalse
104− , isUnknown
105− , isNotUnknown
106− -- ** Time
107− , TimeOp (..)
108− , currentDate
109− , currentTime
110− , currentTimestamp
111− , localTime
112− , localTimestamp
113− , now
114− , makeDate
115− , makeTime
116− , makeTimestamp
117− , makeTimestamptz
118− , interval_
119− , TimeUnit (..)
120− -- ** Text
121− , lower
122− , upper
123− , charLength
124− , like
125− , ilike
126− -- ** Json
127− -- *** Json and Jsonb operators
128− , (.->)
129− , (.->>)
130− , (.#>)
131− , (.#>>)
132− -- *** Jsonb operators
133− , (.?)
134− , (.?|)
135− , (.?&)
136− , (.-.)
137− , (#-.)
138− -- *** Functions
139− , jsonLit
140− , jsonbLit
141− , toJson
142− , toJsonb
143− , arrayToJson
144− , rowToJson
145− , jsonBuildArray
146− , jsonbBuildArray
147− , PGBuildObject
148− , jsonBuildObject
149− , jsonbBuildObject
150− , jsonObject
151− , jsonbObject
152− , jsonZipObject
153− , jsonbZipObject
154− , jsonArrayLength
155− , jsonbArrayLength
156− , jsonExtractPath
157− , jsonbExtractPath
158− , jsonExtractPathAsText
159− , jsonbExtractPathAsText
160− , jsonTypeof
161− , jsonbTypeof
162− , jsonStripNulls
163− , jsonbStripNulls
164− , jsonbSet
165− , jsonbInsert
166− , jsonbPretty
167− -- ** Text Search
168− , (@@)
169− , (.&)
170− , (.|)
171− , (.!)
172− , (<->)
173− , arrayToTSvector
174− , tsvectorLength
175− , numnode
176− , plainToTSquery
177− , phraseToTSquery
178− , websearchToTSquery
179− , queryTree
180− , toTSquery
181− , toTSvector
182− , setWeight
183− , strip
184− , jsonToTSvector
185− , jsonbToTSvector
186− , tsDelete
187− , tsFilter
188− , tsHeadline
189− -- ** Aggregation
190− , Aggregate (..)
191− , Distinction (..)
192− , PGAvg
193− -- * Window Functions
194− , WindowDefinition (..)
195− , partitionBy
196− , WindowFunction (..)
197− , rank
198− , rowNumber
199− , denseRank
200− , percentRank
201− , cumeDist
202− , ntile
203− , lag
204− , lead
205− , firstValue
206− , lastValue
207− , nthValue
208− -- * Sorting
209− , SortExpression (..)
210− , OrderBy (..)
211− -- * Types
212− , TypeExpression (..)
213− , PGTyped (..)
214− , typedef
215− , typetable
216− , typeview
217− , bool
218− , int2
219− , smallint
220− , int4
221− , int
222− , integer
223− , int8
224− , bigint
225− , numeric
226− , float4
227− , real
228− , float8
229− , doublePrecision
230− , money
231− , text
232− , char
233− , character
234− , varchar
235− , characterVarying
236− , bytea
237− , timestamp
238− , timestampWithTimeZone
239− , date
240− , time
241− , timeWithTimeZone
242− , interval
243− , uuid
244− , inet
245− , json
246− , jsonb
247− , vararray
248− , fixarray
249− , tsvector
250− , tsquery
56+ , PGIntersect (..)
25157 -- * Re-export
25258 , (&)
253− , NP (..)
25459 , K (..)
60+ , unK
25561 ) where
25662
25763import Control.Category
25864import Control.DeepSeq
25965import Data.ByteString (ByteString)
260−import Data.ByteString.Lazy (toStrict)
26166import Data.Function ((&))
262−import Data.Kind
26367import Data.Semigroup hiding (All)
264−import qualified Data.Aeson as JSON
26568import Data.String
266−import Data.Word
26769import Generics.SOP hiding (All, from)
26870import GHC.OverloadedLabels
26971import GHC.TypeLits
27072import Numeric
27173import Prelude hiding (id, (.))
27274
273−import qualified Data.ByteString as ByteString
27475import qualified GHC.Generics as GHC
275−import qualified Generics.SOP as SOP
27676
77+import Squeal.PostgreSQL.Alias
78+import Squeal.PostgreSQL.List
27779import Squeal.PostgreSQL.Render
27880import Squeal.PostgreSQL.Schema
27981
82+-- $setup
83+-- >>> import Squeal.PostgreSQL
84+
28085{-----------------------------------------
28186column expressions
28287-----------------------------------------}
28388
28489{- | `Expression`s are used in a variety of contexts,
285−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,
28692as new column values in `Squeal.PostgreSQL.Manipulation.insertRow` or
28793`Squeal.PostgreSQL.Manipulation.update`,
288−or in search `Condition`s in a number of commands.
94+or in search `Squeal.PostgreSQL.Logic.Condition`s in a number of commands.
28995
29096The expression syntax allows the calculation of
29197values from primitive expression using arithmetic, logical,
29298and 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`.
293113-}
294114newtype Expression
295115 (outer :: FromType)
296− (grp :: Grouping)
297116 (commons :: FromType)
117+ (grp :: Grouping)
298118 (schemas :: SchemasType)
299119 (params :: [NullityType])
300120 (from :: FromType)
301121 (ty :: NullityType)
302122 = UnsafeExpression { renderExpression :: ByteString }
303123 deriving (GHC.Generic,Show,Eq,Ord,NFData)
304−instance RenderSQL (Expression outer grp commons schemas params from ty) where
124+instance RenderSQL (Expression outer commons grp schemas params from ty) where
305125 renderSQL = renderExpression
306126
307127-- | An `Expr` is a closed `Expression`.
308−-- It is a F`RankNType` but don't be scared.
128+-- It is a F@RankNType@ but don't be scared.
309129-- Think of it as an expression which sees no
310130-- namespaces, so you can't use parameters
311131-- or alias references. It can be used as
312132-- a simple piece of more complex `Expression`s.
313133type Expr x
314− = forall outer grp commons schemas params from
315− . 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
316136 -- ^ cannot reference aliases
317137
318−-- | A `RankNType` for binary operators.
138+-- | A @RankNType@ for binary operators.
319139type Operator x1 x2 y
320− = forall outer grp commons schemas params from
321− . Expression outer grp commons schemas params from x1
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
322151 -- ^ left input
323− -> Expression outer grp commons schemas params from x2
152+ -> Expression outer commons grp schemas params from x2
324153 -- ^ right input
325− -> Expression outer grp commons schemas params from y
154+ -> Expression outer commons grp schemas params from y
326155 -- ^ output
327156
328−-- | A `RankNType` for functions with a single argument.
157+-- | A @RankNType@ for functions with a single argument.
329158-- These could be either function calls or unary operators.
330159-- This is a subtype of the usual Haskell function type `Prelude.->`,
331160-- indeed a subcategory as it is closed under the usual
332161-- `Prelude..` and `Prelude.id`.
333−type (:-->) x y
334− = forall outer grp commons schemas params from
335− . Expression outer grp commons schemas params from x
162+type (-->) x y
163+ = forall outer commons grp schemas params from
164+ . Expression outer commons grp schemas params from x
336165 -- ^ input
337− -> Expression outer grp commons schemas params from y
166+ -> Expression outer commons grp schemas params from y
338167 -- ^ output
339168
340−{- | A `RankNType` for functions with a fixed-length list of heterogeneous arguments.
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.
341177Use the `*:` operator to end your argument lists, like so.
342178
343−>>> printSQL (unsafeFunctionHet "fun" (true :* false :* localTime *: true))
179+>>> printSQL (unsafeFunctionN "fun" (true :* false :* localTime *: true))
344180fun(TRUE, FALSE, LOCALTIME, TRUE)
345181-}
346−type FunctionHet xs y
347− = forall outer grp commons schemas params from
348− . NP (Expression outer grp commons schemas params from) xs
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
349192 -- ^ inputs
350− -> Expression outer grp commons schemas params from y
193+ -> Expression outer commons grp schemas params from y
351194 -- ^ output
352195
353−{- | A `RankNType` for functions with a variable-length list of
196+{- | A @RankNType@ for functions with a variable-length list of
354197homogeneous arguments and at least 1 more argument.
355198-}
356−type FunctionHom x0 x1 y
357− = forall outer grp commons schemas params from
358− . [Expression outer grp commons schemas params from x0]
199+type FunctionVar x0 x1 y
200+ = forall outer commons grp schemas params from
201+ . [Expression outer commons grp schemas params from x0]
359202 -- ^ inputs
360− -> Expression outer grp commons schemas params from x1
203+ -> Expression outer commons grp schemas params from x1
361204 -- ^ must have at least 1 input
362− -> Expression outer grp commons schemas params from y
205+ -> Expression outer commons grp schemas params from y
363206 -- ^ output
364207
365−{- | >>> printSQL (unsafeFunctionHom "greatest" [true, null_] false)
208+{- | >>> printSQL (unsafeFunctionVar "greatest" [true, null_] false)
366209greatest(TRUE, NULL, FALSE)
367210-}
368−unsafeFunctionHom :: ByteString -> FunctionHom x0 x1 y
369−unsafeFunctionHom fun xs x = UnsafeExpression $ fun <> parenthesized
211+unsafeFunctionVar :: ByteString -> FunctionVar x0 x1 y
212+unsafeFunctionVar fun xs x = UnsafeExpression $ fun <> parenthesized
370213 (commaSeparated (renderSQL <$> xs) <> ", " <> renderSQL x)
371214
372−{- | A `HasParameter` constraint is used to indicate a value that is
373−supplied externally to a SQL statement.
374−`Squeal.PostgreSQL.PQ.manipulateParams`,
375−`Squeal.PostgreSQL.PQ.queryParams` and
376−`Squeal.PostgreSQL.PQ.traversePrepared` support specifying data values
377−separately from the SQL command string, in which case `param`s are used to
378−refer to the out-of-line data values.
379−-}
380−class KnownNat n => HasParameter
381− (n :: Nat)
382− (params :: [NullityType])
383− (ty :: NullityType)
384− | n params -> ty where
385− -- | `parameter` takes a `Nat` using type application and a `TypeExpression`.
386− --
387− -- >>> let expr = parameter @1 int4 :: Expression outer grp '[] schemas '[ 'Null 'PGint4] from ('Null 'PGint4)
388− -- >>> printSQL expr
389− -- ($1 :: int4)
390− parameter
391− :: TypeExpression schemas ty
392− -> Expression outer grp commons schemas params from ty
393− parameter ty = UnsafeExpression $ parenthesized $
394− "$" <> renderNat @n <+> "::"
395− <+> renderSQL ty
396−instance {-# OVERLAPPING #-} HasParameter 1 (ty1:tys) ty1
397−instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)
398− => HasParameter n (ty' : params) ty
399−
400−-- | `param` takes a `Nat` using type application and for basic types,
401−-- infers a `TypeExpression`.
402−--
403−-- >>> let expr = param @1 :: Expression outer grp commons schemas '[ 'Null 'PGint4] from ('Null 'PGint4)
404−-- >>> printSQL expr
405−-- ($1 :: int4)
406−param
407− :: forall n outer commons schemas params from grp ty
408− . (PGTyped schemas ty, HasParameter n params ty)
409− => Expression outer grp commons schemas params from ty -- ^ param
410−param = parameter @n (pgtype @schemas)
411−
412215instance (HasUnique tab (Join outer from) row, Has col row ty)
413− => IsLabel col (Expression outer 'Ungrouped commons schemas params from ty) where
216+ => IsLabel col (Expression outer commons 'Ungrouped schemas params from ty) where
414217 fromLabel = UnsafeExpression $ renderSQL (Alias @col)
415218instance (HasUnique tab (Join outer from) row, Has col row ty, tys ~ '[ty])
416− => 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
417220 fromLabel = fromLabel @col :* Nil
418221instance (HasUnique tab (Join outer from) row, Has col row ty, column ~ (col ::: ty))
419222 => IsLabel col
420− (Aliased (Expression outer 'Ungrouped commons schemas params from) column) where
223+ (Aliased (Expression outer commons 'Ungrouped schemas params from) column) where
421224 fromLabel = fromLabel @col `As` Alias
422225instance (HasUnique tab (Join outer from) row, Has col row ty, columns ~ '[col ::: ty])
423226 => IsLabel col
424− (NP (Aliased (Expression outer 'Ungrouped commons schemas params from)) columns) where
227+ (NP (Aliased (Expression outer commons 'Ungrouped schemas params from)) columns) where
425228 fromLabel = fromLabel @col :* Nil
426229
427230instance (Has tab (Join outer from) row, Has col row ty)
428− => 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
429232 tab ! col = UnsafeExpression $
430233 renderSQL tab <> "." <> renderSQL col
431234instance (Has tab (Join outer from) row, Has col row ty, tys ~ '[ty])
432− => 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
433236 tab ! col = tab ! col :* Nil
434237instance (Has tab (Join outer from) row, Has col row ty, column ~ (col ::: ty))
435238 => IsQualified tab col
436− (Aliased (Expression outer 'Ungrouped commons schemas params from) column) where
239+ (Aliased (Expression outer commons 'Ungrouped schemas params from) column) where
437240 tab ! col = tab ! col `As` col
438241instance (Has tab (Join outer from) row, Has col row ty, columns ~ '[col ::: ty])
439242 => IsQualified tab col
440− (NP (Aliased (Expression outer 'Ungrouped commons schemas params from)) columns) where
243+ (NP (Aliased (Expression outer commons 'Ungrouped schemas params from)) columns) where
441244 tab ! col = tab ! col :* Nil
442245
443246instance
@@ -445,7 +248,7 @@ instance
445248 , Has col row ty
446249 , GroupedBy tab col bys
447250 ) => IsLabel col
448− (Expression outer ('Grouped bys) commons schemas params from ty) where
251+ (Expression outer commons ('Grouped bys) schemas params from ty) where
449252 fromLabel = UnsafeExpression $ renderSQL (Alias @col)
450253instance
451254 ( HasUnique tab (Join outer from) row
@@ -453,7 +256,7 @@ instance
453256 , GroupedBy tab col bys
454257 , tys ~ '[ty]
455258 ) => IsLabel col
456− (NP (Expression outer ('Grouped bys) commons schemas params from) tys) where
259+ (NP (Expression outer commons ('Grouped bys) schemas params from) tys) where
457260 fromLabel = fromLabel @col :* Nil
458261instance
459262 ( HasUnique tab (Join outer from) row
@@ -461,7 +264,7 @@ instance
461264 , GroupedBy tab col bys
462265 , column ~ (col ::: ty)
463266 ) => IsLabel col
464− (Aliased (Expression outer ('Grouped bys) commons schemas params from) column) where
267+ (Aliased (Expression outer commons ('Grouped bys) schemas params from) column) where
465268 fromLabel = fromLabel @col `As` Alias
466269instance
467270 ( HasUnique tab (Join outer from) row
@@ -469,7 +272,7 @@ instance
469272 , GroupedBy tab col bys
470273 , columns ~ '[col ::: ty]
471274 ) => IsLabel col
472− (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
473276 fromLabel = fromLabel @col :* Nil
474277
475278instance
@@ -477,7 +280,7 @@ instance
477280 , Has col row ty
478281 , GroupedBy tab col bys
479282 ) => IsQualified tab col
480− (Expression outer ('Grouped bys) commons schemas params from ty) where
283+ (Expression outer commons ('Grouped bys) schemas params from ty) where
481284 tab ! col = UnsafeExpression $
482285 renderSQL tab <> "." <> renderSQL col
483286instance
@@ -486,7 +289,7 @@ instance
486289 , GroupedBy tab col bys
487290 , tys ~ '[ty]
488291 ) => IsQualified tab col
489− (NP (Expression outer ('Grouped bys) commons schemas params from) tys) where
292+ (NP (Expression outer commons ('Grouped bys) schemas params from) tys) where
490293 tab ! col = tab ! col :* Nil
491294instance
492295 ( Has tab (Join outer from) row
@@ -494,7 +297,7 @@ instance
494297 , GroupedBy tab col bys
495298 , column ~ (col ::: ty)
496299 ) => IsQualified tab col
497− (Aliased (Expression outer ('Grouped bys) commons schemas params from) column) where
300+ (Aliased (Expression outer commons ('Grouped bys) schemas params from) column) where
498301 tab ! col = tab ! col `As` col
499302instance
500303 ( Has tab (Join outer from) row
@@ -502,250 +305,78 @@ instance
502305 , GroupedBy tab col bys
503306 , columns ~ '[col ::: ty]
504307 ) => IsQualified tab col
505− (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
506309 tab ! col = tab ! col :* Nil
507310
508−-- | analagous to `Nothing`
509−--
510−-- >>> printSQL null_
511−-- NULL
512−null_ :: Expr ('Null ty)
513−null_ = UnsafeExpression "NULL"
514−
515−-- | analagous to `Just`
516−--
517−-- >>> printSQL $ notNull true
518−-- TRUE
519−notNull :: 'NotNull ty :--> 'Null ty
520−notNull = UnsafeExpression . renderSQL
521−
522−-- | return the leftmost value which is not NULL
523−--
524−-- >>> printSQL $ coalesce [null_, true] false
525−-- COALESCE(NULL, TRUE, FALSE)
526−coalesce :: FunctionHom ('Null ty) ('NotNull ty) ('NotNull ty)
527−coalesce nullxs notNullx = UnsafeExpression $
528− "COALESCE" <> parenthesized (commaSeparated
529− ((renderSQL <$> nullxs) <> [renderSQL notNullx]))
530−
531−-- | analagous to `Data.Maybe.fromMaybe` using @COALESCE@
532−--
533−-- >>> printSQL $ fromNull true null_
534−-- COALESCE(NULL, TRUE)
535−fromNull
536− :: Expression outer grp commons schemas params from ('NotNull ty)
537− -- ^ what to convert @NULL@ to
538− -> Expression outer grp commons schemas params from ('Null ty)
539− -> Expression outer grp commons schemas params from ('NotNull ty)
540−fromNull notNullx nullx = coalesce [nullx] notNullx
541−
542−-- | >>> printSQL $ null_ & isNull
543−-- NULL IS NULL
544−isNull :: 'Null ty :--> null 'PGbool
545−isNull x = UnsafeExpression $ renderSQL x <+> "IS NULL"
546−
547−-- | >>> printSQL $ null_ & isNotNull
548−-- NULL IS NOT NULL
549−isNotNull :: 'Null ty :--> null 'PGbool
550−isNotNull x = UnsafeExpression $ renderSQL x <+> "IS NOT NULL"
551−
552−-- | analagous to `maybe` using @IS NULL@
553−--
554−-- >>> printSQL $ matchNull true not_ null_
555−-- CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END
556−matchNull
557− :: Expression outer grp commons schemas params from (nullty)
558− -- ^ what to convert @NULL@ to
559− -> ( Expression outer grp commons schemas params from ('NotNull ty)
560− -> Expression outer grp commons schemas params from (nullty) )
561− -- ^ function to perform when @NULL@ is absent
562− -> Expression outer grp commons schemas params from ('Null ty)
563− -> Expression outer grp commons schemas params from (nullty)
564−matchNull y f x = ifThenElse (isNull x) y
565− (f (UnsafeExpression (renderSQL x)))
566−
567−{-| right inverse to `fromNull`, if its arguments are equal then
568−`nullIf` gives @NULL@.
569−
570−>>> :set -XTypeApplications -XDataKinds
571−>>> let expr = nullIf (false *: param @1) :: Expression outer grp commons schemas '[ 'NotNull 'PGbool] from ('Null 'PGbool)
572−>>> printSQL expr
573−NULLIF(FALSE, ($1 :: bool))
574−-}
575−nullIf :: FunctionHet '[ 'NotNull ty, 'NotNull ty] ('Null ty)
576−nullIf = unsafeFunctionHet "NULLIF"
577−
578−-- | >>> printSQL $ array [null_, false, true]
579−-- ARRAY[NULL, FALSE, TRUE]
580−array
581− :: [Expression outer grp commons schemas params from ty]
582− -- ^ array elements
583− -> Expression outer grp commons schemas params from (null ('PGvararray ty))
584−array xs = UnsafeExpression $ "ARRAY" <>
585− bracketed (commaSeparated (renderSQL <$> xs))
586−
587−{- | construct a 1-dimensional fixed length array
588−
589−>>> printSQL $ array1 (null_ :* false *: true)
590−ARRAY[NULL, FALSE, TRUE]
591−
592−>>> :type array1 (null_ :* false *: true)
593−array1 (null_ :* false *: true)
594− :: Expression
595− outer
596− grp
597− commons
598− schemas
599− params
600− from
601− (null ('PGfixarray '[3] ('Null 'PGbool)))
602−-}
603−array1
604− :: (n ~ Length tys, SOP.All ((~) ty) tys)
605− => NP (Expression outer grp commons schemas params from) tys
606− -> Expression outer grp commons schemas params from (null ('PGfixarray '[n] ty))
607−array1 xs = UnsafeExpression $ "ARRAY" <>
608− bracketed (renderCommaSeparated renderSQL xs)
609−
610−{- | construct a 2-dimensional fixed length array
611−
612−>>> printSQL $ array2 ((null_ :* false *: true) *: (false :* null_ *: true))
613−ARRAY[[NULL, FALSE, TRUE], [FALSE, NULL, TRUE]]
614−
615−>>> :type array2 ((null_ :* false *: true) *: (false :* null_ *: true))
616−array2 ((null_ :* false *: true) *: (false :* null_ *: true))
617− :: Expression
618− outer
619− grp
620− commons
621− schemas
622− params
623− from
624− (null ('PGfixarray '[2, 3] ('Null 'PGbool)))
625−-}
626−array2
627− :: ( SOP.All ((~) tys) tyss
628− , SOP.All SOP.SListI tyss
629− , Length tyss ~ n1
630− , SOP.All ((~) ty) tys
631− , Length tys ~ n2 )
632− => NP (NP (Expression outer grp commons schemas params from)) tyss
633− -> Expression outer grp commons schemas params from (null ('PGfixarray '[n1,n2] ty))
634−array2 xss = UnsafeExpression $ "ARRAY" <>
635− bracketed (renderCommaSeparatedConstraint @SOP.SListI (bracketed . renderCommaSeparated renderSQL) xss)
636−
637−-- | >>> printSQL $ cardinality (array [null_, false, true])
638−-- cardinality(ARRAY[NULL, FALSE, TRUE])
639−cardinality :: null ('PGvararray ty) :--> null 'PGint8
640−cardinality = unsafeFunction "cardinality"
641−
642−-- | >>> printSQL $ array [null_, false, true] & index 2
643−-- (ARRAY[NULL, FALSE, TRUE])[2]
644−index
645− :: Word64 -- ^ index
646− -> null ('PGvararray ty) :--> NullifyType ty
647−index n expr = UnsafeExpression $
648− parenthesized (renderSQL expr) <> "[" <> fromString (show n) <> "]"
649−
650311instance (KnownSymbol label, label `In` labels) => IsPGlabel label
651− (Expression outer grp commons schemas params from (null ('PGenum labels))) where
312+ (Expression outer commons grp schemas params from (null ('PGenum labels))) where
652313 label = UnsafeExpression $ renderSQL (PGlabel @label)
653314
654−-- | A row constructor is an expression that builds a row value
655−-- (also called a composite value) using values for its member fields.
656−--
657−-- >>> :{
658−-- type Complex = 'PGcomposite
659−-- '[ "real" ::: 'NotNull 'PGfloat8
660−-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
661−-- :}
662−--
663−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression outer grp commons schemas params from ('NotNull Complex)
664−-- >>> printSQL i
665−-- ROW(0, 1)
666−row
667− :: SListI row
668− => NP (Aliased (Expression outer grp commons schemas params from)) row
669− -- ^ zero or more expressions for the row field values
670− -> Expression outer grp commons schemas params from (null ('PGcomposite row))
671−row exprs = UnsafeExpression $ "ROW" <> parenthesized
672− (renderCommaSeparated (\ (expr `As` _) -> renderSQL expr) exprs)
673−
674−-- | >>> :{
675−-- type Complex = 'PGcomposite
676−-- '[ "real" ::: 'NotNull 'PGfloat8
677−-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
678−-- type Schema = '["complex" ::: 'Typedef Complex]
679−-- :}
680−--
681−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression outer grp '[] (Public Schema) from params ('NotNull Complex)
682−-- >>> printSQL $ i & field #complex #imaginary
683−-- (ROW(0, 1)::"complex")."imaginary"
684−field
685− :: ( Has sch schemas schema
686− , Has tydef schema ('Typedef ('PGcomposite row))
687− , Has field row ty)
688− => QualifiedAlias sch tydef -- ^ row type
689− -> Alias field -- ^ field name
690− -> Expression outer grp commons schemas params from ('NotNull ('PGcomposite row))
691− -> Expression outer grp commons schemas params from ty
692−field td fld expr = UnsafeExpression $
693− parenthesized (renderSQL expr <> "::" <> renderSQL td)
694− <> "." <> renderSQL fld
695−
696−instance Semigroup
697− (Expression outer grp commons schemas params from (null ('PGvararray ty))) where
698− (<>) = unsafeBinaryOp "||"
699−
700−instance Monoid
701− (Expression outer grp commons schemas params from (null ('PGvararray ty))) where
702− mempty = array []
703− mappend = (<>)
704−
705−-- | >>> let expr = greatest [param @1] currentTimestamp :: Expression outer grp commons schemas '[ 'NotNull 'PGtimestamptz] from ('NotNull 'PGtimestamptz)
706−-- >>> printSQL expr
707−-- GREATEST(($1 :: timestamp with time zone), CURRENT_TIMESTAMP)
708−greatest :: FunctionHom ty ty ty
709−greatest = unsafeFunctionHom "GREATEST"
710−
711−-- | >>> printSQL $ least [null_] currentTimestamp
712−-- LEAST(NULL, CURRENT_TIMESTAMP)
713−least :: FunctionHom ty ty ty
714−least = unsafeFunctionHom "LEAST"
715−
716315-- | >>> printSQL $ unsafeBinaryOp "OR" true false
717316-- (TRUE OR FALSE)
718−unsafeBinaryOp :: ByteString {- ^ operator -} -> Operator ty0 ty1 ty2
317+unsafeBinaryOp :: ByteString -> Operator ty0 ty1 ty2
719318unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $
720319 renderSQL x <+> op <+> renderSQL y
721320
722−-- | >>> printSQL $ unsafeUnaryOpL "NOT" true
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
327+
328+-- | >>> printSQL $ unsafeLeftOp "NOT" true
723329-- (NOT TRUE)
724−unsafeUnaryOpL :: ByteString {- ^ operator -} -> x :--> y
725−unsafeUnaryOpL op x = UnsafeExpression $ parenthesized $ op <+> renderSQL x
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
726339
727−-- | >>> printSQL $ true & unsafeUnaryOpR "IS NOT TRUE"
340+-- | >>> printSQL $ true & unsafeRightOp "IS NOT TRUE"
728341-- (TRUE IS NOT TRUE)
729−unsafeUnaryOpR :: ByteString {- ^ operator -} -> x :--> y
730−unsafeUnaryOpR op x = UnsafeExpression $ parenthesized $ renderSQL x <+> op
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
731351
732352-- | >>> printSQL $ unsafeFunction "f" true
733353-- f(TRUE)
734−unsafeFunction :: ByteString {- ^ function -} -> x :--> y
354+unsafeFunction :: ByteString -> x --> y
735355unsafeFunction fun x = UnsafeExpression $
736356 fun <> parenthesized (renderSQL x)
737357
738−-- | >>> printSQL $ unsafeFunctionHet "f" (currentTime :* localTimestamp :* false *: litChar 'a')
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')
739365-- f(CURRENT_TIME, LOCALTIMESTAMP, FALSE, E'a')
740−unsafeFunctionHet
741− :: SListI xs
742− => ByteString {- ^ function -}
743− -> FunctionHet xs y
744−unsafeFunctionHet fun xs = UnsafeExpression $
366+unsafeFunctionN :: SListI xs => ByteString -> xs ---> y
367+unsafeFunctionN fun xs = UnsafeExpression $
745368 fun <> parenthesized (renderCommaSeparated renderSQL xs)
746369
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
377+
747378instance ty `In` PGNum
748− => Num (Expression outer grp commons schemas params from (null ty)) where
379+ => Num (Expression outer commons grp schemas params from (null ty)) where
749380 (+) = unsafeBinaryOp "+"
750381 (-) = unsafeBinaryOp "-"
751382 (*) = unsafeBinaryOp "*"
@@ -757,7 +388,7 @@ instance ty `In` PGNum
757388 . show
758389
759390instance (ty `In` PGNum, ty `In` PGFloating) => Fractional
760− (Expression outer grp commons schemas params from (null ty)) where
391+ (Expression outer commons grp schemas params from (null ty)) where
761392 (/) = unsafeBinaryOp "/"
762393 fromRational
763394 = UnsafeExpression
@@ -767,7 +398,7 @@ instance (ty `In` PGNum, ty `In` PGFloating) => Fractional
767398 . fromRat @Double
768399
769400instance (ty `In` PGNum, ty `In` PGFloating) => Floating
770− (Expression outer grp commons schemas params from (null ty)) where
401+ (Expression outer commons grp schemas params from (null ty)) where
771402 pi = UnsafeExpression "pi()"
772403 exp = unsafeFunction "exp"
773404 log = unsafeFunction "ln"
@@ -788,1782 +419,54 @@ instance (ty `In` PGNum, ty `In` PGFloating) => Floating
788419 acosh x = log (x + sqrt (x*x - 1))
789420 atanh x = log ((1 + x) / (1 - x)) / 2
790421
791−-- | >>> :{
792−-- let
793−-- expression :: Expr (null 'PGfloat4)
794−-- expression = atan2_ (pi *: 2)
795−-- in printSQL expression
796−-- :}
797−-- atan2(pi(), 2)
798−atan2_
799− :: float `In` PGFloating
800− => FunctionHet '[ null float, null float] (null float)
801−atan2_ = unsafeFunctionHet "atan2"
802−
803−-- When a `cast` is applied to an `Expression` of a known type, it
804−-- represents a run-time type conversion. The cast will succeed only if a
805−-- suitable type conversion operation has been defined.
806−--
807−-- | >>> printSQL $ true & cast int4
808−-- (TRUE :: int4)
809−cast
810− :: TypeExpression schemas ty1
811− -- ^ type to cast as
812− -> Expression outer grp commons schemas params from ty0
813− -- ^ value to convert
814− -> Expression outer grp commons schemas params from ty1
815−cast ty x = UnsafeExpression $ parenthesized $
816− renderSQL x <+> "::" <+> renderSQL ty
817−
818−-- | integer division, truncates the result
819−--
820−-- >>> :{
821−-- let
822−-- expression :: Expression outer grp commons schemas params from (null 'PGint2)
823−-- expression = 5 `quot_` 2
824−-- in printSQL expression
825−-- :}
826−-- (5 / 2)
827−quot_
828− :: int `In` PGIntegral
829− => Operator (null int) (null int) (null int)
830−quot_ = unsafeBinaryOp "/"
831−
832−-- | remainder upon integer division
833−--
834−-- >>> :{
835−-- let
836−-- expression :: Expression outer grp commons schemas params from (null 'PGint2)
837−-- expression = 5 `rem_` 2
838−-- in printSQL expression
839−-- :}
840−-- (5 % 2)
841−rem_
842− :: int `In` PGIntegral
843− => Operator (null int) (null int) (null int)
844−rem_ = unsafeBinaryOp "%"
845−
846−-- | >>> :{
847−-- let
848−-- expression :: Expression outer grp commons schemas params from (null 'PGfloat4)
849−-- expression = trunc pi
850−-- in printSQL expression
851−-- :}
852−-- trunc(pi())
853−trunc :: frac `In` PGFloating => null frac :--> null frac
854−trunc = unsafeFunction "trunc"
855−
856−-- | >>> :{
857−-- let
858−-- expression :: Expression outer grp commons schemas params from (null 'PGfloat4)
859−-- expression = round_ pi
860−-- in printSQL expression
861−-- :}
862−-- round(pi())
863−round_ :: frac `In` PGFloating => null frac :--> null frac
864−round_ = unsafeFunction "round"
865−
866−-- | >>> :{
867−-- let
868−-- expression :: Expression outer grp commons schemas params from (null 'PGfloat4)
869−-- expression = ceiling_ pi
870−-- in printSQL expression
871−-- :}
872−-- ceiling(pi())
873−ceiling_ :: frac `In` PGFloating => null frac :--> null frac
874−ceiling_ = unsafeFunction "ceiling"
875−
876−-- | A `Condition` is an `Expression`, which can evaluate
877−-- to `true`, `false` or `null_`. This is because SQL uses
878−-- a three valued logic.
879−type Condition outer grp commons schemas params from =
880− Expression outer grp commons schemas params from ('Null 'PGbool)
881−
882−-- | >>> printSQL true
883−-- TRUE
884−true :: Expr (null 'PGbool)
885−true = UnsafeExpression "TRUE"
886−
887−-- | >>> printSQL false
888−-- FALSE
889−false :: Expr (null 'PGbool)
890−false = UnsafeExpression "FALSE"
891−
892−-- | >>> printSQL $ not_ true
893−-- (NOT TRUE)
894−not_ :: null 'PGbool :--> null 'PGbool
895−not_ = unsafeUnaryOpL "NOT"
896−
897−-- | >>> printSQL $ true .&& false
898−-- (TRUE AND FALSE)
899−(.&&) :: Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
900−infixr 3 .&&
901−(.&&) = unsafeBinaryOp "AND"
902−
903−-- | >>> printSQL $ true .|| false
904−-- (TRUE OR FALSE)
905−(.||) :: Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
906−infixr 2 .||
907−(.||) = unsafeBinaryOp "OR"
908−
909−-- | >>> :{
910−-- let
911−-- expression :: Expression outer grp commons schemas params from (null 'PGint2)
912−-- expression = caseWhenThenElse [(true, 1), (false, 2)] 3
913−-- in printSQL expression
914−-- :}
915−-- CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END
916−caseWhenThenElse
917− :: [ ( Condition outer grp commons schemas params from
918− , Expression outer grp commons schemas params from ty
919− ) ]
920− -- ^ whens and thens
921− -> Expression outer grp commons schemas params from ty
922− -- ^ else
923− -> Expression outer grp commons schemas params from ty
924−caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
925− [ "CASE"
926− , mconcat
927− [ mconcat
928− [ " WHEN ", renderSQL when_
929− , " THEN ", renderSQL then_
930− ]
931− | (when_,then_) <- whenThens
932− ]
933− , " ELSE ", renderSQL else_
934− , " END"
935− ]
936−
937−-- | >>> :{
938−-- let
939−-- expression :: Expression outer grp commons schemas params from (null 'PGint2)
940−-- expression = ifThenElse true 1 0
941−-- in printSQL expression
942−-- :}
943−-- CASE WHEN TRUE THEN 1 ELSE 0 END
944−ifThenElse
945− :: Condition outer grp commons schemas params from
946− -> Expression outer grp commons schemas params from ty -- ^ then
947− -> Expression outer grp commons schemas params from ty -- ^ else
948− -> Expression outer grp commons schemas params from ty
949−ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
950−
951−-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`
952−-- will produce @NULL@s if one of their arguments is @NULL@.
953−--
954−-- >>> printSQL $ true .== null_
955−-- (TRUE = NULL)
956−(.==) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
957−(.==) = unsafeBinaryOp "="
958−infix 4 .==
959−
960−-- | >>> printSQL $ true ./= null_
961−-- (TRUE <> NULL)
962−(./=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
963−(./=) = unsafeBinaryOp "<>"
964−infix 4 ./=
965−
966−-- | >>> printSQL $ true .>= null_
967−-- (TRUE >= NULL)
968−(.>=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
969−(.>=) = unsafeBinaryOp ">="
970−infix 4 .>=
971−
972−-- | >>> printSQL $ true .< null_
973−-- (TRUE < NULL)
974−(.<) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
975−(.<) = unsafeBinaryOp "<"
976−infix 4 .<
977−
978−-- | >>> printSQL $ true .<= null_
979−-- (TRUE <= NULL)
980−(.<=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
981−(.<=) = unsafeBinaryOp "<="
982−infix 4 .<=
983−
984−-- | >>> printSQL $ true .> null_
985−-- (TRUE > NULL)
986−(.>) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
987−(.>) = unsafeBinaryOp ">"
988−infix 4 .>
989−
990−{- | >>> printSQL $ true `between` (null_, false)
991−TRUE BETWEEN NULL AND FALSE
992−-}
993−between
994− :: Expression outer grp commons schemas params from (null ty)
995− -> ( Expression outer grp commons schemas params from (null ty)
996− , Expression outer grp commons schemas params from (null ty) ) -- ^ bounds
997− -> Condition outer grp commons schemas params from
998−between a (x,y) = UnsafeExpression $ renderSQL a <+> "BETWEEN"
999− <+> renderSQL x <+> "AND" <+> renderSQL y
1000−
1001−{- | >>> printSQL $ true `notBetween` (null_, false)
1002−TRUE NOT BETWEEN NULL AND FALSE
1003−-}
1004−notBetween
1005− :: Expression outer grp commons schemas params from (null ty)
1006− -> ( Expression outer grp commons schemas params from (null ty)
1007− , Expression outer grp commons schemas params from (null ty) ) -- ^ bounds
1008− -> Condition outer grp commons schemas params from
1009−notBetween a (x,y) = UnsafeExpression $ renderSQL a <+> "NOT BETWEEN"
1010− <+> renderSQL x <+> "AND" <+> renderSQL y
1011−
1012−{- | between, after sorting the comparison values
1013−
1014−>>> printSQL $ true `betweenSymmetric` (null_, false)
1015−TRUE BETWEEN SYMMETRIC NULL AND FALSE
1016−-}
1017−betweenSymmetric
1018− :: Expression outer grp commons schemas params from (null ty)
1019− -> ( Expression outer grp commons schemas params from (null ty)
1020− , Expression outer grp commons schemas params from (null ty) ) -- ^ bounds
1021− -> Condition outer grp commons schemas params from
1022−betweenSymmetric a (x,y) = UnsafeExpression $ renderSQL a
1023− <+> "BETWEEN SYMMETRIC" <+> renderSQL x <+> "AND" <+> renderSQL y
1024−
1025−{- | not between, after sorting the comparison values
1026−
1027−>>> printSQL $ true `notBetweenSymmetric` (null_, false)
1028−TRUE NOT BETWEEN SYMMETRIC NULL AND FALSE
1029−-}
1030−notBetweenSymmetric
1031− :: Expression outer grp commons schemas params from (null ty)
1032− -> ( Expression outer grp commons schemas params from (null ty)
1033− , Expression outer grp commons schemas params from (null ty) ) -- ^ bounds
1034− -> Condition outer grp commons schemas params from
1035−notBetweenSymmetric a (x,y) = UnsafeExpression $ renderSQL a
1036− <+> "NOT BETWEEN SYMMETRIC" <+> renderSQL x <+> "AND" <+> renderSQL y
1037−
1038−{- | not equal, treating null like an ordinary value
1039−
1040−>>> printSQL $ true `isDistinctFrom` null_
1041−(TRUE IS DISTINCT FROM NULL)
1042−-}
1043−isDistinctFrom :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
1044−isDistinctFrom = unsafeBinaryOp "IS DISTINCT FROM"
1045−
1046−{- | equal, treating null like an ordinary value
1047−
1048−>>> printSQL $ true `isNotDistinctFrom` null_
1049−(TRUE IS NOT DISTINCT FROM NULL)
1050−-}
1051−isNotDistinctFrom :: Operator (null0 ty) (null1 ty) ('NotNull 'PGbool)
1052−isNotDistinctFrom = unsafeBinaryOp "IS NOT DISTINCT FROM"
1053−
1054−{- | is true
1055−
1056−>>> printSQL $ true & isTrue
1057−(TRUE IS TRUE)
1058−-}
1059−isTrue :: null0 'PGbool :--> null1 'PGbool
1060−isTrue = unsafeUnaryOpR "IS TRUE"
1061−
1062−{- | is false or unknown
1063−
1064−>>> printSQL $ true & isNotTrue
1065−(TRUE IS NOT TRUE)
1066−-}
1067−isNotTrue :: null0 'PGbool :--> null1 'PGbool
1068−isNotTrue = unsafeUnaryOpR "IS NOT TRUE"
1069−
1070−{- | is false
1071−
1072−>>> printSQL $ true & isFalse
1073−(TRUE IS FALSE)
1074−-}
1075−isFalse :: null0 'PGbool :--> null1 'PGbool
1076−isFalse = unsafeUnaryOpR "IS FALSE"
1077−
1078−{- | is true or unknown
1079−
1080−>>> printSQL $ true & isNotFalse
1081−(TRUE IS NOT FALSE)
1082−-}
1083−isNotFalse :: null0 'PGbool :--> null1 'PGbool
1084−isNotFalse = unsafeUnaryOpR "IS NOT FALSE"
1085−
1086−{- | is unknown
1087−
1088−>>> printSQL $ true & isUnknown
1089−(TRUE IS UNKNOWN)
1090−-}
1091−isUnknown :: null0 'PGbool :--> null1 'PGbool
1092−isUnknown = unsafeUnaryOpR "IS UNKNOWN"
1093−
1094−{- | is true or false
1095−
1096−>>> printSQL $ true & isNotUnknown
1097−(TRUE IS NOT UNKNOWN)
1098−-}
1099−isNotUnknown :: null0 'PGbool :--> null1 'PGbool
1100−isNotUnknown = unsafeUnaryOpR "IS NOT UNKNOWN"
1101−
1102−-- | >>> printSQL currentDate
1103−-- CURRENT_DATE
1104−currentDate :: Expr (null 'PGdate)
1105−currentDate = UnsafeExpression "CURRENT_DATE"
1106−
1107−-- | >>> printSQL currentTime
1108−-- CURRENT_TIME
1109−currentTime :: Expr (null 'PGtimetz)
1110−currentTime = UnsafeExpression "CURRENT_TIME"
1111−
1112−-- | >>> printSQL currentTimestamp
1113−-- CURRENT_TIMESTAMP
1114−currentTimestamp :: Expr (null 'PGtimestamptz)
1115−currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"
1116−
1117−-- | >>> printSQL localTime
1118−-- LOCALTIME
1119−localTime :: Expr (null 'PGtime)
1120−localTime = UnsafeExpression "LOCALTIME"
1121−
1122−-- | >>> printSQL localTimestamp
1123−-- LOCALTIMESTAMP
1124−localTimestamp :: Expr (null 'PGtimestamp)
1125−localTimestamp = UnsafeExpression "LOCALTIMESTAMP"
1126−
1127−-- | Current date and time (equivalent to `currentTimestamp`)
1128−--
1129−-- >>> printSQL now
1130−-- now()
1131−now :: Expr (null 'PGtimestamptz)
1132−now = UnsafeExpression "now()"
1133−
1134−{-----------------------------------------
1135−text
1136−-----------------------------------------}
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)
1137432
1138−escape :: Char -> String
1139−escape = \case
1140− '\NUL' -> "\\0"
1141− '\'' -> "''"
1142− '"' -> "\\\""
1143− '\b' -> "\\b"
1144− '\n' -> "\\n"
1145− '\r' -> "\\r"
1146− '\t' -> "\\t"
1147− '\\' -> "\\\\"
1148− c -> [c]
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)
1149438
1150439instance IsString
1151− (Expression outer grp commons schemas params from (null 'PGtext)) where
440+ (Expression outer commons grp schemas params from (null 'PGtext)) where
1152441 fromString str = UnsafeExpression $
1153442 "E\'" <> fromString (escape =<< str) <> "\'"
1154443instance IsString
1155− (Expression outer grp commons schemas params from (null 'PGtsvector)) where
1156− fromString str = cast tsvector . UnsafeExpression $
444+ (Expression outer commons grp schemas params from (null 'PGtsvector)) where
445+ fromString str = UnsafeExpression . parenthesized . (<> " :: tsvector") $
1157446 "E\'" <> fromString (escape =<< str) <> "\'"
1158447instance IsString
1159− (Expression outer grp commons schemas params from (null 'PGtsquery)) where
1160− fromString str = cast tsquery . UnsafeExpression $
448+ (Expression outer commons grp schemas params from (null 'PGtsquery)) where
449+ fromString str = UnsafeExpression . parenthesized . (<> " :: tsquery") $
1161450 "E\'" <> fromString (escape =<< str) <> "\'"
1162451
1163452instance Semigroup
1164− (Expression outer grp commons schemas params from (null 'PGtext)) where
453+ (Expression outer commons grp schemas params from (null ('PGvararray ty))) where
1165454 (<>) = unsafeBinaryOp "||"
1166455instance Semigroup
1167− (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
1168463 (<>) = unsafeBinaryOp "||"
1169464
1170465instance Monoid
1171− (Expression outer grp commons schemas params from (null 'PGtext)) where
466+ (Expression outer commons grp schemas params from (null 'PGtext)) where
1172467 mempty = fromString ""
1173468 mappend = (<>)
1174469instance Monoid
1175− (Expression outer grp commons schemas params from (null 'PGtsvector)) where
470+ (Expression outer commons grp schemas params from (null 'PGtsvector)) where
1176471 mempty = fromString ""
1177472 mappend = (<>)
1178−
1179−-- | >>> printSQL $ lower "ARRRGGG"
1180−-- lower(E'ARRRGGG')
1181−lower :: null 'PGtext :--> null 'PGtext
1182−lower = unsafeFunction "lower"
1183−
1184−-- | >>> printSQL $ upper "eeee"
1185−-- upper(E'eeee')
1186−upper :: null 'PGtext :--> null 'PGtext
1187−upper = unsafeFunction "upper"
1188−
1189−-- | >>> printSQL $ charLength "four"
1190−-- char_length(E'four')
1191−charLength :: null 'PGtext :--> null 'PGint4
1192−charLength = unsafeFunction "char_length"
1193−
1194−-- | The `like` expression returns true if the @string@ matches
1195−-- the supplied @pattern@. If @pattern@ does not contain percent signs
1196−-- or underscores, then the pattern only represents the string itself;
1197−-- in that case `like` acts like the equals operator. An underscore (_)
1198−-- in pattern stands for (matches) any single character; a percent sign (%)
1199−-- matches any sequence of zero or more characters.
1200−--
1201−-- >>> printSQL $ "abc" `like` "a%"
1202−-- (E'abc' LIKE E'a%')
1203−like :: Operator (null 'PGtext) (null 'PGtext) ('Null 'PGbool)
1204−like = unsafeBinaryOp "LIKE"
1205−
1206−-- | The key word ILIKE can be used instead of LIKE to make the
1207−-- match case-insensitive according to the active locale.
1208−--
1209−-- >>> printSQL $ "abc" `ilike` "a%"
1210−-- (E'abc' ILIKE E'a%')
1211−ilike :: Operator (null 'PGtext) (null 'PGtext) ('Null 'PGbool)
1212−ilike = unsafeBinaryOp "ILIKE"
1213−
1214−{-----------------------------------------
1215− -- json and jsonb support
1216−
1217−See https://www.postgresql.org/docs/10/static/functions-json.html -- most
1218−comments lifted directly from this page.
1219−
1220−Table 9.44: json and jsonb operators
1221−-----------------------------------------}
1222−
1223−-- | Get JSON value (object field or array element) at a key.
1224−(.->)
1225− :: (json `In` PGJsonType, key `In` PGJsonKey)
1226− => Operator (null json) (null key) ('Null json)
1227−infixl 8 .->
1228−(.->) = unsafeBinaryOp "->"
1229−
1230−-- | Get JSON value (object field or array element) at a key, as text.
1231−(.->>)
1232− :: (json `In` PGJsonType, key `In` PGJsonKey)
1233− => Operator (null json) (null key) ('Null 'PGtext)
1234−infixl 8 .->>
1235−(.->>) = unsafeBinaryOp "->>"
1236−
1237−-- | Get JSON value at a specified path.
1238−(.#>)
1239− :: json `In` PGJsonType
1240− => Operator (null json) (null ('PGvararray ('NotNull 'PGtext))) ('Null json)
1241−infixl 8 .#>
1242−(.#>) = unsafeBinaryOp "#>"
1243−
1244−-- | Get JSON value at a specified path as text.
1245−(.#>>)
1246− :: json `In` PGJsonType
1247− => Operator (null json) (null ('PGvararray ('NotNull 'PGtext))) ('Null 'PGtext)
1248−infixl 8 .#>>
1249−(.#>>) = unsafeBinaryOp "#>>"
1250−
1251−-- Additional jsonb operators
1252−
1253−class PGSubset container where
1254− (@>) :: Operator (null0 container) (null1 container) ('Null 'PGbool)
1255− (@>) = unsafeBinaryOp "@>"
1256− (<@) :: Operator (null0 container) (null1 container) ('Null 'PGbool)
1257− (<@) = unsafeBinaryOp "<@"
1258−instance PGSubset 'PGjsonb
1259−instance PGSubset 'PGtsquery
1260−instance PGSubset ('PGvararray ty)
1261−
1262−-- | Does the string exist as a top-level key within the JSON value?
1263−(.?) :: Operator (null 'PGjsonb) (null 'PGtext) ('Null 'PGbool)
1264−infixl 9 .?
1265−(.?) = unsafeBinaryOp "?"
1266−
1267−-- | Do any of these array strings exist as top-level keys?
1268−(.?|) :: Operator
1269− (null 'PGjsonb)
1270− (null ('PGvararray ('NotNull 'PGtext)))
1271− ('Null 'PGbool)
1272−infixl 9 .?|
1273−(.?|) = unsafeBinaryOp "?|"
1274−
1275−-- | Do all of these array strings exist as top-level keys?
1276−(.?&) :: Operator
1277− (null 'PGjsonb)
1278− (null ('PGvararray ('NotNull 'PGtext)))
1279− ('Null 'PGbool)
1280−infixl 9 .?&
1281−(.?&) = unsafeBinaryOp "?&"
1282−
1283−-- | Concatenate two jsonb values into a new jsonb value.
1284−instance Semigroup
1285− (Expression outer grp commons schemas params from (null 'PGjsonb)) where
1286− (<>) = unsafeBinaryOp "||"
1287−
1288−-- | Delete a key or keys from a JSON object, or remove an array element.
1289−--
1290−-- If the right operand is..
1291−--
1292−-- @ text @: Delete key/value pair or string element from left operand. Key/value pairs
1293−-- are matched based on their key value.
1294−--
1295−-- @ text[] @: Delete multiple key/value pairs or string elements
1296−-- from left operand. Key/value pairs are matched based on their key value.
1297−--
1298−-- @ integer @: Delete the array element with specified index (Negative integers
1299−-- count from the end). Throws an error if top level container is not an array.
1300−(.-.)
1301− :: (key `In` '[ 'PGtext, 'PGvararray ('NotNull 'PGtext), 'PGint4, 'PGint2 ]) -- hlint error without parens here
1302− => Operator (null 'PGjsonb) (null key) (null 'PGjsonb)
1303−infixl 6 .-.
1304−(.-.) = unsafeBinaryOp "-"
1305−
1306−-- | Delete the field or element with specified path (for JSON arrays, negative
1307−-- integers count from the end)
1308−(#-.) :: Operator (null 'PGjsonb) (null ('PGvararray ('NotNull 'PGtext))) (null 'PGjsonb)
1309−infixl 6 #-.
1310−(#-.) = unsafeBinaryOp "#-"
1311−
1312−{-----------------------------------------
1313−Table 9.45: JSON creation functions
1314−-----------------------------------------}
1315−
1316−-- | Literal binary JSON
1317−jsonbLit :: JSON.ToJSON x => x -> Expr (null 'PGjsonb)
1318−jsonbLit = cast jsonb . UnsafeExpression
1319− . singleQuotedUtf8 . toStrict . JSON.encode
1320−
1321−-- | Literal JSON
1322−jsonLit :: JSON.ToJSON x => x -> Expr (null 'PGjson)
1323−jsonLit = cast json . UnsafeExpression
1324− . singleQuotedUtf8 . toStrict . JSON.encode
1325−
1326−-- | Returns the value as json. Arrays and composites are converted
1327−-- (recursively) to arrays and objects; otherwise, if there is a cast from the
1328−-- type to json, the cast function will be used to perform the conversion;
1329−-- otherwise, a scalar value is produced. For any scalar type other than a
1330−-- number, a Boolean, or a null value, the text representation will be used, in
1331−-- such a fashion that it is a valid json value.
1332−toJson :: null ty :--> null 'PGjson
1333−toJson = unsafeFunction "to_json"
1334−
1335−-- | Returns the value as jsonb. Arrays and composites are converted
1336−-- (recursively) to arrays and objects; otherwise, if there is a cast from the
1337−-- type to json, the cast function will be used to perform the conversion;
1338−-- otherwise, a scalar value is produced. For any scalar type other than a
1339−-- number, a Boolean, or a null value, the text representation will be used, in
1340−-- such a fashion that it is a valid jsonb value.
1341−toJsonb :: null ty :--> null 'PGjsonb
1342−toJsonb = unsafeFunction "to_jsonb"
1343−
1344−-- | Returns the array as a JSON array. A PostgreSQL multidimensional array
1345−-- becomes a JSON array of arrays.
1346−arrayToJson :: null ('PGvararray ty) :--> null 'PGjson
1347−arrayToJson = unsafeFunction "array_to_json"
1348−
1349−-- | Returns the row as a JSON object.
1350−rowToJson :: null ('PGcomposite ty) :--> null 'PGjson
1351−rowToJson = unsafeFunction "row_to_json"
1352−
1353−-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic
1354−-- argument list.
1355−jsonBuildArray :: SListI tuple => FunctionHet tuple (null 'PGjson)
1356−jsonBuildArray = unsafeFunctionHet "json_build_array"
1357−
1358−-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a
1359−-- variadic argument list.
1360−jsonbBuildArray :: SListI tuple => FunctionHet tuple (null 'PGjsonb)
1361−jsonbBuildArray = unsafeFunctionHet "jsonb_build_array"
1362−
1363−class PGBuildObject tys where
1364−instance PGBuildObject '[]
1365−instance (PGBuildObject tys, key `In` PGJsonKey)
1366− => PGBuildObject ('NotNull key ': value ': tys)
1367−
1368−-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic
1369−-- argument list. The elements of the argument list must alternate between text
1370−-- and values.
1371−jsonBuildObject
1372− :: (SListI elems, PGBuildObject elems)
1373− => FunctionHet elems (null 'PGjson)
1374−jsonBuildObject = unsafeFunctionHet "json_build_object"
1375−
1376−-- | Builds a possibly-heterogeneously-typed (binary) JSON object out of a
1377−-- variadic argument list. The elements of the argument list must alternate
1378−-- between keys and values.
1379−jsonbBuildObject
1380− :: (SListI elems, PGBuildObject elems)
1381− => FunctionHet elems (null 'PGjsonb)
1382−jsonbBuildObject = unsafeFunctionHet "jsonb_build_object"
1383−
1384−-- | Builds a JSON object out of a text array.
1385−-- The array must have two dimensions
1386−-- such that each inner array has exactly two elements,
1387−-- which are taken as a key/value pair.
1388−jsonObject
1389− :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
1390− :--> null 'PGjson
1391−jsonObject = unsafeFunction "json_object"
1392−
1393−-- | Builds a binary JSON object out of a text array.
1394−-- The array must have two dimensions
1395−-- such that each inner array has exactly two elements,
1396−-- which are taken as a key/value pair.
1397−jsonbObject
1398− :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
1399− :--> null 'PGjsonb
1400−jsonbObject = unsafeFunction "jsonb_object"
1401−
1402−-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
1403−-- keys and one for values, that are zipped pairwise to create a JSON object.
1404−jsonZipObject :: FunctionHet
1405− '[ null ('PGvararray ('NotNull 'PGtext))
1406− , null ('PGvararray ('NotNull 'PGtext)) ]
1407− ( null 'PGjson )
1408−jsonZipObject = unsafeFunctionHet "json_object"
1409−
1410−-- | This is an alternate form of 'jsonbObject' that takes two arrays; one for
1411−-- keys and one for values, that are zipped pairwise to create a binary JSON
1412−-- object.
1413−jsonbZipObject :: FunctionHet
1414− '[ null ('PGvararray ('NotNull 'PGtext))
1415− , null ('PGvararray ('NotNull 'PGtext)) ]
1416− ( null 'PGjsonb )
1417−jsonbZipObject = unsafeFunctionHet "jsonb_object"
1418−
1419−{-----------------------------------------
1420−Table 9.46: JSON processing functions
1421−-----------------------------------------}
1422−
1423−-- | Returns the number of elements in the outermost JSON array.
1424−jsonArrayLength :: null 'PGjson :--> null 'PGint4
1425−jsonArrayLength = unsafeFunction "json_array_length"
1426−
1427−-- | Returns the number of elements in the outermost binary JSON array.
1428−jsonbArrayLength :: null 'PGjsonb :--> null 'PGint4
1429−jsonbArrayLength = unsafeFunction "jsonb_array_length"
1430−
1431−-- | Returns JSON value pointed to by the given path (equivalent to #>
1432−-- operator).
1433−jsonExtractPath
1434− :: SListI elems
1435− => Expression outer grp commons schemas params from (null 'PGjson)
1436− -> NP (Expression outer grp commons schemas params from) elems
1437− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1438−jsonExtractPath x xs =
1439− unsafeFunctionHet "json_extract_path" (x :* xs)
1440−
1441−-- | Returns JSON value pointed to by the given path (equivalent to #>
1442−-- operator).
1443−jsonbExtractPath
1444− :: SListI elems
1445− => Expression outer grp commons schemas params from (null 'PGjsonb)
1446− -> NP (Expression outer grp commons schemas params from) elems
1447− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1448−jsonbExtractPath x xs =
1449− unsafeFunctionHet "jsonb_extract_path" (x :* xs)
1450−
1451−-- | Returns JSON value pointed to by the given path (equivalent to #>
1452−-- operator), as text.
1453−jsonExtractPathAsText
1454− :: SListI elems
1455− => Expression outer grp commons schemas params from (null 'PGjson)
1456− -> NP (Expression outer grp commons schemas params from) elems
1457− -> Expression outer grp commons schemas params from (null 'PGjson)
1458−jsonExtractPathAsText x xs =
1459− unsafeFunctionHet "json_extract_path_text" (x :* xs)
1460−
1461−-- | Returns JSON value pointed to by the given path (equivalent to #>
1462−-- operator), as text.
1463−jsonbExtractPathAsText
1464− :: SListI elems
1465− => Expression outer grp commons schemas params from (null 'PGjsonb)
1466− -> NP (Expression outer grp commons schemas params from) elems
1467− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1468−jsonbExtractPathAsText x xs =
1469− unsafeFunctionHet "jsonb_extract_path_text" (x :* xs)
1470−
1471−-- | Returns the type of the outermost JSON value as a text string. Possible
1472−-- types are object, array, string, number, boolean, and null.
1473−jsonTypeof :: null 'PGjson :--> null 'PGtext
1474−jsonTypeof = unsafeFunction "json_typeof"
1475−
1476−-- | Returns the type of the outermost binary JSON value as a text string.
1477−-- Possible types are object, array, string, number, boolean, and null.
1478−jsonbTypeof :: null 'PGjsonb :--> null 'PGtext
1479−jsonbTypeof = unsafeFunction "jsonb_typeof"
1480−
1481−-- | Returns its argument with all object fields that have null values omitted.
1482−-- Other null values are untouched.
1483−jsonStripNulls :: null 'PGjson :--> null 'PGjson
1484−jsonStripNulls = unsafeFunction "json_strip_nulls"
1485−
1486−-- | Returns its argument with all object fields that have null values omitted.
1487−-- Other null values are untouched.
1488−jsonbStripNulls :: null 'PGjsonb :--> null 'PGjsonb
1489−jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
1490−
1491−-- | @ jsonbSet target path new_value create_missing @
1492−--
1493−-- Returns target with the section designated by path replaced by new_value,
1494−-- or with new_value added if create_missing is true ( default is true) and the
1495−-- item designated by path does not exist. As with the path orientated
1496−-- operators, negative integers that appear in path count from the end of JSON
1497−-- arrays.
1498−jsonbSet
1499− :: Expression outer grp commons schemas params from (null 'PGjsonb)
1500− -> Expression outer grp commons schemas params from (null ('PGvararray ('NotNull 'PGtext)))
1501− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1502− -> Maybe (Expression outer grp commons schemas params from (null 'PGbool))
1503− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1504−jsonbSet tgt path val createMissing = case createMissing of
1505− Just m -> unsafeFunctionHet "jsonb_set" (tgt :* path :* val :* m :* Nil)
1506− Nothing -> unsafeFunctionHet "jsonb_set" (tgt :* path :* val :* Nil)
1507−
1508−-- | @ jsonbInsert target path new_value insert_after @
1509−--
1510−-- Returns target with new_value inserted. If target section designated by
1511−-- path is in a JSONB array, new_value will be inserted before target or after
1512−-- if insert_after is true (default is false). If target section designated by
1513−-- path is in JSONB object, new_value will be inserted only if target does not
1514−-- exist. As with the path orientated operators, negative integers that appear
1515−-- in path count from the end of JSON arrays.
1516−jsonbInsert
1517− :: Expression outer grp commons schemas params from (null 'PGjsonb)
1518− -> Expression outer grp commons schemas params from (null ('PGvararray ('NotNull 'PGtext)))
1519− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1520− -> Maybe (Expression outer grp commons schemas params from (null 'PGbool))
1521− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1522−jsonbInsert tgt path val insertAfter = case insertAfter of
1523− Just i -> unsafeFunctionHet "jsonb_insert" (tgt :* path :* val :* i :* Nil)
1524− Nothing -> unsafeFunctionHet "jsonb_insert" (tgt :* path :* val :* Nil)
1525−
1526−-- | Returns its argument as indented JSON text.
1527−jsonbPretty :: null 'PGjsonb :--> null 'PGtext
1528−jsonbPretty = unsafeFunction "jsonb_pretty"
1529−
1530−(@@) :: Operator (null 'PGtsvector) (null 'PGtsquery) ('Null 'PGbool)
1531−(@@) = unsafeBinaryOp "@@"
1532−
1533−(.&) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
1534−(.&) = unsafeBinaryOp "&&"
1535−
1536−(.|) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
1537−(.|) = unsafeBinaryOp "||"
1538−
1539−(.!) :: null 'PGtsquery :--> null 'PGtsquery
1540−(.!) = unsafeUnaryOpL "!!"
1541−
1542−(<->) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
1543−(<->) = unsafeBinaryOp "<->"
1544−
1545−arrayToTSvector
1546− :: null ('PGvararray ('NotNull 'PGtext))
1547− :--> null 'PGtsvector
1548−arrayToTSvector = unsafeFunction "array_to_tsvector"
1549−
1550−tsvectorLength :: null 'PGtsvector :--> null 'PGint4
1551−tsvectorLength = unsafeFunction "length"
1552−
1553−numnode :: null 'PGtsquery :--> null 'PGint4
1554−numnode = unsafeFunction "numnode"
1555−
1556−plainToTSquery :: null 'PGtext :--> null 'PGtsquery
1557−plainToTSquery = unsafeFunction "plainto_tsquery"
1558−
1559−phraseToTSquery :: null 'PGtext :--> null 'PGtsquery
1560−phraseToTSquery = unsafeFunction "phraseto_tsquery"
1561−
1562−websearchToTSquery :: null 'PGtext :--> null 'PGtsquery
1563−websearchToTSquery = unsafeFunction "websearch_to_tsquery"
1564−
1565−queryTree :: null 'PGtsquery :--> null 'PGtext
1566−queryTree = unsafeFunction "query_tree"
1567−
1568−toTSquery :: null 'PGtext :--> null 'PGtsquery
1569−toTSquery = unsafeFunction "to_tsquery"
1570−
1571−toTSvector
1572− :: ty `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
1573− => null ty :--> null 'PGtsquery
1574−toTSvector = unsafeFunction "to_tsvector"
1575−
1576−setWeight
1577− :: FunctionHet '[null 'PGtsvector, null ('PGchar 1)] (null 'PGtsvector)
1578−setWeight = unsafeFunctionHet "set_weight"
1579−
1580−litChar :: Char -> Expr (null ('PGchar 1))
1581−litChar chr = UnsafeExpression $
1582− "E\'" <> fromString (escape =<< [chr]) <> "\'"
1583−
1584−strip :: null 'PGtsvector :--> null 'PGtsvector
1585−strip = unsafeFunction "strip"
1586−
1587−jsonToTSvector :: FunctionHet '[null 'PGjson, null 'PGjson] (null 'PGtsvector)
1588−jsonToTSvector = unsafeFunctionHet "json_to_tsvector"
1589−
1590−jsonbToTSvector :: FunctionHet '[null 'PGjsonb, null 'PGjsonb] (null 'PGtsvector)
1591−jsonbToTSvector = unsafeFunctionHet "jsonb_to_tsvector"
1592−
1593−tsDelete :: FunctionHet
1594− '[null 'PGtsvector, null ('PGvararray ('NotNull 'PGtext))]
1595− (null 'PGtsvector)
1596−tsDelete = unsafeFunctionHet "ts_delete"
1597−
1598−tsFilter :: FunctionHet
1599− '[null 'PGtsvector, null ('PGvararray ('NotNull ('PGchar 1)))]
1600− (null 'PGtsvector)
1601−tsFilter = unsafeFunctionHet "ts_filter"
1602−
1603−tsHeadline
1604− :: document `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
1605− => FunctionHet '[null document, null 'PGtsquery] (null 'PGtext)
1606−tsHeadline = unsafeFunctionHet "ts_headline"
1607−{-----------------------------------------
1608−aggregation
1609−-----------------------------------------}
1610−
1611−type AggrFun x y
1612− = forall outer bys commons schemas params from
1613− . Distinction (Expression outer 'Ungrouped commons schemas params from) x
1614− -- ^ input
1615− -> Expression outer ('Grouped bys) commons schemas params from y
1616− -- ^ output
1617−
1618−type AggrHet xs y
1619− = forall outer bys commons schemas params from
1620− . Distinction (NP (Expression outer 'Ungrouped commons schemas params from)) xs
1621− -- ^ inputs
1622− -> Expression outer ('Grouped bys) commons schemas params from y
1623− -- ^ output
1624−
1625−unsafeAggregateHet :: SOP.SListI xs => ByteString -> AggrHet xs y
1626−unsafeAggregateHet fun xs = UnsafeExpression $ mconcat
1627− [fun, "(", renderSQL xs, ")"]
1628−
1629−{- |
1630−`Aggregate` functions compute a single result from a set of input values.
1631−`Aggregate` functions can be used as `GroupedBy` `Expression`s as well
1632−as `WindowFunction`s.
1633−-}
1634−class Aggregate expr1 exprHet aggr
1635− | aggr -> expr1, aggr -> exprHet where
1636−
1637− -- | A special aggregation that does not require an input
1638− --
1639− -- >>> :{
1640− -- let
1641− -- expression :: Expression '[] ('Grouped bys) commons schemas params from ('NotNull 'PGint8)
1642− -- expression = countStar
1643− -- in printSQL expression
1644− -- :}
1645− -- count(*)
1646− countStar :: aggr ('NotNull 'PGint8)
1647−
1648− -- | >>> :{
1649− -- let
1650− -- expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: null ty]] ('NotNull 'PGint8)
1651− -- expression = count (All #col)
1652− -- in printSQL expression
1653− -- :}
1654− -- count(ALL "col")
1655− count
1656− :: expr1 ty
1657− -- ^ what to count
1658− -> aggr ('NotNull 'PGint8)
1659−
1660− -- | >>> :{
1661− -- let
1662− -- expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: 'Null 'PGnumeric]] ('NotNull 'PGnumeric)
1663− -- expression = sum_ (Distinct #col)
1664− -- in printSQL expression
1665− -- :}
1666− -- sum(DISTINCT "col")
1667− sum_
1668− :: ty `In` PGNum
1669− => expr1 (null ty)
1670− -> aggr ('NotNull ty)
1671−
1672− -- | input values, including nulls, concatenated into an array
1673− arrayAgg
1674− :: expr1 ty
1675− -> aggr ('Null ('PGvararray ty))
1676−
1677− -- | aggregates values as a JSON array
1678− jsonAgg
1679− :: expr1 ty
1680− -> aggr ('Null 'PGjson)
1681−
1682− -- | aggregates values as a JSON array
1683− jsonbAgg
1684− :: expr1 ty
1685− -> aggr ('Null 'PGjsonb)
1686−
1687− {- |
1688− the bitwise AND of all non-null input values, or null if none
1689− >>> :{
1690− let
1691− expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: null 'PGint4]] ('Null 'PGint4)
1692− expression = bitAnd (Distinct #col)
1693− in printSQL expression
1694− :}
1695− bit_and(DISTINCT "col")
1696− -}
1697− bitAnd
1698− :: int `In` PGIntegral
1699− => expr1 (null int)
1700− -- ^ what to aggregate
1701− -> aggr ('Null int)
1702−
1703− {- |
1704− the bitwise OR of all non-null input values, or null if none
1705−
1706− >>> :{
1707− let
1708− expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: null 'PGint4]] ('Null 'PGint4)
1709− expression = bitOr (All #col)
1710− in printSQL expression
1711− :}
1712− bit_or(ALL "col")
1713− -}
1714− bitOr
1715− :: int `In` PGIntegral
1716− => expr1 (null int)
1717− -- ^ what to aggregate
1718− -> aggr ('Null int)
1719−
1720− {- |
1721− true if all input values are true, otherwise false
1722−
1723− >>> :{
1724− let
1725− winFun :: WindowFunction '[] 'Ungrouped commons schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
1726− winFun = boolAnd #col
1727− in printSQL winFun
1728− :}
1729− bool_and("col")
1730− -}
1731− boolAnd
1732− :: expr1 (null 'PGbool)
1733− -- ^ what to aggregate
1734− -> aggr ('Null 'PGbool)
1735−
1736− {- |
1737− true if at least one input value is true, otherwise false
1738−
1739− >>> :{
1740− let
1741− expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
1742− expression = boolOr (All #col)
1743− in printSQL expression
1744− :}
1745− bool_or(ALL "col")
1746− -}
1747− boolOr
1748− :: expr1 (null 'PGbool)
1749− -- ^ what to aggregate
1750− -> aggr ('Null 'PGbool)
1751−
1752− {- |
1753− equivalent to `boolAnd`
1754−
1755− >>> :{
1756− let
1757− expression :: Expression '[] ('Grouped bys) commons schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
1758− expression = every (Distinct #col)
1759− in printSQL expression
1760− :}
1761− every(DISTINCT "col")
1762− -}
1763− every
1764− :: expr1 (null 'PGbool)
1765− -- ^ what to aggregate
1766− -> aggr ('Null 'PGbool)
1767−
1768− {- |maximum value of expression across all input values-}
1769− max_
1770− :: expr1 (null ty)
1771− -- ^ what to maximize
1772− -> aggr ('Null ty)
1773−
1774− -- | minimum value of expression across all input values
1775− min_
1776− :: expr1 (null ty)
1777− -- ^ what to minimize
1778− -> aggr ('Null ty)
1779−
1780− -- | the average (arithmetic mean) of all input values
1781− avg
1782− :: expr1 (null ty)
1783− -- ^ what to average
1784− -> aggr ('Null (PGAvg ty))
1785−
1786− {- | correlation coefficient
1787− >>> :{
1788− let
1789− expression :: Expression '[] ('Grouped g) c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1790− expression = corr (All (#y *: #x))
1791− in printSQL expression
1792− :}
1793− corr(ALL "y", "x")
1794− -}
1795− corr
1796− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1797− -> aggr ('Null 'PGfloat8)
1798−
1799− {- | population covariance
1800− >>> :{
1801− let
1802− expression :: Expression '[] ('Grouped g) c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1803− expression = covarPop (All (#y *: #x))
1804− in printSQL expression
1805− :}
1806− covar_pop(ALL "y", "x")
1807− -}
1808− covarPop
1809− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1810− -> aggr ('Null 'PGfloat8)
1811−
1812− {- | sample covariance
1813− >>> :{
1814− let
1815− winFun :: WindowFunction '[] 'Ungrouped c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1816− winFun = covarSamp (#y *: #x)
1817− in printSQL winFun
1818− :}
1819− covar_samp("y", "x")
1820− -}
1821− covarSamp
1822− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1823− -> aggr ('Null 'PGfloat8)
1824−
1825− {- | average of the independent variable (sum(X)/N)
1826− >>> :{
1827− let
1828− expression :: Expression '[] ('Grouped g) c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1829− expression = regrAvgX (All (#y *: #x))
1830− in printSQL expression
1831− :}
1832− regr_avgx(ALL "y", "x")
1833− -}
1834− regrAvgX
1835− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1836− -> aggr ('Null 'PGfloat8)
1837−
1838− {- | average of the dependent variable (sum(Y)/N)
1839− >>> :{
1840− let
1841− winFun :: WindowFunction '[] 'Ungrouped c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1842− winFun = regrAvgY (#y *: #x)
1843− in printSQL winFun
1844− :}
1845− regr_avgy("y", "x")
1846− -}
1847− regrAvgY
1848− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1849− -> aggr ('Null 'PGfloat8)
1850−
1851− {- | number of input rows in which both expressions are nonnull
1852− >>> :{
1853− let
1854− winFun :: WindowFunction '[] 'Ungrouped c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGint8)
1855− winFun = regrCount (#y *: #x)
1856− in printSQL winFun
1857− :}
1858− regr_count("y", "x")
1859− -}
1860− regrCount
1861− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1862− -> aggr ('Null 'PGint8)
1863−
1864− {- | y-intercept of the least-squares-fit linear equation determined by the (X, Y) pairs
1865− >>> :{
1866− let
1867− expression :: Expression '[] ('Grouped g) c s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1868− expression = regrIntercept (All (#y *: #x))
1869− in printSQL expression
1870− :}
1871− regr_intercept(ALL "y", "x")
1872− -}
1873− regrIntercept
1874− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1875− -> aggr ('Null 'PGfloat8)
1876−
1877− -- | @regr_r2(Y, X)@, square of the correlation coefficient
1878− regrR2
1879− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1880− -> aggr ('Null 'PGfloat8)
1881−
1882− -- | @regr_slope(Y, X)@, slope of the least-squares-fit linear equation
1883− -- determined by the (X, Y) pairs
1884− regrSlope
1885− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1886− -> aggr ('Null 'PGfloat8)
1887−
1888− -- | @regr_sxx(Y, X)@, sum(X^2) - sum(X)^2/N
1889− -- (“sum of squares” of the independent variable)
1890− regrSxx
1891− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1892− -> aggr ('Null 'PGfloat8)
1893−
1894− -- | @regr_sxy(Y, X)@, sum(X*Y) - sum(X) * sum(Y)/N
1895− -- (“sum of products” of independent times dependent variable)
1896− regrSxy
1897− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1898− -> aggr ('Null 'PGfloat8)
1899−
1900− -- | @regr_syy(Y, X)@, sum(Y^2) - sum(Y)^2/N
1901− -- (“sum of squares” of the dependent variable)
1902− regrSyy
1903− :: exprHet '[null 'PGfloat8, null 'PGfloat8]
1904− -> aggr ('Null 'PGfloat8)
1905−
1906− -- | historical alias for `stddevSamp`
1907− stddev
1908− :: expr1 (null ty)
1909− -> aggr ('Null (PGAvg ty))
1910−
1911− -- | population standard deviation of the input values
1912− stddevPop
1913− :: expr1 (null ty)
1914− -> aggr ('Null (PGAvg ty))
1915−
1916− -- | sample standard deviation of the input values
1917− stddevSamp
1918− :: expr1 (null ty)
1919− -> aggr ('Null (PGAvg ty))
1920−
1921− -- | historical alias for `varSamp`
1922− variance
1923− :: expr1 (null ty)
1924− -> aggr ('Null (PGAvg ty))
1925−
1926− -- | population variance of the input values
1927− -- (square of the population standard deviation)
1928− varPop
1929− :: expr1 (null ty)
1930− -> aggr ('Null (PGAvg ty))
1931−
1932− -- | sample variance of the input values
1933− -- (square of the sample standard deviation)
1934− varSamp
1935− :: expr1 (null ty)
1936− -> aggr ('Null (PGAvg ty))
1937−
1938−{- |
1939−`Distinction`s are used for the input of `Aggregate` `Expression`s.
1940−`All` invokes the aggregate once for each input row.
1941−`Distinct` invokes the aggregate once for each distinct value of the expression
1942−(or distinct set of values, for multiple expressions) found in the input
1943−-}
1944−data Distinction (expr :: kind -> Type) (ty :: kind)
1945− = All (expr ty)
1946− | Distinct (expr ty)
1947− deriving (GHC.Generic,Show,Eq,Ord)
1948−instance NFData (Distinction (Expression outer grp commons schemas params from) ty)
1949−instance RenderSQL (Distinction (Expression outer grp commons schemas params from) ty) where
1950− renderSQL = \case
1951− All x -> "ALL" <+> renderSQL x
1952− Distinct x -> "DISTINCT" <+> renderSQL x
1953−instance SOP.SListI tys => RenderSQL
1954− (Distinction (NP (Expression outer grp commons schemas params from)) tys) where
1955− renderSQL = \case
1956− All xs -> "ALL" <+> renderCommaSeparated renderSQL xs
1957− Distinct xs -> "DISTINCT" <+> renderCommaSeparated renderSQL xs
1958−
1959−instance Aggregate
1960− (Distinction (Expression outer 'Ungrouped commons schemas params from))
1961− (Distinction (NP (Expression outer 'Ungrouped commons schemas params from)))
1962− (Expression outer ('Grouped bys) commons schemas params from) where
1963− countStar = UnsafeExpression "count(*)"
1964− count = unsafeAggregate1 "count"
1965− sum_ = unsafeAggregate1 "sum"
1966− arrayAgg = unsafeAggregate1 "array_agg"
1967− jsonAgg = unsafeAggregate1 "json_agg"
1968− jsonbAgg = unsafeAggregate1 "jsonb_agg"
1969− bitAnd = unsafeAggregate1 "bit_and"
1970− bitOr = unsafeAggregate1 "bit_or"
1971− boolAnd = unsafeAggregate1 "bool_and"
1972− boolOr = unsafeAggregate1 "bool_or"
1973− every = unsafeAggregate1 "every"
1974− max_ = unsafeAggregate1 "max"
1975− min_ = unsafeAggregate1 "min"
1976− avg = unsafeAggregate1 "avg"
1977− corr = unsafeAggregateHet "corr"
1978− covarPop = unsafeAggregateHet "covar_pop"
1979− covarSamp = unsafeAggregateHet "covar_samp"
1980− regrAvgX = unsafeAggregateHet "regr_avgx"
1981− regrAvgY = unsafeAggregateHet "regr_avgy"
1982− regrCount = unsafeAggregateHet "regr_count"
1983− regrIntercept = unsafeAggregateHet "regr_intercept"
1984− regrR2 = unsafeAggregateHet "regr_r2"
1985− regrSlope = unsafeAggregateHet "regr_slope"
1986− regrSxx = unsafeAggregateHet "regr_sxx"
1987− regrSxy = unsafeAggregateHet "regr_sxy"
1988− regrSyy = unsafeAggregateHet "regr_syy"
1989− stddev = unsafeAggregate1 "stddev"
1990− stddevPop = unsafeAggregate1 "stddev_pop"
1991− stddevSamp = unsafeAggregate1 "stddev_samp"
1992− variance = unsafeAggregate1 "variance"
1993− varPop = unsafeAggregate1 "var_pop"
1994− varSamp = unsafeAggregate1 "var_samp"
1995−instance Aggregate
1996− (Expression outer grp commons schemas params from)
1997− (NP (Expression outer grp commons schemas params from))
1998− (WindowFunction outer grp commons schemas params from) where
1999− countStar = UnsafeWindowFunction "count(*)"
2000− count = unsafeWindowFunction1 "count"
2001− sum_ = unsafeWindowFunction1 "sum"
2002− arrayAgg = unsafeWindowFunction1 "array_agg"
2003− jsonAgg = unsafeWindowFunction1 "json_agg"
2004− jsonbAgg = unsafeWindowFunction1 "jsonb_agg"
2005− bitAnd = unsafeWindowFunction1 "bit_and"
2006− bitOr = unsafeWindowFunction1 "bit_or"
2007− boolAnd = unsafeWindowFunction1 "bool_and"
2008− boolOr = unsafeWindowFunction1 "bool_or"
2009− every = unsafeWindowFunction1 "every"
2010− max_ = unsafeWindowFunction1 "max"
2011− min_ = unsafeWindowFunction1 "min"
2012− avg = unsafeWindowFunction1 "avg"
2013− corr = unsafeWindowFunctionHet "corr"
2014− covarPop = unsafeWindowFunctionHet "covar_pop"
2015− covarSamp = unsafeWindowFunctionHet "covar_samp"
2016− regrAvgX = unsafeWindowFunctionHet "regr_avgx"
2017− regrAvgY = unsafeWindowFunctionHet "regr_avgy"
2018− regrCount = unsafeWindowFunctionHet "regr_count"
2019− regrIntercept = unsafeWindowFunctionHet "regr_intercept"
2020− regrR2 = unsafeWindowFunctionHet "regr_r2"
2021− regrSlope = unsafeWindowFunctionHet "regr_slope"
2022− regrSxx = unsafeWindowFunctionHet "regr_sxx"
2023− regrSxy = unsafeWindowFunctionHet "regr_sxy"
2024− regrSyy = unsafeWindowFunctionHet "regr_syy"
2025− stddev = unsafeWindowFunction1 "stddev"
2026− stddevPop = unsafeWindowFunction1 "stddev_pop"
2027− stddevSamp = unsafeWindowFunction1 "stddev_samp"
2028− variance = unsafeWindowFunction1 "variance"
2029− varPop = unsafeWindowFunction1 "var_pop"
2030− varSamp = unsafeWindowFunction1 "var_samp"
2031−
2032−-- | escape hatch to define aggregate functions
2033−unsafeAggregate1
2034− :: ByteString -- ^ aggregate function
2035− -> AggrFun xty yty
2036−unsafeAggregate1 fun x = UnsafeExpression $ mconcat
2037− [fun, "(", renderSQL x, ")"]
2038−
2039−-- | A type family that calculates `PGAvg` type of a `PGType`.
2040−type family PGAvg ty where
2041− PGAvg 'PGint2 = 'PGnumeric
2042− PGAvg 'PGint4 = 'PGnumeric
2043− PGAvg 'PGint8 = 'PGnumeric
2044− PGAvg 'PGnumeric = 'PGnumeric
2045− PGAvg 'PGfloat4 = 'PGfloat8
2046− PGAvg 'PGfloat8 = 'PGfloat8
2047− PGAvg 'PGinterval = 'PGinterval
2048− PGAvg pg = TypeError
2049− ('Text "Squeal type error: No average for " ':<>: 'ShowType pg)
2050−
2051−{-----------------------------------------
2052−type expressions
2053−-----------------------------------------}
2054−
2055−-- | `TypeExpression`s are used in `cast`s and
2056−-- `Squeal.PostgreSQL.Definition.createTable` commands.
2057−newtype TypeExpression (schemas :: SchemasType) (ty :: NullityType)
2058− = UnsafeTypeExpression { renderTypeExpression :: ByteString }
2059− deriving (GHC.Generic,Show,Eq,Ord,NFData)
2060−instance RenderSQL (TypeExpression schemas ty) where
2061− renderSQL = renderTypeExpression
2062−
2063−-- | The enum or composite type in a `Typedef` can be expressed by its alias.
2064−typedef
2065− :: (Has sch schemas schema, Has td schema ('Typedef ty))
2066− => QualifiedAlias sch td
2067− -> TypeExpression schemas (null ty)
2068−typedef = UnsafeTypeExpression . renderSQL
2069−
2070−-- | The composite type corresponding to a `Table` definition can be expressed
2071−-- by its alias.
2072−typetable
2073− :: (Has sch schemas schema, Has tab schema ('Table table))
2074− => QualifiedAlias sch tab
2075− -> TypeExpression schemas (null ('PGcomposite (TableToRow table)))
2076−typetable = UnsafeTypeExpression . renderSQL
2077−
2078−-- | The composite type corresponding to a `View` definition can be expressed
2079−-- by its alias.
2080−typeview
2081− :: (Has sch schemas schema, Has vw schema ('View view))
2082− => QualifiedAlias sch vw
2083− -> TypeExpression schemas (null ('PGcomposite view))
2084−typeview = UnsafeTypeExpression . renderSQL
2085−
2086−-- | logical Boolean (true/false)
2087−bool :: TypeExpression schemas (null 'PGbool)
2088−bool = UnsafeTypeExpression "bool"
2089−-- | signed two-byte integer
2090−int2, smallint :: TypeExpression schemas (null 'PGint2)
2091−int2 = UnsafeTypeExpression "int2"
2092−smallint = UnsafeTypeExpression "smallint"
2093−-- | signed four-byte integer
2094−int4, int, integer :: TypeExpression schemas (null 'PGint4)
2095−int4 = UnsafeTypeExpression "int4"
2096−int = UnsafeTypeExpression "int"
2097−integer = UnsafeTypeExpression "integer"
2098−-- | signed eight-byte integer
2099−int8, bigint :: TypeExpression schemas (null 'PGint8)
2100−int8 = UnsafeTypeExpression "int8"
2101−bigint = UnsafeTypeExpression "bigint"
2102−-- | arbitrary precision numeric type
2103−numeric :: TypeExpression schemas (null 'PGnumeric)
2104−numeric = UnsafeTypeExpression "numeric"
2105−-- | single precision floating-point number (4 bytes)
2106−float4, real :: TypeExpression schemas (null 'PGfloat4)
2107−float4 = UnsafeTypeExpression "float4"
2108−real = UnsafeTypeExpression "real"
2109−-- | double precision floating-point number (8 bytes)
2110−float8, doublePrecision :: TypeExpression schemas (null 'PGfloat8)
2111−float8 = UnsafeTypeExpression "float8"
2112−doublePrecision = UnsafeTypeExpression "double precision"
2113−-- | currency amount
2114−money :: TypeExpression schema (null 'PGmoney)
2115−money = UnsafeTypeExpression "money"
2116−-- | variable-length character string
2117−text :: TypeExpression schemas (null 'PGtext)
2118−text = UnsafeTypeExpression "text"
2119−-- | fixed-length character string
2120−char, character
2121− :: forall n schemas null. (KnownNat n, 1 <= n)
2122− => TypeExpression schemas (null ('PGchar n))
2123−char = UnsafeTypeExpression $ "char(" <> renderNat @n <> ")"
2124−character = UnsafeTypeExpression $ "character(" <> renderNat @n <> ")"
2125−-- | variable-length character string
2126−varchar, characterVarying
2127− :: forall n schemas null. (KnownNat n, 1 <= n)
2128− => TypeExpression schemas (null ('PGvarchar n))
2129−varchar = UnsafeTypeExpression $ "varchar(" <> renderNat @n <> ")"
2130−characterVarying = UnsafeTypeExpression $
2131− "character varying(" <> renderNat @n <> ")"
2132−-- | binary data ("byte array")
2133−bytea :: TypeExpression schemas (null 'PGbytea)
2134−bytea = UnsafeTypeExpression "bytea"
2135−-- | date and time (no time zone)
2136−timestamp :: TypeExpression schemas (null 'PGtimestamp)
2137−timestamp = UnsafeTypeExpression "timestamp"
2138−-- | date and time, including time zone
2139−timestampWithTimeZone :: TypeExpression schemas (null 'PGtimestamptz)
2140−timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"
2141−-- | calendar date (year, month, day)
2142−date :: TypeExpression schemas (null 'PGdate)
2143−date = UnsafeTypeExpression "date"
2144−-- | time of day (no time zone)
2145−time :: TypeExpression schemas (null 'PGtime)
2146−time = UnsafeTypeExpression "time"
2147−-- | time of day, including time zone
2148−timeWithTimeZone :: TypeExpression schemas (null 'PGtimetz)
2149−timeWithTimeZone = UnsafeTypeExpression "time with time zone"
2150−-- | time span
2151−interval :: TypeExpression schemas (null 'PGinterval)
2152−interval = UnsafeTypeExpression "interval"
2153−-- | universally unique identifier
2154−uuid :: TypeExpression schemas (null 'PGuuid)
2155−uuid = UnsafeTypeExpression "uuid"
2156−-- | IPv4 or IPv6 host address
2157−inet :: TypeExpression schemas (null 'PGinet)
2158−inet = UnsafeTypeExpression "inet"
2159−-- | textual JSON data
2160−json :: TypeExpression schemas (null 'PGjson)
2161−json = UnsafeTypeExpression "json"
2162−-- | binary JSON data, decomposed
2163−jsonb :: TypeExpression schemas (null 'PGjsonb)
2164−jsonb = UnsafeTypeExpression "jsonb"
2165−-- | variable length array
2166−vararray
2167− :: TypeExpression schemas pg
2168− -> TypeExpression schemas (null ('PGvararray pg))
2169−vararray ty = UnsafeTypeExpression $ renderSQL ty <> "[]"
2170−-- | fixed length array
2171−--
2172−-- >>> renderSQL (fixarray @'[2] json)
2173−-- "json[2]"
2174−fixarray
2175− :: forall dims schemas null pg. SOP.All KnownNat dims
2176− => TypeExpression schemas pg
2177− -> TypeExpression schemas (null ('PGfixarray dims pg))
2178−fixarray ty = UnsafeTypeExpression $
2179− renderSQL ty <> renderDims @dims
2180− where
2181− renderDims :: forall ns. SOP.All KnownNat ns => ByteString
2182− renderDims =
2183− ("[" <>)
2184− . (<> "]")
2185− . ByteString.intercalate "]["
2186− . hcollapse
2187− $ hcmap (SOP.Proxy @KnownNat)
2188− (K . fromString . show . natVal)
2189− (hpure SOP.Proxy :: NP SOP.Proxy ns)
2190−tsvector :: TypeExpression schemas (null 'PGtsvector)
2191−tsvector = UnsafeTypeExpression "tsvector"
2192−tsquery :: TypeExpression schemas (null 'PGtsquery)
2193−tsquery = UnsafeTypeExpression "tsquery"
2194−
2195−-- | `pgtype` is a demoted version of a `PGType`
2196−class PGTyped schemas (ty :: NullityType) where
2197− pgtype :: TypeExpression schemas ty
2198−instance PGTyped schemas (null 'PGbool) where pgtype = bool
2199−instance PGTyped schemas (null 'PGint2) where pgtype = int2
2200−instance PGTyped schemas (null 'PGint4) where pgtype = int4
2201−instance PGTyped schemas (null 'PGint8) where pgtype = int8
2202−instance PGTyped schemas (null 'PGnumeric) where pgtype = numeric
2203−instance PGTyped schemas (null 'PGfloat4) where pgtype = float4
2204−instance PGTyped schemas (null 'PGfloat8) where pgtype = float8
2205−instance PGTyped schemas (null 'PGmoney) where pgtype = money
2206−instance PGTyped schemas (null 'PGtext) where pgtype = text
2207−instance (KnownNat n, 1 <= n)
2208− => PGTyped schemas (null ('PGchar n)) where pgtype = char @n
2209−instance (KnownNat n, 1 <= n)
2210− => PGTyped schemas (null ('PGvarchar n)) where pgtype = varchar @n
2211−instance PGTyped schemas (null 'PGbytea) where pgtype = bytea
2212−instance PGTyped schemas (null 'PGtimestamp) where pgtype = timestamp
2213−instance PGTyped schemas (null 'PGtimestamptz) where pgtype = timestampWithTimeZone
2214−instance PGTyped schemas (null 'PGdate) where pgtype = date
2215−instance PGTyped schemas (null 'PGtime) where pgtype = time
2216−instance PGTyped schemas (null 'PGtimetz) where pgtype = timeWithTimeZone
2217−instance PGTyped schemas (null 'PGinterval) where pgtype = interval
2218−instance PGTyped schemas (null 'PGuuid) where pgtype = uuid
2219−instance PGTyped schemas (null 'PGjson) where pgtype = json
2220−instance PGTyped schemas (null 'PGjsonb) where pgtype = jsonb
2221−instance PGTyped schemas ty
2222− => PGTyped schemas (null ('PGvararray ty)) where
2223− pgtype = vararray (pgtype @schemas @ty)
2224−instance (SOP.All KnownNat dims, PGTyped schemas ty)
2225− => PGTyped schemas (null ('PGfixarray dims ty)) where
2226− pgtype = fixarray @dims (pgtype @schemas @ty)
2227−instance PGTyped schemas (null 'PGtsvector) where pgtype = tsvector
2228−instance PGTyped schemas (null 'PGtsquery) where pgtype = tsquery
2229−
2230−{-----------------------------------------
2231−Sorting
2232−-----------------------------------------}
2233−
2234−-- | `SortExpression`s are used by `orderBy` to optionally sort the results
2235−-- of a `Squeal.PostgreSQL.Query.Query`. `Asc` or `Desc`
2236−-- set the sort direction of a `NotNull` result
2237−-- column to ascending or descending. Ascending order puts smaller values
2238−-- first, where "smaller" is defined in terms of the `.<` operator. Similarly,
2239−-- descending order is determined with the `.>` operator. `AscNullsFirst`,
2240−-- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to
2241−-- determine whether nulls appear before or after non-null values in the sort
2242−-- ordering of a `Null` result column.
2243−data SortExpression outer grp commons schemas params from where
2244− Asc
2245− :: Expression outer grp commons schemas params from ('NotNull ty)
2246− -> SortExpression outer grp commons schemas params from
2247− Desc
2248− :: Expression outer grp commons schemas params from ('NotNull ty)
2249− -> SortExpression outer grp commons schemas params from
2250− AscNullsFirst
2251− :: Expression outer grp commons schemas params from ('Null ty)
2252− -> SortExpression outer grp commons schemas params from
2253− AscNullsLast
2254− :: Expression outer grp commons schemas params from ('Null ty)
2255− -> SortExpression outer grp commons schemas params from
2256− DescNullsFirst
2257− :: Expression outer grp commons schemas params from ('Null ty)
2258− -> SortExpression outer grp commons schemas params from
2259− DescNullsLast
2260− :: Expression outer grp commons schemas params from ('Null ty)
2261− -> SortExpression outer grp commons schemas params from
2262−deriving instance Show (SortExpression outer grp commons schemas params from)
2263−
2264−{- |
2265−The `orderBy` clause causes the result rows of a `Squeal.PostgreSQL.Query.TableExpression`
2266−to be sorted according to the specified `SortExpression`(s).
2267−If two rows are equal according to the leftmost expression,
2268−they are compared according to the next expression and so on.
2269−If they are equal according to all specified expressions,
2270−they are returned in an implementation-dependent order.
2271−
2272−You can also control the order in which rows are processed by window functions
2273−using `orderBy` within `Squeal.PostgreSQL.Query.Over`.
2274−-}
2275−class OrderBy expr where
2276− orderBy
2277− :: [SortExpression outer grp commons schemas params from]
2278− -> expr outer grp commons schemas params from
2279− -> expr outer grp commons schemas params from
2280−
2281−-- | Render a `SortExpression`.
2282−instance RenderSQL (SortExpression outer grp commons schemas params from) where
2283− renderSQL = \case
2284− Asc expression -> renderSQL expression <+> "ASC"
2285− Desc expression -> renderSQL expression <+> "DESC"
2286− AscNullsFirst expression -> renderSQL expression
2287− <+> "ASC NULLS FIRST"
2288− DescNullsFirst expression -> renderSQL expression
2289− <+> "DESC NULLS FIRST"
2290− AscNullsLast expression -> renderSQL expression <+> "ASC NULLS LAST"
2291− DescNullsLast expression -> renderSQL expression <+> "DESC NULLS LAST"
2292−
2293−-- | A `WindowDefinition` is a set of table rows that are somehow related
2294−-- to the current row
2295−data WindowDefinition outer grp commons schemas params from where
2296− WindowDefinition
2297− :: SListI bys
2298− => NP (Expression outer grp commons schemas params from) bys
2299− -> [SortExpression outer grp commons schemas params from]
2300− -> WindowDefinition outer grp commons schemas params from
2301−
2302−instance OrderBy WindowDefinition where
2303− orderBy sortsR (WindowDefinition parts sortsL)
2304− = WindowDefinition parts (sortsL ++ sortsR)
2305−
2306−instance RenderSQL (WindowDefinition outer commons schemas from grp params) where
2307− renderSQL (WindowDefinition part ord) =
2308− renderPartitionByClause part <> renderOrderByClause ord
2309− where
2310− renderPartitionByClause = \case
2311− Nil -> ""
2312− parts -> "PARTITION" <+> "BY" <+> renderCommaSeparated renderExpression parts
2313− renderOrderByClause = \case
2314− [] -> ""
2315− srts -> " ORDER" <+> "BY"
2316− <+> commaSeparated (renderSQL <$> srts)
2317−
2318−{- |
2319−The `partitionBy` clause within `Squeal.PostgreSQL.Query.Over` divides the rows into groups,
2320−or partitions, that share the same values of the `partitionBy` `Expression`(s).
2321−For each row, the window function is computed across the rows that fall into
2322−the same partition as the current row.
2323−-}
2324−partitionBy
2325− :: SListI bys
2326− => NP (Expression outer grp commons schemas params from) bys
2327− -> WindowDefinition outer grp commons schemas params from
2328−partitionBy bys = WindowDefinition bys []
2329−
2330−{- |
2331−A window function performs a calculation across a set of table rows
2332−that are somehow related to the current row. This is comparable to the type
2333−of calculation that can be done with an aggregate function.
2334−However, window functions do not cause rows to become grouped into a single
2335−output row like non-window aggregate calls would.
2336−Instead, the rows retain their separate identities.
2337−Behind the scenes, the window function is able to access more than
2338−just the current row of the query result.
2339−-}
2340−newtype WindowFunction
2341− (outer :: FromType)
2342− (grp :: Grouping)
2343− (commons :: FromType)
2344− (schemas :: SchemasType)
2345− (params :: [NullityType])
2346− (from :: FromType)
2347− (ty :: NullityType)
2348− = UnsafeWindowFunction { renderWindowFunction :: ByteString }
2349− deriving (GHC.Generic,Show,Eq,Ord,NFData)
2350−
2351−instance RenderSQL (WindowFunction outer grp commons schemas params from ty) where
2352− renderSQL = renderWindowFunction
2353−
2354−type WinFun0 x
2355− = forall outer grp commons schemas params from
2356− . WindowFunction outer grp commons schemas params from x
2357− -- ^ cannot reference aliases
2358−
2359−type WinFun1 x y
2360− = forall outer grp commons schemas params from
2361− . Expression outer grp commons schemas params from x
2362− -- ^ input
2363− -> WindowFunction outer grp commons schemas params from y
2364− -- ^ output
2365−
2366−type WinFunHet xs y
2367− = forall outer grp commons schemas params from
2368− . NP (Expression outer grp commons schemas params from) xs
2369− -- ^ inputs
2370− -> WindowFunction outer grp commons schemas params from y
2371− -- ^ output
2372−
2373−unsafeWindowFunction1 :: ByteString -> WinFun1 x y
2374−unsafeWindowFunction1 fun x
2375− = UnsafeWindowFunction $ fun <> parenthesized (renderSQL x)
2376−
2377−unsafeWindowFunctionHet :: SOP.SListI xs => ByteString -> WinFunHet xs y
2378−unsafeWindowFunctionHet fun xs = UnsafeWindowFunction $ fun <>
2379− parenthesized (renderCommaSeparated renderSQL xs)
2380−
2381−{- | rank of the current row with gaps; same as `rowNumber` of its first peer
2382−>>> printSQL rank
2383−rank()
2384−-}
2385−rank :: WinFun0 ('NotNull 'PGint8)
2386−rank = UnsafeWindowFunction "rank()"
2387−
2388−{- | number of the current row within its partition, counting from 1
2389−>>> printSQL rowNumber
2390−row_number()
2391−-}
2392−rowNumber :: WinFun0 ('NotNull 'PGint8)
2393−rowNumber = UnsafeWindowFunction "row_number()"
2394−
2395−{- | rank of the current row without gaps; this function counts peer groups
2396−>>> printSQL denseRank
2397−dense_rank()
2398−-}
2399−denseRank :: WinFun0 ('NotNull 'PGint8)
2400−denseRank = UnsafeWindowFunction "dense_rank()"
2401−
2402−{- | relative rank of the current row: (rank - 1) / (total partition rows - 1)
2403−>>> printSQL percentRank
2404−percent_rank()
2405−-}
2406−percentRank :: WinFun0 ('NotNull 'PGfloat8)
2407−percentRank = UnsafeWindowFunction "percent_rank()"
2408−
2409−{- | cumulative distribution: (number of partition rows
2410−preceding or peer with current row) / total partition rows
2411−>>> printSQL cumeDist
2412−cume_dist()
2413−-}
2414−cumeDist :: WinFun0 ('NotNull 'PGfloat8)
2415−cumeDist = UnsafeWindowFunction "cume_dist()"
2416−
2417−{- | integer ranging from 1 to the argument value,
2418−dividing the partition as equally as possible
2419−-}
2420−ntile :: WinFun1 ('NotNull 'PGint4) ('NotNull 'PGint4)
2421−ntile = unsafeWindowFunction1 "ntile"
2422−
2423−{- | returns value evaluated at the row that is offset rows before the current
2424−row within the partition; if there is no such row, instead return default
2425−(which must be of the same type as value). Both offset and default are
2426−evaluated with respect to the current row.
2427−-}
2428−lag :: WinFunHet '[ty, 'NotNull 'PGint4, ty] ty
2429−lag = unsafeWindowFunctionHet "lag"
2430−
2431−{- | returns value evaluated at the row that is offset rows after the current
2432−row within the partition; if there is no such row, instead return default
2433−(which must be of the same type as value). Both offset and default are
2434−evaluated with respect to the current row.
2435−-}
2436−lead :: WinFunHet '[ty, 'NotNull 'PGint4, ty] ty
2437−lead = unsafeWindowFunctionHet "lag"
2438−
2439−{- | returns value evaluated at the row that is the
2440−first row of the window frame
2441−-}
2442−firstValue :: WinFun1 ty ty
2443−firstValue = unsafeWindowFunction1 "first_value"
2444−
2445−{- | returns value evaluated at the row that is the
2446−last row of the window frame
2447−-}
2448−lastValue :: WinFun1 ty ty
2449−lastValue = unsafeWindowFunction1 "last_value"
2450−
2451−{- | returns value evaluated at the row that is the nth
2452−row of the window frame (counting from 1); null if no such row
2453−-}
2454−nthValue :: WinFunHet '[null ty, 'NotNull 'PGint4] ('Null ty)
2455−nthValue = unsafeWindowFunctionHet "nth_value"
2456−
2457−{-|
2458−Create date from year, month and day fields
2459−
2460−>>> printSQL (makeDate (1984 :* 7 *: 3))
2461−make_date(1984, 7, 3)
2462−-}
2463−makeDate :: FunctionHet
2464− '[ null 'PGint4, null 'PGint4, null 'PGint4 ]
2465− ( null 'PGdate )
2466−makeDate = unsafeFunctionHet "make_date"
2467−
2468−{-|
2469−Create time from hour, minute and seconds fields
2470−
2471−>>> printSQL (makeTime (8 :* 15 *: 23.5))
2472−make_time(8, 15, 23.5)
2473−-}
2474−makeTime :: FunctionHet
2475− '[ null 'PGint4, null 'PGint4, null 'PGfloat8 ]
2476− ( null 'PGtime )
2477−makeTime = unsafeFunctionHet "make_time"
2478−
2479−{-|
2480−Create timestamp from year, month, day, hour, minute and seconds fields
2481−
2482−>>> printSQL (makeTimestamp (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
2483−make_timestamp(2013, 7, 15, 8, 15, 23.5)
2484−-}
2485−makeTimestamp :: FunctionHet
2486− '[ null 'PGint4, null 'PGint4, null 'PGint4
2487− , null 'PGint4, null 'PGint4, null 'PGfloat8 ]
2488− ( null 'PGtimestamp )
2489−makeTimestamp = unsafeFunctionHet "make_timestamp"
2490−
2491−{-|
2492−Create timestamp with time zone from
2493−year, month, day, hour, minute and seconds fields;
2494−the current time zone is used
2495−
2496−>>> printSQL (makeTimestamptz (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
2497−make_timestamptz(2013, 7, 15, 8, 15, 23.5)
2498−-}
2499−makeTimestamptz :: FunctionHet
2500− '[ null 'PGint4, null 'PGint4, null 'PGint4
2501− , null 'PGint4, null 'PGint4, null 'PGfloat8 ]
2502− ( null 'PGtimestamptz )
2503−makeTimestamptz = unsafeFunctionHet "make_timestamptz"
2504−
2505−{-|
2506−Affine space operations on time types.
2507−-}
2508−class TimeOp time diff | time -> diff where
2509− {-|
2510− >>> printSQL (makeDate (1984 :* 7 *: 3) !+ 365)
2511− (make_date(1984, 7, 3) + 365)
2512− -}
2513− (!+) :: Operator (null time) (null diff) (null time)
2514− (!+) = unsafeBinaryOp "+"
2515− {-|
2516− >>> printSQL (365 +! makeDate (1984 :* 7 *: 3))
2517− (365 + make_date(1984, 7, 3))
2518− -}
2519− (+!) :: Operator (null diff) (null time) (null time)
2520− (+!) = unsafeBinaryOp "+"
2521− {-|
2522− >>> printSQL (makeDate (1984 :* 7 *: 3) !- 365)
2523− (make_date(1984, 7, 3) - 365)
2524− -}
2525− (!-) :: Operator (null time) (null diff) (null time)
2526− (!-) = unsafeBinaryOp "-"
2527− {-|
2528− >>> printSQL (makeDate (1984 :* 7 *: 3) !-! currentDate)
2529− (make_date(1984, 7, 3) - CURRENT_DATE)
2530− -}
2531− (!-!) :: Operator (null time) (null time) (null diff)
2532− (!-!) = unsafeBinaryOp "-"
2533−instance TimeOp 'PGtimestamp 'PGinterval
2534−instance TimeOp 'PGtimestamptz 'PGinterval
2535−instance TimeOp 'PGtime 'PGinterval
2536−instance TimeOp 'PGtimetz 'PGinterval
2537−instance TimeOp 'PGinterval 'PGinterval
2538−instance TimeOp 'PGdate 'PGint4
2539−infixl 6 !+
2540−infixl 6 +!
2541−infixl 6 !-
2542−infixl 6 !-!
2543−
2544−data TimeUnit
2545− = Years | Months | Weeks | Days
2546− | Hours | Minutes | Seconds
2547− | Microseconds | Milliseconds
2548− | Decades | Centuries | Millennia
2549− deriving (Eq, Ord, Show, Read, Enum, GHC.Generic)
2550−instance RenderSQL TimeUnit where
2551− renderSQL = \case
2552− Years -> "years"
2553− Months -> "months"
2554− Weeks -> "weeks"
2555− Days -> "days"
2556− Hours -> "hours"
2557− Minutes -> "minutes"
2558− Seconds -> "seconds"
2559− Microseconds -> "microseconds"
2560− Milliseconds -> "milliseconds"
2561− Decades -> "decades"
2562− Centuries -> "centuries"
2563− Millennia -> "millennia"
2564−
2565−-- | >>> printSQL $ interval_ 7 Days
2566−-- INTERVAL '7.0 days'
2567−interval_ :: Double -> TimeUnit -> Expr (null 'PGinterval)
2568−interval_ num unit = UnsafeExpression $ "INTERVAL" <+>
2569− "'" <> fromString (show num) <+> renderSQL unit <> "'"