git.iko.soy/squeal
on dev help sign in
start documentation
commit701d5486aed4c9aeb1b1a2cfed0cc6de18adc8dc authorEitan Chatav <eitan.chatav@gmail.com> dateFri 18 Aug 2017, 01:34 (9 years ago) parent2a737b6
3 files changed+659−246
compare with dev
unifiedsplit
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+108−38 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+194−70 squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+357−138
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+108−38
@@ -1,5 +1,16 @@
1+{-|
2+Module: Squeel.PostgreSQL.Binary
3+Description: Binary encoding and decoding
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Binary encoding and decoding between Haskell and PostgreSQL types.
9+-}
10+
111{-# LANGUAGE
2− DataKinds
12+ ConstraintKinds
13+ , DataKinds
314 , DefaultSignatures
415 , DeriveFoldable
516 , DeriveFunctor
@@ -14,34 +25,62 @@
1425 , ScopedTypeVariables
1526 , TypeApplications
1627 , TypeFamilies
28+ , TypeInType
1729 , TypeOperators
1830 , UndecidableInstances
1931#-}
2032
21−module Squeal.PostgreSQL.Binary where
33+module Squeal.PostgreSQL.Binary
34+ ( -- * Encoding
35+ ToParam (..)
36+ , ToColumnParam (..)
37+ , ToParams (..)
38+ -- * Decoding
39+ , FromValue (..)
40+ , FromColumnValue (..)
41+ , FromRow (..)
42+ -- * Only
43+ , Only (..)
44+ ) where
2245
2346import Data.Aeson hiding (Null)
24−import Data.Bits
2547import Data.Int
48+import Data.Kind
2649import Data.Scientific
2750import Data.Time
28−import Data.Word
2951import Data.UUID
52+import Data.Word
3053import Generics.SOP
54+import GHC.TypeLits
3155import Network.IP.Addr
3256
3357import qualified Data.ByteString.Lazy as Lazy
3458import qualified Data.ByteString as Strict hiding (unpack)
3559import qualified Data.Text.Lazy as Lazy
3660import qualified Data.Text as Strict
37−import qualified Generics.SOP.Type.Metadata as Type
3861import qualified GHC.Generics as GHC
3962import qualified PostgreSQL.Binary.Decoding as Decoding
4063import qualified PostgreSQL.Binary.Encoding as Encoding
4164
4265import Squeal.PostgreSQL.Schema
4366
44−class ToParam x (pg :: PGType) where toParam :: x -> K Encoding.Encoding pg
67+-- | A `ToParam` constraint gives an encoding of a Haskell `Type` into
68+-- into the binary format of a PostgreSQL `PGType`.
69+class ToParam (x :: Type) (pg :: PGType) where
70+ -- | >>> toParam @Bool @'PGbool False
71+ -- K "\NUL"
72+ --
73+ -- >>> toParam @Int16 @'PGint2 0
74+ -- K "\NUL\NUL"
75+ --
76+ -- >>> toParam @Int32 @'PGint4 0
77+ -- K "\NUL\NUL\NUL\NUL"
78+ --
79+ -- >>> data Id = Id { getId :: Int16 } deriving Show
80+ -- >>> instance ToParam Id 'PGint2 where toParam = toParam . getId
81+ -- >>> toParam @Id @'PGint2 (Id 1)
82+ -- K "\NUL\SOH"
83+ toParam :: x -> K Encoding.Encoding pg
4584instance ToParam Bool 'PGbool where toParam = K . Encoding.bool
4685instance ToParam Int16 'PGint2 where toParam = K . Encoding.int2_int16
4786instance ToParam Word16 'PGint2 where toParam = K . Encoding.int2_word16
@@ -73,14 +112,34 @@ instance ToParam DiffTime 'PGinterval where toParam = K . Encoding.interval_int
73112instance ToParam Value 'PGjson where toParam = K . Encoding.json_ast
74113instance ToParam Value 'PGjsonb where toParam = K . Encoding.jsonb_ast
75114
76−class ToColumnParam x (ty :: ColumnType) where
115+-- | A `ToColumnParam` constraint lifts the `ToParam` encoding
116+-- of a `Type` to a `ColumnType`, encoding `Maybe`s to `Null`s.
117+class ToColumnParam (x :: Type) (ty :: ColumnType) where
118+ -- | >>> toColumnParam @Int16 @('Required ('NotNull 'PGint2)) 0
119+ -- K (Just "\NUL\NUL")
120+ --
121+ -- >>> toColumnParam @(Maybe Int16) @('Required ('Null 'PGint2)) (Just 0)
122+ -- K (Just "\NUL\NUL")
123+ --
124+ -- >>> toColumnParam @(Maybe Int16) @('Required ('Null 'PGint2)) Nothing
125+ -- K Nothing
77126 toColumnParam :: x -> K (Maybe Strict.ByteString) ty
78127instance ToParam x pg => ToColumnParam x (optionality ('NotNull pg)) where
79128 toColumnParam = K . Just . Encoding.encodingBytes . unK . toParam @x @pg
80129instance ToParam x pg => ToColumnParam (Maybe x) (optionality ('Null pg)) where
81130 toColumnParam = K . fmap (Encoding.encodingBytes . unK . toParam @x @pg)
82131
83−class SListI tys => ToParams x (tys :: [ColumnType]) where
132+-- | A `ToParams` constraint generically sequences the encodings of `Type`s
133+-- of the fields of a tuple or record to a row of `ColumnType`s.
134+class SListI tys => ToParams (x :: Type) (tys :: [ColumnType]) where
135+ -- | >>> type PGparams = '[ 'Required ('NotNull 'PGbool), 'Required ('Null 'PGint2)]
136+ -- >>> toParams @(Bool, Maybe Int16) @PGparams (False, Just 0)
137+ -- K (Just "\NUL") :* (K (Just "\NUL\NUL") :* Nil)
138+ --
139+ -- >>> data Hparams = Hparams { col1 :: Bool, col2 :: Maybe Int16} deriving GHC.Generic
140+ -- >>> instance SOP.Generic Hparams
141+ -- >>> toParams @Hparams @PGparams (Hparams False (Just 0))
142+ -- K (Just "\NUL") :* (K (Just "\NUL\NUL") :* Nil)
84143 toParams :: x -> NP (K (Maybe Strict.ByteString)) tys
85144instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)
86145 => ToParams x tys where
@@ -88,15 +147,15 @@ instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)
88147 = htrans (Proxy @ToColumnParam) (toColumnParam . unI)
89148 . unZ . unSOP . from
90149
91−class FromValue (pg :: PGType) y where
150+-- | A `FromValue` constraint gives a parser from the binary format of
151+-- a PostgreSQL `PGType` into a Haskell `Type`.
152+class FromValue (pg :: PGType) (y :: Type) where
153+ -- | >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue
92154 fromValue :: proxy pg -> Decoding.Value y
93155instance FromValue 'PGbool Bool where fromValue _ = Decoding.bool
94−instance (Integral int, Bits int) => FromValue 'PGint2 int where
95− fromValue _ = Decoding.int
96−instance (Integral int, Bits int) => FromValue 'PGint4 int where
97− fromValue _ = Decoding.int
98−instance (Integral int, Bits int) => FromValue 'PGint8 int where
99− fromValue _ = Decoding.int
156+instance FromValue 'PGint2 Int16 where fromValue _ = Decoding.int
157+instance FromValue 'PGint4 Int32 where fromValue _ = Decoding.int
158+instance FromValue 'PGint8 Int64 where fromValue _ = Decoding.int
100159instance FromValue 'PGfloat4 Float where fromValue _ = Decoding.float4
101160instance FromValue 'PGfloat8 Double where fromValue _ = Decoding.float8
102161instance FromValue 'PGnumeric Scientific where fromValue _ = Decoding.numeric
@@ -122,7 +181,15 @@ instance FromValue 'PGinterval DiffTime where
122181instance FromValue 'PGjson Value where fromValue _ = Decoding.json_ast
123182instance FromValue 'PGjsonb Value where fromValue _ = Decoding.jsonb_ast
124183
125−class FromColumnValue (colty :: (Symbol,ColumnType)) y where
184+-- | A `FromColumnValue` constraint lifts the `FromValue` parser
185+-- to a decoding of a `(Symbol,ColumnType)` to a `Type`,
186+-- decoding `Null`s to `Maybe`s.
187+class FromColumnValue (colty :: (Symbol,ColumnType)) (y :: Type) where
188+ -- | >>> fromColumnValue @("col" ::: 'Required ('NotNull 'PGint2)) @Id (K (Just "\NUL\SOH"))
189+ -- Id {getId = 1}
190+ --
191+ -- >>> fromColumnValue @("col" ::: 'Required ('Null 'PGint2)) @(Maybe Id) (K (Just "\NUL\SOH"))
192+ -- Just (Id {getId = 1})
126193 fromColumnValue :: K (Maybe Strict.ByteString) colty -> y
127194instance FromValue pg y
128195 => FromColumnValue (column ::: ('Required ('NotNull pg))) y where
@@ -144,32 +211,35 @@ instance FromValue pg y
144211 where
145212 err str = error $ "fromColumnValue: " ++ Strict.unpack str
146213
147−class SListI columns => FromRow (columns :: [(Symbol,ColumnType)]) y where
148− fromRow :: NP (K (Maybe Strict.ByteString)) columns -> y
214+-- | A `FromRow` constraint generically sequences the parsings of the columns
215+-- of a `ColumnsType` into the fields of a record `Type` provided they have
216+-- the same field names.
217+class SListI results => FromRow (results :: ColumnsType) y where
218+ -- | >>> data Hrow = Hrow { userId :: Id, userName :: Maybe Text } deriving (Show, GHC.Generic)
219+ -- >>> instance SOP.Generic Hrow
220+ -- >>> instance SOP.HasDatatypeInfo Hrow
221+ -- >>> type PGrow = '["userId" ::: 'Required ('NotNull 'PGint2), "userName" ::: 'Required ('Null 'PGtext)]
222+ -- >>> fromRow @PGrow @Hrow (K (Just "\NUL\SOH") :* K (Just "bloodninja") :* Nil)
223+ -- Hrow {userId = Id {getId = 1}, userName = Just "bloodninja"}
224+ fromRow :: NP (K (Maybe Strict.ByteString)) results -> y
149225instance
150− ( SListI columns, IsProductType y ys
151− , AllZip FromColumnValue columns ys
152− , HasDatatypeInfo y
153− , SameFields (DatatypeInfoOf y) columns
154− ) => FromRow columns y where
226+ ( SListI results
227+ , IsProductType y ys
228+ , AllZip FromColumnValue results ys
229+ , SameFields (DatatypeInfoOf y) results
230+ ) => FromRow results y where
155231 fromRow
156232 = to . SOP . Z . htrans (Proxy @FromColumnValue) (I . fromColumnValue)
157233
158−class SameField
159− (fieldInfo :: Type.FieldInfo) (columnty :: (Symbol,ColumnType)) where
160−instance field ~ column => SameField ('Type.FieldInfo field) (column ::: ty)
161−
162−type family SameFields
163− (datatypeInfo :: Type.DatatypeInfo) (columns :: [(Symbol,ColumnType)]) where
164− SameFields
165− ('Type.ADT _module _datatype '[ 'Type.Record _constructor fields])
166− columns
167− = AllZip SameField fields columns
168− SameFields
169− ('Type.Newtype _module _datatype ('Type.Record _constructor '[field]))
170− '[column]
171− = SameField field column
172−
234+-- | `Only` is a 1-tuple type, useful for encoding a single parameter with
235+-- `toParams` or decoding a single value with `fromRow`.
236+--
237+-- >>> toParams @(Only (Maybe Text)) @'[ 'Required ('Null 'PGtext)] (Only (Just "foo"))
238+-- K (Just "foo") :* Nil
239+--
240+-- >>> type PGShortRow = '["only" ::: 'Required ('Null 'PGtext)]
241+-- >>> fromRow @PGShortRow @(Only (Maybe Text)) (K (Just "bar") :* Nil)
242+-- Only {only = Just "bar"}
173243newtype Only x = Only { only :: x }
174244 deriving (Functor,Foldable,Traversable,Eq,Ord,Read,Show,GHC.Generic)
175245instance Generic (Only x)
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+194−70
@@ -1,5 +1,16 @@
1+{-|
2+Module: Squeel.PostgreSQL.Schema
3+Description: Embedding of PostgreSQL type and alias system
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Embedding of PostgreSQL type and alias system
9+-}
10+
111{-# LANGUAGE
2− DataKinds
12+ ConstraintKinds
13+ , DataKinds
314 , DeriveAnyClass
415 , DeriveDataTypeable
516 , DeriveGeneric
@@ -15,37 +26,48 @@
1526 , StandaloneDeriving
1627 , TypeApplications
1728 , TypeFamilies
29+ , TypeInType
1830 , TypeOperators
1931#-}
2032
2133module Squeal.PostgreSQL.Schema
22− ( PGType (..)
23− , PGNum (..)
34+ ( -- * Kinds
35+ PGType (..)
36+ , NullityType (..)
37+ , ColumnType (..)
38+ , ColumnsType
39+ , TablesType
40+ , Grouping (..)
41+ -- * Constraints
42+ , PGNum
2443 , PGIntegral
2544 , PGFloating
45+ -- * Aliases
2646 , (:::)
2747 , Alias (Alias)
2848 , renderAlias
2949 , Aliased (As)
3050 , renderAliased
51+ , IsLabel (..)
3152 , IsTableColumn (..)
32− , NullityType (..)
33− , ColumnType (..)
34− , Grouping (..)
53+ -- * Type Families
54+ , In
55+ , HasUnique
56+ , BaseType
3557 , SameTypes
3658 , AllNotNull
3759 , NotAllNull
3860 , NullifyType
3961 , NullifyColumns
4062 , NullifyTables
41− , BaseType
63+ , Join
4264 , Create
4365 , Drop
4466 , Alter
4567 , Rename
46− , Join
47− , module GHC.OverloadedLabels
48− , module GHC.TypeLits
68+ -- * Generics
69+ , SameField
70+ , SameFields
4971 ) where
5072
5173import Control.DeepSeq
@@ -53,64 +75,110 @@ import Data.ByteString
5375import Data.Data (Data)
5476import Data.Monoid
5577import Data.String
78+import Generics.SOP (AllZip)
5679import GHC.Generics (Generic)
5780import GHC.Exts
5881import GHC.OverloadedLabels
5982import GHC.TypeLits
6083
84+import qualified Generics.SOP.Type.Metadata as Type
85+
86+-- | `PGType` is the promoted datakind of PostgreSQL types.
6187data PGType
62− = PGbool
63− | PGint2
64− | PGint4
65− | PGint8
66− | PGnumeric
67− | PGfloat4
68− | PGfloat8
69− | PGchar Nat
70− | PGvarchar Nat
71− | PGtext
72− | PGbytea
73− | PGtimestamp
74− | PGtimestamptz
75− | PGdate
76− | PGtime
77− | PGtimetz
78− | PGinterval
79− | PGuuid
80− | PGinet
81− | PGjson
82− | PGjsonb
83−
84−class PGNum (ty :: PGType) where
85− decimal :: proxy ty -> Bool
86−instance PGNum 'PGint2 where decimal _ = False
87−instance PGNum 'PGint4 where decimal _ = False
88−instance PGNum 'PGint8 where decimal _ = False
89−instance PGNum 'PGnumeric where decimal _ = True
90−instance PGNum 'PGfloat4 where decimal _ = True
91−instance PGNum 'PGfloat8 where decimal _ = True
92−
93−class PGNum ty => PGIntegral (ty :: PGType) where
94−instance PGIntegral 'PGint2
95−instance PGIntegral 'PGint4
96−instance PGIntegral 'PGint8
97−
98−class PGNum ty => PGFloating (ty :: PGType) where
99−instance PGFloating 'PGnumeric
100−instance PGFloating 'PGfloat4
101−instance PGFloating 'PGfloat8
88+ = PGbool -- ^ logical Boolean (true/false)
89+ | PGint2 -- ^ signed two-byte integer
90+ | PGint4 -- ^ signed four-byte integer
91+ | PGint8 -- ^ signed eight-byte integer
92+ | PGnumeric -- ^ arbitrary precision numeric type
93+ | PGfloat4 -- ^ single precision floating-point number (4 bytes)
94+ | PGfloat8 -- ^ double precision floating-point number (8 bytes)
95+ | PGchar Nat -- ^ fixed-length character string
96+ | PGvarchar Nat -- ^ variable-length character string
97+ | PGtext -- ^ variable-length character string
98+ | PGbytea -- ^ binary data ("byte array")
99+ | PGtimestamp -- ^ date and time (no time zone)
100+ | PGtimestamptz -- ^ date and time, including time zone
101+ | PGdate -- ^ calendar date (year, month, day)
102+ | PGtime -- ^ time of day (no time zone)
103+ | PGtimetz -- ^ time of day, including time zone
104+ | PGinterval -- ^ time span
105+ | PGuuid -- ^ universally unique identifier
106+ | PGinet -- ^ IPv4 or IPv6 host address
107+ | PGjson -- ^ textual JSON data
108+ | PGjsonb -- ^ binary JSON data, decomposed
109+
110+-- | `NullityType` encodes the potential presence or definite absence of a
111+-- @NULL@ allowing operations which are sensitive to such to be well typed.
112+data NullityType
113+ = Null PGType -- ^ @NULL@ may be present
114+ | NotNull PGType -- ^ @NULL@ is absent
115+
116+-- | `ColumnType` encodes the allowance of @DEFAULT@ and the only way
117+-- to generate an `Optional` `Squeel.PostgreSQL.Statement.Expression`
118+-- is to use `Squeel.PostgreSQL.Statement.def`
119+-- or `Squeel.PostgreSQL.Statement.unDef`.
120+data ColumnType
121+ = Optional NullityType
122+ -- ^ @DEFAULT@ is an allowed `Squeel.PostgreSQL.Statement.Expression`
123+ | Required NullityType
124+ -- ^ @DEFAULT@ is not allowed
125+
126+-- | `ColumnsType` is a kind synonym for a row of `ColumnType`s.
127+type ColumnsType = [(Symbol,ColumnType)]
128+
129+-- | `TablesType` is a kind synonym for a row of `ColumnsType`s.
130+-- It is used as a kind for both a schema, a disjoint union of tables,
131+-- and a joined table @FROM@ clause, a product of tables.
132+type TablesType = [(Symbol,ColumnsType)]
133+
134+-- | `Grouping` is an auxiliary namespace, created by
135+-- @GROUP BY@ clauses (`Squeel.PostgreSQL.Statement.group`), and used by
136+-- for typesafe aggregation
137+data Grouping
138+ = Ungrouped
139+ | Grouped [(Symbol,Symbol)]
102140
141+-- | `PGNum` is a constraint on `PGType` whose
142+-- `Squeel.PostgreSQL.Statement.Expression`s have a `Num` constraint.
143+type PGNum ty =
144+ In ty '[ 'PGint2, 'PGint4, 'PGint8, 'PGnumeric, 'PGfloat4, 'PGfloat8]
145+
146+-- | `PGFloating` is a constraint on `PGType` whose
147+-- `Squeel.PostgreSQL.Statement.Expression`s
148+-- have `Fractional` and `Floating` constraints.
149+type PGFloating ty = In ty '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]
150+
151+-- | `PGIntegral` is a constraint on `PGType` whose
152+-- `Squeel.PostgreSQL.Statement.Expression`s
153+-- have `Squeel.PostgreSQL.Statement.div_` and
154+-- `Squeel.PostgreSQL.Statement.mod_` functions.
155+type PGIntegral ty = In ty '[ 'PGint2, 'PGint4, 'PGint8]
156+
157+-- | `:::` is the promoted version of `As`, a type level pair between
158+-- an alias and some type, usually a column alias and a `ColumnType` or
159+-- a table alias and a `ColumnsType`.
103160type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)
104161
162+-- | `Alias`es are proxies for a type level string or `Symbol`
163+-- and have an `IsLabel` instance so that with @-XOverloadedLabels@
164+--
165+-- >>> #foobar :: Alias "foobar"
166+-- Alias
105167data Alias (alias :: Symbol) = Alias
106168 deriving (Eq,Generic,Data,Ord,Show,NFData)
169+instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where
170+ fromLabel = Alias
107171
172+-- | >>> renderAlias #alias
173+-- "alias"
108174renderAlias :: KnownSymbol alias => Alias alias -> ByteString
109175renderAlias = fromString . symbolVal
110176
111−instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where
112− fromLabel = Alias
113−
177+-- | The `As` operator is used to name an expression. `As` is the demoted
178+-- version of `:::`.
179+--
180+-- >>> Just "hello" `As` #hi :: Aliased Maybe ("hi" ::: String)
181+-- As (Just "hello") Alias
114182data Aliased expression aliased where
115183 As
116184 :: KnownSymbol alias
@@ -124,6 +192,9 @@ deriving instance Eq (expression ty)
124192deriving instance Ord (expression ty)
125193 => Ord (Aliased expression (alias ::: ty))
126194
195+-- | >>> let renderMaybe = fromString . maybe "Nothing" (const "Just")
196+-- >>> renderAliased renderMaybe (Just (3::Int) `As` #an_int)
197+-- "Just AS an_int"
127198renderAliased
128199 :: (forall ty. expression ty -> ByteString)
129200 -> Aliased expression aliased
@@ -131,67 +202,120 @@ renderAliased
131202renderAliased render (expression `As` alias) =
132203 render expression <> " AS " <> renderAlias alias
133204
205+-- | Analagous to `IsLabel`, the constraint
206+-- `IsTableColumn` defines `!` for a column alias qualified
207+-- by a table alias.
134208class IsTableColumn table column expression where
135209 (!) :: Alias table -> Alias column -> expression
136210 infixl 9 !
137211instance IsTableColumn table column (Alias table, Alias column) where (!) = (,)
138212
139−data NullityType = Null PGType | NotNull PGType
213+-- | `In x xs` is a constraint that proves that `x` is in `xs.
214+type family In x xs :: Constraint where
215+ In x (x ': xs) = ()
216+ In x (y ': xs) = In x xs
140217
141−data ColumnType = Optional NullityType | Required NullityType
142−
143−data Grouping
144− = Ungrouped
145− | Grouped [(Symbol,Symbol)]
218+-- | `HasUnique alias xs x` is a constraint that proves that xs is a singleton
219+-- of `alias ::: x`.
220+type HasUnique alias xs x = xs ~ '[alias ::: x]
146221
147−type family BaseType (ty :: ColumnType) where
222+-- | `BaseType` forgets about @NULL@ and @DEFAULT@
223+type family BaseType (ty :: ColumnType) :: PGType where
148224 BaseType (optionality (nullity pg)) = pg
149225
150−type family SameTypes columns0 columns1 :: Constraint where
226+-- | `SameTypes` is a constraint that proves two `ColumnsType`s have the same
227+-- length and the same `ColumnType`s.
228+type family SameTypes
229+ (columns0 :: ColumnsType) (columns1 :: ColumnsType)
230+ :: Constraint where
151231 SameTypes '[] '[] = ()
152232 SameTypes ((column0 ::: ty0) ': columns0) ((column1 ::: ty1) ': columns1)
153233 = (ty0 ~ ty1, SameTypes columns0 columns1)
154234
155−type family AllNotNull columns :: Constraint where
235+-- | `AllNotNull` is a constraint that proves a `ColumnsType` has no @NULL@s.
236+type family AllNotNull (columns :: ColumnsType) :: Constraint where
156237 AllNotNull '[] = ()
157238 AllNotNull ((column ::: (optionality ('NotNull ty))) ': columns)
158239 = AllNotNull columns
159240
241+-- | `NotAllNull` is a constraint that proves a `ColumnsType` has some
242+-- @NOT NULL@.
160243type family NotAllNull columns :: Constraint where
161244 NotAllNull ((column ::: (optionality ('NotNull ty))) ': columns) = ()
162245 NotAllNull ((column ::: (optionality ('Null ty))) ': columns)
163246 = NotAllNull columns
164247
165−type family NullifyType (ty :: ColumnType) where
248+-- | `NullifyType` is an idempotent that nullifies a `ColumnType`.
249+type family NullifyType (ty :: ColumnType) :: ColumnType where
166250 NullifyType (optionality ('Null ty)) = optionality ('Null ty)
167251 NullifyType (optionality ('NotNull ty)) = optionality ('Null ty)
168252
169−type family NullifyColumns columns where
253+-- | `NullifyColumns` is an idempotent that nullifies a `ColumnsType`.
254+type family NullifyColumns (columns :: ColumnsType) :: ColumnsType where
170255 NullifyColumns '[] = '[]
171256 NullifyColumns ((column ::: ty) ': columns) =
172257 (column ::: NullifyType ty) ': NullifyColumns columns
173258
174−type family NullifyTables tables where
259+-- | `NullifyTables` is an idempotent that nullifies a `TablesType`
260+-- used to nullify the left or right hand side of an outer join
261+-- in a `Squeel.PostgreSQL.Statement.FromClause`
262+type family NullifyTables (tables :: TablesType) :: TablesType where
175263 NullifyTables '[] = '[]
176− NullifyTables ((column ::: ty) ': columns) =
177− (column ::: NullifyColumns ty) ': NullifyTables columns
264+ NullifyTables ((table ::: columns) ': tables) =
265+ (table ::: NullifyColumns columns) ': NullifyTables tables
266+
267+-- | `Join` is simply promoted `++` and is used in @JOIN@s in
268+-- `Squeel.PostgreSQL.Statement.FromClause`s.
269+type family Join xs ys where
270+ Join '[] ys = ys
271+ Join (x ': xs) ys = x ': Join xs ys
178272
273+-- | `Create alias x xs` adds `alias ::: x` to the end of `xs` and is used in
274+-- `Squeel.PostgreSQL.Statement.createTable` statements and in @ALTER TABLE@
275+-- `Squeel.PostgreSQL.Statement.addColumnDefault` and
276+-- `Squeel.PostgreSQL.Statement.addColumnNull` statements
179277type family Create alias x xs where
180278 Create alias x '[] = '[alias ::: x]
181279 Create alias y (x ': xs) = x ': Create alias y xs
182280
281+-- | `Drop alias xs` removes the type associated with `alias` in `xs`
282+-- and is used in `Squeel.PostgreSQL.Statement.dropTable` statements
283+-- and in @ALTER TABLE@ `Squeel.PostgreSQL.Statement.dropColumn` statements
183284type family Drop alias xs where
184285 Drop alias ((alias ::: x) ': xs) = xs
185286 Drop alias (x ': xs) = x ': Drop alias xs
186287
288+-- | `Alter alias xs x` replaces the type associated with an `alias` in `xs`
289+-- with the type `x` and is used in `Squeel.PostgreSQL.Statement.alterTable`
290+-- and `Squeel.PostgreSQL.Statement.alterColumn`.
187291type family Alter alias xs x where
188292 Alter alias ((alias ::: x0) ': xs) x1 = (alias ::: x1) ': xs
189293 Alter alias (x0 ': xs) x1 = x0 ': Alter alias xs x1
190294
295+-- | `Rename alias0 alias1 xs` replaces the alias `alias0` by `alias1` in `xs`
296+-- and is used in `Squeel.PostgreSQL.Statement.alterTableRename` and
297+-- `Squeel.PostgreSQL.Statement.renameColumn`
191298type family Rename alias0 alias1 xs where
192299 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs
193300 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs
194301
195−type family Join xs ys where
196− Join '[] ys = ys
197− Join (x ': xs) ys = x ': Join xs ys
302+-- | A `SameField` constraint is an equality constraint on a
303+-- `Generics.SOP.Type.Metadata.FieldInfo` and the column alias in a `:::` pair.
304+class SameField
305+ (fieldInfo :: Type.FieldInfo) (fieldty :: (Symbol,ColumnType)) where
306+instance field ~ column => SameField ('Type.FieldInfo field) (column ::: ty)
307+
308+-- | A `SameFields` constraint proves that a
309+-- `Generics.SOP.Type.Metadata.DatatypeInfo` of a record type has the same
310+-- field names as the column aliases of a `ColumnsType`.
311+type family SameFields
312+ (datatypeInfo :: Type.DatatypeInfo) (columns :: ColumnsType)
313+ :: Constraint where
314+ SameFields
315+ ('Type.ADT _module _datatype '[ 'Type.Record _constructor fields])
316+ columns
317+ = AllZip SameField fields columns
318+ SameFields
319+ ('Type.Newtype _module _datatype ('Type.Record _constructor fields))
320+ columns
321+ = AllZip SameField fields columns
squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+357−138
@@ -17,11 +17,205 @@
1717 , StandaloneDeriving
1818 , TypeApplications
1919 , TypeFamilies
20+ , TypeInType
2021 , TypeOperators
2122 , UndecidableInstances
2223#-}
2324
24−module Squeal.PostgreSQL.Statement where
25+module Squeal.PostgreSQL.Statement
26+ ( -- * Column Expressions
27+ Expression (UnsafeExpression, renderExpression)
28+ , HasParameter (param)
29+ , HasColumn (getColumn)
30+ , Column (Column)
31+ , renderColumn
32+ -- ** Default
33+ , def
34+ , unDef
35+ -- ** Null
36+ , null_
37+ , unNull
38+ , coalesce
39+ , fromNull
40+ , isNull
41+ , isn'tNull
42+ , matchNull
43+ , nullIf
44+ -- ** Functions
45+ , unsafeBinaryOp
46+ , unsafeUnaryOp
47+ , unsafeFunction
48+ , atan2_
49+ , cast
50+ , div_
51+ , mod_
52+ , trunc
53+ , round_
54+ , ceiling_
55+ , greatest
56+ , least
57+ -- ** Conditions
58+ , Condition
59+ , true
60+ , false
61+ , not_
62+ , (&&*)
63+ , (||*)
64+ , caseWhenThenElse
65+ , ifThenElse
66+ , (==*)
67+ , (/=*)
68+ , (>=*)
69+ , (*<)
70+ , (*<=)
71+ , (>*)
72+ -- ** Time
73+ , currentDate
74+ , currentTime
75+ , currentTimestamp
76+ , localTime
77+ , localTimestamp
78+ -- ** Aggregation
79+ , unsafeAggregate
80+ , unsafeAggregateDistinct
81+ , sum_
82+ , sumDistinct
83+ , PGAvg (avg, avgDistinct)
84+ , bitAnd
85+ , bitOr
86+ , boolAnd
87+ , boolOr
88+ , countStar
89+ , countDistinctStar
90+ , count
91+ , every
92+ , jsonAgg
93+ , jsonbAgg
94+ , jsonObjectAgg
95+ , jsonbObjectAgg
96+ , max_
97+ , min_
98+ -- * Tables
99+ , Table (UnsafeTable, renderTable)
100+ , HasTable (getTable)
101+ -- ** Froms and Joins
102+ , FromClause (..)
103+ , renderFromClause
104+ -- ** Table Expressions
105+ , TableExpression (..)
106+ , renderTableExpression
107+ , from
108+ , where_
109+ , group
110+ , having
111+ , orderBy
112+ , limit
113+ , offset
114+ , By (By, By2)
115+ , renderBy
116+ , GroupByClause (NoGroups, Group)
117+ , renderGroupByClause
118+ , HavingClause (NoHaving, Having)
119+ , renderHavingClause
120+ , GroupedBy (getGroup1, getGroup2)
121+ , SortExpression (..)
122+ , renderSortExpression
123+ -- * TypeExpression
124+ , TypeExpression (UnsafeTypeExpression, renderTypeExpression)
125+ , PGTyped (pgtype)
126+ , bool
127+ , int2
128+ , smallint
129+ , int4
130+ , int
131+ , integer
132+ , int8
133+ , bigint
134+ , numeric
135+ , float4
136+ , real
137+ , float8
138+ , doublePrecision
139+ , serial2
140+ , smallserial
141+ , serial4
142+ , serial
143+ , serial8
144+ , bigserial
145+ , text
146+ , char
147+ , character
148+ , varchar
149+ , characterVarying
150+ , bytea
151+ , timestamp
152+ , timestampWithTimeZone
153+ , date
154+ , time
155+ , timeWithTimeZone
156+ , interval
157+ , uuid
158+ , json
159+ , jsonb
160+ , notNull
161+ , default_
162+ -- * Statements
163+ -- ** Queries
164+ , Query (UnsafeQuery, renderQuery)
165+ , select
166+ , selectDistinct
167+ , selectStar
168+ , selectDistinctStar
169+ , selectDotStar
170+ , selectDistinctDotStar
171+ , union
172+ , unionAll
173+ , intersect
174+ , intersectAll
175+ , except
176+ , exceptAll
177+ -- ** Data Definition Language
178+ , Definition (UnsafeDefinition, renderDefinition)
179+ , createTable
180+ , TableConstraint (UnsafeTableConstraint, renderTableConstraint)
181+ , check
182+ , unique
183+ , primaryKey
184+ , foreignKey
185+ , OnDelete (OnDeleteNoAction, OnDeleteRestrict, OnDeleteCascade)
186+ , renderOnDelete
187+ , OnUpdate (OnUpdateNoAction, OnUpdateRestrict, OnUpdateCascade)
188+ , renderOnUpdate
189+ , dropTable
190+ , alterTable
191+ , alterTableRename
192+ , AlterTable (UnsafeAlterTable, renderAlterTable)
193+ , addColumnDefault
194+ , addColumnNull
195+ , dropColumn
196+ , renameColumn
197+ , alterColumn
198+ , AlterColumn (UnsafeAlterColumn, renderAlterColumn)
199+ , setDefault
200+ , dropDefault
201+ , setNotNull
202+ , dropNotNull
203+ , alterType
204+ -- ** Data Manipulation Language
205+ , Manipulation (UnsafeManipulation, renderManipulation)
206+ , queryStatement
207+ , insertInto
208+ , ValuesClause (Values, ValuesQuery)
209+ , renderValuesClause
210+ , ReturningClause (ReturningStar, Returning)
211+ , renderReturningClause
212+ , ConflictClause (Conflict, OnConflictDoNothing, OnConflictDoUpdate)
213+ , renderConflictClause
214+ , UpdateExpression (Same, Set)
215+ , renderUpdateExpression
216+ , update
217+ , deleteFrom
218+ ) where
25219
26220import Control.Category
27221import Control.DeepSeq
@@ -33,11 +227,11 @@ import Data.Monoid hiding (All)
33227import Data.Ratio
34228import Data.String
35229import Data.Word
36−import Generics.SOP
230+import Generics.SOP hiding (from)
37231import GHC.Exts
38232import GHC.OverloadedLabels
39233import GHC.TypeLits
40−import Prelude hiding (RealFrac(..), id, (.))
234+import Prelude hiding (id, (.))
41235
42236import qualified GHC.Generics as GHC
43237import qualified Data.ByteString as ByteString
@@ -48,14 +242,31 @@ import Squeal.PostgreSQL.Schema
48242column expressions
49243-----------------------------------------}
50244
245+{- | `Expression`s are used in a variety of contexts,
246+such as in the target list of the `select` command,
247+as new column values in `insertInto` or `update`,
248+or in search `Condition`s in a number of commands.
249+
250+The expression syntax allows the calculation of
251+values from primitive expression using arithmetic, logical,
252+and other operations.
253+-}
51254newtype Expression
52255 (params :: [ColumnType])
53− (tables :: [(Symbol,[(Symbol,ColumnType)])])
256+ (tables :: TablesType)
54257 (grouping :: Grouping)
55258 (ty :: ColumnType)
56259 = UnsafeExpression { renderExpression :: ByteString }
57260 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
58261
262+{- | A `HasParameter` constraint is used to indicate a value that is
263+supplied externally to a SQL statement.
264+`Squeal.PostgreSQL.PQ.manipulateParams`,
265+`Squeal.PostgreSQL.PQ.queryParams` and
266+`Squeal.PostgreSQL.PQ.traversePrepared` support specifying data values
267+separately from the SQL command string, in which case `param`s are used to
268+refer to the out-of-line data values.
269+-}
59270class (PGTyped (BaseType ty), KnownNat n)
60271 => HasParameter (n :: Nat) params ty | n params -> ty where
61272 param :: proxy n -> Expression params tables grouping ty
@@ -67,18 +278,25 @@ instance {-# OVERLAPPING #-} PGTyped (BaseType ty1)
67278instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)
68279 => HasParameter n (ty' : params) ty
69280
281+{- | A `HasColumn` constraint indicates an unqualified column reference.
282+`getColumn` can only be unambiguous when the `TableExpression` the column
283+references is unique, in which case the column may be referenced using
284+@-XOverloadedLabels@. Otherwise, combined with a `HasTable` constraint, the
285+qualified column reference operator `!` may be used.
286+-}
70287class KnownSymbol column => HasColumn column columns ty
71288 | column columns -> ty where
72289 getColumn
73− :: Alias column
74− -> Expression params '[table ::: columns] 'Ungrouped ty
290+ :: HasUnique table tables columns
291+ => Alias column
292+ -> Expression params tables 'Ungrouped ty
75293 getColumn column = UnsafeExpression $ renderAlias column
76294instance {-# OVERLAPPING #-} KnownSymbol column
77295 => HasColumn column ((column ::: optionality ty) ': tys) ('Required ty)
78296instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)
79297 => HasColumn column (ty' ': table) ty
80298
81−instance (HasColumn column columns ty, tables ~ '[table ::: columns])
299+instance (HasColumn column columns ty, HasUnique table tables columns)
82300 => IsLabel column (Expression params tables 'Ungrouped ty) where
83301 fromLabel = getColumn (Alias @column)
84302
@@ -88,7 +306,7 @@ instance (HasTable table tables columns, HasColumn column columns ty)
88306 renderAlias table <> "." <> renderAlias column
89307
90308data Column
91− (columns :: [(Symbol,ColumnType)])
309+ (columns :: ColumnsType)
92310 (columnty :: (Symbol,ColumnType))
93311 where
94312 Column
@@ -99,22 +317,38 @@ deriving instance Show (Column columns columnty)
99317deriving instance Eq (Column columns columnty)
100318deriving instance Ord (Column columns columnty)
101319
320+-- | >>> renderExpression def
321+-- "DEFAULT"
102322def :: Expression params '[] 'Ungrouped ('Optional (nullity ty))
103323def = UnsafeExpression "DEFAULT"
104324
325+-- | >>> renderExpression $ unDef false
326+-- "FALSE"
105327unDef
106328 :: Expression params '[] 'Ungrouped ('Required (nullity ty))
107329 -> Expression params '[] 'Ungrouped ('Optional (nullity ty))
108330unDef = UnsafeExpression . renderExpression
109331
110−null :: Expression params tables grouping (optionality ('Null ty))
111−null = UnsafeExpression "NULL"
112−
332+-- | analagous to `Nothing`
333+--
334+-- >>> renderExpression $ null_
335+-- "NULL"
336+null_ :: Expression params tables grouping (optionality ('Null ty))
337+null_ = UnsafeExpression "NULL"
338+
339+-- | analagous to `Just`
340+--
341+-- >>> renderExpression $ unNull true
342+-- "TRUE"
113343unNull
114344 :: Expression params tables grouping (optionality ('NotNull ty))
115345 -> Expression params tables grouping (optionality ('Null ty))
116346unNull = UnsafeExpression . renderExpression
117347
348+-- | return the leftmost value which is not NULL
349+--
350+-- >>> renderExpression $ coalesce [null_, unNull true] false
351+-- "COALESCE(NULL, TRUE, FALSE)"
118352coalesce
119353 :: [Expression params tables grouping ('Required ('Null ty))]
120354 -> Expression params tables grouping ('Required ('NotNull ty))
@@ -123,22 +357,34 @@ coalesce nullxs notNullx = UnsafeExpression $
123357 "COALESCE" <> parenthesized (commaSeparated
124358 ((renderExpression <$> nullxs) <> [renderExpression notNullx]))
125359
360+-- | analagous to `fromMaybe` using @COALESCE@
361+--
362+-- >>> renderExpression $ fromNull true null_
363+-- "COALESCE(NULL, TRUE)"
126364fromNull
127365 :: Expression params tables grouping ('Required ('NotNull ty))
128366 -> Expression params tables grouping ('Required ('Null ty))
129367 -> Expression params tables grouping ('Required ('NotNull ty))
130368fromNull notNullx nullx = coalesce [nullx] notNullx
131369
370+-- | >>> renderExpression $ null_ & isNull
371+-- "NULL IS NULL"
132372isNull
133373 :: Expression params tables grouping ('Required ('Null ty))
134374 -> Condition params tables grouping
135375isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"
136376
377+-- | >>> renderExpression $ null_ & isn'tNull
378+-- "NULL IS NOT NULL"
137379isn'tNull
138380 :: Expression params tables grouping ('Required ('Null ty))
139381 -> Condition params tables grouping
140382isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"
141383
384+-- | analagous to `maybe` using @IS NULL@
385+--
386+-- >>> renderExpression $ matchNull true not null_
387+-- "CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT TRUE) END"
142388matchNull
143389 :: Expression params tables grouping ('Required nullty)
144390 -> ( Expression params tables grouping ('Required ('NotNull ty))
@@ -148,24 +394,34 @@ matchNull
148394matchNull y f x = ifThenElse (isNull x) y
149395 (f (UnsafeExpression (renderExpression y)))
150396
397+-- | left inverse to `fromNull`
398+--
399+-- >>> renderExpression $ nullIf false (fromNull false null_)
400+-- "NULL IF (FALSE, COALESCE(NULL, FALSE))"
151401nullIf
152402 :: Expression params tables grouping ('Required ('NotNull ty))
153403 -> Expression params tables grouping ('Required ('NotNull ty))
154404 -> Expression params tables grouping ('Required ('Null ty))
155−nullIf x y = UnsafeExpression $ parenthesized $
156− renderExpression x <> ", " <> renderExpression y
405+nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized
406+ (renderExpression x <> ", " <> renderExpression y)
157407
408+-- | >>> renderExpression $ greatest @'[_] currentTimestamp [param (Proxy @1)]
409+-- "GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))"
158410greatest
159− :: [Expression params tables grouping ('Required nullty)]
411+ :: Expression params tables grouping ('Required nullty)
412+ -> [Expression params tables grouping ('Required nullty)]
160413 -> Expression params table grouping ('Required nullty)
161−greatest xs = UnsafeExpression $ "GREATEST("
162− <> commaSeparated (renderExpression <$> xs) <> ")"
414+greatest x xs = UnsafeExpression $ "GREATEST("
415+ <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
163416
417+-- | >>> renderExpression $ least currentTimestamp [null_]
418+-- "LEAST(CURRENT_TIMESTAMP, NULL)"
164419least
165− :: [Expression params tables grouping ('Required nullty)]
420+ :: Expression params tables grouping ('Required nullty)
421+ -> [Expression params tables grouping ('Required nullty)]
166422 -> Expression params table grouping ('Required nullty)
167−least xs = UnsafeExpression $ "LEAST("
168− <> commaSeparated (renderExpression <$> xs) <> ")"
423+least x xs = UnsafeExpression $ "LEAST("
424+ <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
169425
170426unsafeBinaryOp
171427 :: ByteString
@@ -198,16 +454,15 @@ instance PGNum ty
198454 signum = unsafeFunction "sign"
199455 fromInteger
200456 = UnsafeExpression
201− . (<> if decimal (Proxy :: Proxy ty) then "." else "")
202457 . fromString
203458 . show
204459
205−instance PGFloating ty => Fractional
460+instance (PGNum ty, PGFloating ty) => Fractional
206461 (Expression params tables grouping ('Required (nullity ty))) where
207462 (/) = unsafeBinaryOp "/"
208463 fromRational x = fromInteger (numerator x) / fromInteger (denominator x)
209464
210−instance (PGFloating ty, PGTyped ty) => Floating
465+instance (PGNum ty, PGFloating ty) => Floating
211466 (Expression params tables grouping ('Required (nullity ty))) where
212467 pi = UnsafeExpression "pi()"
213468 exp = unsafeFunction "exp"
@@ -215,19 +470,7 @@ instance (PGFloating ty, PGTyped ty) => Floating
215470 sqrt = unsafeFunction "sqrt"
216471 b ** x = UnsafeExpression $
217472 "power(" <> renderExpression b <> ", " <> renderExpression x <> ")"
218− logBase b y = cast pgtype $ logBaseNumeric b y
219− where
220− logBaseNumeric
221− :: Expression params tables grouping ('Required (nullity ty))
222− -> Expression params tables grouping ('Required (nullity ty))
223− -> Expression params tables grouping ('Required (nullity 'PGnumeric))
224− logBaseNumeric b' y' = UnsafeExpression $ mconcat
225− [ "log("
226− , renderExpression (cast numeric b')
227− , ", "
228− , renderExpression (cast numeric y')
229− , ")"
230− ]
473+ logBase b y = log y / log b
231474 sin = unsafeFunction "sin"
232475 cos = unsafeFunction "cos"
233476 tan = unsafeFunction "tan"
@@ -241,12 +484,12 @@ instance (PGFloating ty, PGTyped ty) => Floating
241484 acosh x = log (x + sqrt (x*x - 1))
242485 atanh x = log ((1 + x) / (1 - x)) / 2
243486
244−atan2
487+atan2_
245488 :: PGFloating float
246489 => Expression params tables grouping ('Required (nullity float))
247490 -> Expression params tables grouping ('Required (nullity float))
248491 -> Expression params tables grouping ('Required (nullity float))
249−atan2 y x = UnsafeExpression $
492+atan2_ y x = UnsafeExpression $
250493 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
251494
252495cast
@@ -256,19 +499,19 @@ cast
256499cast ty x = UnsafeExpression $ parenthesized $
257500 renderExpression x <+> "::" <+> renderTypeExpression ty
258501
259−div
502+div_
260503 :: PGIntegral int
261504 => Expression params tables grouping ('Required (nullity int))
262505 -> Expression params tables grouping ('Required (nullity int))
263506 -> Expression params tables grouping ('Required (nullity int))
264−div = unsafeBinaryOp "/"
507+div_ = unsafeBinaryOp "/"
265508
266−mod
509+mod_
267510 :: PGIntegral int
268511 => Expression params tables grouping ('Required (nullity int))
269512 -> Expression params tables grouping ('Required (nullity int))
270513 -> Expression params tables grouping ('Required (nullity int))
271−mod = unsafeBinaryOp "%"
514+mod_ = unsafeBinaryOp "%"
272515
273516trunc
274517 :: PGFloating frac
@@ -377,19 +620,19 @@ infix 4 /=*
377620(>=*) = unsafeBinaryOp ">="
378621infix 4 >=*
379622
380−(<*)
623+(*<)
381624 :: Expression params tables grouping ('Required (nullity ty))
382625 -> Expression params tables grouping ('Required (nullity ty))
383626 -> Expression params tables grouping ('Required (nullity 'PGbool))
384−(<*) = unsafeBinaryOp "<"
385−infix 4 <*
627+(*<) = unsafeBinaryOp "<"
628+infix 4 *<
386629
387−(<=*)
630+(*<=)
388631 :: Expression params tables grouping ('Required (nullity ty))
389632 -> Expression params tables grouping ('Required (nullity ty))
390633 -> Expression params tables grouping ('Required (nullity 'PGbool))
391−(<=*) = unsafeBinaryOp "<="
392−infix 4 <=*
634+(*<=) = unsafeBinaryOp "<="
635+infix 4 *<=
393636
394637(>*)
395638 :: Expression params tables grouping ('Required (nullity ty))
@@ -456,7 +699,7 @@ aggregation
456699-----------------------------------------}
457700
458701data By
459− (tables :: [(Symbol,[(Symbol,ColumnType)])])
702+ (tables :: TablesType)
460703 (by :: (Symbol,Symbol)) where
461704 By
462705 :: (tables ~ '[table ::: columns], HasColumn column columns ty)
@@ -527,7 +770,7 @@ instance {-# OVERLAPPABLE #-}
527770 ) => GroupedBy table column (tabcol ': bys)
528771
529772instance
530− ( tables ~ '[table ::: columns]
773+ ( HasUnique table tables columns
531774 , HasColumn column columns ty
532775 , GroupedBy table column bys
533776 ) => IsLabel column
@@ -541,97 +784,80 @@ instance
541784 ) => IsTableColumn table column
542785 (Expression params tables ('Grouped bys) ty) where (!) = getGroup2
543786
544−data AllOrDistinct = All | Distinct
545− deriving (GHC.Generic,Show,Eq,Ord,Data)
546−instance NFData AllOrDistinct
787+-- data AllOrDistinct = All | Distinct
788+-- deriving (GHC.Generic,Show,Eq,Ord,Data)
789+-- instance NFData AllOrDistinct
547790
548−renderAllOrDistinct :: AllOrDistinct -> ByteString
549−renderAllOrDistinct = \case
550− All -> "ALL"
551− Distinct -> "DISTINCT"
791+-- renderAllOrDistinct :: AllOrDistinct -> ByteString
792+-- renderAllOrDistinct = \case
793+-- All -> "ALL"
794+-- Distinct -> "DISTINCT"
552795
553−unsafeAggregate
796+unsafeAggregate, unsafeAggregateDistinct
554797 :: ByteString
555− -> AllOrDistinct
556798 -> Expression params tables 'Ungrouped ('Required xty)
557799 -> Expression params tables ('Grouped bys) ('Required yty)
558−unsafeAggregate fun allOrDistinct x = UnsafeExpression $ mconcat
559− [fun, "(", renderAllOrDistinct allOrDistinct <+> renderExpression x, ")"]
800+unsafeAggregate fun x = UnsafeExpression $ mconcat
801+ [fun, "(", renderExpression x, ")"]
802+unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat
803+ [fun, "(DISTINCT ", renderExpression x, ")"]
560804
561−sum_
805+sum_, sumDistinct
562806 :: PGNum ty
563− => AllOrDistinct
564− -> Expression params tables 'Ungrouped ('Required (nullity ty))
807+ => Expression params tables 'Ungrouped ('Required (nullity ty))
565808 -> Expression params tables ('Grouped bys) ('Required (nullity ty))
566809sum_ = unsafeAggregate "sum"
567−
568−avgInt
569− :: PGIntegral int
570− => AllOrDistinct
571− -> Expression params tables 'Ungrouped ('Required (nullity int))
572− -> Expression params tables ('Grouped bys) ('Required (nullity 'PGnumeric))
573−avgInt = unsafeAggregate "avg"
574−
575−avgFloat
576− :: PGFloating float
577− => AllOrDistinct
578− -> Expression params tables 'Ungrouped ('Required (nullity float))
579− -> Expression params tables ('Grouped bys) ('Required (nullity 'PGfloat8))
580−avgFloat = unsafeAggregate "avg"
581−
582−bitAnd
810+sumDistinct = unsafeAggregateDistinct "sum"
811+
812+class PGAvg ty avg | ty -> avg where
813+ avg, avgDistinct
814+ :: Expression params tables 'Ungrouped ('Required (nullity ty))
815+ -> Expression params tables ('Grouped bys) ('Required (nullity avg))
816+ avg = unsafeAggregate "avg"
817+ avgDistinct = unsafeAggregateDistinct "avg"
818+instance PGAvg 'PGint2 'PGnumeric
819+instance PGAvg 'PGint4 'PGnumeric
820+instance PGAvg 'PGint8 'PGnumeric
821+instance PGAvg 'PGnumeric 'PGnumeric
822+instance PGAvg 'PGfloat4 'PGfloat8
823+instance PGAvg 'PGfloat8 'PGfloat8
824+instance PGAvg 'PGinterval 'PGinterval
825+
826+bitAnd, bitOr
583827 :: PGIntegral int
584− => AllOrDistinct
585− -> Expression params tables 'Ungrouped ('Required (nullity int))
828+ => Expression params tables 'Ungrouped ('Required (nullity int))
586829 -> Expression params tables ('Grouped bys) ('Required (nullity int))
587830bitAnd = unsafeAggregate "bit_and"
588−
589−bitOr
590− :: PGIntegral int
591− => AllOrDistinct
592− -> Expression params tables 'Ungrouped ('Required (nullity int))
593− -> Expression params tables ('Grouped bys) ('Required (nullity int))
594831bitOr = unsafeAggregate "bit_or"
595832
596−boolAnd
597− :: AllOrDistinct
598− -> Expression params tables 'Ungrouped ('Required (nullity 'PGbool))
833+boolAnd, boolOr
834+ :: Expression params tables 'Ungrouped ('Required (nullity 'PGbool))
599835 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGbool))
600836boolAnd = unsafeAggregate "bool_and"
601−
602−boolOr
603− :: AllOrDistinct
604− -> Expression params tables 'Ungrouped ('Required (nullity 'PGbool))
605− -> Expression params tables ('Grouped bys) ('Required (nullity 'PGbool))
606837boolOr = unsafeAggregate "bool_or"
607838
608−countStar
609− :: AllOrDistinct
610− -> Expression params table ('Grouped bys) ('Required ('NotNull 'PGint8))
611−countStar allOrDistinct = UnsafeExpression $
612− "count(" <> renderAllOrDistinct allOrDistinct <+> "*)"
839+countStar, countDistinctStar
840+ :: Expression params table ('Grouped bys) ('Required ('NotNull 'PGint8))
841+countStar = UnsafeExpression $ "count(*)"
842+countDistinctStar = UnsafeExpression $ "count(DISTINCT *)"
613843
614844count
615− :: AllOrDistinct
616− -> Expression params tables 'Ungrouped ('Required ty)
845+ :: Expression params tables 'Ungrouped ('Required ty)
617846 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGint8))
618847count = unsafeAggregate "count"
619848
620849every
621− :: AllOrDistinct
622− -> Expression params tables 'Ungrouped ('Required (nullity 'PGbool))
850+ :: Expression params tables 'Ungrouped ('Required (nullity 'PGbool))
623851 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGbool))
624852every = unsafeAggregate "every"
625853
626854jsonAgg
627− :: AllOrDistinct
628− -> Expression params tables 'Ungrouped ('Required ty)
855+ :: Expression params tables 'Ungrouped ('Required ty)
629856 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjson))
630857jsonAgg = unsafeAggregate "json_agg"
631858
632859jsonbAgg
633− :: AllOrDistinct
634− -> Expression params tables 'Ungrouped ('Required ty)
860+ :: Expression params tables 'Ungrouped ('Required ty)
635861 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjsonb))
636862jsonbAgg = unsafeAggregate "jsonb_agg"
637863
@@ -644,24 +870,17 @@ jsonObjectAgg k v = UnsafeExpression $
644870 <> ", " <> renderExpression v <> ")"
645871
646872jsonbObjectAgg
647− :: AllOrDistinct
648− -> Expression params tables 'Ungrouped ('Required ('NotNull keyty))
873+ :: Expression params tables 'Ungrouped ('Required ('NotNull keyty))
649874 -> Expression params tables 'Ungrouped ('Required valty)
650875 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjsonb))
651−jsonbObjectAgg allOrDistinct k v = UnsafeExpression $
652− "jsonb_object_agg(" <> renderAllOrDistinct allOrDistinct
653− <+> renderExpression k <> ", " <> renderExpression v <> ")"
876+jsonbObjectAgg k v = UnsafeExpression $
877+ "jsonb_object_agg("
878+ <> renderExpression k <> ", " <> renderExpression v <> ")"
654879
655−max_
656− :: AllOrDistinct
657− -> Expression params tables 'Ungrouped ('Required (nullity ty))
880+max_, min_
881+ :: Expression params tables 'Ungrouped ('Required (nullity ty))
658882 -> Expression params tables ('Grouped bys) ('Required (nullity ty))
659883max_ = unsafeAggregate "max"
660−
661−min_
662− :: AllOrDistinct
663− -> Expression params tables 'Ungrouped ('Required (nullity ty))
664− -> Expression params tables ('Grouped bys) ('Required (nullity ty))
665884min_ = unsafeAggregate "min"
666885
667886{-----------------------------------------
@@ -669,8 +888,8 @@ tables
669888-----------------------------------------}
670889
671890newtype Table
672− (schema :: [(Symbol,[(Symbol,ColumnType)])])
673− (columns :: [(Symbol,ColumnType)])
891+ (schema :: TablesType)
892+ (columns :: ColumnsType)
674893 = UnsafeTable { renderTable :: ByteString }
675894 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
676895
@@ -738,8 +957,8 @@ renderFromClause = \case
738957
739958data TableExpression
740959 (params :: [ColumnType])
741− (schema :: [(Symbol,[(Symbol,ColumnType)])])
742− (tables :: [(Symbol,[(Symbol,ColumnType)])])
960+ (schema :: TablesType)
961+ (tables :: TablesType)
743962 (grouping :: Grouping)
744963 = TableExpression
745964 { fromClause :: FromClause params schema tables
@@ -960,8 +1179,8 @@ statements
9601179-----------------------------------------}
9611180
9621181newtype Definition
963− (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
964− (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
1182+ (schema0 :: TablesType)
1183+ (schema1 :: TablesType)
9651184 = UnsafeDefinition { renderDefinition :: ByteString }
9661185 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
9671186
@@ -971,16 +1190,16 @@ instance Category Definition where
9711190 renderDefinition ddl0 <+> renderDefinition ddl1
9721191
9731192newtype Manipulation
974− (schema :: [(Symbol,[(Symbol,ColumnType)])])
1193+ (schema :: TablesType)
9751194 (params :: [ColumnType])
976− (columns :: [(Symbol,ColumnType)])
1195+ (columns :: ColumnsType)
9771196 = UnsafeManipulation { renderManipulation :: ByteString }
9781197 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
9791198
9801199newtype Query
981− (schema :: [(Symbol,[(Symbol,ColumnType)])])
1200+ (schema :: TablesType)
9821201 (params :: [ColumnType])
983− (columns :: [(Symbol,ColumnType)])
1202+ (columns :: ColumnsType)
9841203 = UnsafeQuery { renderQuery :: ByteString }
9851204 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
9861205
@@ -1098,8 +1317,8 @@ createTable table columns constraints = UnsafeDefinition $
10981317 _ -> ", " <> commaSeparated (renderTableConstraint <$> constraints)
10991318
11001319newtype TableConstraint
1101− (schema :: [(Symbol,[(Symbol,ColumnType)])])
1102− (columns :: [(Symbol,ColumnType)])
1320+ (schema :: TablesType)
1321+ (columns :: ColumnsType)
11031322 = UnsafeTableConstraint { renderTableConstraint :: ByteString }
11041323 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
11051324
@@ -1224,7 +1443,7 @@ addColumnNull
12241443 :: KnownSymbol column
12251444 => Alias column
12261445 -> TypeExpression ('Required ('Null ty))
1227− -> AlterTable columns ((column ::: 'Required ('Null ty)) ': columns)
1446+ -> AlterTable columns (Create column ('Required ('Null ty)) columns)
12281447addColumnNull column ty = UnsafeAlterTable $
12291448 "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty
12301449
@@ -1295,9 +1514,9 @@ insertInto table insert conflict returning = UnsafeManipulation $
12951514 <> renderReturningClause returning
12961515
12971516data ValuesClause
1298− (schema :: [(Symbol,[(Symbol,ColumnType)])])
1517+ (schema :: TablesType)
12991518 (params :: [ColumnType])
1300− (columns :: [(Symbol,ColumnType)])
1519+ (columns :: ColumnsType)
13011520 = Values
13021521 (NP (Aliased (Expression params '[] 'Ungrouped)) columns)
13031522 [NP (Aliased (Expression params '[] 'Ungrouped)) columns]
@@ -1322,8 +1541,8 @@ renderValuesClause = \case
13221541
13231542data ReturningClause
13241543 (params :: [ColumnType])
1325− (columns :: [(Symbol,ColumnType)])
1326− (results :: [(Symbol,ColumnType)])
1544+ (columns :: ColumnsType)
1545+ (results :: ColumnsType)
13271546 where
13281547 ReturningStar :: ReturningClause params columns columns
13291548 Returning