git.iko.soy/squeal
on dev help sign in
improve error messages and actually do exports
f8baea2Mike Ledger
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+53−11
compare with dev
unifiedsplit
@@ -26,6 +26,7 @@ Squeal expressions are the atoms used to build statements.
26 , TypeInType
26 , TypeInType
27 , TypeOperators
27 , TypeOperators
28 , UndecidableInstances
28 , UndecidableInstances
29+ , RankNTypes
29#-}
30#-}
30
31
31module Squeal.PostgreSQL.Expression
32module Squeal.PostgreSQL.Expression
@@ -84,6 +85,27 @@ module Squeal.PostgreSQL.Expression
84 , upper
85 , upper
85 , charLength
86 , charLength
86 , like
87 , like
88+ -- ** json or jsonb operators
89+ , PGarray
90+ , PGarrayOf
91+ , (.->)
92+ , (.->>)
93+ , (.#>)
94+ , (.#>>)
95+ -- *** jsonb only operators
96+ , (.@>)
97+ , (.<@)
98+ , (.?)
99+ , (.?|)
100+ , (.?&)
101+ , (.||.)
102+ , (.-.)
103+ , (#-.)
104+ -- *** Functions
105+ , toJson
106+ , toJsonb
107+ , arrayToJson
108+ , rowToJson
87 -- ** Aggregation
109 -- ** Aggregation
88 , unsafeAggregate, unsafeAggregateDistinct
110 , unsafeAggregate, unsafeAggregateDistinct
89 , sum_, sumDistinct
111 , sum_, sumDistinct
@@ -141,6 +163,7 @@ import Data.Semigroup
141import Data.Ratio
163import Data.Ratio
142import Data.String
164import Data.String
143import Generics.SOP hiding (from)
165import Generics.SOP hiding (from)
166+import GHC.Exts (Constraint)
144import GHC.OverloadedLabels
167import GHC.OverloadedLabels
145import GHC.TypeLits
168import GHC.TypeLits
146import Prelude hiding (id, (.))
169import Prelude hiding (id, (.))
@@ -882,16 +905,35 @@ see https://www.postgresql.org/docs/10/static/functions-json.html
882type IsJSONKey key = key `In` '[ 'PGint2, 'PGint4, 'PGtext ]
905type IsJSONKey key = key `In` '[ 'PGint2, 'PGint4, 'PGtext ]
883type IsJSON json = json `In` '[ 'PGjson, 'PGjsonb ]
906type IsJSON json = json `In` '[ 'PGjson, 'PGjsonb ]
884
907
885−class IsArray arr => IsArrayOf arr ty
908+type Placeholder k
886−instance arrTy ~ expectTy => IsArrayOf ('PGvararray arrTy) expectTy
909+ = 'Text "(_"
887−instance arrTy ~ expectTy => IsArrayOf ('PGfixarray n arrTy) expectTy
910+ ':<>: 'Text "::"
888−
911+ ':<>: 'ShowType k ':<>:
889−-- IsArray will generate nicer error messages when it is all that is required.
912+ 'Text ")"
890−class IsArray arr
913+
914+type ErrArrayOf arr ty = arr ':<>: 'Text " " ':<>: ty
915+type ErrPGfixarrayOf t = ErrArrayOf ('ShowType 'PGfixarray ':<>: 'Text " " ':<>: Placeholder Nat) t
916+type ErrPGvararrayOf t = ErrArrayOf ('ShowType 'PGvararray) t
917+
918+type family PGarray arr :: Constraint where
919+ PGarray ('PGvararray x) = ()
920+ PGarray ('PGfixarray n x) = ()
921+ PGarray val = TypeError
922+ ('Text "Unsatisfied PGarrayOf constraint. Expected either: "
923+ ':$$: 'Text " • " ':<>: ErrPGvararrayOf (Placeholder PGType)
924+ ':$$: 'Text " • " ':<>: ErrPGfixarrayOf (Placeholder PGType)
925+ ':$$: 'Text "But got: " ':<>: 'ShowType val)
926+
927+type family PGarrayOf arr ty :: Constraint where
891−instance IsArray ('PGvararray x)
928+ PGarrayOf ('PGvararray x) ty = x ~ ty
892−instance IsArray ('PGfixarray n x)
929+ PGarrayOf ('PGfixarray n x) ty = x ~ ty
893−
930+ PGarrayOf val ty = TypeError
931+ ('Text "Unsatisfied PGarrayOf constraint. Expected either: "
932+ ':$$: 'Text " • " ':<>: ErrPGvararrayOf ('ShowType ty)
933+ ':$$: 'Text " • " ':<>: ErrPGfixarrayOf ('ShowType ty)
934+ ':$$: 'Text "But got: " ':<>: 'ShowType val)
935+
894−type IsPGtextArray arr = IsArrayOf arr 'PGtext
936+type IsPGtextArray arr = PGarrayOf arr 'PGtext
895
937
896-- | Get JSON value (object field or array element) at a key.
938-- | Get JSON value (object field or array element) at a key.
897(.->)
939(.->)
@@ -1022,7 +1064,7 @@ toJsonb
1022toJsonb = unsafeUnaryOp "to_jsonb"
1064toJsonb = unsafeUnaryOp "to_jsonb"
1023
1065
1024arrayToJson
1066arrayToJson
1025− :: IsArray arr
1067+ :: PGarray arr
1026 => Expression schema relations grouping params (nullity arr)
1068 => Expression schema relations grouping params (nullity arr)
1027 -> Expression schema relations grouping params (nullity 'PGjson)
1069 -> Expression schema relations grouping params (nullity 'PGjson)
1028arrayToJson = unsafeFunction "array_to_json"
1070arrayToJson = unsafeFunction "array_to_json"