on dev help sign in
rehierarch expression
commita1f833462da3628ef39c900de514117286b7e981 authorEitan Chatav <eitan@Eitans-MacBook-Pro.local> dateSat 6 Apr 2019, 13:31 (8 years ago) parent6f1f957
22 files changed+2174−1942
squeal-postgresql/squeal-postgresql.cabal+12 squeal-postgresql/src/Squeal/PostgreSQL.hs+22 squeal-postgresql/src/Squeal/PostgreSQL/Alias.hs+11−10 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+2 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+14−1892 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Aggregate.hs+427 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Collection.hs+149 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Comparison.hs+195 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Json.hs+348 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Logic.hs+95 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Math.hs+89 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Null.hs+91 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Sort.hs+75 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Text.hs+51 squeal-postgresql/src/Squeal/PostgreSQL/Expression/TextSearch.hs+107 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Time.hs+183 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Window.hs+246 squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+1 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+7−9 squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+28−28 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+3 squeal-postgresql/src/Squeal/PostgreSQL/Render.hs+18−3
squeal-postgresql/squeal-postgresql.cabal+12
@@ -26,6 +26,18 @@ library
2626 Squeal.PostgreSQL.Binary
2727 Squeal.PostgreSQL.Definition
2828 Squeal.PostgreSQL.Expression
29+ Squeal.PostgreSQL.Expression.Aggregate
30+ Squeal.PostgreSQL.Expression.Collection
31+ Squeal.PostgreSQL.Expression.Comparison
32+ Squeal.PostgreSQL.Expression.Json
33+ Squeal.PostgreSQL.Expression.Logic
34+ Squeal.PostgreSQL.Expression.Math
35+ Squeal.PostgreSQL.Expression.Null
36+ Squeal.PostgreSQL.Expression.Sort
37+ Squeal.PostgreSQL.Expression.Text
38+ Squeal.PostgreSQL.Expression.TextSearch
39+ Squeal.PostgreSQL.Expression.Time
40+ Squeal.PostgreSQL.Expression.Window
2941 Squeal.PostgreSQL.List
3042 Squeal.PostgreSQL.Manipulation
3143 Squeal.PostgreSQL.Migration
squeal-postgresql/src/Squeal/PostgreSQL.hs+22
@@ -198,6 +198,17 @@ module Squeal.PostgreSQL
198198 , module Squeal.PostgreSQL.Binary
199199 , module Squeal.PostgreSQL.Definition
200200 , module Squeal.PostgreSQL.Expression
201+ , module Squeal.PostgreSQL.Expression.Aggregate
202+ , module Squeal.PostgreSQL.Expression.Collection
203+ , module Squeal.PostgreSQL.Expression.Comparison
204+ , module Squeal.PostgreSQL.Expression.Json
205+ , module Squeal.PostgreSQL.Expression.Logic
206+ , module Squeal.PostgreSQL.Expression.Math
207+ , module Squeal.PostgreSQL.Expression.Null
208+ , module Squeal.PostgreSQL.Expression.Text
209+ , module Squeal.PostgreSQL.Expression.TextSearch
210+ , module Squeal.PostgreSQL.Expression.Time
211+ , module Squeal.PostgreSQL.Expression.Window
201212 , module Squeal.PostgreSQL.List
202213 , module Squeal.PostgreSQL.Manipulation
203214 , module Squeal.PostgreSQL.PG
@@ -211,6 +222,17 @@ import Squeal.PostgreSQL.Alias
211222import Squeal.PostgreSQL.Binary
212223import Squeal.PostgreSQL.Definition
213224import Squeal.PostgreSQL.Expression
225+import Squeal.PostgreSQL.Expression.Aggregate
226+import Squeal.PostgreSQL.Expression.Collection
227+import Squeal.PostgreSQL.Expression.Comparison
228+import Squeal.PostgreSQL.Expression.Json
229+import Squeal.PostgreSQL.Expression.Logic
230+import Squeal.PostgreSQL.Expression.Math
231+import Squeal.PostgreSQL.Expression.Null
232+import Squeal.PostgreSQL.Expression.Text
233+import Squeal.PostgreSQL.Expression.TextSearch
234+import Squeal.PostgreSQL.Expression.Time
235+import Squeal.PostgreSQL.Expression.Window
214236import Squeal.PostgreSQL.List
215237import Squeal.PostgreSQL.Manipulation
216238import Squeal.PostgreSQL.PG
squeal-postgresql/src/Squeal/PostgreSQL/Alias.hs+11−10
@@ -49,6 +49,7 @@ import GHC.TypeLits
4949import qualified Generics.SOP as SOP
5050import qualified GHC.Generics as GHC
5151
52+import Squeal.PostgreSQL.List
5253import Squeal.PostgreSQL.Render
5354
5455-- | The alias operator `:::` is like a promoted version of `As`,
@@ -88,17 +89,17 @@ data Alias (alias :: Symbol) = Alias
8889 deriving (Eq,GHC.Generic,Ord,Show,NFData)
8990instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where
9091 fromLabel = Alias
91−instance aliases ~ '[alias] => IsLabel alias (SOP.NP Alias aliases) where
92− fromLabel = fromLabel SOP.:* SOP.Nil
92+instance aliases ~ '[alias] => IsLabel alias (NP Alias aliases) where
93+ fromLabel = fromLabel SOP.:* Nil
9394-- | >>> printSQL (#jimbob :: Alias "jimbob")
9495-- "jimbob"
9596instance KnownSymbol alias => RenderSQL (Alias alias) where
9697 renderSQL = doubleQuoted . fromString . symbolVal
9798
98−-- | >>> import Generics.SOP (SOP.NP(..))
99−-- >>> printSQL (#jimbob SOP.:* #kandi :: SOP.NP Alias '["jimbob", "kandi"])
99+-- | >>> import Generics.SOP (NP(..))
100+-- >>> printSQL (#jimbob SOP.:* #kandi :: NP Alias '["jimbob", "kandi"])
100101-- "jimbob", "kandi"
101−instance SOP.All KnownSymbol aliases => RenderSQL (SOP.NP Alias aliases) where
102+instance SOP.All KnownSymbol aliases => RenderSQL (NP Alias aliases) where
102103 renderSQL
103104 = commaSeparated
104105 . SOP.hcollapse
@@ -125,8 +126,8 @@ instance (alias0 ~ alias1, alias0 ~ alias2, KnownSymbol alias2)
125126 => IsLabel alias0 (Aliased Alias (alias1 ::: alias2)) where
126127 fromLabel = fromLabel @alias2 `As` fromLabel @alias1
127128
128−-- | The `Aliasable` class provides a way to scrap your `SOP.Nil`s
129−-- in an `SOP.NP` list of `Aliased` expressions.
129+-- | The `Aliasable` class provides a way to scrap your `Nil`s
130+-- in an `NP` list of `Aliased` expressions.
130131class KnownSymbol alias => Aliasable alias expression aliased
131132 | aliased -> expression
132133 , aliased -> alias
@@ -138,9 +139,9 @@ instance (KnownSymbol alias, aliased ~ (alias ::: ty)) => Aliasable alias
138139 as = As
139140instance (KnownSymbol alias, tys ~ '[alias ::: ty]) => Aliasable alias
140141 (expression ty)
141− (SOP.NP (Aliased expression) tys)
142+ (NP (Aliased expression) tys)
142143 where
143− expression `as` alias = expression `As` alias SOP.:* SOP.Nil
144+ expression `as` alias = expression `As` alias SOP.:* Nil
144145
145146-- | >>> let renderMaybe = fromString . maybe "Nothing" (const "Just")
146147-- >>> renderAliased renderMaybe (Just (3::Int) `As` #an_int)
@@ -175,7 +176,7 @@ class HasIn fields field where
175176instance (Has alias fields field) => HasIn fields (alias ::: field) where
176177
177178{- |
178−The `DefaultAliasable` class is intended to help with Scrap your SOP.Nils
179+The `DefaultAliasable` class is intended to help with Scrap your Nils
179180for default inserts and updates.
180181-}
181182class KnownSymbol alias
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+2
@@ -97,6 +97,8 @@ import qualified GHC.Generics as GHC
9797
9898import Squeal.PostgreSQL.Alias
9999import Squeal.PostgreSQL.Expression
100+import Squeal.PostgreSQL.Expression.Logic
101+import Squeal.PostgreSQL.List
100102import Squeal.PostgreSQL.PG
101103import Squeal.PostgreSQL.Query
102104import Squeal.PostgreSQL.Render
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+14−1892
@@ -48,164 +48,7 @@ module Squeal.PostgreSQL.Expression
4848 , Literal (..)
4949 , HasParameter (parameter)
5050 , param
51− -- * Null
52− , null_
53− , notNull
54− , coalesce
55− , fromNull
56− , isNull
57− , isNotNull
58− , matchNull
59− , nullIf
60− -- * Collections
61− , array
62− , array1
63− , array2
64− , cardinality
65− , index
66− , row
67− , field
6851 , PGSubset (..)
69− -- * Numerical
70− , atan2_
71− , quot_
72− , rem_
73− , trunc
74− , round_
75− , ceiling_
76− -- * Logic
77− , Condition
78− , true
79− , false
80− , not_
81− , (.&&)
82− , (.||)
83− , caseWhenThenElse
84− , ifThenElse
85− -- * Comparison
86− , (.==)
87− , (./=)
88− , (.>=)
89− , (.<)
90− , (.<=)
91− , (.>)
92− , greatest
93− , least
94− , between
95− , notBetween
96− , betweenSymmetric
97− , notBetweenSymmetric
98− , isDistinctFrom
99− , isNotDistinctFrom
100− , isTrue
101− , isNotTrue
102− , isFalse
103− , isNotFalse
104− , isUnknown
105− , isNotUnknown
106− -- * Time
107− , TimeOp (..)
108− , currentDate
109− , currentTime
110− , currentTimestamp
111− , localTime
112− , localTimestamp
113− , now
114− , makeDate
115− , makeTime
116− , makeTimestamp
117− , makeTimestamptz
118− , interval_
119− , TimeUnit (..)
120− -- * Text
121− , lower
122− , upper
123− , charLength
124− , like
125− , ilike
126− -- * Json
127− -- ** Json and Jsonb operators
128− , (.->)
129− , (.->>)
130− , (.#>)
131− , (.#>>)
132− -- ** Jsonb operators
133− , (.?)
134− , (.?|)
135− , (.?&)
136− , (.-.)
137− , (#-.)
138− -- ** Functions
139− , toJson
140− , toJsonb
141− , arrayToJson
142− , rowToJson
143− , jsonBuildArray
144− , jsonbBuildArray
145− , PGBuildObject
146− , jsonBuildObject
147− , jsonbBuildObject
148− , jsonObject
149− , jsonbObject
150− , jsonZipObject
151− , jsonbZipObject
152− , jsonArrayLength
153− , jsonbArrayLength
154− , jsonExtractPath
155− , jsonbExtractPath
156− , jsonExtractPathAsText
157− , jsonbExtractPathAsText
158− , jsonTypeof
159− , jsonbTypeof
160− , jsonStripNulls
161− , jsonbStripNulls
162− , jsonbSet
163− , jsonbInsert
164− , jsonbPretty
165− -- * Text Search
166− , (@@)
167− , (.&)
168− , (.|)
169− , (.!)
170− , (<->)
171− , arrayToTSvector
172− , tsvectorLength
173− , numnode
174− , plainToTSquery
175− , phraseToTSquery
176− , websearchToTSquery
177− , queryTree
178− , toTSquery
179− , toTSvector
180− , setWeight
181− , strip
182− , jsonToTSvector
183− , jsonbToTSvector
184− , tsDelete
185− , tsFilter
186− , tsHeadline
187− -- * Aggregation
188− , Aggregate (..)
189− , Distinction (..)
190− , PGAvg
191− -- * Window Functions
192− , WindowDefinition (..)
193− , partitionBy
194− , WindowFunction (..)
195− , rank
196− , rowNumber
197− , denseRank
198− , percentRank
199− , cumeDist
200− , ntile
201− , lag
202− , lead
203− , firstValue
204− , lastValue
205− , nthValue
206− -- * Sorting
207− , SortExpression (..)
208− , OrderBy (..)
20952 -- * Types
21053 , TypeExpression (..)
21154 , cast
@@ -249,7 +92,6 @@ module Squeal.PostgreSQL.Expression
24992 , tsquery
25093 -- * Re-export
25194 , (&)
252− , NP (..)
25395 , K (..)
25496 ) where
25597
@@ -259,13 +101,11 @@ import Data.ByteString (ByteString)
259101import Data.ByteString.Lazy (toStrict)
260102import ByteString.StrictBuilder (builderBytes)
261103import Data.Function ((&))
262−import Data.Kind
263104import Data.Semigroup hiding (All)
264105import qualified Data.Aeson as JSON
265106import Data.Int
266107import Data.String
267108import Data.Text (Text)
268−import Data.Word
269109import Generics.SOP hiding (All, from)
270110import GHC.OverloadedLabels
271111import GHC.TypeLits
@@ -529,214 +369,10 @@ instance
529369 (NP (Aliased (Expression outer commons ('Grouped bys) schemas params from)) columns) where
530370 tab ! col = tab ! col :* Nil
531371
532−-- | analagous to `Nothing`
533−--
534−-- >>> printSQL null_
535−-- NULL
536−null_ :: Expr ('Null ty)
537−null_ = UnsafeExpression "NULL"
538−
539−-- | analagous to `Just`
540−--
541−-- >>> printSQL $ notNull true
542−-- TRUE
543−notNull :: 'NotNull ty :--> 'Null ty
544−notNull = UnsafeExpression . renderSQL
545−
546−-- | return the leftmost value which is not NULL
547−--
548−-- >>> printSQL $ coalesce [null_, true] false
549−-- COALESCE(NULL, TRUE, FALSE)
550−coalesce :: FunctionVar ('Null ty) ('NotNull ty) ('NotNull ty)
551−coalesce nullxs notNullx = UnsafeExpression $
552− "COALESCE" <> parenthesized (commaSeparated
553− ((renderSQL <$> nullxs) <> [renderSQL notNullx]))
554−
555−-- | analagous to `Data.Maybe.fromMaybe` using @COALESCE@
556−--
557−-- >>> printSQL $ fromNull true null_
558−-- COALESCE(NULL, TRUE)
559−fromNull
560− :: Expression outer commons grp schemas params from ('NotNull ty)
561− -- ^ what to convert @NULL@ to
562− -> Expression outer commons grp schemas params from ('Null ty)
563− -> Expression outer commons grp schemas params from ('NotNull ty)
564−fromNull notNullx nullx = coalesce [nullx] notNullx
565−
566−-- | >>> printSQL $ null_ & isNull
567−-- NULL IS NULL
568−isNull :: 'Null ty :--> null 'PGbool
569−isNull x = UnsafeExpression $ renderSQL x <+> "IS NULL"
570−
571−-- | >>> printSQL $ null_ & isNotNull
572−-- NULL IS NOT NULL
573−isNotNull :: 'Null ty :--> null 'PGbool
574−isNotNull x = UnsafeExpression $ renderSQL x <+> "IS NOT NULL"
575−
576−-- | analagous to `maybe` using @IS NULL@
577−--
578−-- >>> printSQL $ matchNull true not_ null_
579−-- CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END
580−matchNull
581− :: Expression outer commons grp schemas params from (nullty)
582− -- ^ what to convert @NULL@ to
583− -> ( Expression outer commons grp schemas params from ('NotNull ty)
584− -> Expression outer commons grp schemas params from (nullty) )
585− -- ^ function to perform when @NULL@ is absent
586− -> Expression outer commons grp schemas params from ('Null ty)
587− -> Expression outer commons grp schemas params from (nullty)
588−matchNull y f x = ifThenElse (isNull x) y
589− (f (UnsafeExpression (renderSQL x)))
590−
591−{-| right inverse to `fromNull`, if its arguments are equal then
592−`nullIf` gives @NULL@.
593−
594−>>> :set -XTypeApplications -XDataKinds
595−>>> let expr = nullIf (false *: param @1) :: Expression outer commons grp schemas '[ 'NotNull 'PGbool] from ('Null 'PGbool)
596−>>> printSQL expr
597−NULLIF(FALSE, ($1 :: bool))
598−-}
599−nullIf :: FunctionN '[ 'NotNull ty, 'NotNull ty] ('Null ty)
600−nullIf = unsafeFunctionN "NULLIF"
601−
602−-- | >>> printSQL $ array [null_, false, true]
603−-- ARRAY[NULL, FALSE, TRUE]
604−array
605− :: [Expression outer commons grp schemas params from ty]
606− -- ^ array elements
607− -> Expression outer commons grp schemas params from (null ('PGvararray ty))
608−array xs = UnsafeExpression $ "ARRAY" <>
609− bracketed (commaSeparated (renderSQL <$> xs))
610−
611−{- | construct a 1-dimensional fixed length array
612−
613−>>> printSQL $ array1 (null_ :* false *: true)
614−ARRAY[NULL, FALSE, TRUE]
615−
616−>>> :type array1 (null_ :* false *: true)
617−array1 (null_ :* false *: true)
618− :: Expression
619− outer
620− commons
621− grp
622− schemas
623− params
624− from
625− (null ('PGfixarray '[3] ('Null 'PGbool)))
626−-}
627−array1
628− :: (n ~ Length tys, SOP.All ((~) ty) tys)
629− => NP (Expression outer commons grp schemas params from) tys
630− -> Expression outer commons grp schemas params from (null ('PGfixarray '[n] ty))
631−array1 xs = UnsafeExpression $ "ARRAY" <>
632− bracketed (renderCommaSeparated renderSQL xs)
633−
634−{- | construct a 2-dimensional fixed length array
635−
636−>>> printSQL $ array2 ((null_ :* false *: true) *: (false :* null_ *: true))
637−ARRAY[[NULL, FALSE, TRUE], [FALSE, NULL, TRUE]]
638−
639−>>> :type array2 ((null_ :* false *: true) *: (false :* null_ *: true))
640−array2 ((null_ :* false *: true) *: (false :* null_ *: true))
641− :: Expression
642− outer
643− commons
644− grp
645− schemas
646− params
647− from
648− (null ('PGfixarray '[2, 3] ('Null 'PGbool)))
649−-}
650−array2
651− :: ( SOP.All ((~) tys) tyss
652− , SOP.All SOP.SListI tyss
653− , Length tyss ~ n1
654− , SOP.All ((~) ty) tys
655− , Length tys ~ n2 )
656− => NP (NP (Expression outer commons grp schemas params from)) tyss
657− -> Expression outer commons grp schemas params from (null ('PGfixarray '[n1,n2] ty))
658−array2 xss = UnsafeExpression $ "ARRAY" <>
659− bracketed (renderCommaSeparatedConstraint @SOP.SListI (bracketed . renderCommaSeparated renderSQL) xss)
660−
661−-- | >>> printSQL $ cardinality (array [null_, false, true])
662−-- cardinality(ARRAY[NULL, FALSE, TRUE])
663−cardinality :: null ('PGvararray ty) :--> null 'PGint8
664−cardinality = unsafeFunction "cardinality"
665−
666−-- | >>> printSQL $ array [null_, false, true] & index 2
667−-- (ARRAY[NULL, FALSE, TRUE])[2]
668−index
669− :: Word64 -- ^ index
670− -> null ('PGvararray ty) :--> NullifyType ty
671−index n expr = UnsafeExpression $
672− parenthesized (renderSQL expr) <> "[" <> fromString (show n) <> "]"
673−
674372instance (KnownSymbol label, label `In` labels) => IsPGlabel label
675373 (Expression outer commons grp schemas params from (null ('PGenum labels))) where
676374 label = UnsafeExpression $ renderSQL (PGlabel @label)
677375
678−-- | A row constructor is an expression that builds a row value
679−-- (also called a composite value) using values for its member fields.
680−--
681−-- >>> :{
682−-- type Complex = 'PGcomposite
683−-- '[ "real" ::: 'NotNull 'PGfloat8
684−-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
685−-- :}
686−--
687−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression outer commons grp schemas params from ('NotNull Complex)
688−-- >>> printSQL i
689−-- ROW(0, 1)
690−row
691− :: SListI row
692− => NP (Aliased (Expression outer commons grp schemas params from)) row
693− -- ^ zero or more expressions for the row field values
694− -> Expression outer commons grp schemas params from (null ('PGcomposite row))
695−row exprs = UnsafeExpression $ "ROW" <> parenthesized
696− (renderCommaSeparated (\ (expr `As` _) -> renderSQL expr) exprs)
697−
698−-- | >>> :{
699−-- type Complex = 'PGcomposite
700−-- '[ "real" ::: 'NotNull 'PGfloat8
701−-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
702−-- type Schema = '["complex" ::: 'Typedef Complex]
703−-- :}
704−--
705−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression outer '[] grp (Public Schema) from params ('NotNull Complex)
706−-- >>> printSQL $ i & field #complex #imaginary
707−-- (ROW(0, 1)::"complex")."imaginary"
708−field
709− :: ( Has sch schemas schema
710− , Has tydef schema ('Typedef ('PGcomposite row))
711− , Has field row ty)
712− => QualifiedAlias sch tydef -- ^ row type
713− -> Alias field -- ^ field name
714− -> Expression outer commons grp schemas params from ('NotNull ('PGcomposite row))
715− -> Expression outer commons grp schemas params from ty
716−field td fld expr = UnsafeExpression $
717− parenthesized (renderSQL expr <> "::" <> renderSQL td)
718− <> "." <> renderSQL fld
719−
720−instance Semigroup
721− (Expression outer commons grp schemas params from (null ('PGvararray ty))) where
722− (<>) = unsafeBinaryOp "||"
723−
724−instance Monoid
725− (Expression outer commons grp schemas params from (null ('PGvararray ty))) where
726− mempty = array []
727− mappend = (<>)
728−
729−-- | >>> let expr = greatest [param @1] currentTimestamp :: Expression outer commons grp schemas '[ 'NotNull 'PGtimestamptz] from ('NotNull 'PGtimestamptz)
730−-- >>> printSQL expr
731−-- GREATEST(($1 :: timestamp with time zone), CURRENT_TIMESTAMP)
732−greatest :: FunctionVar ty ty ty
733−greatest = unsafeFunctionVar "GREATEST"
734−
735−-- | >>> printSQL $ least [null_] currentTimestamp
736−-- LEAST(NULL, CURRENT_TIMESTAMP)
737−least :: FunctionVar ty ty ty
738−least = unsafeFunctionVar "LEAST"
739−
740376-- | >>> printSQL $ unsafeBinaryOp "OR" true false
741377-- (TRUE OR FALSE)
742378unsafeBinaryOp :: ByteString -> Operator ty0 ty1 ty2
@@ -809,17 +445,14 @@ instance (ty `In` PGNum, ty `In` PGFloating) => Floating
809445 acosh x = log (x + sqrt (x*x - 1))
810446 atanh x = log ((1 + x) / (1 - x)) / 2
811447
812−-- | >>> :{
813−-- let
814−-- expression :: Expr (null 'PGfloat4)
815−-- expression = atan2_ (pi *: 2)
816−-- in printSQL expression
817−-- :}
818−-- atan2(pi(), 2)
819−atan2_
820− :: float `In` PGFloating
821− => FunctionN '[ null float, null float] (null float)
822−atan2_ = unsafeFunctionN "atan2"
448+class PGSubset container where
449+ (@>) :: Operator (null0 container) (null1 container) ('Null 'PGbool)
450+ (@>) = unsafeBinaryOp "@>"
451+ (<@) :: Operator (null0 container) (null1 container) ('Null 'PGbool)
452+ (<@) = unsafeBinaryOp "<@"
453+instance PGSubset 'PGjsonb
454+instance PGSubset 'PGtsquery
455+instance PGSubset ('PGvararray ty)
823456
824457-- When a `cast` is applied to an `Expression` of a known type, it
825458-- represents a run-time type conversion. The cast will succeed only if a
@@ -836,338 +469,10 @@ cast
836469cast ty x = UnsafeExpression $ parenthesized $
837470 renderSQL x <+> "::" <+> renderSQL ty
838471
839−-- | integer division, truncates the result
840−--
841−-- >>> :{
842−-- let
843−-- expression :: Expression outer commons grp schemas params from (null 'PGint2)
844−-- expression = 5 `quot_` 2
845−-- in printSQL expression
846−-- :}
847−-- (5 / 2)
848−quot_
849− :: int `In` PGIntegral
850− => Operator (null int) (null int) (null int)
851−quot_ = unsafeBinaryOp "/"
852−
853−-- | remainder upon integer division
854−--
855−-- >>> :{
856−-- let
857−-- expression :: Expression outer commons grp schemas params from (null 'PGint2)
858−-- expression = 5 `rem_` 2
859−-- in printSQL expression
860−-- :}
861−-- (5 % 2)
862−rem_
863− :: int `In` PGIntegral
864− => Operator (null int) (null int) (null int)
865−rem_ = unsafeBinaryOp "%"
866−
867−-- | >>> :{
868−-- let
869−-- expression :: Expression outer commons grp schemas params from (null 'PGfloat4)
870−-- expression = trunc pi
871−-- in printSQL expression
872−-- :}
873−-- trunc(pi())
874−trunc :: frac `In` PGFloating => null frac :--> null frac
875−trunc = unsafeFunction "trunc"
876−
877−-- | >>> :{
878−-- let
879−-- expression :: Expression outer commons grp schemas params from (null 'PGfloat4)
880−-- expression = round_ pi
881−-- in printSQL expression
882−-- :}
883−-- round(pi())
884−round_ :: frac `In` PGFloating => null frac :--> null frac
885−round_ = unsafeFunction "round"
886−
887−-- | >>> :{
888−-- let
889−-- expression :: Expression outer commons grp schemas params from (null 'PGfloat4)
890−-- expression = ceiling_ pi
891−-- in printSQL expression
892−-- :}
893−-- ceiling(pi())
894−ceiling_ :: frac `In` PGFloating => null frac :--> null frac
895−ceiling_ = unsafeFunction "ceiling"
896−
897−-- | A `Condition` is an `Expression`, which can evaluate
898−-- to `true`, `false` or `null_`. This is because SQL uses
899−-- a three valued logic.
900−type Condition outer commons grp schemas params from =
901− Expression outer commons grp schemas params from ('Null 'PGbool)
902−
903−-- | >>> printSQL true
904−-- TRUE
905−true :: Expr (null 'PGbool)
906−true = UnsafeExpression "TRUE"
907−
908−-- | >>> printSQL false
909−-- FALSE
910−false :: Expr (null 'PGbool)
911−false = UnsafeExpression "FALSE"
912−
913−-- | >>> printSQL $ not_ true
914−-- (NOT TRUE)
915−not_ :: null 'PGbool :--> null 'PGbool
916−not_ = unsafeUnaryOpL "NOT"
917−
918−-- | >>> printSQL $ true .&& false
919−-- (TRUE AND FALSE)
920−(.&&) :: Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
921−infixr 3 .&&
922−(.&&) = unsafeBinaryOp "AND"
923−
924−-- | >>> printSQL $ true .|| false
925−-- (TRUE OR FALSE)
926−(.||) :: Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
927−infixr 2 .||
928−(.||) = unsafeBinaryOp "OR"
929−
930−-- | >>> :{
931−-- let
932−-- expression :: Expression outer commons grp schemas params from (null 'PGint2)
933−-- expression = caseWhenThenElse [(true, 1), (false, 2)] 3
934−-- in printSQL expression
935−-- :}
936−-- CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END
937−caseWhenThenElse
938− :: [ ( Condition outer commons grp schemas params from
939− , Expression outer commons grp schemas params from ty
940− ) ]
941− -- ^ whens and thens
942− -> Expression outer commons grp schemas params from ty
943− -- ^ else
944− -> Expression outer commons grp schemas params from ty
945−caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
946− [ "CASE"
947− , mconcat
948− [ mconcat
949− [ " WHEN ", renderSQL when_
950− , " THEN ", renderSQL then_
951− ]
952− | (when_,then_) <- whenThens
953− ]
954− , " ELSE ", renderSQL else_
955− , " END"
956− ]
957−
958−-- | >>> :{
959−-- let
960−-- expression :: Expression outer commons grp schemas params from (null 'PGint2)
961−-- expression = ifThenElse true 1 0
962−-- in printSQL expression
963−-- :}
964−-- CASE WHEN TRUE THEN 1 ELSE 0 END
965−ifThenElse
966− :: Condition outer commons grp schemas params from
967− -> Expression outer commons grp schemas params from ty -- ^ then
968− -> Expression outer commons grp schemas params from ty -- ^ else
969− -> Expression outer commons grp schemas params from ty
970−ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
971−
972−-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`
973−-- will produce @NULL@s if one of their arguments is @NULL@.
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 .>= null_
988−-- (TRUE >= NULL)
989−(.>=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
990−(.>=) = unsafeBinaryOp ">="
991−infix 4 .>=
992−
993−-- | >>> printSQL $ true .< null_
994−-- (TRUE < NULL)
995−(.<) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
996−(.<) = unsafeBinaryOp "<"
997−infix 4 .<
998−
999−-- | >>> printSQL $ true .<= null_
1000−-- (TRUE <= NULL)
1001−(.<=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
1002−(.<=) = unsafeBinaryOp "<="
1003−infix 4 .<=
1004−
1005−-- | >>> printSQL $ true .> null_
1006−-- (TRUE > NULL)
1007−(.>) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
1008−(.>) = unsafeBinaryOp ">"
1009−infix 4 .>
1010−
1011−{- | >>> printSQL $ true `between` (null_, false)
1012−TRUE BETWEEN NULL AND FALSE
1013−-}
1014−between
1015− :: Expression outer commons grp schemas params from (null ty)
1016− -> ( Expression outer commons grp schemas params from (null ty)
1017− , Expression outer commons grp schemas params from (null ty) ) -- ^ bounds
1018− -> Condition outer commons grp schemas params from
1019−between a (x,y) = UnsafeExpression $ renderSQL a <+> "BETWEEN"
1020− <+> renderSQL x <+> "AND" <+> renderSQL y
1021−
1022−{- | >>> printSQL $ true `notBetween` (null_, false)
1023−TRUE NOT BETWEEN NULL AND FALSE
1024−-}
1025−notBetween
1026− :: Expression outer commons grp schemas params from (null ty)
1027− -> ( Expression outer commons grp schemas params from (null ty)
1028− , Expression outer commons grp schemas params from (null ty) ) -- ^ bounds
1029− -> Condition outer commons grp schemas params from
1030−notBetween a (x,y) = UnsafeExpression $ renderSQL a <+> "NOT BETWEEN"
1031− <+> renderSQL x <+> "AND" <+> renderSQL y
1032−
1033−{- | between, after sorting the comparison values
1034−
1035−>>> printSQL $ true `betweenSymmetric` (null_, false)
1036−TRUE BETWEEN SYMMETRIC NULL AND FALSE
1037−-}
1038−betweenSymmetric
1039− :: Expression outer commons grp schemas params from (null ty)
1040− -> ( Expression outer commons grp schemas params from (null ty)
1041− , Expression outer commons grp schemas params from (null ty) ) -- ^ bounds
1042− -> Condition outer commons grp schemas params from
1043−betweenSymmetric a (x,y) = UnsafeExpression $ renderSQL a
1044− <+> "BETWEEN SYMMETRIC" <+> renderSQL x <+> "AND" <+> renderSQL y
1045−
1046−{- | not between, after sorting the comparison values
1047−
1048−>>> printSQL $ true `notBetweenSymmetric` (null_, false)
1049−TRUE NOT BETWEEN SYMMETRIC NULL AND FALSE
1050−-}
1051−notBetweenSymmetric
1052− :: Expression outer commons grp schemas params from (null ty)
1053− -> ( Expression outer commons grp schemas params from (null ty)
1054− , Expression outer commons grp schemas params from (null ty) ) -- ^ bounds
1055− -> Condition outer commons grp schemas params from
1056−notBetweenSymmetric a (x,y) = UnsafeExpression $ renderSQL a
1057− <+> "NOT BETWEEN SYMMETRIC" <+> renderSQL x <+> "AND" <+> renderSQL y
1058−
1059−{- | not equal, treating null like an ordinary value
1060−
1061−>>> printSQL $ true `isDistinctFrom` null_
1062−(TRUE IS DISTINCT FROM NULL)
1063−-}
1064−isDistinctFrom :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
1065−isDistinctFrom = unsafeBinaryOp "IS DISTINCT FROM"
1066−
1067−{- | equal, treating null like an ordinary value
1068−
1069−>>> printSQL $ true `isNotDistinctFrom` null_
1070−(TRUE IS NOT DISTINCT FROM NULL)
1071−-}
1072−isNotDistinctFrom :: Operator (null0 ty) (null1 ty) ('NotNull 'PGbool)
1073−isNotDistinctFrom = unsafeBinaryOp "IS NOT DISTINCT FROM"
1074−
1075−{- | is true
1076−
1077−>>> printSQL $ true & isTrue
1078−(TRUE IS TRUE)
1079−-}
1080−isTrue :: null0 'PGbool :--> null1 'PGbool
1081−isTrue = unsafeUnaryOpR "IS TRUE"
1082−
1083−{- | is false or unknown
1084−
1085−>>> printSQL $ true & isNotTrue
1086−(TRUE IS NOT TRUE)
1087−-}
1088−isNotTrue :: null0 'PGbool :--> null1 'PGbool
1089−isNotTrue = unsafeUnaryOpR "IS NOT TRUE"
1090−
1091−{- | is false
1092−
1093−>>> printSQL $ true & isFalse
1094−(TRUE IS FALSE)
1095−-}
1096−isFalse :: null0 'PGbool :--> null1 'PGbool
1097−isFalse = unsafeUnaryOpR "IS FALSE"
1098−
1099−{- | is true or unknown
1100−
1101−>>> printSQL $ true & isNotFalse
1102−(TRUE IS NOT FALSE)
1103−-}
1104−isNotFalse :: null0 'PGbool :--> null1 'PGbool
1105−isNotFalse = unsafeUnaryOpR "IS NOT FALSE"
1106−
1107−{- | is unknown
1108−
1109−>>> printSQL $ true & isUnknown
1110−(TRUE IS UNKNOWN)
1111−-}
1112−isUnknown :: null0 'PGbool :--> null1 'PGbool
1113−isUnknown = unsafeUnaryOpR "IS UNKNOWN"
1114−
1115−{- | is true or false
1116−
1117−>>> printSQL $ true & isNotUnknown
1118−(TRUE IS NOT UNKNOWN)
1119−-}
1120−isNotUnknown :: null0 'PGbool :--> null1 'PGbool
1121−isNotUnknown = unsafeUnaryOpR "IS NOT UNKNOWN"
1122−
1123−-- | >>> printSQL currentDate
1124−-- CURRENT_DATE
1125−currentDate :: Expr (null 'PGdate)
1126−currentDate = UnsafeExpression "CURRENT_DATE"
1127−
1128−-- | >>> printSQL currentTime
1129−-- CURRENT_TIME
1130−currentTime :: Expr (null 'PGtimetz)
1131−currentTime = UnsafeExpression "CURRENT_TIME"
1132−
1133−-- | >>> printSQL currentTimestamp
1134−-- CURRENT_TIMESTAMP
1135−currentTimestamp :: Expr (null 'PGtimestamptz)
1136−currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"
1137−
1138−-- | >>> printSQL localTime
1139−-- LOCALTIME
1140−localTime :: Expr (null 'PGtime)
1141−localTime = UnsafeExpression "LOCALTIME"
1142−
1143−-- | >>> printSQL localTimestamp
1144−-- LOCALTIMESTAMP
1145−localTimestamp :: Expr (null 'PGtimestamp)
1146−localTimestamp = UnsafeExpression "LOCALTIMESTAMP"
1147−
1148−-- | Current date and time (equivalent to `currentTimestamp`)
1149−--
1150−-- >>> printSQL now
1151−-- now()
1152−now :: Expr (null 'PGtimestamptz)
1153−now = UnsafeExpression "now()"
1154−
1155472{-----------------------------------------
1156473text
1157474-----------------------------------------}
1158475
1159−escape :: Char -> String
1160−escape = \case
1161− '\NUL' -> "\\0"
1162− '\'' -> "''"
1163− '"' -> "\\\""
1164− '\b' -> "\\b"
1165− '\n' -> "\\n"
1166− '\r' -> "\\r"
1167− '\t' -> "\\t"
1168− '\\' -> "\\\\"
1169− c -> [c]
1170−
1171476instance IsString
1172477 (Expression outer commons grp schemas params from (null 'PGtext)) where
1173478 fromString str = UnsafeExpression $
@@ -1181,6 +486,12 @@ instance IsString
1181486 fromString str = cast tsquery . UnsafeExpression $
1182487 "E\'" <> fromString (escape =<< str) <> "\'"
1183488
489+instance Semigroup
490+ (Expression outer commons grp schemas params from (null ('PGvararray ty))) where
491+ (<>) = unsafeBinaryOp "||"
492+instance Semigroup
493+ (Expression outer commons grp schemas params from (null 'PGjsonb)) where
494+ (<>) = unsafeBinaryOp "||"
1184495instance Semigroup
1185496 (Expression outer commons grp schemas params from (null 'PGtext)) where
1186497 (<>) = unsafeBinaryOp "||"
@@ -1197,852 +508,6 @@ instance Monoid
1197508 mempty = fromString ""
1198509 mappend = (<>)
1199510
1200−-- | >>> printSQL $ lower "ARRRGGG"
1201−-- lower(E'ARRRGGG')
1202−lower :: null 'PGtext :--> null 'PGtext
1203−lower = unsafeFunction "lower"
1204−
1205−-- | >>> printSQL $ upper "eeee"
1206−-- upper(E'eeee')
1207−upper :: null 'PGtext :--> null 'PGtext
1208−upper = unsafeFunction "upper"
1209−
1210−-- | >>> printSQL $ charLength "four"
1211−-- char_length(E'four')
1212−charLength :: null 'PGtext :--> null 'PGint4
1213−charLength = unsafeFunction "char_length"
1214−
1215−-- | The `like` expression returns true if the @string@ matches
1216−-- the supplied @pattern@. If @pattern@ does not contain percent signs
1217−-- or underscores, then the pattern only represents the string itself;
1218−-- in that case `like` acts like the equals operator. An underscore (_)
1219−-- in pattern stands for (matches) any single character; a percent sign (%)
1220−-- matches any sequence of zero or more characters.
1221−--
1222−-- >>> printSQL $ "abc" `like` "a%"
1223−-- (E'abc' LIKE E'a%')
1224−like :: Operator (null 'PGtext) (null 'PGtext) ('Null 'PGbool)
1225−like = unsafeBinaryOp "LIKE"
1226−
1227−-- | The key word ILIKE can be used instead of LIKE to make the
1228−-- match case-insensitive according to the active locale.
1229−--
1230−-- >>> printSQL $ "abc" `ilike` "a%"
1231−-- (E'abc' ILIKE E'a%')
1232−ilike :: Operator (null 'PGtext) (null 'PGtext) ('Null 'PGbool)
1233−ilike = unsafeBinaryOp "ILIKE"
1234−
1235−{-----------------------------------------
1236− -- json and jsonb support
1237−
1238−See https://www.postgresql.org/docs/10/static/functions-json.html -- most
1239−comments lifted directly from this page.
1240−
1241−Table 9.44: json and jsonb operators
1242−-----------------------------------------}
1243−
1244−-- | Get JSON value (object field or array element) at a key.
1245−(.->)
1246− :: (json `In` PGJsonType, key `In` PGJsonKey)
1247− => Operator (null json) (null key) ('Null json)
1248−infixl 8 .->
1249−(.->) = unsafeBinaryOp "->"
1250−
1251−-- | Get JSON value (object field or array element) at a key, as text.
1252−(.->>)
1253− :: (json `In` PGJsonType, key `In` PGJsonKey)
1254− => Operator (null json) (null key) ('Null 'PGtext)
1255−infixl 8 .->>
1256−(.->>) = unsafeBinaryOp "->>"
1257−
1258−-- | Get JSON value at a specified path.
1259−(.#>)
1260− :: json `In` PGJsonType
1261− => Operator (null json) (null ('PGvararray ('NotNull 'PGtext))) ('Null json)
1262−infixl 8 .#>
1263−(.#>) = unsafeBinaryOp "#>"
1264−
1265−-- | Get JSON value at a specified path as text.
1266−(.#>>)
1267− :: json `In` PGJsonType
1268− => Operator (null json) (null ('PGvararray ('NotNull 'PGtext))) ('Null 'PGtext)
1269−infixl 8 .#>>
1270−(.#>>) = unsafeBinaryOp "#>>"
1271−
1272−-- Additional jsonb operators
1273−
1274−class PGSubset container where
1275− (@>) :: Operator (null0 container) (null1 container) ('Null 'PGbool)
1276− (@>) = unsafeBinaryOp "@>"
1277− (<@) :: Operator (null0 container) (null1 container) ('Null 'PGbool)
1278− (<@) = unsafeBinaryOp "<@"
1279−instance PGSubset 'PGjsonb
1280−instance PGSubset 'PGtsquery
1281−instance PGSubset ('PGvararray ty)
1282−
1283−-- | Does the string exist as a top-level key within the JSON value?
1284−(.?) :: Operator (null 'PGjsonb) (null 'PGtext) ('Null 'PGbool)
1285−infixl 9 .?
1286−(.?) = unsafeBinaryOp "?"
1287−
1288−-- | Do any of these array strings exist as top-level keys?
1289−(.?|) :: Operator
1290− (null 'PGjsonb)
1291− (null ('PGvararray ('NotNull 'PGtext)))
1292− ('Null 'PGbool)
1293−infixl 9 .?|
1294−(.?|) = unsafeBinaryOp "?|"
1295−
1296−-- | Do all of these array strings exist as top-level keys?
1297−(.?&) :: Operator
1298− (null 'PGjsonb)
1299− (null ('PGvararray ('NotNull 'PGtext)))
1300− ('Null 'PGbool)
1301−infixl 9 .?&
1302−(.?&) = unsafeBinaryOp "?&"
1303−
1304−instance Semigroup
1305− (Expression outer commons grp schemas params from (null 'PGjsonb)) where
1306− (<>) = unsafeBinaryOp "||"
1307−
1308−-- | Delete a key or keys from a JSON object, or remove an array element.
1309−--
1310−-- If the right operand is..
1311−--
1312−-- @ text @: Delete key/value pair or string element from left operand. Key/value pairs
1313−-- are matched based on their key value.
1314−--
1315−-- @ text[] @: Delete multiple key/value pairs or string elements
1316−-- from left operand. Key/value pairs are matched based on their key value.
1317−--
1318−-- @ integer @: Delete the array element with specified index (Negative integers
1319−-- count from the end). Throws an error if top level container is not an array.
1320−(.-.)
1321− :: (key `In` '[ 'PGtext, 'PGvararray ('NotNull 'PGtext), 'PGint4, 'PGint2 ]) -- hlint error without parens here
1322− => Operator (null 'PGjsonb) (null key) (null 'PGjsonb)
1323−infixl 6 .-.
1324−(.-.) = unsafeBinaryOp "-"
1325−
1326−-- | Delete the field or element with specified path (for JSON arrays, negative
1327−-- integers count from the end)
1328−(#-.) :: Operator (null 'PGjsonb) (null ('PGvararray ('NotNull 'PGtext))) (null 'PGjsonb)
1329−infixl 6 #-.
1330−(#-.) = unsafeBinaryOp "#-"
1331−
1332−{-----------------------------------------
1333−Table 9.45: JSON creation functions
1334−-----------------------------------------}
1335−
1336−-- | Returns the value as json. Arrays and composites are converted
1337−-- (recursively) to arrays and objects; otherwise, if there is a cast from the
1338−-- type to json, the cast function will be used to perform the conversion;
1339−-- otherwise, a scalar value is produced. For any scalar type other than a
1340−-- number, a Boolean, or a null value, the text representation will be used, in
1341−-- such a fashion that it is a valid json value.
1342−toJson :: null ty :--> null 'PGjson
1343−toJson = unsafeFunction "to_json"
1344−
1345−-- | Returns the value as jsonb. Arrays and composites are converted
1346−-- (recursively) to arrays and objects; otherwise, if there is a cast from the
1347−-- type to json, the cast function will be used to perform the conversion;
1348−-- otherwise, a scalar value is produced. For any scalar type other than a
1349−-- number, a Boolean, or a null value, the text representation will be used, in
1350−-- such a fashion that it is a valid jsonb value.
1351−toJsonb :: null ty :--> null 'PGjsonb
1352−toJsonb = unsafeFunction "to_jsonb"
1353−
1354−-- | Returns the array as a JSON array. A PostgreSQL multidimensional array
1355−-- becomes a JSON array of arrays.
1356−arrayToJson :: null ('PGvararray ty) :--> null 'PGjson
1357−arrayToJson = unsafeFunction "array_to_json"
1358−
1359−-- | Returns the row as a JSON object.
1360−rowToJson :: null ('PGcomposite ty) :--> null 'PGjson
1361−rowToJson = unsafeFunction "row_to_json"
1362−
1363−-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic
1364−-- argument list.
1365−jsonBuildArray :: SListI tuple => FunctionN tuple (null 'PGjson)
1366−jsonBuildArray = unsafeFunctionN "json_build_array"
1367−
1368−-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a
1369−-- variadic argument list.
1370−jsonbBuildArray :: SListI tuple => FunctionN tuple (null 'PGjsonb)
1371−jsonbBuildArray = unsafeFunctionN "jsonb_build_array"
1372−
1373−class PGBuildObject tys where
1374−instance PGBuildObject '[]
1375−instance (PGBuildObject tys, key `In` PGJsonKey)
1376− => PGBuildObject ('NotNull key ': value ': tys)
1377−
1378−-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic
1379−-- argument list. The elements of the argument list must alternate between text
1380−-- and values.
1381−jsonBuildObject
1382− :: (SListI elems, PGBuildObject elems)
1383− => FunctionN elems (null 'PGjson)
1384−jsonBuildObject = unsafeFunctionN "json_build_object"
1385−
1386−-- | Builds a possibly-heterogeneously-typed (binary) JSON object out of a
1387−-- variadic argument list. The elements of the argument list must alternate
1388−-- between keys and values.
1389−jsonbBuildObject
1390− :: (SListI elems, PGBuildObject elems)
1391− => FunctionN elems (null 'PGjsonb)
1392−jsonbBuildObject = unsafeFunctionN "jsonb_build_object"
1393−
1394−-- | Builds a JSON object out of a text array.
1395−-- The array must have two dimensions
1396−-- such that each inner array has exactly two elements,
1397−-- which are taken as a key/value pair.
1398−jsonObject
1399− :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
1400− :--> null 'PGjson
1401−jsonObject = unsafeFunction "json_object"
1402−
1403−-- | Builds a binary JSON object out of a text array.
1404−-- The array must have two dimensions
1405−-- such that each inner array has exactly two elements,
1406−-- which are taken as a key/value pair.
1407−jsonbObject
1408− :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
1409− :--> null 'PGjsonb
1410−jsonbObject = unsafeFunction "jsonb_object"
1411−
1412−-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
1413−-- keys and one for values, that are zipped pairwise to create a JSON object.
1414−jsonZipObject :: FunctionN
1415− '[ null ('PGvararray ('NotNull 'PGtext))
1416− , null ('PGvararray ('NotNull 'PGtext)) ]
1417− ( null 'PGjson )
1418−jsonZipObject = unsafeFunctionN "json_object"
1419−
1420−-- | This is an alternate form of 'jsonbObject' that takes two arrays; one for
1421−-- keys and one for values, that are zipped pairwise to create a binary JSON
1422−-- object.
1423−jsonbZipObject :: FunctionN
1424− '[ null ('PGvararray ('NotNull 'PGtext))
1425− , null ('PGvararray ('NotNull 'PGtext)) ]
1426− ( null 'PGjsonb )
1427−jsonbZipObject = unsafeFunctionN "jsonb_object"
1428−
1429−{-----------------------------------------
1430−Table 9.46: JSON processing functions
1431−-----------------------------------------}
1432−
1433−-- | Returns the number of elements in the outermost JSON array.
1434−jsonArrayLength :: null 'PGjson :--> null 'PGint4
1435−jsonArrayLength = unsafeFunction "json_array_length"
1436−
1437−-- | Returns the number of elements in the outermost binary JSON array.
1438−jsonbArrayLength :: null 'PGjsonb :--> null 'PGint4
1439−jsonbArrayLength = unsafeFunction "jsonb_array_length"
1440−
1441−-- | Returns JSON value pointed to by the given path (equivalent to #>
1442−-- operator).
1443−jsonExtractPath
1444− :: SListI elems
1445− => Expression outer commons grp schemas params from (null 'PGjson)
1446− -> NP (Expression outer commons grp schemas params from) elems
1447− -> Expression outer commons grp schemas params from (null 'PGjsonb)
1448−jsonExtractPath x xs =
1449− unsafeFunctionN "json_extract_path" (x :* xs)
1450−
1451−-- | Returns JSON value pointed to by the given path (equivalent to #>
1452−-- operator).
1453−jsonbExtractPath
1454− :: SListI elems
1455− => Expression outer commons grp schemas params from (null 'PGjsonb)
1456− -> NP (Expression outer commons grp schemas params from) elems
1457− -> Expression outer commons grp schemas params from (null 'PGjsonb)
1458−jsonbExtractPath x xs =
1459− unsafeFunctionN "jsonb_extract_path" (x :* xs)
1460−
1461−-- | Returns JSON value pointed to by the given path (equivalent to #>
1462−-- operator), as text.
1463−jsonExtractPathAsText
1464− :: SListI elems
1465− => Expression outer commons grp schemas params from (null 'PGjson)
1466− -> NP (Expression outer commons grp schemas params from) elems
1467− -> Expression outer commons grp schemas params from (null 'PGjson)
1468−jsonExtractPathAsText x xs =
1469− unsafeFunctionN "json_extract_path_text" (x :* xs)
1470−
1471−-- | Returns JSON value pointed to by the given path (equivalent to #>
1472−-- operator), as text.
1473−jsonbExtractPathAsText
1474− :: SListI elems
1475− => Expression outer commons grp schemas params from (null 'PGjsonb)
1476− -> NP (Expression outer commons grp schemas params from) elems
1477− -> Expression outer commons grp schemas params from (null 'PGjsonb)
1478−jsonbExtractPathAsText x xs =
1479− unsafeFunctionN "jsonb_extract_path_text" (x :* xs)
1480−
1481−-- | Returns the type of the outermost JSON value as a text string. Possible
1482−-- types are object, array, string, number, boolean, and null.
1483−jsonTypeof :: null 'PGjson :--> null 'PGtext
1484−jsonTypeof = unsafeFunction "json_typeof"
1485−
1486−-- | Returns the type of the outermost binary JSON value as a text string.
1487−-- Possible types are object, array, string, number, boolean, and null.
1488−jsonbTypeof :: null 'PGjsonb :--> null 'PGtext
1489−jsonbTypeof = unsafeFunction "jsonb_typeof"
1490−
1491−-- | Returns its argument with all object fields that have null values omitted.
1492−-- Other null values are untouched.
1493−jsonStripNulls :: null 'PGjson :--> null 'PGjson
1494−jsonStripNulls = unsafeFunction "json_strip_nulls"
1495−
1496−-- | Returns its argument with all object fields that have null values omitted.
1497−-- Other null values are untouched.
1498−jsonbStripNulls :: null 'PGjsonb :--> null 'PGjsonb
1499−jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
1500−
1501−-- | @ jsonbSet target path new_value create_missing @
1502−--
1503−-- Returns target with the section designated by path replaced by new_value,
1504−-- or with new_value added if create_missing is true ( default is true) and the
1505−-- item designated by path does not exist. As with the path orientated
1506−-- operators, negative integers that appear in path count from the end of JSON
1507−-- arrays.
1508−jsonbSet
1509− :: Expression outer commons grp schemas params from (null 'PGjsonb)
1510− -> Expression outer commons grp schemas params from (null ('PGvararray ('NotNull 'PGtext)))
1511− -> Expression outer commons grp schemas params from (null 'PGjsonb)
1512− -> Maybe (Expression outer commons grp schemas params from (null 'PGbool))
1513− -> Expression outer commons grp schemas params from (null 'PGjsonb)
1514−jsonbSet tgt path val createMissing = case createMissing of
1515− Just m -> unsafeFunctionN "jsonb_set" (tgt :* path :* val :* m :* Nil)
1516− Nothing -> unsafeFunctionN "jsonb_set" (tgt :* path :* val :* Nil)
1517−
1518−-- | @ jsonbInsert target path new_value insert_after @
1519−--
1520−-- Returns target with new_value inserted. If target section designated by
1521−-- path is in a JSONB array, new_value will be inserted before target or after
1522−-- if insert_after is true (default is false). If target section designated by
1523−-- path is in JSONB object, new_value will be inserted only if target does not
1524−-- exist. As with the path orientated operators, negative integers that appear
1525−-- in path count from the end of JSON arrays.
1526−jsonbInsert
1527− :: Expression outer commons grp schemas params from (null 'PGjsonb)
1528− -> Expression outer commons grp schemas params from (null ('PGvararray ('NotNull 'PGtext)))
1529− -> Expression outer commons grp schemas params from (null 'PGjsonb)
1530− -> Maybe (Expression outer commons grp schemas params from (null 'PGbool))
1531− -> Expression outer commons grp schemas params from (null 'PGjsonb)
1532−jsonbInsert tgt path val insertAfter = case insertAfter of
1533− Just i -> unsafeFunctionN "jsonb_insert" (tgt :* path :* val :* i :* Nil)
1534− Nothing -> unsafeFunctionN "jsonb_insert" (tgt :* path :* val :* Nil)
1535−
1536−-- | Returns its argument as indented JSON text.
1537−jsonbPretty :: null 'PGjsonb :--> null 'PGtext
1538−jsonbPretty = unsafeFunction "jsonb_pretty"
1539−
1540−(@@) :: Operator (null 'PGtsvector) (null 'PGtsquery) ('Null 'PGbool)
1541−(@@) = unsafeBinaryOp "@@"
1542−
1543−(.&) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
1544−(.&) = unsafeBinaryOp "&&"
1545−
1546−(.|) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
1547−(.|) = unsafeBinaryOp "||"
1548−
1549−(.!) :: null 'PGtsquery :--> null 'PGtsquery
1550−(.!) = unsafeUnaryOpL "!!"
1551−
1552−(<->) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
1553−(<->) = unsafeBinaryOp "<->"
1554−
1555−arrayToTSvector
1556− :: null ('PGvararray ('NotNull 'PGtext))
1557− :--> null 'PGtsvector
1558−arrayToTSvector = unsafeFunction "array_to_tsvector"
1559−
1560−tsvectorLength :: null 'PGtsvector :--> null 'PGint4
1561−tsvectorLength = unsafeFunction "length"
1562−
1563−numnode :: null 'PGtsquery :--> null 'PGint4
1564−numnode = unsafeFunction "numnode"
1565−
1566−plainToTSquery :: null 'PGtext :--> null 'PGtsquery
1567−plainToTSquery = unsafeFunction "plainto_tsquery"
1568−
1569−phraseToTSquery :: null 'PGtext :--> null 'PGtsquery
1570−phraseToTSquery = unsafeFunction "phraseto_tsquery"
1571−
1572−websearchToTSquery :: null 'PGtext :--> null 'PGtsquery
1573−websearchToTSquery = unsafeFunction "websearch_to_tsquery"
1574−
1575−queryTree :: null 'PGtsquery :--> null 'PGtext
1576−queryTree = unsafeFunction "query_tree"
1577−
1578−toTSquery :: null 'PGtext :--> null 'PGtsquery
1579−toTSquery = unsafeFunction "to_tsquery"
1580−
1581−toTSvector
1582− :: ty `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
1583− => null ty :--> null 'PGtsvector
1584−toTSvector = unsafeFunction "to_tsvector"
1585−
1586−setWeight
1587− :: FunctionN '[null 'PGtsvector, null ('PGchar 1)] (null 'PGtsvector)
1588−setWeight = unsafeFunctionN "set_weight"
1589−
1590−strip :: null 'PGtsvector :--> null 'PGtsvector
1591−strip = unsafeFunction "strip"
1592−
1593−jsonToTSvector :: FunctionN '[null 'PGjson, null 'PGjson] (null 'PGtsvector)
1594−jsonToTSvector = unsafeFunctionN "json_to_tsvector"
1595−
1596−jsonbToTSvector :: FunctionN '[null 'PGjsonb, null 'PGjsonb] (null 'PGtsvector)
1597−jsonbToTSvector = unsafeFunctionN "jsonb_to_tsvector"
1598−
1599−tsDelete :: FunctionN
1600− '[null 'PGtsvector, null ('PGvararray ('NotNull 'PGtext))]
1601− (null 'PGtsvector)
1602−tsDelete = unsafeFunctionN "ts_delete"
1603−
1604−tsFilter :: FunctionN
1605− '[null 'PGtsvector, null ('PGvararray ('NotNull ('PGchar 1)))]
1606− (null 'PGtsvector)
1607−tsFilter = unsafeFunctionN "ts_filter"
1608−
1609−tsHeadline
1610− :: document `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
1611− => FunctionN '[null document, null 'PGtsquery] (null 'PGtext)
1612−tsHeadline = unsafeFunctionN "ts_headline"
1613−{-----------------------------------------
1614−aggregation
1615−-----------------------------------------}
1616−
1617−unsafeAggregateN
1618− :: SOP.SListI xs
1619− => ByteString -- ^ function
1620− -> Distinction (NP (Expression outer commons 'Ungrouped schemas params from)) xs
1621− -> Expression outer commons ('Grouped bys) schemas params from y
1622−unsafeAggregateN fun xs = UnsafeExpression $ fun <> parenthesized (renderSQL xs)
1623−
1624−{- |
1625−`Aggregate` functions compute a single result from a set of input values.
1626−`Aggregate` functions can be used as `GroupedBy` `Expression`s as well
1627−as `WindowFunction`s.
1628−-}
1629−class Aggregate expr1 exprN aggr
1630− | aggr -> expr1, aggr -> exprN where
1631−
1632− -- | A special aggregation that does not require an input
1633− --
1634− -- >>> :{
1635− -- let
1636− -- expression :: Expression '[] commons ('Grouped bys) schemas params from ('NotNull 'PGint8)
1637− -- expression = countStar
1638− -- in printSQL expression
1639− -- :}
1640− -- count(*)
1641− countStar :: aggr ('NotNull 'PGint8)
1642−
1643− -- | >>> :{
1644− -- let
1645− -- expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: null ty]] ('NotNull 'PGint8)
1646− -- expression = count (All #col)
1647− -- in printSQL expression
1648− -- :}
1649− -- count(ALL "col")
1650− count
1651− :: expr1 ty
1652− -- ^ what to count
1653− -> aggr ('NotNull 'PGint8)
1654−
1655− -- | >>> :{
1656− -- let
1657− -- expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: 'Null 'PGnumeric]] ('NotNull 'PGnumeric)
1658− -- expression = sum_ (Distinct #col)
1659− -- in printSQL expression
1660− -- :}
1661− -- sum(DISTINCT "col")
1662− sum_
1663− :: ty `In` PGNum
1664− => expr1 (null ty)
1665− -> aggr ('NotNull ty)
1666−
1667− -- | input values, including nulls, concatenated into an array
1668− arrayAgg
1669− :: expr1 ty
1670− -> aggr ('Null ('PGvararray ty))
1671−
1672− -- | aggregates values as a JSON array
1673− jsonAgg
1674− :: expr1 ty
1675− -> aggr ('Null 'PGjson)
1676−
1677− -- | aggregates values as a JSON array
1678− jsonbAgg
1679− :: expr1 ty
1680− -> aggr ('Null 'PGjsonb)
1681−
1682− {- |
1683− the bitwise AND of all non-null input values, or null if none
1684− >>> :{
1685− let
1686− expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: null 'PGint4]] ('Null 'PGint4)
1687− expression = bitAnd (Distinct #col)
1688− in printSQL expression
1689− :}
1690− bit_and(DISTINCT "col")
1691− -}
1692− bitAnd
1693− :: int `In` PGIntegral
1694− => expr1 (null int)
1695− -- ^ what to aggregate
1696− -> aggr ('Null int)
1697−
1698− {- |
1699− the bitwise OR of all non-null input values, or null if none
1700−
1701− >>> :{
1702− let
1703− expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: null 'PGint4]] ('Null 'PGint4)
1704− expression = bitOr (All #col)
1705− in printSQL expression
1706− :}
1707− bit_or(ALL "col")
1708− -}
1709− bitOr
1710− :: int `In` PGIntegral
1711− => expr1 (null int)
1712− -- ^ what to aggregate
1713− -> aggr ('Null int)
1714−
1715− {- |
1716− true if all input values are true, otherwise false
1717−
1718− >>> :{
1719− let
1720− winFun :: WindowFunction '[] commons 'Ungrouped schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
1721− winFun = boolAnd #col
1722− in printSQL winFun
1723− :}
1724− bool_and("col")
1725− -}
1726− boolAnd
1727− :: expr1 (null 'PGbool)
1728− -- ^ what to aggregate
1729− -> aggr ('Null 'PGbool)
1730−
1731− {- |
1732− true if at least one input value is true, otherwise false
1733−
1734− >>> :{
1735− let
1736− expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
1737− expression = boolOr (All #col)
1738− in printSQL expression
1739− :}
1740− bool_or(ALL "col")
1741− -}
1742− boolOr
1743− :: expr1 (null 'PGbool)
1744− -- ^ what to aggregate
1745− -> aggr ('Null 'PGbool)
1746−
1747− {- |
1748− equivalent to `boolAnd`
1749−
1750− >>> :{
1751− let
1752− expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
1753− expression = every (Distinct #col)
1754− in printSQL expression
1755− :}
1756− every(DISTINCT "col")
1757− -}
1758− every
1759− :: expr1 (null 'PGbool)
1760− -- ^ what to aggregate
1761− -> aggr ('Null 'PGbool)
1762−
1763− {- |maximum value of expression across all input values-}
1764− max_
1765− :: expr1 (null ty)
1766− -- ^ what to maximize
1767− -> aggr ('Null ty)
1768−
1769− -- | minimum value of expression across all input values
1770− min_
1771− :: expr1 (null ty)
1772− -- ^ what to minimize
1773− -> aggr ('Null ty)
1774−
1775− -- | the average (arithmetic mean) of all input values
1776− avg
1777− :: expr1 (null ty)
1778− -- ^ what to average
1779− -> aggr ('Null (PGAvg ty))
1780−
1781− {- | correlation coefficient
1782− >>> :{
1783− let
1784− expression :: Expression '[] c ('Grouped g) s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1785− expression = corr (All (#y *: #x))
1786− in printSQL expression
1787− :}
1788− corr(ALL "y", "x")
1789− -}
1790− corr
1791− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1792− -> aggr ('Null 'PGfloat8)
1793−
1794− {- | population covariance
1795− >>> :{
1796− let
1797− expression :: Expression '[] c ('Grouped g) s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1798− expression = covarPop (All (#y *: #x))
1799− in printSQL expression
1800− :}
1801− covar_pop(ALL "y", "x")
1802− -}
1803− covarPop
1804− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1805− -> aggr ('Null 'PGfloat8)
1806−
1807− {- | sample covariance
1808− >>> :{
1809− let
1810− winFun :: WindowFunction '[] c 'Ungrouped s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1811− winFun = covarSamp (#y *: #x)
1812− in printSQL winFun
1813− :}
1814− covar_samp("y", "x")
1815− -}
1816− covarSamp
1817− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1818− -> aggr ('Null 'PGfloat8)
1819−
1820− {- | average of the independent variable (sum(X)/N)
1821− >>> :{
1822− let
1823− expression :: Expression '[] c ('Grouped g) s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1824− expression = regrAvgX (All (#y *: #x))
1825− in printSQL expression
1826− :}
1827− regr_avgx(ALL "y", "x")
1828− -}
1829− regrAvgX
1830− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1831− -> aggr ('Null 'PGfloat8)
1832−
1833− {- | average of the dependent variable (sum(Y)/N)
1834− >>> :{
1835− let
1836− winFun :: WindowFunction '[] c 'Ungrouped s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1837− winFun = regrAvgY (#y *: #x)
1838− in printSQL winFun
1839− :}
1840− regr_avgy("y", "x")
1841− -}
1842− regrAvgY
1843− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1844− -> aggr ('Null 'PGfloat8)
1845−
1846− {- | number of input rows in which both expressions are nonnull
1847− >>> :{
1848− let
1849− winFun :: WindowFunction '[] c 'Ungrouped s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGint8)
1850− winFun = regrCount (#y *: #x)
1851− in printSQL winFun
1852− :}
1853− regr_count("y", "x")
1854− -}
1855− regrCount
1856− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1857− -> aggr ('Null 'PGint8)
1858−
1859− {- | y-intercept of the least-squares-fit linear equation determined by the (X, Y) pairs
1860− >>> :{
1861− let
1862− expression :: Expression '[] c ('Grouped g) s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
1863− expression = regrIntercept (All (#y *: #x))
1864− in printSQL expression
1865− :}
1866− regr_intercept(ALL "y", "x")
1867− -}
1868− regrIntercept
1869− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1870− -> aggr ('Null 'PGfloat8)
1871−
1872− -- | @regr_r2(Y, X)@, square of the correlation coefficient
1873− regrR2
1874− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1875− -> aggr ('Null 'PGfloat8)
1876−
1877− -- | @regr_slope(Y, X)@, slope of the least-squares-fit linear equation
1878− -- determined by the (X, Y) pairs
1879− regrSlope
1880− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1881− -> aggr ('Null 'PGfloat8)
1882−
1883− -- | @regr_sxx(Y, X)@, sum(X^2) - sum(X)^2/N
1884− -- (“sum of squares” of the independent variable)
1885− regrSxx
1886− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1887− -> aggr ('Null 'PGfloat8)
1888−
1889− -- | @regr_sxy(Y, X)@, sum(X*Y) - sum(X) * sum(Y)/N
1890− -- (“sum of products” of independent times dependent variable)
1891− regrSxy
1892− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1893− -> aggr ('Null 'PGfloat8)
1894−
1895− -- | @regr_syy(Y, X)@, sum(Y^2) - sum(Y)^2/N
1896− -- (“sum of squares” of the dependent variable)
1897− regrSyy
1898− :: exprN '[null 'PGfloat8, null 'PGfloat8]
1899− -> aggr ('Null 'PGfloat8)
1900−
1901− -- | historical alias for `stddevSamp`
1902− stddev
1903− :: expr1 (null ty)
1904− -> aggr ('Null (PGAvg ty))
1905−
1906− -- | population standard deviation of the input values
1907− stddevPop
1908− :: expr1 (null ty)
1909− -> aggr ('Null (PGAvg ty))
1910−
1911− -- | sample standard deviation of the input values
1912− stddevSamp
1913− :: expr1 (null ty)
1914− -> aggr ('Null (PGAvg ty))
1915−
1916− -- | historical alias for `varSamp`
1917− variance
1918− :: expr1 (null ty)
1919− -> aggr ('Null (PGAvg ty))
1920−
1921− -- | population variance of the input values
1922− -- (square of the population standard deviation)
1923− varPop
1924− :: expr1 (null ty)
1925− -> aggr ('Null (PGAvg ty))
1926−
1927− -- | sample variance of the input values
1928− -- (square of the sample standard deviation)
1929− varSamp
1930− :: expr1 (null ty)
1931− -> aggr ('Null (PGAvg ty))
1932−
1933−{- |
1934−`Distinction`s are used for the input of `Aggregate` `Expression`s.
1935−`All` invokes the aggregate once for each input row.
1936−`Distinct` invokes the aggregate once for each distinct value of the expression
1937−(or distinct set of values, for multiple expressions) found in the input
1938−-}
1939−data Distinction (expr :: kind -> Type) (ty :: kind)
1940− = All (expr ty)
1941− | Distinct (expr ty)
1942− deriving (GHC.Generic,Show,Eq,Ord)
1943−instance NFData (Distinction (Expression outer commons grp schemas params from) ty)
1944−instance RenderSQL (Distinction (Expression outer commons grp schemas params from) ty) where
1945− renderSQL = \case
1946− All x -> "ALL" <+> renderSQL x
1947− Distinct x -> "DISTINCT" <+> renderSQL x
1948−instance SOP.SListI tys => RenderSQL
1949− (Distinction (NP (Expression outer commons grp schemas params from)) tys) where
1950− renderSQL = \case
1951− All xs -> "ALL" <+> renderCommaSeparated renderSQL xs
1952− Distinct xs -> "DISTINCT" <+> renderCommaSeparated renderSQL xs
1953−
1954−instance Aggregate
1955− (Distinction (Expression outer commons 'Ungrouped schemas params from))
1956− (Distinction (NP (Expression outer commons 'Ungrouped schemas params from)))
1957− (Expression outer commons ('Grouped bys) schemas params from) where
1958− countStar = UnsafeExpression "count(*)"
1959− count = unsafeAggregate1 "count"
1960− sum_ = unsafeAggregate1 "sum"
1961− arrayAgg = unsafeAggregate1 "array_agg"
1962− jsonAgg = unsafeAggregate1 "json_agg"
1963− jsonbAgg = unsafeAggregate1 "jsonb_agg"
1964− bitAnd = unsafeAggregate1 "bit_and"
1965− bitOr = unsafeAggregate1 "bit_or"
1966− boolAnd = unsafeAggregate1 "bool_and"
1967− boolOr = unsafeAggregate1 "bool_or"
1968− every = unsafeAggregate1 "every"
1969− max_ = unsafeAggregate1 "max"
1970− min_ = unsafeAggregate1 "min"
1971− avg = unsafeAggregate1 "avg"
1972− corr = unsafeAggregateN "corr"
1973− covarPop = unsafeAggregateN "covar_pop"
1974− covarSamp = unsafeAggregateN "covar_samp"
1975− regrAvgX = unsafeAggregateN "regr_avgx"
1976− regrAvgY = unsafeAggregateN "regr_avgy"
1977− regrCount = unsafeAggregateN "regr_count"
1978− regrIntercept = unsafeAggregateN "regr_intercept"
1979− regrR2 = unsafeAggregateN "regr_r2"
1980− regrSlope = unsafeAggregateN "regr_slope"
1981− regrSxx = unsafeAggregateN "regr_sxx"
1982− regrSxy = unsafeAggregateN "regr_sxy"
1983− regrSyy = unsafeAggregateN "regr_syy"
1984− stddev = unsafeAggregate1 "stddev"
1985− stddevPop = unsafeAggregate1 "stddev_pop"
1986− stddevSamp = unsafeAggregate1 "stddev_samp"
1987− variance = unsafeAggregate1 "variance"
1988− varPop = unsafeAggregate1 "var_pop"
1989− varSamp = unsafeAggregate1 "var_samp"
1990−instance Aggregate
1991− (Expression outer commons grp schemas params from)
1992− (NP (Expression outer commons grp schemas params from))
1993− (WindowFunction outer commons grp schemas params from) where
1994− countStar = UnsafeWindowFunction "count(*)"
1995− count = unsafeWindowFunction1 "count"
1996− sum_ = unsafeWindowFunction1 "sum"
1997− arrayAgg = unsafeWindowFunction1 "array_agg"
1998− jsonAgg = unsafeWindowFunction1 "json_agg"
1999− jsonbAgg = unsafeWindowFunction1 "jsonb_agg"
2000− bitAnd = unsafeWindowFunction1 "bit_and"
2001− bitOr = unsafeWindowFunction1 "bit_or"
2002− boolAnd = unsafeWindowFunction1 "bool_and"
2003− boolOr = unsafeWindowFunction1 "bool_or"
2004− every = unsafeWindowFunction1 "every"
2005− max_ = unsafeWindowFunction1 "max"
2006− min_ = unsafeWindowFunction1 "min"
2007− avg = unsafeWindowFunction1 "avg"
2008− corr = unsafeWindowFunctionN "corr"
2009− covarPop = unsafeWindowFunctionN "covar_pop"
2010− covarSamp = unsafeWindowFunctionN "covar_samp"
2011− regrAvgX = unsafeWindowFunctionN "regr_avgx"
2012− regrAvgY = unsafeWindowFunctionN "regr_avgy"
2013− regrCount = unsafeWindowFunctionN "regr_count"
2014− regrIntercept = unsafeWindowFunctionN "regr_intercept"
2015− regrR2 = unsafeWindowFunctionN "regr_r2"
2016− regrSlope = unsafeWindowFunctionN "regr_slope"
2017− regrSxx = unsafeWindowFunctionN "regr_sxx"
2018− regrSxy = unsafeWindowFunctionN "regr_sxy"
2019− regrSyy = unsafeWindowFunctionN "regr_syy"
2020− stddev = unsafeWindowFunction1 "stddev"
2021− stddevPop = unsafeWindowFunction1 "stddev_pop"
2022− stddevSamp = unsafeWindowFunction1 "stddev_samp"
2023− variance = unsafeWindowFunction1 "variance"
2024− varPop = unsafeWindowFunction1 "var_pop"
2025− varSamp = unsafeWindowFunction1 "var_samp"
2026−
2027−-- | escape hatch to define aggregate functions
2028−unsafeAggregate1
2029− :: ByteString -- ^ aggregate function
2030− -> Distinction (Expression outer commons 'Ungrouped schemas params from) x
2031− -> Expression outer commons ('Grouped bys) schemas params from y
2032−unsafeAggregate1 fun x = UnsafeExpression $ fun <> parenthesized (renderSQL x)
2033−
2034−-- | A type family that calculates `PGAvg` type of a `PGType`.
2035−type family PGAvg ty where
2036− PGAvg 'PGint2 = 'PGnumeric
2037− PGAvg 'PGint4 = 'PGnumeric
2038− PGAvg 'PGint8 = 'PGnumeric
2039− PGAvg 'PGnumeric = 'PGnumeric
2040− PGAvg 'PGfloat4 = 'PGfloat8
2041− PGAvg 'PGfloat8 = 'PGfloat8
2042− PGAvg 'PGinterval = 'PGinterval
2043− PGAvg pg = TypeError
2044− ('Text "Squeal type error: No average for " ':<>: 'ShowType pg)
2045−
2046511{-----------------------------------------
2047512type expressions
2048513-----------------------------------------}
@@ -2222,349 +687,6 @@ instance (SOP.All KnownNat dims, PGTyped schemas ty)
2222687instance PGTyped schemas (null 'PGtsvector) where pgtype = tsvector
2223688instance PGTyped schemas (null 'PGtsquery) where pgtype = tsquery
2224689
2225−{-----------------------------------------
2226−Sorting
2227−-----------------------------------------}
2228−
2229−-- | `SortExpression`s are used by `orderBy` to optionally sort the results
2230−-- of a `Squeal.PostgreSQL.Query.Query`. `Asc` or `Desc`
2231−-- set the sort direction of a `NotNull` result
2232−-- column to ascending or descending. Ascending order puts smaller values
2233−-- first, where "smaller" is defined in terms of the `.<` operator. Similarly,
2234−-- descending order is determined with the `.>` operator. `AscNullsFirst`,
2235−-- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to
2236−-- determine whether nulls appear before or after non-null values in the sort
2237−-- ordering of a `Null` result column.
2238−data SortExpression outer commons grp schemas params from where
2239− Asc
2240− :: Expression outer commons grp schemas params from ('NotNull ty)
2241− -> SortExpression outer commons grp schemas params from
2242− Desc
2243− :: Expression outer commons grp schemas params from ('NotNull ty)
2244− -> SortExpression outer commons grp schemas params from
2245− AscNullsFirst
2246− :: Expression outer commons grp schemas params from ('Null ty)
2247− -> SortExpression outer commons grp schemas params from
2248− AscNullsLast
2249− :: Expression outer commons grp schemas params from ('Null ty)
2250− -> SortExpression outer commons grp schemas params from
2251− DescNullsFirst
2252− :: Expression outer commons grp schemas params from ('Null ty)
2253− -> SortExpression outer commons grp schemas params from
2254− DescNullsLast
2255− :: Expression outer commons grp schemas params from ('Null ty)
2256− -> SortExpression outer commons grp schemas params from
2257−deriving instance Show (SortExpression outer commons grp schemas params from)
2258−
2259−{- |
2260−The `orderBy` clause causes the result rows of a `Squeal.PostgreSQL.Query.TableExpression`
2261−to be sorted according to the specified `SortExpression`(s).
2262−If two rows are equal according to the leftmost expression,
2263−they are compared according to the next expression and so on.
2264−If they are equal according to all specified expressions,
2265−they are returned in an implementation-dependent order.
2266−
2267−You can also control the order in which rows are processed by window functions
2268−using `orderBy` within `Squeal.PostgreSQL.Query.Over`.
2269−-}
2270−class OrderBy expr where
2271− orderBy
2272− :: [SortExpression outer commons grp schemas params from]
2273− -> expr outer commons grp schemas params from
2274− -> expr outer commons grp schemas params from
2275−
2276−-- | Render a `SortExpression`.
2277−instance RenderSQL (SortExpression outer commons grp schemas params from) where
2278− renderSQL = \case
2279− Asc expression -> renderSQL expression <+> "ASC"
2280− Desc expression -> renderSQL expression <+> "DESC"
2281− AscNullsFirst expression -> renderSQL expression
2282− <+> "ASC NULLS FIRST"
2283− DescNullsFirst expression -> renderSQL expression
2284− <+> "DESC NULLS FIRST"
2285− AscNullsLast expression -> renderSQL expression <+> "ASC NULLS LAST"
2286− DescNullsLast expression -> renderSQL expression <+> "DESC NULLS LAST"
2287−
2288−-- | A `WindowDefinition` is a set of table rows that are somehow related
2289−-- to the current row
2290−data WindowDefinition outer commons grp schemas params from where
2291− WindowDefinition
2292− :: SListI bys
2293− => NP (Expression outer commons grp schemas params from) bys
2294− -> [SortExpression outer commons grp schemas params from]
2295− -> WindowDefinition outer commons grp schemas params from
2296−
2297−instance OrderBy WindowDefinition where
2298− orderBy sortsR (WindowDefinition parts sortsL)
2299− = WindowDefinition parts (sortsL ++ sortsR)
2300−
2301−instance RenderSQL (WindowDefinition outer commons schemas from grp params) where
2302− renderSQL (WindowDefinition part ord) =
2303− renderPartitionByClause part <> renderOrderByClause ord
2304− where
2305− renderPartitionByClause = \case
2306− Nil -> ""
2307− parts -> "PARTITION" <+> "BY" <+> renderCommaSeparated renderExpression parts
2308− renderOrderByClause = \case
2309− [] -> ""
2310− srts -> " ORDER" <+> "BY"
2311− <+> commaSeparated (renderSQL <$> srts)
2312−
2313−{- |
2314−The `partitionBy` clause within `Squeal.PostgreSQL.Query.Over` divides the rows into groups,
2315−or partitions, that share the same values of the `partitionBy` `Expression`(s).
2316−For each row, the window function is computed across the rows that fall into
2317−the same partition as the current row.
2318−-}
2319−partitionBy
2320− :: SListI bys
2321− => NP (Expression outer commons grp schemas params from) bys
2322− -> WindowDefinition outer commons grp schemas params from
2323−partitionBy bys = WindowDefinition bys []
2324−
2325−{- |
2326−A window function performs a calculation across a set of table rows
2327−that are somehow related to the current row. This is comparable to the type
2328−of calculation that can be done with an aggregate function.
2329−However, window functions do not cause rows to become grouped into a single
2330−output row like non-window aggregate calls would.
2331−Instead, the rows retain their separate identities.
2332−Behind the scenes, the window function is able to access more than
2333−just the current row of the query result.
2334−-}
2335−newtype WindowFunction
2336− (outer :: FromType)
2337− (commons :: FromType)
2338− (grp :: Grouping)
2339− (schemas :: SchemasType)
2340− (params :: [NullityType])
2341− (from :: FromType)
2342− (ty :: NullityType)
2343− = UnsafeWindowFunction { renderWindowFunction :: ByteString }
2344− deriving (GHC.Generic,Show,Eq,Ord,NFData)
2345−
2346−instance RenderSQL (WindowFunction outer commons grp schemas params from ty) where
2347− renderSQL = renderWindowFunction
2348−
2349−type WinFun0 x
2350− = forall outer commons grp schemas params from
2351− . WindowFunction outer commons grp schemas params from x
2352− -- ^ cannot reference aliases
2353−
2354−type WinFun1 x y
2355− = forall outer commons grp schemas params from
2356− . Expression outer commons grp schemas params from x
2357− -- ^ input
2358− -> WindowFunction outer commons grp schemas params from y
2359− -- ^ output
2360−
2361−type WinFunN xs y
2362− = forall outer commons grp schemas params from
2363− . NP (Expression outer commons grp schemas params from) xs
2364− -- ^ inputs
2365− -> WindowFunction outer commons grp schemas params from y
2366− -- ^ output
2367−
2368−unsafeWindowFunction1 :: ByteString -> WinFun1 x y
2369−unsafeWindowFunction1 fun x
2370− = UnsafeWindowFunction $ fun <> parenthesized (renderSQL x)
2371−
2372−unsafeWindowFunctionN :: SOP.SListI xs => ByteString -> WinFunN xs y
2373−unsafeWindowFunctionN fun xs = UnsafeWindowFunction $ fun <>
2374− parenthesized (renderCommaSeparated renderSQL xs)
2375−
2376−{- | rank of the current row with gaps; same as `rowNumber` of its first peer
2377−>>> printSQL rank
2378−rank()
2379−-}
2380−rank :: WinFun0 ('NotNull 'PGint8)
2381−rank = UnsafeWindowFunction "rank()"
2382−
2383−{- | number of the current row within its partition, counting from 1
2384−>>> printSQL rowNumber
2385−row_number()
2386−-}
2387−rowNumber :: WinFun0 ('NotNull 'PGint8)
2388−rowNumber = UnsafeWindowFunction "row_number()"
2389−
2390−{- | rank of the current row without gaps; this function counts peer groups
2391−>>> printSQL denseRank
2392−dense_rank()
2393−-}
2394−denseRank :: WinFun0 ('NotNull 'PGint8)
2395−denseRank = UnsafeWindowFunction "dense_rank()"
2396−
2397−{- | relative rank of the current row: (rank - 1) / (total partition rows - 1)
2398−>>> printSQL percentRank
2399−percent_rank()
2400−-}
2401−percentRank :: WinFun0 ('NotNull 'PGfloat8)
2402−percentRank = UnsafeWindowFunction "percent_rank()"
2403−
2404−{- | cumulative distribution: (number of partition rows
2405−preceding or peer with current row) / total partition rows
2406−>>> printSQL cumeDist
2407−cume_dist()
2408−-}
2409−cumeDist :: WinFun0 ('NotNull 'PGfloat8)
2410−cumeDist = UnsafeWindowFunction "cume_dist()"
2411−
2412−{- | integer ranging from 1 to the argument value,
2413−dividing the partition as equally as possible
2414−-}
2415−ntile :: WinFun1 ('NotNull 'PGint4) ('NotNull 'PGint4)
2416−ntile = unsafeWindowFunction1 "ntile"
2417−
2418−{- | returns value evaluated at the row that is offset rows before the current
2419−row within the partition; if there is no such row, instead return default
2420−(which must be of the same type as value). Both offset and default are
2421−evaluated with respect to the current row.
2422−-}
2423−lag :: WinFunN '[ty, 'NotNull 'PGint4, ty] ty
2424−lag = unsafeWindowFunctionN "lag"
2425−
2426−{- | returns value evaluated at the row that is offset rows after the current
2427−row within the partition; if there is no such row, instead return default
2428−(which must be of the same type as value). Both offset and default are
2429−evaluated with respect to the current row.
2430−-}
2431−lead :: WinFunN '[ty, 'NotNull 'PGint4, ty] ty
2432−lead = unsafeWindowFunctionN "lag"
2433−
2434−{- | returns value evaluated at the row that is the
2435−first row of the window frame
2436−-}
2437−firstValue :: WinFun1 ty ty
2438−firstValue = unsafeWindowFunction1 "first_value"
2439−
2440−{- | returns value evaluated at the row that is the
2441−last row of the window frame
2442−-}
2443−lastValue :: WinFun1 ty ty
2444−lastValue = unsafeWindowFunction1 "last_value"
2445−
2446−{- | returns value evaluated at the row that is the nth
2447−row of the window frame (counting from 1); null if no such row
2448−-}
2449−nthValue :: WinFunN '[null ty, 'NotNull 'PGint4] ('Null ty)
2450−nthValue = unsafeWindowFunctionN "nth_value"
2451−
2452−{-|
2453−Create date from year, month and day fields
2454−
2455−>>> printSQL (makeDate (1984 :* 7 *: 3))
2456−make_date(1984, 7, 3)
2457−-}
2458−makeDate :: FunctionN
2459− '[ null 'PGint4, null 'PGint4, null 'PGint4 ]
2460− ( null 'PGdate )
2461−makeDate = unsafeFunctionN "make_date"
2462−
2463−{-|
2464−Create time from hour, minute and seconds fields
2465−
2466−>>> printSQL (makeTime (8 :* 15 *: 23.5))
2467−make_time(8, 15, 23.5)
2468−-}
2469−makeTime :: FunctionN
2470− '[ null 'PGint4, null 'PGint4, null 'PGfloat8 ]
2471− ( null 'PGtime )
2472−makeTime = unsafeFunctionN "make_time"
2473−
2474−{-|
2475−Create timestamp from year, month, day, hour, minute and seconds fields
2476−
2477−>>> printSQL (makeTimestamp (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
2478−make_timestamp(2013, 7, 15, 8, 15, 23.5)
2479−-}
2480−makeTimestamp :: FunctionN
2481− '[ null 'PGint4, null 'PGint4, null 'PGint4
2482− , null 'PGint4, null 'PGint4, null 'PGfloat8 ]
2483− ( null 'PGtimestamp )
2484−makeTimestamp = unsafeFunctionN "make_timestamp"
2485−
2486−{-|
2487−Create timestamp with time zone from
2488−year, month, day, hour, minute and seconds fields;
2489−the current time zone is used
2490−
2491−>>> printSQL (makeTimestamptz (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
2492−make_timestamptz(2013, 7, 15, 8, 15, 23.5)
2493−-}
2494−makeTimestamptz :: FunctionN
2495− '[ null 'PGint4, null 'PGint4, null 'PGint4
2496− , null 'PGint4, null 'PGint4, null 'PGfloat8 ]
2497− ( null 'PGtimestamptz )
2498−makeTimestamptz = unsafeFunctionN "make_timestamptz"
2499−
2500−{-|
2501−Affine space operations on time types.
2502−-}
2503−class TimeOp time diff | time -> diff where
2504− {-|
2505− >>> printSQL (makeDate (1984 :* 7 *: 3) !+ 365)
2506− (make_date(1984, 7, 3) + 365)
2507− -}
2508− (!+) :: Operator (null time) (null diff) (null time)
2509− (!+) = unsafeBinaryOp "+"
2510− {-|
2511− >>> printSQL (365 +! makeDate (1984 :* 7 *: 3))
2512− (365 + make_date(1984, 7, 3))
2513− -}
2514− (+!) :: Operator (null diff) (null time) (null time)
2515− (+!) = unsafeBinaryOp "+"
2516− {-|
2517− >>> printSQL (makeDate (1984 :* 7 *: 3) !- 365)
2518− (make_date(1984, 7, 3) - 365)
2519− -}
2520− (!-) :: Operator (null time) (null diff) (null time)
2521− (!-) = unsafeBinaryOp "-"
2522− {-|
2523− >>> printSQL (makeDate (1984 :* 7 *: 3) !-! currentDate)
2524− (make_date(1984, 7, 3) - CURRENT_DATE)
2525− -}
2526− (!-!) :: Operator (null time) (null time) (null diff)
2527− (!-!) = unsafeBinaryOp "-"
2528−instance TimeOp 'PGtimestamp 'PGinterval
2529−instance TimeOp 'PGtimestamptz 'PGinterval
2530−instance TimeOp 'PGtime 'PGinterval
2531−instance TimeOp 'PGtimetz 'PGinterval
2532−instance TimeOp 'PGinterval 'PGinterval
2533−instance TimeOp 'PGdate 'PGint4
2534−infixl 6 !+
2535−infixl 6 +!
2536−infixl 6 !-
2537−infixl 6 !-!
2538−
2539−data TimeUnit
2540− = Years | Months | Weeks | Days
2541− | Hours | Minutes | Seconds
2542− | Microseconds | Milliseconds
2543− | Decades | Centuries | Millennia
2544− deriving (Eq, Ord, Show, Read, Enum, GHC.Generic)
2545−instance SOP.Generic TimeUnit
2546−instance SOP.HasDatatypeInfo TimeUnit
2547−instance RenderSQL TimeUnit where
2548− renderSQL = \case
2549− Years -> "years"
2550− Months -> "months"
2551− Weeks -> "weeks"
2552− Days -> "days"
2553− Hours -> "hours"
2554− Minutes -> "minutes"
2555− Seconds -> "seconds"
2556− Microseconds -> "microseconds"
2557− Milliseconds -> "milliseconds"
2558− Decades -> "decades"
2559− Centuries -> "centuries"
2560− Millennia -> "millennia"
2561−
2562−-- | >>> printSQL $ interval_ 7 Days
2563−-- (INTERVAL '7.0 days')
2564−interval_ :: Double -> TimeUnit -> Expr (null 'PGinterval)
2565−interval_ num unit = UnsafeExpression . parenthesized $ "INTERVAL" <+>
2566− "'" <> fromString (show num) <+> renderSQL unit <> "'"
2567−
2568690class Literal hask where
2569691 literal :: hask -> Expr (null (PG hask))
2570692instance JSON.ToJSON hask => Literal (Json hask) where
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Aggregate.hsnew file+427
@@ -0,0 +1,427 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , DeriveGeneric
4+ , FlexibleContexts
5+ , FlexibleInstances
6+ , FunctionalDependencies
7+ , LambdaCase
8+ , MultiParamTypeClasses
9+ , OverloadedStrings
10+ , PolyKinds
11+ , TypeFamilies
12+ , TypeOperators
13+ , UndecidableInstances
14+#-}
15+
16+module Squeal.PostgreSQL.Expression.Aggregate
17+ ( Aggregate (..)
18+ , Distinction (..)
19+ , PGAvg
20+ ) where
21+
22+import Control.DeepSeq
23+import Data.ByteString
24+import Data.Kind
25+import GHC.TypeLits
26+
27+import qualified GHC.Generics as GHC
28+import qualified Generics.SOP as SOP
29+
30+import Squeal.PostgreSQL.Alias
31+import Squeal.PostgreSQL.Expression
32+import Squeal.PostgreSQL.List
33+import Squeal.PostgreSQL.Render
34+import Squeal.PostgreSQL.Schema
35+
36+{- |
37+`Aggregate` functions compute a single result from a set of input values.
38+`Aggregate` functions can be used as `GroupedBy` `Expression`s as well
39+as `WindowFunction`s.
40+-}
41+class Aggregate expr1 exprN aggr
42+ | aggr -> expr1, aggr -> exprN where
43+
44+ -- | A special aggregation that does not require an input
45+ --
46+ -- >>> :{
47+ -- let
48+ -- expression :: Expression '[] commons ('Grouped bys) schemas params from ('NotNull 'PGint8)
49+ -- expression = countStar
50+ -- in printSQL expression
51+ -- :}
52+ -- count(*)
53+ countStar :: aggr ('NotNull 'PGint8)
54+
55+ -- | >>> :{
56+ -- let
57+ -- expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: null ty]] ('NotNull 'PGint8)
58+ -- expression = count (All #col)
59+ -- in printSQL expression
60+ -- :}
61+ -- count(ALL "col")
62+ count
63+ :: expr1 ty
64+ -- ^ what to count
65+ -> aggr ('NotNull 'PGint8)
66+
67+ -- | >>> :{
68+ -- let
69+ -- expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: 'Null 'PGnumeric]] ('NotNull 'PGnumeric)
70+ -- expression = sum_ (Distinct #col)
71+ -- in printSQL expression
72+ -- :}
73+ -- sum(DISTINCT "col")
74+ sum_
75+ :: ty `In` PGNum
76+ => expr1 (null ty)
77+ -> aggr ('NotNull ty)
78+
79+ -- | input values, including nulls, concatenated into an array
80+ arrayAgg
81+ :: expr1 ty
82+ -> aggr ('Null ('PGvararray ty))
83+
84+ -- | aggregates values as a JSON array
85+ jsonAgg
86+ :: expr1 ty
87+ -> aggr ('Null 'PGjson)
88+
89+ -- | aggregates values as a JSON array
90+ jsonbAgg
91+ :: expr1 ty
92+ -> aggr ('Null 'PGjsonb)
93+
94+ {- |
95+ the bitwise AND of all non-null input values, or null if none
96+ >>> :{
97+ let
98+ expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: null 'PGint4]] ('Null 'PGint4)
99+ expression = bitAnd (Distinct #col)
100+ in printSQL expression
101+ :}
102+ bit_and(DISTINCT "col")
103+ -}
104+ bitAnd
105+ :: int `In` PGIntegral
106+ => expr1 (null int)
107+ -- ^ what to aggregate
108+ -> aggr ('Null int)
109+
110+ {- |
111+ the bitwise OR of all non-null input values, or null if none
112+
113+ >>> :{
114+ let
115+ expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: null 'PGint4]] ('Null 'PGint4)
116+ expression = bitOr (All #col)
117+ in printSQL expression
118+ :}
119+ bit_or(ALL "col")
120+ -}
121+ bitOr
122+ :: int `In` PGIntegral
123+ => expr1 (null int)
124+ -- ^ what to aggregate
125+ -> aggr ('Null int)
126+
127+ {- |
128+ true if all input values are true, otherwise false
129+
130+ >>> :{
131+ let
132+ winFun :: WindowFunction '[] commons 'Ungrouped schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
133+ winFun = boolAnd #col
134+ in printSQL winFun
135+ :}
136+ bool_and("col")
137+ -}
138+ boolAnd
139+ :: expr1 (null 'PGbool)
140+ -- ^ what to aggregate
141+ -> aggr ('Null 'PGbool)
142+
143+ {- |
144+ true if at least one input value is true, otherwise false
145+
146+ >>> :{
147+ let
148+ expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
149+ expression = boolOr (All #col)
150+ in printSQL expression
151+ :}
152+ bool_or(ALL "col")
153+ -}
154+ boolOr
155+ :: expr1 (null 'PGbool)
156+ -- ^ what to aggregate
157+ -> aggr ('Null 'PGbool)
158+
159+ {- |
160+ equivalent to `boolAnd`
161+
162+ >>> :{
163+ let
164+ expression :: Expression '[] commons ('Grouped bys) schemas params '[tab ::: '["col" ::: null 'PGbool]] ('Null 'PGbool)
165+ expression = every (Distinct #col)
166+ in printSQL expression
167+ :}
168+ every(DISTINCT "col")
169+ -}
170+ every
171+ :: expr1 (null 'PGbool)
172+ -- ^ what to aggregate
173+ -> aggr ('Null 'PGbool)
174+
175+ {- |maximum value of expression across all input values-}
176+ max_
177+ :: expr1 (null ty)
178+ -- ^ what to maximize
179+ -> aggr ('Null ty)
180+
181+ -- | minimum value of expression across all input values
182+ min_
183+ :: expr1 (null ty)
184+ -- ^ what to minimize
185+ -> aggr ('Null ty)
186+
187+ -- | the average (arithmetic mean) of all input values
188+ avg
189+ :: expr1 (null ty)
190+ -- ^ what to average
191+ -> aggr ('Null (PGAvg ty))
192+
193+ {- | correlation coefficient
194+ >>> :{
195+ let
196+ expression :: Expression '[] c ('Grouped g) s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
197+ expression = corr (All (#y *: #x))
198+ in printSQL expression
199+ :}
200+ corr(ALL "y", "x")
201+ -}
202+ corr
203+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
204+ -> aggr ('Null 'PGfloat8)
205+
206+ {- | population covariance
207+ >>> :{
208+ let
209+ expression :: Expression '[] c ('Grouped g) s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
210+ expression = covarPop (All (#y *: #x))
211+ in printSQL expression
212+ :}
213+ covar_pop(ALL "y", "x")
214+ -}
215+ covarPop
216+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
217+ -> aggr ('Null 'PGfloat8)
218+
219+ {- | sample covariance
220+ >>> :{
221+ let
222+ winFun :: WindowFunction '[] c 'Ungrouped s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
223+ winFun = covarSamp (#y *: #x)
224+ in printSQL winFun
225+ :}
226+ covar_samp("y", "x")
227+ -}
228+ covarSamp
229+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
230+ -> aggr ('Null 'PGfloat8)
231+
232+ {- | average of the independent variable (sum(X)/N)
233+ >>> :{
234+ let
235+ expression :: Expression '[] c ('Grouped g) s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
236+ expression = regrAvgX (All (#y *: #x))
237+ in printSQL expression
238+ :}
239+ regr_avgx(ALL "y", "x")
240+ -}
241+ regrAvgX
242+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
243+ -> aggr ('Null 'PGfloat8)
244+
245+ {- | average of the dependent variable (sum(Y)/N)
246+ >>> :{
247+ let
248+ winFun :: WindowFunction '[] c 'Ungrouped s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
249+ winFun = regrAvgY (#y *: #x)
250+ in printSQL winFun
251+ :}
252+ regr_avgy("y", "x")
253+ -}
254+ regrAvgY
255+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
256+ -> aggr ('Null 'PGfloat8)
257+
258+ {- | number of input rows in which both expressions are nonnull
259+ >>> :{
260+ let
261+ winFun :: WindowFunction '[] c 'Ungrouped s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGint8)
262+ winFun = regrCount (#y *: #x)
263+ in printSQL winFun
264+ :}
265+ regr_count("y", "x")
266+ -}
267+ regrCount
268+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
269+ -> aggr ('Null 'PGint8)
270+
271+ {- | y-intercept of the least-squares-fit linear equation determined by the (X, Y) pairs
272+ >>> :{
273+ let
274+ expression :: Expression '[] c ('Grouped g) s p '[t ::: '["x" ::: 'NotNull 'PGfloat8, "y" ::: 'NotNull 'PGfloat8]] ('Null 'PGfloat8)
275+ expression = regrIntercept (All (#y *: #x))
276+ in printSQL expression
277+ :}
278+ regr_intercept(ALL "y", "x")
279+ -}
280+ regrIntercept
281+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
282+ -> aggr ('Null 'PGfloat8)
283+
284+ -- | @regr_r2(Y, X)@, square of the correlation coefficient
285+ regrR2
286+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
287+ -> aggr ('Null 'PGfloat8)
288+
289+ -- | @regr_slope(Y, X)@, slope of the least-squares-fit linear equation
290+ -- determined by the (X, Y) pairs
291+ regrSlope
292+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
293+ -> aggr ('Null 'PGfloat8)
294+
295+ -- | @regr_sxx(Y, X)@, sum(X^2) - sum(X)^2/N
296+ -- (“sum of squares” of the independent variable)
297+ regrSxx
298+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
299+ -> aggr ('Null 'PGfloat8)
300+
301+ -- | @regr_sxy(Y, X)@, sum(X*Y) - sum(X) * sum(Y)/N
302+ -- (“sum of products” of independent times dependent variable)
303+ regrSxy
304+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
305+ -> aggr ('Null 'PGfloat8)
306+
307+ -- | @regr_syy(Y, X)@, sum(Y^2) - sum(Y)^2/N
308+ -- (“sum of squares” of the dependent variable)
309+ regrSyy
310+ :: exprN '[null 'PGfloat8, null 'PGfloat8]
311+ -> aggr ('Null 'PGfloat8)
312+
313+ -- | historical alias for `stddevSamp`
314+ stddev
315+ :: expr1 (null ty)
316+ -> aggr ('Null (PGAvg ty))
317+
318+ -- | population standard deviation of the input values
319+ stddevPop
320+ :: expr1 (null ty)
321+ -> aggr ('Null (PGAvg ty))
322+
323+ -- | sample standard deviation of the input values
324+ stddevSamp
325+ :: expr1 (null ty)
326+ -> aggr ('Null (PGAvg ty))
327+
328+ -- | historical alias for `varSamp`
329+ variance
330+ :: expr1 (null ty)
331+ -> aggr ('Null (PGAvg ty))
332+
333+ -- | population variance of the input values
334+ -- (square of the population standard deviation)
335+ varPop
336+ :: expr1 (null ty)
337+ -> aggr ('Null (PGAvg ty))
338+
339+ -- | sample variance of the input values
340+ -- (square of the sample standard deviation)
341+ varSamp
342+ :: expr1 (null ty)
343+ -> aggr ('Null (PGAvg ty))
344+
345+{- |
346+`Distinction`s are used for the input of `Aggregate` `Expression`s.
347+`All` invokes the aggregate once for each input row.
348+`Distinct` invokes the aggregate once for each distinct value of the expression
349+(or distinct set of values, for multiple expressions) found in the input
350+-}
351+data Distinction (expr :: kind -> Type) (ty :: kind)
352+ = All (expr ty)
353+ | Distinct (expr ty)
354+ deriving (GHC.Generic,Show,Eq,Ord)
355+instance NFData (Distinction (Expression outer commons grp schemas params from) ty)
356+instance RenderSQL (Distinction (Expression outer commons grp schemas params from) ty) where
357+ renderSQL = \case
358+ All x -> "ALL" <+> renderSQL x
359+ Distinct x -> "DISTINCT" <+> renderSQL x
360+instance SOP.SListI tys => RenderSQL
361+ (Distinction (NP (Expression outer commons grp schemas params from)) tys) where
362+ renderSQL = \case
363+ All xs -> "ALL" <+> renderCommaSeparated renderSQL xs
364+ Distinct xs -> "DISTINCT" <+> renderCommaSeparated renderSQL xs
365+
366+instance Aggregate
367+ (Distinction (Expression outer commons 'Ungrouped schemas params from))
368+ (Distinction (NP (Expression outer commons 'Ungrouped schemas params from)))
369+ (Expression outer commons ('Grouped bys) schemas params from) where
370+ countStar = UnsafeExpression "count(*)"
371+ count = unsafeAggregate1 "count"
372+ sum_ = unsafeAggregate1 "sum"
373+ arrayAgg = unsafeAggregate1 "array_agg"
374+ jsonAgg = unsafeAggregate1 "json_agg"
375+ jsonbAgg = unsafeAggregate1 "jsonb_agg"
376+ bitAnd = unsafeAggregate1 "bit_and"
377+ bitOr = unsafeAggregate1 "bit_or"
378+ boolAnd = unsafeAggregate1 "bool_and"
379+ boolOr = unsafeAggregate1 "bool_or"
380+ every = unsafeAggregate1 "every"
381+ max_ = unsafeAggregate1 "max"
382+ min_ = unsafeAggregate1 "min"
383+ avg = unsafeAggregate1 "avg"
384+ corr = unsafeAggregateN "corr"
385+ covarPop = unsafeAggregateN "covar_pop"
386+ covarSamp = unsafeAggregateN "covar_samp"
387+ regrAvgX = unsafeAggregateN "regr_avgx"
388+ regrAvgY = unsafeAggregateN "regr_avgy"
389+ regrCount = unsafeAggregateN "regr_count"
390+ regrIntercept = unsafeAggregateN "regr_intercept"
391+ regrR2 = unsafeAggregateN "regr_r2"
392+ regrSlope = unsafeAggregateN "regr_slope"
393+ regrSxx = unsafeAggregateN "regr_sxx"
394+ regrSxy = unsafeAggregateN "regr_sxy"
395+ regrSyy = unsafeAggregateN "regr_syy"
396+ stddev = unsafeAggregate1 "stddev"
397+ stddevPop = unsafeAggregate1 "stddev_pop"
398+ stddevSamp = unsafeAggregate1 "stddev_samp"
399+ variance = unsafeAggregate1 "variance"
400+ varPop = unsafeAggregate1 "var_pop"
401+ varSamp = unsafeAggregate1 "var_samp"
402+
403+-- | escape hatch to define aggregate functions
404+unsafeAggregate1
405+ :: ByteString -- ^ aggregate function
406+ -> Distinction (Expression outer commons 'Ungrouped schemas params from) x
407+ -> Expression outer commons ('Grouped bys) schemas params from y
408+unsafeAggregate1 fun x = UnsafeExpression $ fun <> parenthesized (renderSQL x)
409+
410+unsafeAggregateN
411+ :: SOP.SListI xs
412+ => ByteString -- ^ function
413+ -> Distinction (NP (Expression outer commons 'Ungrouped schemas params from)) xs
414+ -> Expression outer commons ('Grouped bys) schemas params from y
415+unsafeAggregateN fun xs = UnsafeExpression $ fun <> parenthesized (renderSQL xs)
416+
417+-- | A type family that calculates `PGAvg` type of a `PGType`.
418+type family PGAvg ty where
419+ PGAvg 'PGint2 = 'PGnumeric
420+ PGAvg 'PGint4 = 'PGnumeric
421+ PGAvg 'PGint8 = 'PGnumeric
422+ PGAvg 'PGnumeric = 'PGnumeric
423+ PGAvg 'PGfloat4 = 'PGfloat8
424+ PGAvg 'PGfloat8 = 'PGfloat8
425+ PGAvg 'PGinterval = 'PGinterval
426+ PGAvg pg = TypeError
427+ ('Text "Squeal type error: No average for " ':<>: 'ShowType pg)
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Collection.hsnew file+149
@@ -0,0 +1,149 @@
1+{-# LANGUAGE
2+ AllowAmbiguousTypes
3+ , DataKinds
4+ , FlexibleContexts
5+ , FlexibleInstances
6+ , MultiParamTypeClasses
7+ , OverloadedStrings
8+ , RankNTypes
9+ , ScopedTypeVariables
10+ , TypeApplications
11+ , TypeFamilies
12+ , TypeOperators
13+ , UndecidableInstances
14+#-}
15+
16+module Squeal.PostgreSQL.Expression.Collection
17+ ( array
18+ , array1
19+ , array2
20+ , cardinality
21+ , index
22+ , row
23+ , field
24+ ) where
25+
26+import Data.String
27+import Data.Word (Word64)
28+
29+import qualified Generics.SOP as SOP
30+
31+import Squeal.PostgreSQL.Alias
32+import Squeal.PostgreSQL.Expression
33+import Squeal.PostgreSQL.List
34+import Squeal.PostgreSQL.Render
35+import Squeal.PostgreSQL.Schema
36+
37+-- | >>> printSQL $ array [null_, false, true]
38+-- ARRAY[NULL, FALSE, TRUE]
39+array
40+ :: [Expression outer commons grp schemas params from ty]
41+ -- ^ array elements
42+ -> Expression outer commons grp schemas params from (null ('PGvararray ty))
43+array xs = UnsafeExpression $ "ARRAY" <>
44+ bracketed (commaSeparated (renderSQL <$> xs))
45+
46+{- | construct a 1-dimensional fixed length array
47+
48+>>> printSQL $ array1 (null_ :* false *: true)
49+ARRAY[NULL, FALSE, TRUE]
50+
51+>>> :type array1 (null_ :* false *: true)
52+array1 (null_ :* false *: true)
53+ :: Expression
54+ outer
55+ commons
56+ grp
57+ schemas
58+ params
59+ from
60+ (null ('PGfixarray '[3] ('Null 'PGbool)))
61+-}
62+array1
63+ :: (n ~ Length tys, SOP.All ((~) ty) tys)
64+ => NP (Expression outer commons grp schemas params from) tys
65+ -> Expression outer commons grp schemas params from (null ('PGfixarray '[n] ty))
66+array1 xs = UnsafeExpression $ "ARRAY" <>
67+ bracketed (renderCommaSeparated renderSQL xs)
68+
69+{- | construct a 2-dimensional fixed length array
70+
71+>>> printSQL $ array2 ((null_ :* false *: true) *: (false :* null_ *: true))
72+ARRAY[[NULL, FALSE, TRUE], [FALSE, NULL, TRUE]]
73+
74+>>> :type array2 ((null_ :* false *: true) *: (false :* null_ *: true))
75+array2 ((null_ :* false *: true) *: (false :* null_ *: true))
76+ :: Expression
77+ outer
78+ commons
79+ grp
80+ schemas
81+ params
82+ from
83+ (null ('PGfixarray '[2, 3] ('Null 'PGbool)))
84+-}
85+array2
86+ :: ( SOP.All ((~) tys) tyss
87+ , SOP.All SOP.SListI tyss
88+ , Length tyss ~ n1
89+ , SOP.All ((~) ty) tys
90+ , Length tys ~ n2 )
91+ => NP (NP (Expression outer commons grp schemas params from)) tyss
92+ -> Expression outer commons grp schemas params from (null ('PGfixarray '[n1,n2] ty))
93+array2 xss = UnsafeExpression $ "ARRAY" <>
94+ bracketed (renderCommaSeparatedConstraint @SOP.SListI (bracketed . renderCommaSeparated renderSQL) xss)
95+
96+-- | >>> printSQL $ cardinality (array [null_, false, true])
97+-- cardinality(ARRAY[NULL, FALSE, TRUE])
98+cardinality :: null ('PGvararray ty) :--> null 'PGint8
99+cardinality = unsafeFunction "cardinality"
100+
101+-- | >>> printSQL $ array [null_, false, true] & index 2
102+-- (ARRAY[NULL, FALSE, TRUE])[2]
103+index
104+ :: Word64 -- ^ index
105+ -> null ('PGvararray ty) :--> NullifyType ty
106+index n expr = UnsafeExpression $
107+ parenthesized (renderSQL expr) <> "[" <> fromString (show n) <> "]"
108+
109+-- | A row constructor is an expression that builds a row value
110+-- (also called a composite value) using values for its member fields.
111+--
112+-- >>> :{
113+-- type Complex = 'PGcomposite
114+-- '[ "real" ::: 'NotNull 'PGfloat8
115+-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
116+-- :}
117+--
118+-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression outer commons grp schemas params from ('NotNull Complex)
119+-- >>> printSQL i
120+-- ROW(0, 1)
121+row
122+ :: SOP.SListI row
123+ => NP (Aliased (Expression outer commons grp schemas params from)) row
124+ -- ^ zero or more expressions for the row field values
125+ -> Expression outer commons grp schemas params from (null ('PGcomposite row))
126+row exprs = UnsafeExpression $ "ROW" <> parenthesized
127+ (renderCommaSeparated (\ (expr `As` _) -> renderSQL expr) exprs)
128+
129+-- | >>> :{
130+-- type Complex = 'PGcomposite
131+-- '[ "real" ::: 'NotNull 'PGfloat8
132+-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
133+-- type Schema = '["complex" ::: 'Typedef Complex]
134+-- :}
135+--
136+-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression outer '[] grp (Public Schema) from params ('NotNull Complex)
137+-- >>> printSQL $ i & field #complex #imaginary
138+-- (ROW(0, 1)::"complex")."imaginary"
139+field
140+ :: ( Has sch schemas schema
141+ , Has tydef schema ('Typedef ('PGcomposite row))
142+ , Has field row ty)
143+ => QualifiedAlias sch tydef -- ^ row type
144+ -> Alias field -- ^ field name
145+ -> Expression outer commons grp schemas params from ('NotNull ('PGcomposite row))
146+ -> Expression outer commons grp schemas params from ty
147+field td fld expr = UnsafeExpression $
148+ parenthesized (renderSQL expr <> "::" <> renderSQL td)
149+ <> "." <> renderSQL fld
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Comparison.hsnew file+195
@@ -0,0 +1,195 @@
1+{-# LANGUAGE
2+ OverloadedStrings
3+ , TypeInType
4+ , TypeOperators
5+#-}
6+
7+module Squeal.PostgreSQL.Expression.Comparison
8+ ( (.==)
9+ , (./=)
10+ , (.>=)
11+ , (.<)
12+ , (.<=)
13+ , (.>)
14+ , greatest
15+ , least
16+ , between
17+ , notBetween
18+ , betweenSymmetric
19+ , notBetweenSymmetric
20+ , isDistinctFrom
21+ , isNotDistinctFrom
22+ , isTrue
23+ , isNotTrue
24+ , isFalse
25+ , isNotFalse
26+ , isUnknown
27+ , isNotUnknown
28+ ) where
29+
30+import Squeal.PostgreSQL.Expression
31+import Squeal.PostgreSQL.Expression.Logic
32+import Squeal.PostgreSQL.Render
33+import Squeal.PostgreSQL.Schema
34+
35+-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`
36+-- will produce @NULL@s if one of their arguments is @NULL@.
37+--
38+-- >>> printSQL $ true .== null_
39+-- (TRUE = NULL)
40+(.==) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
41+(.==) = unsafeBinaryOp "="
42+infix 4 .==
43+
44+-- | >>> printSQL $ true ./= null_
45+-- (TRUE <> NULL)
46+(./=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
47+(./=) = unsafeBinaryOp "<>"
48+infix 4 ./=
49+
50+-- | >>> printSQL $ true .>= null_
51+-- (TRUE >= NULL)
52+(.>=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
53+(.>=) = unsafeBinaryOp ">="
54+infix 4 .>=
55+
56+-- | >>> printSQL $ true .< null_
57+-- (TRUE < NULL)
58+(.<) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
59+(.<) = unsafeBinaryOp "<"
60+infix 4 .<
61+
62+-- | >>> printSQL $ true .<= null_
63+-- (TRUE <= NULL)
64+(.<=) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
65+(.<=) = unsafeBinaryOp "<="
66+infix 4 .<=
67+
68+-- | >>> printSQL $ true .> null_
69+-- (TRUE > NULL)
70+(.>) :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
71+(.>) = unsafeBinaryOp ">"
72+infix 4 .>
73+
74+-- | >>> let expr = greatest [param @1] currentTimestamp :: Expression outer commons grp schemas '[ 'NotNull 'PGtimestamptz] from ('NotNull 'PGtimestamptz)
75+-- >>> printSQL expr
76+-- GREATEST(($1 :: timestamp with time zone), CURRENT_TIMESTAMP)
77+greatest :: FunctionVar ty ty ty
78+greatest = unsafeFunctionVar "GREATEST"
79+
80+-- | >>> printSQL $ least [null_] currentTimestamp
81+-- LEAST(NULL, CURRENT_TIMESTAMP)
82+least :: FunctionVar ty ty ty
83+least = unsafeFunctionVar "LEAST"
84+
85+{- | >>> printSQL $ true `between` (null_, false)
86+TRUE BETWEEN NULL AND FALSE
87+-}
88+between
89+ :: Expression outer commons grp schemas params from (null ty)
90+ -> ( Expression outer commons grp schemas params from (null ty)
91+ , Expression outer commons grp schemas params from (null ty) ) -- ^ bounds
92+ -> Condition outer commons grp schemas params from
93+between a (x,y) = UnsafeExpression $ renderSQL a <+> "BETWEEN"
94+ <+> renderSQL x <+> "AND" <+> renderSQL y
95+
96+{- | >>> printSQL $ true `notBetween` (null_, false)
97+TRUE NOT BETWEEN NULL AND FALSE
98+-}
99+notBetween
100+ :: Expression outer commons grp schemas params from (null ty)
101+ -> ( Expression outer commons grp schemas params from (null ty)
102+ , Expression outer commons grp schemas params from (null ty) ) -- ^ bounds
103+ -> Condition outer commons grp schemas params from
104+notBetween a (x,y) = UnsafeExpression $ renderSQL a <+> "NOT BETWEEN"
105+ <+> renderSQL x <+> "AND" <+> renderSQL y
106+
107+{- | between, after sorting the comparison values
108+
109+>>> printSQL $ true `betweenSymmetric` (null_, false)
110+TRUE BETWEEN SYMMETRIC NULL AND FALSE
111+-}
112+betweenSymmetric
113+ :: Expression outer commons grp schemas params from (null ty)
114+ -> ( Expression outer commons grp schemas params from (null ty)
115+ , Expression outer commons grp schemas params from (null ty) ) -- ^ bounds
116+ -> Condition outer commons grp schemas params from
117+betweenSymmetric a (x,y) = UnsafeExpression $ renderSQL a
118+ <+> "BETWEEN SYMMETRIC" <+> renderSQL x <+> "AND" <+> renderSQL y
119+
120+{- | not between, after sorting the comparison values
121+
122+>>> printSQL $ true `notBetweenSymmetric` (null_, false)
123+TRUE NOT BETWEEN SYMMETRIC NULL AND FALSE
124+-}
125+notBetweenSymmetric
126+ :: Expression outer commons grp schemas params from (null ty)
127+ -> ( Expression outer commons grp schemas params from (null ty)
128+ , Expression outer commons grp schemas params from (null ty) ) -- ^ bounds
129+ -> Condition outer commons grp schemas params from
130+notBetweenSymmetric a (x,y) = UnsafeExpression $ renderSQL a
131+ <+> "NOT BETWEEN SYMMETRIC" <+> renderSQL x <+> "AND" <+> renderSQL y
132+
133+{- | not equal, treating null like an ordinary value
134+
135+>>> printSQL $ true `isDistinctFrom` null_
136+(TRUE IS DISTINCT FROM NULL)
137+-}
138+isDistinctFrom :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
139+isDistinctFrom = unsafeBinaryOp "IS DISTINCT FROM"
140+
141+{- | equal, treating null like an ordinary value
142+
143+>>> printSQL $ true `isNotDistinctFrom` null_
144+(TRUE IS NOT DISTINCT FROM NULL)
145+-}
146+isNotDistinctFrom :: Operator (null0 ty) (null1 ty) ('NotNull 'PGbool)
147+isNotDistinctFrom = unsafeBinaryOp "IS NOT DISTINCT FROM"
148+
149+{- | is true
150+
151+>>> printSQL $ true & isTrue
152+(TRUE IS TRUE)
153+-}
154+isTrue :: null0 'PGbool :--> null1 'PGbool
155+isTrue = unsafeUnaryOpR "IS TRUE"
156+
157+{- | is false or unknown
158+
159+>>> printSQL $ true & isNotTrue
160+(TRUE IS NOT TRUE)
161+-}
162+isNotTrue :: null0 'PGbool :--> null1 'PGbool
163+isNotTrue = unsafeUnaryOpR "IS NOT TRUE"
164+
165+{- | is false
166+
167+>>> printSQL $ true & isFalse
168+(TRUE IS FALSE)
169+-}
170+isFalse :: null0 'PGbool :--> null1 'PGbool
171+isFalse = unsafeUnaryOpR "IS FALSE"
172+
173+{- | is true or unknown
174+
175+>>> printSQL $ true & isNotFalse
176+(TRUE IS NOT FALSE)
177+-}
178+isNotFalse :: null0 'PGbool :--> null1 'PGbool
179+isNotFalse = unsafeUnaryOpR "IS NOT FALSE"
180+
181+{- | is unknown
182+
183+>>> printSQL $ true & isUnknown
184+(TRUE IS UNKNOWN)
185+-}
186+isUnknown :: null0 'PGbool :--> null1 'PGbool
187+isUnknown = unsafeUnaryOpR "IS UNKNOWN"
188+
189+{- | is true or false
190+
191+>>> printSQL $ true & isNotUnknown
192+(TRUE IS NOT UNKNOWN)
193+-}
194+isNotUnknown :: null0 'PGbool :--> null1 'PGbool
195+isNotUnknown = unsafeUnaryOpR "IS NOT UNKNOWN"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Json.hsnew file+348
@@ -0,0 +1,348 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , FlexibleContexts
4+ , FlexibleInstances
5+ , OverloadedStrings
6+ , PolyKinds
7+ , TypeOperators
8+ , UndecidableInstances
9+#-}
10+
11+module Squeal.PostgreSQL.Expression.Json
12+ ( -- * Json and Jsonb operators
13+ (.->)
14+ , (.->>)
15+ , (.#>)
16+ , (.#>>)
17+ -- * Jsonb operators
18+ , (.?)
19+ , (.?|)
20+ , (.?&)
21+ , (.-.)
22+ , (#-.)
23+ -- * Json and Jsonb functions
24+ , toJson
25+ , toJsonb
26+ , arrayToJson
27+ , rowToJson
28+ , jsonBuildArray
29+ , jsonbBuildArray
30+ , PGBuildObject
31+ , jsonBuildObject
32+ , jsonbBuildObject
33+ , jsonObject
34+ , jsonbObject
35+ , jsonZipObject
36+ , jsonbZipObject
37+ , jsonArrayLength
38+ , jsonbArrayLength
39+ , jsonExtractPath
40+ , jsonbExtractPath
41+ , jsonExtractPathAsText
42+ , jsonbExtractPathAsText
43+ , jsonTypeof
44+ , jsonbTypeof
45+ , jsonStripNulls
46+ , jsonbStripNulls
47+ , jsonbSet
48+ , jsonbInsert
49+ , jsonbPretty
50+ ) where
51+
52+import Squeal.PostgreSQL.Expression
53+import Squeal.PostgreSQL.List
54+import Squeal.PostgreSQL.Schema
55+
56+import qualified Generics.SOP as SOP
57+
58+{-----------------------------------------
59+ -- json and jsonb support
60+
61+See https://www.postgresql.org/docs/10/static/functions-json.html -- most
62+comments lifted directly from this page.
63+
64+Table 9.44: json and jsonb operators
65+-----------------------------------------}
66+
67+-- | Get JSON value (object field or array element) at a key.
68+(.->)
69+ :: (json `In` PGJsonType, key `In` PGJsonKey)
70+ => Operator (null json) (null key) ('Null json)
71+infixl 8 .->
72+(.->) = unsafeBinaryOp "->"
73+
74+-- | Get JSON value (object field or array element) at a key, as text.
75+(.->>)
76+ :: (json `In` PGJsonType, key `In` PGJsonKey)
77+ => Operator (null json) (null key) ('Null 'PGtext)
78+infixl 8 .->>
79+(.->>) = unsafeBinaryOp "->>"
80+
81+-- | Get JSON value at a specified path.
82+(.#>)
83+ :: json `In` PGJsonType
84+ => Operator (null json) (null ('PGvararray ('NotNull 'PGtext))) ('Null json)
85+infixl 8 .#>
86+(.#>) = unsafeBinaryOp "#>"
87+
88+-- | Get JSON value at a specified path as text.
89+(.#>>)
90+ :: json `In` PGJsonType
91+ => Operator (null json) (null ('PGvararray ('NotNull 'PGtext))) ('Null 'PGtext)
92+infixl 8 .#>>
93+(.#>>) = unsafeBinaryOp "#>>"
94+
95+-- Additional jsonb operators
96+
97+-- | Does the string exist as a top-level key within the JSON value?
98+(.?) :: Operator (null 'PGjsonb) (null 'PGtext) ('Null 'PGbool)
99+infixl 9 .?
100+(.?) = unsafeBinaryOp "?"
101+
102+-- | Do any of these array strings exist as top-level keys?
103+(.?|) :: Operator
104+ (null 'PGjsonb)
105+ (null ('PGvararray ('NotNull 'PGtext)))
106+ ('Null 'PGbool)
107+infixl 9 .?|
108+(.?|) = unsafeBinaryOp "?|"
109+
110+-- | Do all of these array strings exist as top-level keys?
111+(.?&) :: Operator
112+ (null 'PGjsonb)
113+ (null ('PGvararray ('NotNull 'PGtext)))
114+ ('Null 'PGbool)
115+infixl 9 .?&
116+(.?&) = unsafeBinaryOp "?&"
117+
118+-- | Delete a key or keys from a JSON object, or remove an array element.
119+--
120+-- If the right operand is..
121+--
122+-- @ text @: Delete key/value pair or string element from left operand. Key/value pairs
123+-- are matched based on their key value.
124+--
125+-- @ text[] @: Delete multiple key/value pairs or string elements
126+-- from left operand. Key/value pairs are matched based on their key value.
127+--
128+-- @ integer @: Delete the array element with specified index (Negative integers
129+-- count from the end). Throws an error if top level container is not an array.
130+(.-.)
131+ :: (key `In` '[ 'PGtext, 'PGvararray ('NotNull 'PGtext), 'PGint4, 'PGint2 ]) -- hlint error without parens here
132+ => Operator (null 'PGjsonb) (null key) (null 'PGjsonb)
133+infixl 6 .-.
134+(.-.) = unsafeBinaryOp "-"
135+
136+-- | Delete the field or element with specified path (for JSON arrays, negative
137+-- integers count from the end)
138+(#-.) :: Operator (null 'PGjsonb) (null ('PGvararray ('NotNull 'PGtext))) (null 'PGjsonb)
139+infixl 6 #-.
140+(#-.) = unsafeBinaryOp "#-"
141+
142+{-----------------------------------------
143+Table 9.45: JSON creation functions
144+-----------------------------------------}
145+
146+-- | Returns the value as json. Arrays and composites are converted
147+-- (recursively) to arrays and objects; otherwise, if there is a cast from the
148+-- type to json, the cast function will be used to perform the conversion;
149+-- otherwise, a scalar value is produced. For any scalar type other than a
150+-- number, a Boolean, or a null value, the text representation will be used, in
151+-- such a fashion that it is a valid json value.
152+toJson :: null ty :--> null 'PGjson
153+toJson = unsafeFunction "to_json"
154+
155+-- | Returns the value as jsonb. Arrays and composites are converted
156+-- (recursively) to arrays and objects; otherwise, if there is a cast from the
157+-- type to json, the cast function will be used to perform the conversion;
158+-- otherwise, a scalar value is produced. For any scalar type other than a
159+-- number, a Boolean, or a null value, the text representation will be used, in
160+-- such a fashion that it is a valid jsonb value.
161+toJsonb :: null ty :--> null 'PGjsonb
162+toJsonb = unsafeFunction "to_jsonb"
163+
164+-- | Returns the array as a JSON array. A PostgreSQL multidimensional array
165+-- becomes a JSON array of arrays.
166+arrayToJson :: null ('PGvararray ty) :--> null 'PGjson
167+arrayToJson = unsafeFunction "array_to_json"
168+
169+-- | Returns the row as a JSON object.
170+rowToJson :: null ('PGcomposite ty) :--> null 'PGjson
171+rowToJson = unsafeFunction "row_to_json"
172+
173+-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic
174+-- argument list.
175+jsonBuildArray :: SOP.SListI tuple => FunctionN tuple (null 'PGjson)
176+jsonBuildArray = unsafeFunctionN "json_build_array"
177+
178+-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a
179+-- variadic argument list.
180+jsonbBuildArray :: SOP.SListI tuple => FunctionN tuple (null 'PGjsonb)
181+jsonbBuildArray = unsafeFunctionN "jsonb_build_array"
182+
183+class PGBuildObject tys where
184+instance PGBuildObject '[]
185+instance (PGBuildObject tys, key `In` PGJsonKey)
186+ => PGBuildObject ('NotNull key ': value ': tys)
187+
188+-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic
189+-- argument list. The elements of the argument list must alternate between text
190+-- and values.
191+jsonBuildObject
192+ :: (SOP.SListI elems, PGBuildObject elems)
193+ => FunctionN elems (null 'PGjson)
194+jsonBuildObject = unsafeFunctionN "json_build_object"
195+
196+-- | Builds a possibly-heterogeneously-typed (binary) JSON object out of a
197+-- variadic argument list. The elements of the argument list must alternate
198+-- between keys and values.
199+jsonbBuildObject
200+ :: (SOP.SListI elems, PGBuildObject elems)
201+ => FunctionN elems (null 'PGjsonb)
202+jsonbBuildObject = unsafeFunctionN "jsonb_build_object"
203+
204+-- | Builds a JSON object out of a text array.
205+-- The array must have two dimensions
206+-- such that each inner array has exactly two elements,
207+-- which are taken as a key/value pair.
208+jsonObject
209+ :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
210+ :--> null 'PGjson
211+jsonObject = unsafeFunction "json_object"
212+
213+-- | Builds a binary JSON object out of a text array.
214+-- The array must have two dimensions
215+-- such that each inner array has exactly two elements,
216+-- which are taken as a key/value pair.
217+jsonbObject
218+ :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
219+ :--> null 'PGjsonb
220+jsonbObject = unsafeFunction "jsonb_object"
221+
222+-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
223+-- keys and one for values, that are zipped pairwise to create a JSON object.
224+jsonZipObject :: FunctionN
225+ '[ null ('PGvararray ('NotNull 'PGtext))
226+ , null ('PGvararray ('NotNull 'PGtext)) ]
227+ ( null 'PGjson )
228+jsonZipObject = unsafeFunctionN "json_object"
229+
230+-- | This is an alternate form of 'jsonbObject' that takes two arrays; one for
231+-- keys and one for values, that are zipped pairwise to create a binary JSON
232+-- object.
233+jsonbZipObject :: FunctionN
234+ '[ null ('PGvararray ('NotNull 'PGtext))
235+ , null ('PGvararray ('NotNull 'PGtext)) ]
236+ ( null 'PGjsonb )
237+jsonbZipObject = unsafeFunctionN "jsonb_object"
238+
239+{-----------------------------------------
240+Table 9.46: JSON processing functions
241+-----------------------------------------}
242+
243+-- | Returns the number of elements in the outermost JSON array.
244+jsonArrayLength :: null 'PGjson :--> null 'PGint4
245+jsonArrayLength = unsafeFunction "json_array_length"
246+
247+-- | Returns the number of elements in the outermost binary JSON array.
248+jsonbArrayLength :: null 'PGjsonb :--> null 'PGint4
249+jsonbArrayLength = unsafeFunction "jsonb_array_length"
250+
251+-- | Returns JSON value pointed to by the given path (equivalent to #>
252+-- operator).
253+jsonExtractPath
254+ :: SOP.SListI elems
255+ => Expression outer commons grp schemas params from (null 'PGjson)
256+ -> NP (Expression outer commons grp schemas params from) elems
257+ -> Expression outer commons grp schemas params from (null 'PGjsonb)
258+jsonExtractPath x xs =
259+ unsafeFunctionN "json_extract_path" (x :* xs)
260+
261+-- | Returns JSON value pointed to by the given path (equivalent to #>
262+-- operator).
263+jsonbExtractPath
264+ :: SOP.SListI elems
265+ => Expression outer commons grp schemas params from (null 'PGjsonb)
266+ -> NP (Expression outer commons grp schemas params from) elems
267+ -> Expression outer commons grp schemas params from (null 'PGjsonb)
268+jsonbExtractPath x xs =
269+ unsafeFunctionN "jsonb_extract_path" (x :* xs)
270+
271+-- | Returns JSON value pointed to by the given path (equivalent to #>
272+-- operator), as text.
273+jsonExtractPathAsText
274+ :: SOP.SListI elems
275+ => Expression outer commons grp schemas params from (null 'PGjson)
276+ -> NP (Expression outer commons grp schemas params from) elems
277+ -> Expression outer commons grp schemas params from (null 'PGjson)
278+jsonExtractPathAsText x xs =
279+ unsafeFunctionN "json_extract_path_text" (x :* xs)
280+
281+-- | Returns JSON value pointed to by the given path (equivalent to #>
282+-- operator), as text.
283+jsonbExtractPathAsText
284+ :: SOP.SListI elems
285+ => Expression outer commons grp schemas params from (null 'PGjsonb)
286+ -> NP (Expression outer commons grp schemas params from) elems
287+ -> Expression outer commons grp schemas params from (null 'PGjsonb)
288+jsonbExtractPathAsText x xs =
289+ unsafeFunctionN "jsonb_extract_path_text" (x :* xs)
290+
291+-- | Returns the type of the outermost JSON value as a text string. Possible
292+-- types are object, array, string, number, boolean, and null.
293+jsonTypeof :: null 'PGjson :--> null 'PGtext
294+jsonTypeof = unsafeFunction "json_typeof"
295+
296+-- | Returns the type of the outermost binary JSON value as a text string.
297+-- Possible types are object, array, string, number, boolean, and null.
298+jsonbTypeof :: null 'PGjsonb :--> null 'PGtext
299+jsonbTypeof = unsafeFunction "jsonb_typeof"
300+
301+-- | Returns its argument with all object fields that have null values omitted.
302+-- Other null values are untouched.
303+jsonStripNulls :: null 'PGjson :--> null 'PGjson
304+jsonStripNulls = unsafeFunction "json_strip_nulls"
305+
306+-- | Returns its argument with all object fields that have null values omitted.
307+-- Other null values are untouched.
308+jsonbStripNulls :: null 'PGjsonb :--> null 'PGjsonb
309+jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
310+
311+-- | @ jsonbSet target path new_value create_missing @
312+--
313+-- Returns target with the section designated by path replaced by new_value,
314+-- or with new_value added if create_missing is true ( default is true) and the
315+-- item designated by path does not exist. As with the path orientated
316+-- operators, negative integers that appear in path count from the end of JSON
317+-- arrays.
318+jsonbSet
319+ :: Expression outer commons grp schemas params from (null 'PGjsonb)
320+ -> Expression outer commons grp schemas params from (null ('PGvararray ('NotNull 'PGtext)))
321+ -> Expression outer commons grp schemas params from (null 'PGjsonb)
322+ -> Maybe (Expression outer commons grp schemas params from (null 'PGbool))
323+ -> Expression outer commons grp schemas params from (null 'PGjsonb)
324+jsonbSet tgt path val createMissing = case createMissing of
325+ Just m -> unsafeFunctionN "jsonb_set" (tgt :* path :* val :* m :* Nil)
326+ Nothing -> unsafeFunctionN "jsonb_set" (tgt :* path :* val :* Nil)
327+
328+-- | @ jsonbInsert target path new_value insert_after @
329+--
330+-- Returns target with new_value inserted. If target section designated by
331+-- path is in a JSONB array, new_value will be inserted before target or after
332+-- if insert_after is true (default is false). If target section designated by
333+-- path is in JSONB object, new_value will be inserted only if target does not
334+-- exist. As with the path orientated operators, negative integers that appear
335+-- in path count from the end of JSON arrays.
336+jsonbInsert
337+ :: Expression outer commons grp schemas params from (null 'PGjsonb)
338+ -> Expression outer commons grp schemas params from (null ('PGvararray ('NotNull 'PGtext)))
339+ -> Expression outer commons grp schemas params from (null 'PGjsonb)
340+ -> Maybe (Expression outer commons grp schemas params from (null 'PGbool))
341+ -> Expression outer commons grp schemas params from (null 'PGjsonb)
342+jsonbInsert tgt path val insertAfter = case insertAfter of
343+ Just i -> unsafeFunctionN "jsonb_insert" (tgt :* path :* val :* i :* Nil)
344+ Nothing -> unsafeFunctionN "jsonb_insert" (tgt :* path :* val :* Nil)
345+
346+-- | Returns its argument as indented JSON text.
347+jsonbPretty :: null 'PGjsonb :--> null 'PGtext
348+jsonbPretty = unsafeFunction "jsonb_pretty"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Logic.hsnew file+95
@@ -0,0 +1,95 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , OverloadedStrings
4+ , TypeOperators
5+#-}
6+
7+module Squeal.PostgreSQL.Expression.Logic
8+ ( Condition
9+ , true
10+ , false
11+ , not_
12+ , (.&&)
13+ , (.||)
14+ , caseWhenThenElse
15+ , ifThenElse
16+ ) where
17+
18+import Squeal.PostgreSQL.Expression
19+import Squeal.PostgreSQL.Render
20+import Squeal.PostgreSQL.Schema
21+
22+-- | A `Condition` is an `Expression`, which can evaluate
23+-- to `true`, `false` or `null_`. This is because SQL uses
24+-- a three valued logic.
25+type Condition outer commons grp schemas params from =
26+ Expression outer commons grp schemas params from ('Null 'PGbool)
27+
28+-- | >>> printSQL true
29+-- TRUE
30+true :: Expr (null 'PGbool)
31+true = UnsafeExpression "TRUE"
32+
33+-- | >>> printSQL false
34+-- FALSE
35+false :: Expr (null 'PGbool)
36+false = UnsafeExpression "FALSE"
37+
38+-- | >>> printSQL $ not_ true
39+-- (NOT TRUE)
40+not_ :: null 'PGbool :--> null 'PGbool
41+not_ = unsafeUnaryOpL "NOT"
42+
43+-- | >>> printSQL $ true .&& false
44+-- (TRUE AND FALSE)
45+(.&&) :: Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
46+infixr 3 .&&
47+(.&&) = unsafeBinaryOp "AND"
48+
49+-- | >>> printSQL $ true .|| false
50+-- (TRUE OR FALSE)
51+(.||) :: Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
52+infixr 2 .||
53+(.||) = unsafeBinaryOp "OR"
54+
55+-- | >>> :{
56+-- let
57+-- expression :: Expression outer commons grp schemas params from (null 'PGint2)
58+-- expression = caseWhenThenElse [(true, 1), (false, 2)] 3
59+-- in printSQL expression
60+-- :}
61+-- CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END
62+caseWhenThenElse
63+ :: [ ( Condition outer commons grp schemas params from
64+ , Expression outer commons grp schemas params from ty
65+ ) ]
66+ -- ^ whens and thens
67+ -> Expression outer commons grp schemas params from ty
68+ -- ^ else
69+ -> Expression outer commons grp schemas params from ty
70+caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
71+ [ "CASE"
72+ , mconcat
73+ [ mconcat
74+ [ " WHEN ", renderSQL when_
75+ , " THEN ", renderSQL then_
76+ ]
77+ | (when_,then_) <- whenThens
78+ ]
79+ , " ELSE ", renderSQL else_
80+ , " END"
81+ ]
82+
83+-- | >>> :{
84+-- let
85+-- expression :: Expression outer commons grp schemas params from (null 'PGint2)
86+-- expression = ifThenElse true 1 0
87+-- in printSQL expression
88+-- :}
89+-- CASE WHEN TRUE THEN 1 ELSE 0 END
90+ifThenElse
91+ :: Condition outer commons grp schemas params from
92+ -> Expression outer commons grp schemas params from ty -- ^ then
93+ -> Expression outer commons grp schemas params from ty -- ^ else
94+ -> Expression outer commons grp schemas params from ty
95+ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Math.hsnew file+89
@@ -0,0 +1,89 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , OverloadedStrings
4+ , TypeOperators
5+#-}
6+
7+module Squeal.PostgreSQL.Expression.Math
8+ ( atan2_
9+ , quot_
10+ , rem_
11+ , trunc
12+ , round_
13+ , ceiling_
14+ ) where
15+
16+import Squeal.PostgreSQL.Expression
17+import Squeal.PostgreSQL.List
18+import Squeal.PostgreSQL.Schema
19+
20+-- | >>> :{
21+-- let
22+-- expression :: Expr (null 'PGfloat4)
23+-- expression = atan2_ (pi *: 2)
24+-- in printSQL expression
25+-- :}
26+-- atan2(pi(), 2)
27+atan2_
28+ :: float `In` PGFloating
29+ => FunctionN '[ null float, null float] (null float)
30+atan2_ = unsafeFunctionN "atan2"
31+
32+
33+-- | integer division, truncates the result
34+--
35+-- >>> :{
36+-- let
37+-- expression :: Expression outer commons grp schemas params from (null 'PGint2)
38+-- expression = 5 `quot_` 2
39+-- in printSQL expression
40+-- :}
41+-- (5 / 2)
42+quot_
43+ :: int `In` PGIntegral
44+ => Operator (null int) (null int) (null int)
45+quot_ = unsafeBinaryOp "/"
46+
47+-- | remainder upon integer division
48+--
49+-- >>> :{
50+-- let
51+-- expression :: Expression outer commons grp schemas params from (null 'PGint2)
52+-- expression = 5 `rem_` 2
53+-- in printSQL expression
54+-- :}
55+-- (5 % 2)
56+rem_
57+ :: int `In` PGIntegral
58+ => Operator (null int) (null int) (null int)
59+rem_ = unsafeBinaryOp "%"
60+
61+-- | >>> :{
62+-- let
63+-- expression :: Expression outer commons grp schemas params from (null 'PGfloat4)
64+-- expression = trunc pi
65+-- in printSQL expression
66+-- :}
67+-- trunc(pi())
68+trunc :: frac `In` PGFloating => null frac :--> null frac
69+trunc = unsafeFunction "trunc"
70+
71+-- | >>> :{
72+-- let
73+-- expression :: Expression outer commons grp schemas params from (null 'PGfloat4)
74+-- expression = round_ pi
75+-- in printSQL expression
76+-- :}
77+-- round(pi())
78+round_ :: frac `In` PGFloating => null frac :--> null frac
79+round_ = unsafeFunction "round"
80+
81+-- | >>> :{
82+-- let
83+-- expression :: Expression outer commons grp schemas params from (null 'PGfloat4)
84+-- expression = ceiling_ pi
85+-- in printSQL expression
86+-- :}
87+-- ceiling(pi())
88+ceiling_ :: frac `In` PGFloating => null frac :--> null frac
89+ceiling_ = unsafeFunction "ceiling"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Null.hsnew file+91
@@ -0,0 +1,91 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , OverloadedStrings
4+ , TypeOperators
5+#-}
6+
7+module Squeal.PostgreSQL.Expression.Null
8+ ( null_
9+ , notNull
10+ , coalesce
11+ , fromNull
12+ , isNull
13+ , isNotNull
14+ , matchNull
15+ , nullIf
16+ ) where
17+
18+import Squeal.PostgreSQL.Expression
19+import Squeal.PostgreSQL.Expression.Logic
20+import Squeal.PostgreSQL.Render
21+import Squeal.PostgreSQL.Schema
22+
23+-- | analagous to `Nothing`
24+--
25+-- >>> printSQL null_
26+-- NULL
27+null_ :: Expr ('Null ty)
28+null_ = UnsafeExpression "NULL"
29+
30+-- | analagous to `Just`
31+--
32+-- >>> printSQL $ notNull true
33+-- TRUE
34+notNull :: 'NotNull ty :--> 'Null ty
35+notNull = UnsafeExpression . renderSQL
36+
37+-- | return the leftmost value which is not NULL
38+--
39+-- >>> printSQL $ coalesce [null_, true] false
40+-- COALESCE(NULL, TRUE, FALSE)
41+coalesce :: FunctionVar ('Null ty) ('NotNull ty) ('NotNull ty)
42+coalesce nullxs notNullx = UnsafeExpression $
43+ "COALESCE" <> parenthesized (commaSeparated
44+ ((renderSQL <$> nullxs) <> [renderSQL notNullx]))
45+
46+-- | analagous to `Data.Maybe.fromMaybe` using @COALESCE@
47+--
48+-- >>> printSQL $ fromNull true null_
49+-- COALESCE(NULL, TRUE)
50+fromNull
51+ :: Expression outer commons grp schemas params from ('NotNull ty)
52+ -- ^ what to convert @NULL@ to
53+ -> Expression outer commons grp schemas params from ('Null ty)
54+ -> Expression outer commons grp schemas params from ('NotNull ty)
55+fromNull notNullx nullx = coalesce [nullx] notNullx
56+
57+-- | >>> printSQL $ null_ & isNull
58+-- NULL IS NULL
59+isNull :: 'Null ty :--> null 'PGbool
60+isNull x = UnsafeExpression $ renderSQL x <+> "IS NULL"
61+
62+-- | >>> printSQL $ null_ & isNotNull
63+-- NULL IS NOT NULL
64+isNotNull :: 'Null ty :--> null 'PGbool
65+isNotNull x = UnsafeExpression $ renderSQL x <+> "IS NOT NULL"
66+
67+-- | analagous to `maybe` using @IS NULL@
68+--
69+-- >>> printSQL $ matchNull true not_ null_
70+-- CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END
71+matchNull
72+ :: Expression outer commons grp schemas params from (nullty)
73+ -- ^ what to convert @NULL@ to
74+ -> ( Expression outer commons grp schemas params from ('NotNull ty)
75+ -> Expression outer commons grp schemas params from (nullty) )
76+ -- ^ function to perform when @NULL@ is absent
77+ -> Expression outer commons grp schemas params from ('Null ty)
78+ -> Expression outer commons grp schemas params from (nullty)
79+matchNull y f x = ifThenElse (isNull x) y
80+ (f (UnsafeExpression (renderSQL x)))
81+
82+{-| right inverse to `fromNull`, if its arguments are equal then
83+`nullIf` gives @NULL@.
84+
85+>>> :set -XTypeApplications -XDataKinds
86+>>> let expr = nullIf (false *: param @1) :: Expression outer commons grp schemas '[ 'NotNull 'PGbool] from ('Null 'PGbool)
87+>>> printSQL expr
88+NULLIF(FALSE, ($1 :: bool))
89+-}
90+nullIf :: FunctionN '[ 'NotNull ty, 'NotNull ty] ('Null ty)
91+nullIf = unsafeFunctionN "NULLIF"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Sort.hsnew file+75
@@ -0,0 +1,75 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , GADTs
4+ , LambdaCase
5+ , OverloadedStrings
6+ , StandaloneDeriving
7+#-}
8+
9+module Squeal.PostgreSQL.Expression.Sort
10+ ( SortExpression (..)
11+ , OrderBy (..)
12+ ) where
13+
14+import Squeal.PostgreSQL.Expression
15+import Squeal.PostgreSQL.Render
16+import Squeal.PostgreSQL.Schema
17+
18+-- | `SortExpression`s are used by `orderBy` to optionally sort the results
19+-- of a `Squeal.PostgreSQL.Query.Query`. `Asc` or `Desc`
20+-- set the sort direction of a `NotNull` result
21+-- column to ascending or descending. Ascending order puts smaller values
22+-- first, where "smaller" is defined in terms of the `.<` operator. Similarly,
23+-- descending order is determined with the `.>` operator. `AscNullsFirst`,
24+-- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to
25+-- determine whether nulls appear before or after non-null values in the sort
26+-- ordering of a `Null` result column.
27+data SortExpression outer commons grp schemas params from where
28+ Asc
29+ :: Expression outer commons grp schemas params from ('NotNull ty)
30+ -> SortExpression outer commons grp schemas params from
31+ Desc
32+ :: Expression outer commons grp schemas params from ('NotNull ty)
33+ -> SortExpression outer commons grp schemas params from
34+ AscNullsFirst
35+ :: Expression outer commons grp schemas params from ('Null ty)
36+ -> SortExpression outer commons grp schemas params from
37+ AscNullsLast
38+ :: Expression outer commons grp schemas params from ('Null ty)
39+ -> SortExpression outer commons grp schemas params from
40+ DescNullsFirst
41+ :: Expression outer commons grp schemas params from ('Null ty)
42+ -> SortExpression outer commons grp schemas params from
43+ DescNullsLast
44+ :: Expression outer commons grp schemas params from ('Null ty)
45+ -> SortExpression outer commons grp schemas params from
46+deriving instance Show (SortExpression outer commons grp schemas params from)
47+
48+{- |
49+The `orderBy` clause causes the result rows of a `Squeal.PostgreSQL.Query.TableExpression`
50+to be sorted according to the specified `SortExpression`(s).
51+If two rows are equal according to the leftmost expression,
52+they are compared according to the next expression and so on.
53+If they are equal according to all specified expressions,
54+they are returned in an implementation-dependent order.
55+
56+You can also control the order in which rows are processed by window functions
57+using `orderBy` within `Squeal.PostgreSQL.Query.Over`.
58+-}
59+class OrderBy expr where
60+ orderBy
61+ :: [SortExpression outer commons grp schemas params from]
62+ -> expr outer commons grp schemas params from
63+ -> expr outer commons grp schemas params from
64+
65+-- | Render a `SortExpression`.
66+instance RenderSQL (SortExpression outer commons grp schemas params from) where
67+ renderSQL = \case
68+ Asc expression -> renderSQL expression <+> "ASC"
69+ Desc expression -> renderSQL expression <+> "DESC"
70+ AscNullsFirst expression -> renderSQL expression
71+ <+> "ASC NULLS FIRST"
72+ DescNullsFirst expression -> renderSQL expression
73+ <+> "DESC NULLS FIRST"
74+ AscNullsLast expression -> renderSQL expression <+> "ASC NULLS LAST"
75+ DescNullsLast expression -> renderSQL expression <+> "DESC NULLS LAST"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Text.hsnew file+51
@@ -0,0 +1,51 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , OverloadedStrings
4+ , TypeOperators
5+#-}
6+
7+module Squeal.PostgreSQL.Expression.Text
8+ ( lower
9+ , upper
10+ , charLength
11+ , like
12+ , ilike
13+ ) where
14+
15+import Squeal.PostgreSQL.Expression
16+import Squeal.PostgreSQL.Schema
17+
18+-- | >>> printSQL $ lower "ARRRGGG"
19+-- lower(E'ARRRGGG')
20+lower :: null 'PGtext :--> null 'PGtext
21+lower = unsafeFunction "lower"
22+
23+-- | >>> printSQL $ upper "eeee"
24+-- upper(E'eeee')
25+upper :: null 'PGtext :--> null 'PGtext
26+upper = unsafeFunction "upper"
27+
28+-- | >>> printSQL $ charLength "four"
29+-- char_length(E'four')
30+charLength :: null 'PGtext :--> null 'PGint4
31+charLength = unsafeFunction "char_length"
32+
33+-- | The `like` expression returns true if the @string@ matches
34+-- the supplied @pattern@. If @pattern@ does not contain percent signs
35+-- or underscores, then the pattern only represents the string itself;
36+-- in that case `like` acts like the equals operator. An underscore (_)
37+-- in pattern stands for (matches) any single character; a percent sign (%)
38+-- matches any sequence of zero or more characters.
39+--
40+-- >>> printSQL $ "abc" `like` "a%"
41+-- (E'abc' LIKE E'a%')
42+like :: Operator (null 'PGtext) (null 'PGtext) ('Null 'PGbool)
43+like = unsafeBinaryOp "LIKE"
44+
45+-- | The key word ILIKE can be used instead of LIKE to make the
46+-- match case-insensitive according to the active locale.
47+--
48+-- >>> printSQL $ "abc" `ilike` "a%"
49+-- (E'abc' ILIKE E'a%')
50+ilike :: Operator (null 'PGtext) (null 'PGtext) ('Null 'PGbool)
51+ilike = unsafeBinaryOp "ILIKE"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/TextSearch.hsnew file+107
@@ -0,0 +1,107 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , OverloadedStrings
4+ , TypeOperators
5+#-}
6+
7+module Squeal.PostgreSQL.Expression.TextSearch
8+ ( (@@)
9+ , (.&)
10+ , (.|)
11+ , (.!)
12+ , (<->)
13+ , arrayToTSvector
14+ , tsvectorLength
15+ , numnode
16+ , plainToTSquery
17+ , phraseToTSquery
18+ , websearchToTSquery
19+ , queryTree
20+ , toTSquery
21+ , toTSvector
22+ , setWeight
23+ , strip
24+ , jsonToTSvector
25+ , jsonbToTSvector
26+ , tsDelete
27+ , tsFilter
28+ , tsHeadline
29+ ) where
30+
31+import Squeal.PostgreSQL.Expression
32+import Squeal.PostgreSQL.List
33+import Squeal.PostgreSQL.Schema
34+
35+(@@) :: Operator (null 'PGtsvector) (null 'PGtsquery) ('Null 'PGbool)
36+(@@) = unsafeBinaryOp "@@"
37+
38+(.&) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
39+(.&) = unsafeBinaryOp "&&"
40+
41+(.|) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
42+(.|) = unsafeBinaryOp "||"
43+
44+(.!) :: null 'PGtsquery :--> null 'PGtsquery
45+(.!) = unsafeUnaryOpL "!!"
46+
47+(<->) :: Operator (null 'PGtsquery) (null 'PGtsquery) (null 'PGtsquery)
48+(<->) = unsafeBinaryOp "<->"
49+
50+arrayToTSvector
51+ :: null ('PGvararray ('NotNull 'PGtext))
52+ :--> null 'PGtsvector
53+arrayToTSvector = unsafeFunction "array_to_tsvector"
54+
55+tsvectorLength :: null 'PGtsvector :--> null 'PGint4
56+tsvectorLength = unsafeFunction "length"
57+
58+numnode :: null 'PGtsquery :--> null 'PGint4
59+numnode = unsafeFunction "numnode"
60+
61+plainToTSquery :: null 'PGtext :--> null 'PGtsquery
62+plainToTSquery = unsafeFunction "plainto_tsquery"
63+
64+phraseToTSquery :: null 'PGtext :--> null 'PGtsquery
65+phraseToTSquery = unsafeFunction "phraseto_tsquery"
66+
67+websearchToTSquery :: null 'PGtext :--> null 'PGtsquery
68+websearchToTSquery = unsafeFunction "websearch_to_tsquery"
69+
70+queryTree :: null 'PGtsquery :--> null 'PGtext
71+queryTree = unsafeFunction "query_tree"
72+
73+toTSquery :: null 'PGtext :--> null 'PGtsquery
74+toTSquery = unsafeFunction "to_tsquery"
75+
76+toTSvector
77+ :: ty `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
78+ => null ty :--> null 'PGtsvector
79+toTSvector = unsafeFunction "to_tsvector"
80+
81+setWeight
82+ :: FunctionN '[null 'PGtsvector, null ('PGchar 1)] (null 'PGtsvector)
83+setWeight = unsafeFunctionN "set_weight"
84+
85+strip :: null 'PGtsvector :--> null 'PGtsvector
86+strip = unsafeFunction "strip"
87+
88+jsonToTSvector :: FunctionN '[null 'PGjson, null 'PGjson] (null 'PGtsvector)
89+jsonToTSvector = unsafeFunctionN "json_to_tsvector"
90+
91+jsonbToTSvector :: FunctionN '[null 'PGjsonb, null 'PGjsonb] (null 'PGtsvector)
92+jsonbToTSvector = unsafeFunctionN "jsonb_to_tsvector"
93+
94+tsDelete :: FunctionN
95+ '[null 'PGtsvector, null ('PGvararray ('NotNull 'PGtext))]
96+ (null 'PGtsvector)
97+tsDelete = unsafeFunctionN "ts_delete"
98+
99+tsFilter :: FunctionN
100+ '[null 'PGtsvector, null ('PGvararray ('NotNull ('PGchar 1)))]
101+ (null 'PGtsvector)
102+tsFilter = unsafeFunctionN "ts_filter"
103+
104+tsHeadline
105+ :: document `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
106+ => FunctionN '[null document, null 'PGtsquery] (null 'PGtext)
107+tsHeadline = unsafeFunctionN "ts_headline"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Time.hsnew file+183
@@ -0,0 +1,183 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , DeriveGeneric
4+ , FunctionalDependencies
5+ , LambdaCase
6+ , MultiParamTypeClasses
7+ , OverloadedStrings
8+ , PolyKinds
9+ , RankNTypes
10+#-}
11+
12+module Squeal.PostgreSQL.Expression.Time
13+ ( TimeOp (..)
14+ , currentDate
15+ , currentTime
16+ , currentTimestamp
17+ , localTime
18+ , localTimestamp
19+ , now
20+ , makeDate
21+ , makeTime
22+ , makeTimestamp
23+ , makeTimestamptz
24+ , interval_
25+ , TimeUnit (..)
26+ ) where
27+
28+import Data.String
29+
30+import qualified GHC.Generics as GHC
31+import qualified Generics.SOP as SOP
32+
33+import Squeal.PostgreSQL.Expression
34+import Squeal.PostgreSQL.Render
35+import Squeal.PostgreSQL.Schema
36+
37+-- | >>> printSQL currentDate
38+-- CURRENT_DATE
39+currentDate :: Expr (null 'PGdate)
40+currentDate = UnsafeExpression "CURRENT_DATE"
41+
42+-- | >>> printSQL currentTime
43+-- CURRENT_TIME
44+currentTime :: Expr (null 'PGtimetz)
45+currentTime = UnsafeExpression "CURRENT_TIME"
46+
47+-- | >>> printSQL currentTimestamp
48+-- CURRENT_TIMESTAMP
49+currentTimestamp :: Expr (null 'PGtimestamptz)
50+currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"
51+
52+-- | >>> printSQL localTime
53+-- LOCALTIME
54+localTime :: Expr (null 'PGtime)
55+localTime = UnsafeExpression "LOCALTIME"
56+
57+-- | >>> printSQL localTimestamp
58+-- LOCALTIMESTAMP
59+localTimestamp :: Expr (null 'PGtimestamp)
60+localTimestamp = UnsafeExpression "LOCALTIMESTAMP"
61+
62+-- | Current date and time (equivalent to `currentTimestamp`)
63+--
64+-- >>> printSQL now
65+-- now()
66+now :: Expr (null 'PGtimestamptz)
67+now = UnsafeExpression "now()"
68+
69+{-|
70+Create date from year, month and day fields
71+
72+>>> printSQL (makeDate (1984 :* 7 *: 3))
73+make_date(1984, 7, 3)
74+-}
75+makeDate :: FunctionN
76+ '[ null 'PGint4, null 'PGint4, null 'PGint4 ]
77+ ( null 'PGdate )
78+makeDate = unsafeFunctionN "make_date"
79+
80+{-|
81+Create time from hour, minute and seconds fields
82+
83+>>> printSQL (makeTime (8 :* 15 *: 23.5))
84+make_time(8, 15, 23.5)
85+-}
86+makeTime :: FunctionN
87+ '[ null 'PGint4, null 'PGint4, null 'PGfloat8 ]
88+ ( null 'PGtime )
89+makeTime = unsafeFunctionN "make_time"
90+
91+{-|
92+Create timestamp from year, month, day, hour, minute and seconds fields
93+
94+>>> printSQL (makeTimestamp (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
95+make_timestamp(2013, 7, 15, 8, 15, 23.5)
96+-}
97+makeTimestamp :: FunctionN
98+ '[ null 'PGint4, null 'PGint4, null 'PGint4
99+ , null 'PGint4, null 'PGint4, null 'PGfloat8 ]
100+ ( null 'PGtimestamp )
101+makeTimestamp = unsafeFunctionN "make_timestamp"
102+
103+{-|
104+Create timestamp with time zone from
105+year, month, day, hour, minute and seconds fields;
106+the current time zone is used
107+
108+>>> printSQL (makeTimestamptz (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
109+make_timestamptz(2013, 7, 15, 8, 15, 23.5)
110+-}
111+makeTimestamptz :: FunctionN
112+ '[ null 'PGint4, null 'PGint4, null 'PGint4
113+ , null 'PGint4, null 'PGint4, null 'PGfloat8 ]
114+ ( null 'PGtimestamptz )
115+makeTimestamptz = unsafeFunctionN "make_timestamptz"
116+
117+{-|
118+Affine space operations on time types.
119+-}
120+class TimeOp time diff | time -> diff where
121+ {-|
122+ >>> printSQL (makeDate (1984 :* 7 *: 3) !+ 365)
123+ (make_date(1984, 7, 3) + 365)
124+ -}
125+ (!+) :: Operator (null time) (null diff) (null time)
126+ (!+) = unsafeBinaryOp "+"
127+ {-|
128+ >>> printSQL (365 +! makeDate (1984 :* 7 *: 3))
129+ (365 + make_date(1984, 7, 3))
130+ -}
131+ (+!) :: Operator (null diff) (null time) (null time)
132+ (+!) = unsafeBinaryOp "+"
133+ {-|
134+ >>> printSQL (makeDate (1984 :* 7 *: 3) !- 365)
135+ (make_date(1984, 7, 3) - 365)
136+ -}
137+ (!-) :: Operator (null time) (null diff) (null time)
138+ (!-) = unsafeBinaryOp "-"
139+ {-|
140+ >>> printSQL (makeDate (1984 :* 7 *: 3) !-! currentDate)
141+ (make_date(1984, 7, 3) - CURRENT_DATE)
142+ -}
143+ (!-!) :: Operator (null time) (null time) (null diff)
144+ (!-!) = unsafeBinaryOp "-"
145+instance TimeOp 'PGtimestamp 'PGinterval
146+instance TimeOp 'PGtimestamptz 'PGinterval
147+instance TimeOp 'PGtime 'PGinterval
148+instance TimeOp 'PGtimetz 'PGinterval
149+instance TimeOp 'PGinterval 'PGinterval
150+instance TimeOp 'PGdate 'PGint4
151+infixl 6 !+
152+infixl 6 +!
153+infixl 6 !-
154+infixl 6 !-!
155+
156+data TimeUnit
157+ = Years | Months | Weeks | Days
158+ | Hours | Minutes | Seconds
159+ | Microseconds | Milliseconds
160+ | Decades | Centuries | Millennia
161+ deriving (Eq, Ord, Show, Read, Enum, GHC.Generic)
162+instance SOP.Generic TimeUnit
163+instance SOP.HasDatatypeInfo TimeUnit
164+instance RenderSQL TimeUnit where
165+ renderSQL = \case
166+ Years -> "years"
167+ Months -> "months"
168+ Weeks -> "weeks"
169+ Days -> "days"
170+ Hours -> "hours"
171+ Minutes -> "minutes"
172+ Seconds -> "seconds"
173+ Microseconds -> "microseconds"
174+ Milliseconds -> "milliseconds"
175+ Decades -> "decades"
176+ Centuries -> "centuries"
177+ Millennia -> "millennia"
178+
179+-- | >>> printSQL $ interval_ 7 Days
180+-- (INTERVAL '7.0 days')
181+interval_ :: Double -> TimeUnit -> Expr (null 'PGinterval)
182+interval_ num unit = UnsafeExpression . parenthesized $ "INTERVAL" <+>
183+ "'" <> fromString (show num) <+> renderSQL unit <> "'"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Window.hsnew file+246
@@ -0,0 +1,246 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , DeriveGeneric
4+ , FlexibleContexts
5+ , FlexibleInstances
6+ , GADTs
7+ , GeneralizedNewtypeDeriving
8+ , LambdaCase
9+ , MultiParamTypeClasses
10+ , OverloadedStrings
11+ , RankNTypes
12+ , KindSignatures
13+#-}
14+
15+module Squeal.PostgreSQL.Expression.Window
16+ ( WindowDefinition (..)
17+ , partitionBy
18+ , WindowFunction (..)
19+ , rank
20+ , rowNumber
21+ , denseRank
22+ , percentRank
23+ , cumeDist
24+ , ntile
25+ , lag
26+ , lead
27+ , firstValue
28+ , lastValue
29+ , nthValue
30+ ) where
31+
32+import Control.DeepSeq
33+import Data.ByteString
34+
35+import qualified GHC.Generics as GHC
36+import qualified Generics.SOP as SOP
37+
38+import Squeal.PostgreSQL.Alias
39+import Squeal.PostgreSQL.Expression
40+import Squeal.PostgreSQL.Expression.Aggregate
41+import Squeal.PostgreSQL.Expression.Sort
42+import Squeal.PostgreSQL.List
43+import Squeal.PostgreSQL.Render
44+import Squeal.PostgreSQL.Schema
45+
46+instance Aggregate
47+ (Expression outer commons grp schemas params from)
48+ (NP (Expression outer commons grp schemas params from))
49+ (WindowFunction outer commons grp schemas params from) where
50+ countStar = UnsafeWindowFunction "count(*)"
51+ count = unsafeWindowFunction1 "count"
52+ sum_ = unsafeWindowFunction1 "sum"
53+ arrayAgg = unsafeWindowFunction1 "array_agg"
54+ jsonAgg = unsafeWindowFunction1 "json_agg"
55+ jsonbAgg = unsafeWindowFunction1 "jsonb_agg"
56+ bitAnd = unsafeWindowFunction1 "bit_and"
57+ bitOr = unsafeWindowFunction1 "bit_or"
58+ boolAnd = unsafeWindowFunction1 "bool_and"
59+ boolOr = unsafeWindowFunction1 "bool_or"
60+ every = unsafeWindowFunction1 "every"
61+ max_ = unsafeWindowFunction1 "max"
62+ min_ = unsafeWindowFunction1 "min"
63+ avg = unsafeWindowFunction1 "avg"
64+ corr = unsafeWindowFunctionN "corr"
65+ covarPop = unsafeWindowFunctionN "covar_pop"
66+ covarSamp = unsafeWindowFunctionN "covar_samp"
67+ regrAvgX = unsafeWindowFunctionN "regr_avgx"
68+ regrAvgY = unsafeWindowFunctionN "regr_avgy"
69+ regrCount = unsafeWindowFunctionN "regr_count"
70+ regrIntercept = unsafeWindowFunctionN "regr_intercept"
71+ regrR2 = unsafeWindowFunctionN "regr_r2"
72+ regrSlope = unsafeWindowFunctionN "regr_slope"
73+ regrSxx = unsafeWindowFunctionN "regr_sxx"
74+ regrSxy = unsafeWindowFunctionN "regr_sxy"
75+ regrSyy = unsafeWindowFunctionN "regr_syy"
76+ stddev = unsafeWindowFunction1 "stddev"
77+ stddevPop = unsafeWindowFunction1 "stddev_pop"
78+ stddevSamp = unsafeWindowFunction1 "stddev_samp"
79+ variance = unsafeWindowFunction1 "variance"
80+ varPop = unsafeWindowFunction1 "var_pop"
81+ varSamp = unsafeWindowFunction1 "var_samp"
82+
83+
84+-- | A `WindowDefinition` is a set of table rows that are somehow related
85+-- to the current row
86+data WindowDefinition outer commons grp schemas params from where
87+ WindowDefinition
88+ :: SOP.SListI bys
89+ => NP (Expression outer commons grp schemas params from) bys
90+ -> [SortExpression outer commons grp schemas params from]
91+ -> WindowDefinition outer commons grp schemas params from
92+
93+instance OrderBy WindowDefinition where
94+ orderBy sortsR (WindowDefinition parts sortsL)
95+ = WindowDefinition parts (sortsL ++ sortsR)
96+
97+instance RenderSQL (WindowDefinition outer commons schemas from grp params) where
98+ renderSQL (WindowDefinition part ord) =
99+ renderPartitionByClause part <> renderOrderByClause ord
100+ where
101+ renderPartitionByClause = \case
102+ Nil -> ""
103+ parts -> "PARTITION" <+> "BY" <+> renderCommaSeparated renderExpression parts
104+ renderOrderByClause = \case
105+ [] -> ""
106+ srts -> " ORDER" <+> "BY"
107+ <+> commaSeparated (renderSQL <$> srts)
108+
109+{- |
110+The `partitionBy` clause within `Squeal.PostgreSQL.Query.Over` divides the rows into groups,
111+or partitions, that share the same values of the `partitionBy` `Expression`(s).
112+For each row, the window function is computed across the rows that fall into
113+the same partition as the current row.
114+-}
115+partitionBy
116+ :: SOP.SListI bys
117+ => NP (Expression outer commons grp schemas params from) bys
118+ -> WindowDefinition outer commons grp schemas params from
119+partitionBy bys = WindowDefinition bys []
120+
121+{- |
122+A window function performs a calculation across a set of table rows
123+that are somehow related to the current row. This is comparable to the type
124+of calculation that can be done with an aggregate function.
125+However, window functions do not cause rows to become grouped into a single
126+output row like non-window aggregate calls would.
127+Instead, the rows retain their separate identities.
128+Behind the scenes, the window function is able to access more than
129+just the current row of the query result.
130+-}
131+newtype WindowFunction
132+ (outer :: FromType)
133+ (commons :: FromType)
134+ (grp :: Grouping)
135+ (schemas :: SchemasType)
136+ (params :: [NullityType])
137+ (from :: FromType)
138+ (ty :: NullityType)
139+ = UnsafeWindowFunction { renderWindowFunction :: ByteString }
140+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
141+
142+instance RenderSQL (WindowFunction outer commons grp schemas params from ty) where
143+ renderSQL = renderWindowFunction
144+
145+type WinFun0 x
146+ = forall outer commons grp schemas params from
147+ . WindowFunction outer commons grp schemas params from x
148+ -- ^ cannot reference aliases
149+
150+type WinFun1 x y
151+ = forall outer commons grp schemas params from
152+ . Expression outer commons grp schemas params from x
153+ -- ^ input
154+ -> WindowFunction outer commons grp schemas params from y
155+ -- ^ output
156+
157+type WinFunN xs y
158+ = forall outer commons grp schemas params from
159+ . NP (Expression outer commons grp schemas params from) xs
160+ -- ^ inputs
161+ -> WindowFunction outer commons grp schemas params from y
162+ -- ^ output
163+
164+unsafeWindowFunction1 :: ByteString -> WinFun1 x y
165+unsafeWindowFunction1 fun x
166+ = UnsafeWindowFunction $ fun <> parenthesized (renderSQL x)
167+
168+unsafeWindowFunctionN :: SOP.SListI xs => ByteString -> WinFunN xs y
169+unsafeWindowFunctionN fun xs = UnsafeWindowFunction $ fun <>
170+ parenthesized (renderCommaSeparated renderSQL xs)
171+
172+{- | rank of the current row with gaps; same as `rowNumber` of its first peer
173+>>> printSQL rank
174+rank()
175+-}
176+rank :: WinFun0 ('NotNull 'PGint8)
177+rank = UnsafeWindowFunction "rank()"
178+
179+{- | number of the current row within its partition, counting from 1
180+>>> printSQL rowNumber
181+row_number()
182+-}
183+rowNumber :: WinFun0 ('NotNull 'PGint8)
184+rowNumber = UnsafeWindowFunction "row_number()"
185+
186+{- | rank of the current row without gaps; this function counts peer groups
187+>>> printSQL denseRank
188+dense_rank()
189+-}
190+denseRank :: WinFun0 ('NotNull 'PGint8)
191+denseRank = UnsafeWindowFunction "dense_rank()"
192+
193+{- | relative rank of the current row: (rank - 1) / (total partition rows - 1)
194+>>> printSQL percentRank
195+percent_rank()
196+-}
197+percentRank :: WinFun0 ('NotNull 'PGfloat8)
198+percentRank = UnsafeWindowFunction "percent_rank()"
199+
200+{- | cumulative distribution: (number of partition rows
201+preceding or peer with current row) / total partition rows
202+>>> printSQL cumeDist
203+cume_dist()
204+-}
205+cumeDist :: WinFun0 ('NotNull 'PGfloat8)
206+cumeDist = UnsafeWindowFunction "cume_dist()"
207+
208+{- | integer ranging from 1 to the argument value,
209+dividing the partition as equally as possible
210+-}
211+ntile :: WinFun1 ('NotNull 'PGint4) ('NotNull 'PGint4)
212+ntile = unsafeWindowFunction1 "ntile"
213+
214+{- | returns value evaluated at the row that is offset rows before the current
215+row within the partition; if there is no such row, instead return default
216+(which must be of the same type as value). Both offset and default are
217+evaluated with respect to the current row.
218+-}
219+lag :: WinFunN '[ty, 'NotNull 'PGint4, ty] ty
220+lag = unsafeWindowFunctionN "lag"
221+
222+{- | returns value evaluated at the row that is offset rows after the current
223+row within the partition; if there is no such row, instead return default
224+(which must be of the same type as value). Both offset and default are
225+evaluated with respect to the current row.
226+-}
227+lead :: WinFunN '[ty, 'NotNull 'PGint4, ty] ty
228+lead = unsafeWindowFunctionN "lag"
229+
230+{- | returns value evaluated at the row that is the
231+first row of the window frame
232+-}
233+firstValue :: WinFun1 ty ty
234+firstValue = unsafeWindowFunction1 "first_value"
235+
236+{- | returns value evaluated at the row that is the
237+last row of the window frame
238+-}
239+lastValue :: WinFun1 ty ty
240+lastValue = unsafeWindowFunction1 "last_value"
241+
242+{- | returns value evaluated at the row that is the nth
243+row of the window frame (counting from 1); null if no such row
244+-}
245+nthValue :: WinFunN '[null ty, 'NotNull 'PGint4] ('Null ty)
246+nthValue = unsafeWindowFunctionN "nth_value"
squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+1
@@ -64,6 +64,7 @@ import qualified GHC.Generics as GHC
6464
6565import Squeal.PostgreSQL.Alias
6666import Squeal.PostgreSQL.Expression
67+import Squeal.PostgreSQL.Expression.Logic
6768import Squeal.PostgreSQL.List
6869import Squeal.PostgreSQL.PG
6970import Squeal.PostgreSQL.Render
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+7−9
@@ -120,6 +120,7 @@ In addition to enabling `Migration`s using pure SQL `Definition`s for
120120the `up` and `down` instructions, you can also perform impure `IO` actions
121121by using a `Migration`s over the `Terminally` `PQ` `IO` category.
122122-}
123+
123124{-# LANGUAGE
124125 DataKinds
125126 , DeriveGeneric
@@ -157,7 +158,6 @@ import Data.Text (Text)
157158import Data.Time (UTCTime)
158159import Generics.SOP (K (..))
159160import Prelude hiding ((.), id)
160−import Squeal.PostgreSQL
161161import System.Environment
162162import UnliftIO (MonadIO (..))
163163
@@ -165,6 +165,8 @@ import qualified Data.Text.IO as Text (putStrLn)
165165import qualified Generics.SOP as SOP
166166import qualified GHC.Generics as GHC
167167
168+import Squeal.PostgreSQL
169+
168170-- | A `Migration` is a named "isomorphism" over a given category.
169171-- It should contain an inverse pair of `up` and `down`
170172-- instructions and a unique `name`.
@@ -353,18 +355,14 @@ createMigrations =
353355
354356-- | Inserts a `Migration` into the `MigrationsTable`, returning
355357-- the time at which it was inserted.
356−insertMigration
357− :: Manipulation_ MigrationsSchemas (Only Text) (P ("executed_at" ::: UTCTime))
358−insertMigration = insertInto #schema_migrations
358+insertMigration :: Manipulation_ MigrationsSchemas (Only Text) ()
359+insertMigration = insertInto_ #schema_migrations
359360 (Values_ ((param @1) `as` #name :* defaultAs #executed_at))
360− OnConflictDoRaise (Returning #executed_at)
361361
362362-- | Deletes a `Migration` from the `MigrationsTable`, returning
363363-- the time at which it was inserted.
364−deleteMigration
365− :: Manipulation_ MigrationsSchemas (Only Text) (P ("executed_at" ::: UTCTime))
366−deleteMigration = deleteFrom #schema_migrations
367− NoUsing (#name .== param @1) (Returning #executed_at)
364+deleteMigration :: Manipulation_ MigrationsSchemas (Only Text) ()
365+deleteMigration = deleteFrom_ #schema_migrations (#name .== param @1)
368366
369367-- | Selects a `Migration` from the `MigrationsTable`, returning
370368-- the time at which it was inserted.
squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+28−28
@@ -115,8 +115,8 @@ type instance PG Value = 'PGjson
115115Haskell enum type.
116116
117117>>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
118−>>> instance Generic Schwarma
119−>>> instance HasDatatypeInfo Schwarma
118+>>> instance SOP.Generic Schwarma
119+>>> instance SOP.HasDatatypeInfo Schwarma
120120>>> :kind! LabelsPG Schwarma
121121LabelsPG Schwarma :: [Type.ConstructorName]
122122= '["Beef", "Lamb", "Chicken"]
@@ -129,27 +129,27 @@ type family LabelsPG (hask :: Type) :: [Type.ConstructorName] where
129129`RowPG` turns a Haskell `Type` into a `RowType`.
130130
131131`RowPG` may be applied to normal Haskell record types provided they
132−have the `Generic` and `HasDatatypeInfo` instances;
132+have the `SOP.Generic` and `SOP.HasDatatypeInfo` instances;
133133
134−>>> data Person = Person { name :: Text, age :: Int32 } deriving GHC.Generic
135−>>> instance Generic Person
136−>>> instance HasDatatypeInfo Person
134+>>> data Person = Person { name :: Strict.Text, age :: Int32 } deriving GHC.Generic
135+>>> instance SOP.Generic Person
136+>>> instance SOP.HasDatatypeInfo Person
137137>>> :kind! RowPG Person
138138RowPG Person :: [(Symbol, NullityType)]
139139= '["name" ::: 'NotNull 'PGtext, "age" ::: 'NotNull 'PGint4]
140140
141−Or to tuples of `P` types;
141+Or to tuples of `SOP.P` types;
142142
143−>>> :kind! RowPG (P ("id" ::: Int32), P ("foreign_id" ::: Int32))
144−RowPG (P ("id" ::: Int32), P ("foreign_id" ::: Int32)) :: [(Symbol,
145− NullityType)]
143+>>> :kind! RowPG (SOP.P ("id" ::: Int32), SOP.P ("foreign_id" ::: Int32))
144+RowPG (SOP.P ("id" ::: Int32), SOP.P ("foreign_id" ::: Int32)) :: [(Symbol,
145+ NullityType)]
146146= '[ '("id", 'NotNull 'PGint4), "foreign_id" ::: 'NotNull 'PGint4]
147147
148−Or to tuples which mix `P` types and record types.
148+Or to tuples which mix `SOP.P` types and record types.
149149
150−>>> :kind! RowPG (P ("id" ::: Int32), Person, P ("foreign_id" ::: Int32))
151−RowPG (P ("id" ::: Int32), Person, P ("foreign_id" ::: Int32)) :: [(Symbol,
152− NullityType)]
150+>>> :kind! RowPG (SOP.P ("id" ::: Int32), Person, SOP.P ("foreign_id" ::: Int32))
151+RowPG (SOP.P ("id" ::: Int32), Person, SOP.P ("foreign_id" ::: Int32)) :: [(Symbol,
152+ NullityType)]
153153= '[ '("id", 'NotNull 'PGint4), '("name", 'NotNull 'PGtext),
154154 '("age", 'NotNull 'PGint4), "foreign_id" ::: 'NotNull 'PGint4]
155155-}
@@ -161,7 +161,7 @@ type family RowPG (hask :: Type) :: RowType where
161161 Join (RowPG hask1) (RowPG (hask2, hask3, hask4))
162162 RowPG (hask1, hask2, hask3, hask4, hask5) =
163163 Join (RowPG hask1) (RowPG (hask2, hask3, hask4, hask5))
164− RowPG (SOP.P (col ::: head)) = '[col ::: NullPG head]
164+ RowPG (SOP.P (col ::: ty)) = '[col ::: NullPG ty]
165165 RowPG hask = RowOf (SOP.RecordCodeOf hask)
166166
167167type family RowOf (record :: [(Symbol, Type)]) :: RowType where
@@ -177,29 +177,29 @@ type family ColumnsOf (record :: [(Symbol, Type)]) :: ColumnsType where
177177`Entity` turns a Haskell `Type` into a `ColumnsType`.
178178
179179`Entity` may be applied to normal Haskell record types provided they
180−have the `Generic` and `HasDatatypeInfo` instances;
180+have the `SOP.Generic` and `SOP.HasDatatypeInfo` instances;
181181
182−>>> data Person = Person { name :: Text, age :: Int32 } deriving GHC.Generic
183−>>> instance Generic Person
184−>>> instance HasDatatypeInfo Person
182+>>> data Person = Person { name :: Strict.Text, age :: Int32 } deriving GHC.Generic
183+>>> instance SOP.Generic Person
184+>>> instance SOP.HasDatatypeInfo Person
185185>>> :kind! Entity Person
186186Entity Person :: [(Symbol, (ColumnConstraint, NullityType))]
187187= '["name" ::: ('NoDef :=> 'NotNull 'PGtext),
188188 "age" ::: ('NoDef :=> 'NotNull 'PGint4)]
189189
190−Or to tuples of `P` types;
190+Or to tuples of `SOP.P` types;
191191
192−>>> :kind! Entity (P ("id" ::: Int32), P ("foreign_id" ::: Int32))
193−Entity (P ("id" ::: Int32), P ("foreign_id" ::: Int32)) :: [(Symbol,
194− ColumnType)]
192+>>> :kind! Entity (SOP.P ("id" ::: Int32), SOP.P ("foreign_id" ::: Int32))
193+Entity (SOP.P ("id" ::: Int32), SOP.P ("foreign_id" ::: Int32)) :: [(Symbol,
194+ ColumnType)]
195195= '[ '("id", 'Def :=> 'NotNull 'PGint4),
196196 "foreign_id" ::: ('Def :=> 'NotNull 'PGint4)]
197197
198−Or to tuples which mix `P` types and record types.
198+Or to tuples which mix `SOP.P` types and record types.
199199
200−>>> :kind! Entity (P ("id" ::: Int32), Person, P ("foreign_id" ::: Int32))
201−Entity (P ("id" ::: Int32), Person, P ("foreign_id" ::: Int32)) :: [(Symbol,
202− ColumnType)]
200+>>> :kind! Entity (SOP.P ("id" ::: Int32), Person, SOP.P ("foreign_id" ::: Int32))
201+Entity (SOP.P ("id" ::: Int32), Person, SOP.P ("foreign_id" ::: Int32)) :: [(Symbol,
202+ ColumnType)]
203203= '[ '("id", 'Def :=> 'NotNull 'PGint4),
204204 '("name", 'NoDef :=> 'NotNull 'PGtext),
205205 '("age", 'NoDef :=> 'NotNull 'PGint4),
@@ -213,7 +213,7 @@ type family Entity (hask :: Type) :: ColumnsType where
213213 Join (Entity hask1) (Entity (hask2, hask3, hask4))
214214 Entity (hask1, hask2, hask3, hask4, hask5) =
215215 Join (Entity hask1) (Entity (hask2, hask3, hask4, hask5))
216− Entity (SOP.P (col ::: head)) = '[col ::: 'Def :=> NullPG head]
216+ Entity (SOP.P (col ::: ty)) = '[col ::: 'Def :=> NullPG ty]
217217 Entity hask = ColumnsOf (SOP.RecordCodeOf hask)
218218
219219{- | `NullPG` turns a Haskell type into a `NullityType`.
squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+3
@@ -114,6 +114,9 @@ import qualified GHC.Generics as GHC
114114
115115import Squeal.PostgreSQL.Alias
116116import Squeal.PostgreSQL.Expression
117+import Squeal.PostgreSQL.Expression.Logic
118+import Squeal.PostgreSQL.Expression.Sort
119+import Squeal.PostgreSQL.Expression.Window
117120import Squeal.PostgreSQL.List
118121import Squeal.PostgreSQL.PG
119122import Squeal.PostgreSQL.Render
squeal-postgresql/src/Squeal/PostgreSQL/Render.hs+18−3
@@ -12,6 +12,7 @@ Rendering helper functions.
1212 AllowAmbiguousTypes
1313 , ConstraintKinds
1414 , FlexibleContexts
15+ , LambdaCase
1516 , MagicHash
1617 , OverloadedStrings
1718 , PolyKinds
@@ -22,7 +23,10 @@ Rendering helper functions.
2223
2324module Squeal.PostgreSQL.Render
2425 ( -- * Render
25− parenthesized
26+ RenderSQL (..)
27+ , printSQL
28+ , escape
29+ , parenthesized
2630 , bracketed
2731 , (<+>)
2832 , commaSeparated
@@ -34,8 +38,6 @@ module Squeal.PostgreSQL.Render
3438 , renderCommaSeparatedMaybe
3539 , renderNat
3640 , renderSymbol
37− , RenderSQL (..)
38− , printSQL
3941 ) where
4042
4143import Control.Monad.IO.Class (MonadIO (..))
@@ -128,3 +130,16 @@ class RenderSQL sql where renderSQL :: sql -> ByteString
128130-- | Print SQL.
129131printSQL :: (RenderSQL sql, MonadIO io) => sql -> io ()
130132printSQL = liftIO . Char8.putStrLn . renderSQL
133+
134+-- | `escape` a character to prevent injection
135+escape :: Char -> String
136+escape = \case
137+ '\NUL' -> "\\0"
138+ '\'' -> "''"
139+ '"' -> "\\\""
140+ '\b' -> "\\b"
141+ '\n' -> "\\n"
142+ '\r' -> "\\r"
143+ '\t' -> "\\t"
144+ '\\' -> "\\\\"
145+ c -> [c]