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