git.iko.soy/squeal
on dev help sign in
start documentation
701d548Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+108−38
compare with dev
unifiedsplit
@@ -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+
1{-# LANGUAGE
11{-# LANGUAGE
12+ ConstraintKinds
2− DataKinds
13+ , DataKinds
3 , DefaultSignatures
14 , DefaultSignatures
4 , DeriveFoldable
15 , DeriveFoldable
5 , DeriveFunctor
16 , DeriveFunctor
@@ -14,34 +25,62 @@
14 , ScopedTypeVariables
25 , ScopedTypeVariables
15 , TypeApplications
26 , TypeApplications
16 , TypeFamilies
27 , TypeFamilies
28+ , TypeInType
17 , TypeOperators
29 , TypeOperators
18 , UndecidableInstances
30 , UndecidableInstances
19#-}
31#-}
20
32
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
22
45
23import Data.Aeson hiding (Null)
46import Data.Aeson hiding (Null)
24−import Data.Bits
25import Data.Int
47import Data.Int
48+import Data.Kind
26import Data.Scientific
49import Data.Scientific
27import Data.Time
50import Data.Time
28−import Data.Word
29import Data.UUID
51import Data.UUID
52+import Data.Word
30import Generics.SOP
53import Generics.SOP
54+import GHC.TypeLits
31import Network.IP.Addr
55import Network.IP.Addr
32
56
33import qualified Data.ByteString.Lazy as Lazy
57import qualified Data.ByteString.Lazy as Lazy
34import qualified Data.ByteString as Strict hiding (unpack)
58import qualified Data.ByteString as Strict hiding (unpack)
35import qualified Data.Text.Lazy as Lazy
59import qualified Data.Text.Lazy as Lazy
36import qualified Data.Text as Strict
60import qualified Data.Text as Strict
37−import qualified Generics.SOP.Type.Metadata as Type
38import qualified GHC.Generics as GHC
61import qualified GHC.Generics as GHC
39import qualified PostgreSQL.Binary.Decoding as Decoding
62import qualified PostgreSQL.Binary.Decoding as Decoding
40import qualified PostgreSQL.Binary.Encoding as Encoding
63import qualified PostgreSQL.Binary.Encoding as Encoding
41
64
42import Squeal.PostgreSQL.Schema
65import Squeal.PostgreSQL.Schema
43
66
67+-- | A `ToParam` constraint gives an encoding of a Haskell `Type` into
68+-- into the binary format of a PostgreSQL `PGType`.
44−class ToParam x (pg :: PGType) where toParam :: x -> K Encoding.Encoding pg
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
45instance ToParam Bool 'PGbool where toParam = K . Encoding.bool
84instance ToParam Bool 'PGbool where toParam = K . Encoding.bool
46instance ToParam Int16 'PGint2 where toParam = K . Encoding.int2_int16
85instance ToParam Int16 'PGint2 where toParam = K . Encoding.int2_int16
47instance ToParam Word16 'PGint2 where toParam = K . Encoding.int2_word16
86instance ToParam Word16 'PGint2 where toParam = K . Encoding.int2_word16
@@ -73,14 +112,34 @@ instance ToParam DiffTime 'PGinterval where toParam = K . Encoding.interval_int
73instance ToParam Value 'PGjson where toParam = K . Encoding.json_ast
112instance ToParam Value 'PGjson where toParam = K . Encoding.json_ast
74instance ToParam Value 'PGjsonb where toParam = K . Encoding.jsonb_ast
113instance ToParam Value 'PGjsonb where toParam = K . Encoding.jsonb_ast
75
114
115+-- | A `ToColumnParam` constraint lifts the `ToParam` encoding
116+-- of a `Type` to a `ColumnType`, encoding `Maybe`s to `Null`s.
76−class ToColumnParam x (ty :: ColumnType) where
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
77 toColumnParam :: x -> K (Maybe Strict.ByteString) ty
126 toColumnParam :: x -> K (Maybe Strict.ByteString) ty
78instance ToParam x pg => ToColumnParam x (optionality ('NotNull pg)) where
127instance ToParam x pg => ToColumnParam x (optionality ('NotNull pg)) where
79 toColumnParam = K . Just . Encoding.encodingBytes . unK . toParam @x @pg
128 toColumnParam = K . Just . Encoding.encodingBytes . unK . toParam @x @pg
80instance ToParam x pg => ToColumnParam (Maybe x) (optionality ('Null pg)) where
129instance ToParam x pg => ToColumnParam (Maybe x) (optionality ('Null pg)) where
81 toColumnParam = K . fmap (Encoding.encodingBytes . unK . toParam @x @pg)
130 toColumnParam = K . fmap (Encoding.encodingBytes . unK . toParam @x @pg)
82
131
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.
83−class SListI tys => ToParams x (tys :: [ColumnType]) where
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)
84 toParams :: x -> NP (K (Maybe Strict.ByteString)) tys
143 toParams :: x -> NP (K (Maybe Strict.ByteString)) tys
85instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)
144instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)
86 => ToParams x tys where
145 => ToParams x tys where
@@ -88,15 +147,15 @@ instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)
88 = htrans (Proxy @ToColumnParam) (toColumnParam . unI)
147 = htrans (Proxy @ToColumnParam) (toColumnParam . unI)
89 . unZ . unSOP . from
148 . unZ . unSOP . from
90
149
150+-- | A `FromValue` constraint gives a parser from the binary format of
151+-- a PostgreSQL `PGType` into a Haskell `Type`.
91−class FromValue (pg :: PGType) y where
152+class FromValue (pg :: PGType) (y :: Type) where
153+ -- | >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue
92 fromValue :: proxy pg -> Decoding.Value y
154 fromValue :: proxy pg -> Decoding.Value y
93instance FromValue 'PGbool Bool where fromValue _ = Decoding.bool
155instance FromValue 'PGbool Bool where fromValue _ = Decoding.bool
94−instance (Integral int, Bits int) => FromValue 'PGint2 int where
95− fromValue _ = Decoding.int
156+instance FromValue 'PGint2 Int16 where fromValue _ = Decoding.int
96−instance (Integral int, Bits int) => FromValue 'PGint4 int where
97− fromValue _ = Decoding.int
157+instance FromValue 'PGint4 Int32 where fromValue _ = Decoding.int
98−instance (Integral int, Bits int) => FromValue 'PGint8 int where
99− fromValue _ = Decoding.int
158+instance FromValue 'PGint8 Int64 where fromValue _ = Decoding.int
100instance FromValue 'PGfloat4 Float where fromValue _ = Decoding.float4
159instance FromValue 'PGfloat4 Float where fromValue _ = Decoding.float4
101instance FromValue 'PGfloat8 Double where fromValue _ = Decoding.float8
160instance FromValue 'PGfloat8 Double where fromValue _ = Decoding.float8
102instance FromValue 'PGnumeric Scientific where fromValue _ = Decoding.numeric
161instance FromValue 'PGnumeric Scientific where fromValue _ = Decoding.numeric
@@ -122,7 +181,15 @@ instance FromValue 'PGinterval DiffTime where
122instance FromValue 'PGjson Value where fromValue _ = Decoding.json_ast
181instance FromValue 'PGjson Value where fromValue _ = Decoding.json_ast
123instance FromValue 'PGjsonb Value where fromValue _ = Decoding.jsonb_ast
182instance FromValue 'PGjsonb Value where fromValue _ = Decoding.jsonb_ast
124
183
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.
125−class FromColumnValue (colty :: (Symbol,ColumnType)) y where
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})
126 fromColumnValue :: K (Maybe Strict.ByteString) colty -> y
193 fromColumnValue :: K (Maybe Strict.ByteString) colty -> y
127instance FromValue pg y
194instance FromValue pg y
128 => FromColumnValue (column ::: ('Required ('NotNull pg))) y where
195 => FromColumnValue (column ::: ('Required ('NotNull pg))) y where
@@ -144,32 +211,35 @@ instance FromValue pg y
144 where
211 where
145 err str = error $ "fromColumnValue: " ++ Strict.unpack str
212 err str = error $ "fromColumnValue: " ++ Strict.unpack str
146
213
147−class SListI columns => FromRow (columns :: [(Symbol,ColumnType)]) y where
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"}
148− fromRow :: NP (K (Maybe Strict.ByteString)) columns -> y
224+ fromRow :: NP (K (Maybe Strict.ByteString)) results -> y
149instance
225instance
226+ ( SListI results
150− ( SListI columns, IsProductType y ys
227+ , IsProductType y ys
151− , AllZip FromColumnValue columns ys
228+ , AllZip FromColumnValue results ys
152− , HasDatatypeInfo y
153− , SameFields (DatatypeInfoOf y) columns
229+ , SameFields (DatatypeInfoOf y) results
154− ) => FromRow columns y where
230+ ) => FromRow results y where
155 fromRow
231 fromRow
156 = to . SOP . Z . htrans (Proxy @FromColumnValue) (I . fromColumnValue)
232 = to . SOP . Z . htrans (Proxy @FromColumnValue) (I . fromColumnValue)
157
233
158−class SameField
234+-- | `Only` is a 1-tuple type, useful for encoding a single parameter with
159− (fieldInfo :: Type.FieldInfo) (columnty :: (Symbol,ColumnType)) where
235+-- `toParams` or decoding a single value with `fromRow`.
160−instance field ~ column => SameField ('Type.FieldInfo field) (column ::: ty)
236+--
161−
237+-- >>> toParams @(Only (Maybe Text)) @'[ 'Required ('Null 'PGtext)] (Only (Just "foo"))
162−type family SameFields
238+-- K (Just "foo") :* Nil
163− (datatypeInfo :: Type.DatatypeInfo) (columns :: [(Symbol,ColumnType)]) where
239+--
164− SameFields
240+-- >>> type PGShortRow = '["only" ::: 'Required ('Null 'PGtext)]
165− ('Type.ADT _module _datatype '[ 'Type.Record _constructor fields])
241+-- >>> fromRow @PGShortRow @(Only (Maybe Text)) (K (Just "bar") :* Nil)
166− columns
242+-- Only {only = Just "bar"}
167− = AllZip SameField fields columns
168− SameFields
169− ('Type.Newtype _module _datatype ('Type.Record _constructor '[field]))
170− '[column]
171− = SameField field column
172−
173newtype Only x = Only { only :: x }
243newtype Only x = Only { only :: x }
174 deriving (Functor,Foldable,Traversable,Eq,Ord,Read,Show,GHC.Generic)
244 deriving (Functor,Foldable,Traversable,Eq,Ord,Read,Show,GHC.Generic)
175instance Generic (Only x)
245instance 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+
1{-# LANGUAGE
11{-# LANGUAGE
12+ ConstraintKinds
2− DataKinds
13+ , DataKinds
3 , DeriveAnyClass
14 , DeriveAnyClass
4 , DeriveDataTypeable
15 , DeriveDataTypeable
5 , DeriveGeneric
16 , DeriveGeneric
@@ -15,37 +26,48 @@
15 , StandaloneDeriving
26 , StandaloneDeriving
16 , TypeApplications
27 , TypeApplications
17 , TypeFamilies
28 , TypeFamilies
29+ , TypeInType
18 , TypeOperators
30 , TypeOperators
19#-}
31#-}
20
32
21module Squeal.PostgreSQL.Schema
33module Squeal.PostgreSQL.Schema
34+ ( -- * Kinds
22− ( PGType (..)
35+ PGType (..)
36+ , NullityType (..)
37+ , ColumnType (..)
38+ , ColumnsType
39+ , TablesType
40+ , Grouping (..)
41+ -- * Constraints
23− , PGNum (..)
42+ , PGNum
24 , PGIntegral
43 , PGIntegral
25 , PGFloating
44 , PGFloating
45+ -- * Aliases
26 , (:::)
46 , (:::)
27 , Alias (Alias)
47 , Alias (Alias)
28 , renderAlias
48 , renderAlias
29 , Aliased (As)
49 , Aliased (As)
30 , renderAliased
50 , renderAliased
51+ , IsLabel (..)
31 , IsTableColumn (..)
52 , IsTableColumn (..)
32− , NullityType (..)
53+ -- * Type Families
33− , ColumnType (..)
54+ , In
34− , Grouping (..)
55+ , HasUnique
56+ , BaseType
35 , SameTypes
57 , SameTypes
36 , AllNotNull
58 , AllNotNull
37 , NotAllNull
59 , NotAllNull
38 , NullifyType
60 , NullifyType
39 , NullifyColumns
61 , NullifyColumns
40 , NullifyTables
62 , NullifyTables
41− , BaseType
63+ , Join
42 , Create
64 , Create
43 , Drop
65 , Drop
44 , Alter
66 , Alter
45 , Rename
67 , Rename
46− , Join
68+ -- * Generics
47− , module GHC.OverloadedLabels
69+ , SameField
48− , module GHC.TypeLits
70+ , SameFields
49 ) where
71 ) where
50
72
51import Control.DeepSeq
73import Control.DeepSeq
@@ -53,64 +75,110 @@ import Data.ByteString
53import Data.Data (Data)
75import Data.Data (Data)
54import Data.Monoid
76import Data.Monoid
55import Data.String
77import Data.String
78+import Generics.SOP (AllZip)
56import GHC.Generics (Generic)
79import GHC.Generics (Generic)
57import GHC.Exts
80import GHC.Exts
58import GHC.OverloadedLabels
81import GHC.OverloadedLabels
59import GHC.TypeLits
82import GHC.TypeLits
60
83
84+import qualified Generics.SOP.Type.Metadata as Type
85+
86+-- | `PGType` is the promoted datakind of PostgreSQL types.
61data PGType
87data PGType
62− = PGbool
88+ = PGbool -- ^ logical Boolean (true/false)
63− | PGint2
89+ | PGint2 -- ^ signed two-byte integer
64− | PGint4
90+ | PGint4 -- ^ signed four-byte integer
65− | PGint8
91+ | PGint8 -- ^ signed eight-byte integer
66− | PGnumeric
92+ | PGnumeric -- ^ arbitrary precision numeric type
67− | PGfloat4
93+ | PGfloat4 -- ^ single precision floating-point number (4 bytes)
68− | PGfloat8
94+ | PGfloat8 -- ^ double precision floating-point number (8 bytes)
69− | PGchar Nat
95+ | PGchar Nat -- ^ fixed-length character string
70− | PGvarchar Nat
96+ | PGvarchar Nat -- ^ variable-length character string
71− | PGtext
97+ | PGtext -- ^ variable-length character string
72− | PGbytea
98+ | PGbytea -- ^ binary data ("byte array")
73− | PGtimestamp
99+ | PGtimestamp -- ^ date and time (no time zone)
74− | PGtimestamptz
100+ | PGtimestamptz -- ^ date and time, including time zone
75− | PGdate
101+ | PGdate -- ^ calendar date (year, month, day)
76− | PGtime
102+ | PGtime -- ^ time of day (no time zone)
77− | PGtimetz
103+ | PGtimetz -- ^ time of day, including time zone
78− | PGinterval
104+ | PGinterval -- ^ time span
79− | PGuuid
105+ | PGuuid -- ^ universally unique identifier
80− | PGinet
106+ | PGinet -- ^ IPv4 or IPv6 host address
81− | PGjson
107+ | PGjson -- ^ textual JSON data
82− | PGjsonb
108+ | PGjsonb -- ^ binary JSON data, decomposed
83−
109+
84−class PGNum (ty :: PGType) where
110+-- | `NullityType` encodes the potential presence or definite absence of a
85− decimal :: proxy ty -> Bool
111+-- @NULL@ allowing operations which are sensitive to such to be well typed.
86−instance PGNum 'PGint2 where decimal _ = False
112+data NullityType
87−instance PGNum 'PGint4 where decimal _ = False
113+ = Null PGType -- ^ @NULL@ may be present
88−instance PGNum 'PGint8 where decimal _ = False
114+ | NotNull PGType -- ^ @NULL@ is absent
89−instance PGNum 'PGnumeric where decimal _ = True
115+
90−instance PGNum 'PGfloat4 where decimal _ = True
116+-- | `ColumnType` encodes the allowance of @DEFAULT@ and the only way
91−instance PGNum 'PGfloat8 where decimal _ = True
117+-- to generate an `Optional` `Squeel.PostgreSQL.Statement.Expression`
92−
118+-- is to use `Squeel.PostgreSQL.Statement.def`
93−class PGNum ty => PGIntegral (ty :: PGType) where
119+-- or `Squeel.PostgreSQL.Statement.unDef`.
94−instance PGIntegral 'PGint2
120+data ColumnType
95−instance PGIntegral 'PGint4
121+ = Optional NullityType
96−instance PGIntegral 'PGint8
122+ -- ^ @DEFAULT@ is an allowed `Squeel.PostgreSQL.Statement.Expression`
97−
123+ | Required NullityType
98−class PGNum ty => PGFloating (ty :: PGType) where
124+ -- ^ @DEFAULT@ is not allowed
99−instance PGFloating 'PGnumeric
125+
100−instance PGFloating 'PGfloat4
126+-- | `ColumnsType` is a kind synonym for a row of `ColumnType`s.
101−instance PGFloating 'PGfloat8
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)]
102
140
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`.
103type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)
160type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)
104
161
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
105data Alias (alias :: Symbol) = Alias
167data Alias (alias :: Symbol) = Alias
106 deriving (Eq,Generic,Data,Ord,Show,NFData)
168 deriving (Eq,Generic,Data,Ord,Show,NFData)
169+instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where
170+ fromLabel = Alias
107
171
172+-- | >>> renderAlias #alias
173+-- "alias"
108renderAlias :: KnownSymbol alias => Alias alias -> ByteString
174renderAlias :: KnownSymbol alias => Alias alias -> ByteString
109renderAlias = fromString . symbolVal
175renderAlias = fromString . symbolVal
110
176
111−instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where
177+-- | The `As` operator is used to name an expression. `As` is the demoted
112− fromLabel = Alias
178+-- version of `:::`.
113−
179+--
180+-- >>> Just "hello" `As` #hi :: Aliased Maybe ("hi" ::: String)
181+-- As (Just "hello") Alias
114data Aliased expression aliased where
182data Aliased expression aliased where
115 As
183 As
116 :: KnownSymbol alias
184 :: KnownSymbol alias
@@ -124,6 +192,9 @@ deriving instance Eq (expression ty)
124deriving instance Ord (expression ty)
192deriving instance Ord (expression ty)
125 => Ord (Aliased expression (alias ::: ty))
193 => Ord (Aliased expression (alias ::: ty))
126
194
195+-- | >>> let renderMaybe = fromString . maybe "Nothing" (const "Just")
196+-- >>> renderAliased renderMaybe (Just (3::Int) `As` #an_int)
197+-- "Just AS an_int"
127renderAliased
198renderAliased
128 :: (forall ty. expression ty -> ByteString)
199 :: (forall ty. expression ty -> ByteString)
129 -> Aliased expression aliased
200 -> Aliased expression aliased
@@ -131,67 +202,120 @@ renderAliased
131renderAliased render (expression `As` alias) =
202renderAliased render (expression `As` alias) =
132 render expression <> " AS " <> renderAlias alias
203 render expression <> " AS " <> renderAlias alias
133
204
205+-- | Analagous to `IsLabel`, the constraint
206+-- `IsTableColumn` defines `!` for a column alias qualified
207+-- by a table alias.
134class IsTableColumn table column expression where
208class IsTableColumn table column expression where
135 (!) :: Alias table -> Alias column -> expression
209 (!) :: Alias table -> Alias column -> expression
136 infixl 9 !
210 infixl 9 !
137instance IsTableColumn table column (Alias table, Alias column) where (!) = (,)
211instance IsTableColumn table column (Alias table, Alias column) where (!) = (,)
138
212
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
140
217
141−data ColumnType = Optional NullityType | Required NullityType
218+-- | `HasUnique alias xs x` is a constraint that proves that xs is a singleton
142−
219+-- of `alias ::: x`.
143−data Grouping
220+type HasUnique alias xs x = xs ~ '[alias ::: x]
144− = Ungrouped
145− | Grouped [(Symbol,Symbol)]
146
221
222+-- | `BaseType` forgets about @NULL@ and @DEFAULT@
147−type family BaseType (ty :: ColumnType) where
223+type family BaseType (ty :: ColumnType) :: PGType where
148 BaseType (optionality (nullity pg)) = pg
224 BaseType (optionality (nullity pg)) = pg
149
225
226+-- | `SameTypes` is a constraint that proves two `ColumnsType`s have the same
227+-- length and the same `ColumnType`s.
150−type family SameTypes columns0 columns1 :: Constraint where
228+type family SameTypes
229+ (columns0 :: ColumnsType) (columns1 :: ColumnsType)
230+ :: Constraint where
151 SameTypes '[] '[] = ()
231 SameTypes '[] '[] = ()
152 SameTypes ((column0 ::: ty0) ': columns0) ((column1 ::: ty1) ': columns1)
232 SameTypes ((column0 ::: ty0) ': columns0) ((column1 ::: ty1) ': columns1)
153 = (ty0 ~ ty1, SameTypes columns0 columns1)
233 = (ty0 ~ ty1, SameTypes columns0 columns1)
154
234
235+-- | `AllNotNull` is a constraint that proves a `ColumnsType` has no @NULL@s.
155−type family AllNotNull columns :: Constraint where
236+type family AllNotNull (columns :: ColumnsType) :: Constraint where
156 AllNotNull '[] = ()
237 AllNotNull '[] = ()
157 AllNotNull ((column ::: (optionality ('NotNull ty))) ': columns)
238 AllNotNull ((column ::: (optionality ('NotNull ty))) ': columns)
158 = AllNotNull columns
239 = AllNotNull columns
159
240
241+-- | `NotAllNull` is a constraint that proves a `ColumnsType` has some
242+-- @NOT NULL@.
160type family NotAllNull columns :: Constraint where
243type family NotAllNull columns :: Constraint where
161 NotAllNull ((column ::: (optionality ('NotNull ty))) ': columns) = ()
244 NotAllNull ((column ::: (optionality ('NotNull ty))) ': columns) = ()
162 NotAllNull ((column ::: (optionality ('Null ty))) ': columns)
245 NotAllNull ((column ::: (optionality ('Null ty))) ': columns)
163 = NotAllNull columns
246 = NotAllNull columns
164
247
248+-- | `NullifyType` is an idempotent that nullifies a `ColumnType`.
165−type family NullifyType (ty :: ColumnType) where
249+type family NullifyType (ty :: ColumnType) :: ColumnType where
166 NullifyType (optionality ('Null ty)) = optionality ('Null ty)
250 NullifyType (optionality ('Null ty)) = optionality ('Null ty)
167 NullifyType (optionality ('NotNull ty)) = optionality ('Null ty)
251 NullifyType (optionality ('NotNull ty)) = optionality ('Null ty)
168
252
253+-- | `NullifyColumns` is an idempotent that nullifies a `ColumnsType`.
169−type family NullifyColumns columns where
254+type family NullifyColumns (columns :: ColumnsType) :: ColumnsType where
170 NullifyColumns '[] = '[]
255 NullifyColumns '[] = '[]
171 NullifyColumns ((column ::: ty) ': columns) =
256 NullifyColumns ((column ::: ty) ': columns) =
172 (column ::: NullifyType ty) ': NullifyColumns columns
257 (column ::: NullifyType ty) ': NullifyColumns columns
173
258
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`
174−type family NullifyTables tables where
262+type family NullifyTables (tables :: TablesType) :: TablesType where
175 NullifyTables '[] = '[]
263 NullifyTables '[] = '[]
176− NullifyTables ((column ::: ty) ': columns) =
264+ NullifyTables ((table ::: columns) ': tables) =
177− (column ::: NullifyColumns ty) ': NullifyTables columns
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
178
272
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
179type family Create alias x xs where
277type family Create alias x xs where
180 Create alias x '[] = '[alias ::: x]
278 Create alias x '[] = '[alias ::: x]
181 Create alias y (x ': xs) = x ': Create alias y xs
279 Create alias y (x ': xs) = x ': Create alias y xs
182
280
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
183type family Drop alias xs where
284type family Drop alias xs where
184 Drop alias ((alias ::: x) ': xs) = xs
285 Drop alias ((alias ::: x) ': xs) = xs
185 Drop alias (x ': xs) = x ': Drop alias xs
286 Drop alias (x ': xs) = x ': Drop alias xs
186
287
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`.
187type family Alter alias xs x where
291type family Alter alias xs x where
188 Alter alias ((alias ::: x0) ': xs) x1 = (alias ::: x1) ': xs
292 Alter alias ((alias ::: x0) ': xs) x1 = (alias ::: x1) ': xs
189 Alter alias (x0 ': xs) x1 = x0 ': Alter alias xs x1
293 Alter alias (x0 ': xs) x1 = x0 ': Alter alias xs x1
190
294
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`
191type family Rename alias0 alias1 xs where
298type family Rename alias0 alias1 xs where
192 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs
299 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs
193 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs
300 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs
194
301
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`.
195−type family Join xs ys where
311+type family SameFields
196− Join '[] ys = ys
312+ (datatypeInfo :: Type.DatatypeInfo) (columns :: ColumnsType)
197− Join (x ': xs) ys = x ': Join xs ys
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 @@
17 , StandaloneDeriving
17 , StandaloneDeriving
18 , TypeApplications
18 , TypeApplications
19 , TypeFamilies
19 , TypeFamilies
20+ , TypeInType
20 , TypeOperators
21 , TypeOperators
21 , UndecidableInstances
22 , UndecidableInstances
22#-}
23#-}
23
24
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
25
219
26import Control.Category
220import Control.Category
27import Control.DeepSeq
221import Control.DeepSeq
@@ -33,11 +227,11 @@ import Data.Monoid hiding (All)
33import Data.Ratio
227import Data.Ratio
34import Data.String
228import Data.String
35import Data.Word
229import Data.Word
36−import Generics.SOP
230+import Generics.SOP hiding (from)
37import GHC.Exts
231import GHC.Exts
38import GHC.OverloadedLabels
232import GHC.OverloadedLabels
39import GHC.TypeLits
233import GHC.TypeLits
40−import Prelude hiding (RealFrac(..), id, (.))
234+import Prelude hiding (id, (.))
41
235
42import qualified GHC.Generics as GHC
236import qualified GHC.Generics as GHC
43import qualified Data.ByteString as ByteString
237import qualified Data.ByteString as ByteString
@@ -48,14 +242,31 @@ import Squeal.PostgreSQL.Schema
48column expressions
242column expressions
49-----------------------------------------}
243-----------------------------------------}
50
244
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+-}
51newtype Expression
254newtype Expression
52 (params :: [ColumnType])
255 (params :: [ColumnType])
53− (tables :: [(Symbol,[(Symbol,ColumnType)])])
256+ (tables :: TablesType)
54 (grouping :: Grouping)
257 (grouping :: Grouping)
55 (ty :: ColumnType)
258 (ty :: ColumnType)
56 = UnsafeExpression { renderExpression :: ByteString }
259 = UnsafeExpression { renderExpression :: ByteString }
57 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
260 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
58
261
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+-}
59class (PGTyped (BaseType ty), KnownNat n)
270class (PGTyped (BaseType ty), KnownNat n)
60 => HasParameter (n :: Nat) params ty | n params -> ty where
271 => HasParameter (n :: Nat) params ty | n params -> ty where
61 param :: proxy n -> Expression params tables grouping ty
272 param :: proxy n -> Expression params tables grouping ty
@@ -67,18 +278,25 @@ instance {-# OVERLAPPING #-} PGTyped (BaseType ty1)
67instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)
278instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)
68 => HasParameter n (ty' : params) ty
279 => HasParameter n (ty' : params) ty
69
280
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+-}
70class KnownSymbol column => HasColumn column columns ty
287class KnownSymbol column => HasColumn column columns ty
71 | column columns -> ty where
288 | column columns -> ty where
72 getColumn
289 getColumn
290+ :: HasUnique table tables columns
73− :: Alias column
291+ => Alias column
74− -> Expression params '[table ::: columns] 'Ungrouped ty
292+ -> Expression params tables 'Ungrouped ty
75 getColumn column = UnsafeExpression $ renderAlias column
293 getColumn column = UnsafeExpression $ renderAlias column
76instance {-# OVERLAPPING #-} KnownSymbol column
294instance {-# OVERLAPPING #-} KnownSymbol column
77 => HasColumn column ((column ::: optionality ty) ': tys) ('Required ty)
295 => HasColumn column ((column ::: optionality ty) ': tys) ('Required ty)
78instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)
296instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)
79 => HasColumn column (ty' ': table) ty
297 => HasColumn column (ty' ': table) ty
80
298
81−instance (HasColumn column columns ty, tables ~ '[table ::: columns])
299+instance (HasColumn column columns ty, HasUnique table tables columns)
82 => IsLabel column (Expression params tables 'Ungrouped ty) where
300 => IsLabel column (Expression params tables 'Ungrouped ty) where
83 fromLabel = getColumn (Alias @column)
301 fromLabel = getColumn (Alias @column)
84
302
@@ -88,7 +306,7 @@ instance (HasTable table tables columns, HasColumn column columns ty)
88 renderAlias table <> "." <> renderAlias column
306 renderAlias table <> "." <> renderAlias column
89
307
90data Column
308data Column
91− (columns :: [(Symbol,ColumnType)])
309+ (columns :: ColumnsType)
92 (columnty :: (Symbol,ColumnType))
310 (columnty :: (Symbol,ColumnType))
93 where
311 where
94 Column
312 Column
@@ -99,22 +317,38 @@ deriving instance Show (Column columns columnty)
99deriving instance Eq (Column columns columnty)
317deriving instance Eq (Column columns columnty)
100deriving instance Ord (Column columns columnty)
318deriving instance Ord (Column columns columnty)
101
319
320+-- | >>> renderExpression def
321+-- "DEFAULT"
102def :: Expression params '[] 'Ungrouped ('Optional (nullity ty))
322def :: Expression params '[] 'Ungrouped ('Optional (nullity ty))
103def = UnsafeExpression "DEFAULT"
323def = UnsafeExpression "DEFAULT"
104
324
325+-- | >>> renderExpression $ unDef false
326+-- "FALSE"
105unDef
327unDef
106 :: Expression params '[] 'Ungrouped ('Required (nullity ty))
328 :: Expression params '[] 'Ungrouped ('Required (nullity ty))
107 -> Expression params '[] 'Ungrouped ('Optional (nullity ty))
329 -> Expression params '[] 'Ungrouped ('Optional (nullity ty))
108unDef = UnsafeExpression . renderExpression
330unDef = UnsafeExpression . renderExpression
109
331
332+-- | analagous to `Nothing`
333+--
334+-- >>> renderExpression $ null_
335+-- "NULL"
110−null :: Expression params tables grouping (optionality ('Null ty))
336+null_ :: Expression params tables grouping (optionality ('Null ty))
111−null = UnsafeExpression "NULL"
337+null_ = UnsafeExpression "NULL"
112−
338+
339+-- | analagous to `Just`
340+--
341+-- >>> renderExpression $ unNull true
342+-- "TRUE"
113unNull
343unNull
114 :: Expression params tables grouping (optionality ('NotNull ty))
344 :: Expression params tables grouping (optionality ('NotNull ty))
115 -> Expression params tables grouping (optionality ('Null ty))
345 -> Expression params tables grouping (optionality ('Null ty))
116unNull = UnsafeExpression . renderExpression
346unNull = UnsafeExpression . renderExpression
117
347
348+-- | return the leftmost value which is not NULL
349+--
350+-- >>> renderExpression $ coalesce [null_, unNull true] false
351+-- "COALESCE(NULL, TRUE, FALSE)"
118coalesce
352coalesce
119 :: [Expression params tables grouping ('Required ('Null ty))]
353 :: [Expression params tables grouping ('Required ('Null ty))]
120 -> Expression params tables grouping ('Required ('NotNull ty))
354 -> Expression params tables grouping ('Required ('NotNull ty))
@@ -123,22 +357,34 @@ coalesce nullxs notNullx = UnsafeExpression $
123 "COALESCE" <> parenthesized (commaSeparated
357 "COALESCE" <> parenthesized (commaSeparated
124 ((renderExpression <$> nullxs) <> [renderExpression notNullx]))
358 ((renderExpression <$> nullxs) <> [renderExpression notNullx]))
125
359
360+-- | analagous to `fromMaybe` using @COALESCE@
361+--
362+-- >>> renderExpression $ fromNull true null_
363+-- "COALESCE(NULL, TRUE)"
126fromNull
364fromNull
127 :: Expression params tables grouping ('Required ('NotNull ty))
365 :: Expression params tables grouping ('Required ('NotNull ty))
128 -> Expression params tables grouping ('Required ('Null ty))
366 -> Expression params tables grouping ('Required ('Null ty))
129 -> Expression params tables grouping ('Required ('NotNull ty))
367 -> Expression params tables grouping ('Required ('NotNull ty))
130fromNull notNullx nullx = coalesce [nullx] notNullx
368fromNull notNullx nullx = coalesce [nullx] notNullx
131
369
370+-- | >>> renderExpression $ null_ & isNull
371+-- "NULL IS NULL"
132isNull
372isNull
133 :: Expression params tables grouping ('Required ('Null ty))
373 :: Expression params tables grouping ('Required ('Null ty))
134 -> Condition params tables grouping
374 -> Condition params tables grouping
135isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"
375isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"
136
376
377+-- | >>> renderExpression $ null_ & isn'tNull
378+-- "NULL IS NOT NULL"
137isn'tNull
379isn'tNull
138 :: Expression params tables grouping ('Required ('Null ty))
380 :: Expression params tables grouping ('Required ('Null ty))
139 -> Condition params tables grouping
381 -> Condition params tables grouping
140isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"
382isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"
141
383
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"
142matchNull
388matchNull
143 :: Expression params tables grouping ('Required nullty)
389 :: Expression params tables grouping ('Required nullty)
144 -> ( Expression params tables grouping ('Required ('NotNull ty))
390 -> ( Expression params tables grouping ('Required ('NotNull ty))
@@ -148,24 +394,34 @@ matchNull
148matchNull y f x = ifThenElse (isNull x) y
394matchNull y f x = ifThenElse (isNull x) y
149 (f (UnsafeExpression (renderExpression y)))
395 (f (UnsafeExpression (renderExpression y)))
150
396
397+-- | left inverse to `fromNull`
398+--
399+-- >>> renderExpression $ nullIf false (fromNull false null_)
400+-- "NULL IF (FALSE, COALESCE(NULL, FALSE))"
151nullIf
401nullIf
152 :: Expression params tables grouping ('Required ('NotNull ty))
402 :: Expression params tables grouping ('Required ('NotNull ty))
153 -> Expression params tables grouping ('Required ('NotNull ty))
403 -> Expression params tables grouping ('Required ('NotNull ty))
154 -> Expression params tables grouping ('Required ('Null ty))
404 -> Expression params tables grouping ('Required ('Null ty))
155−nullIf x y = UnsafeExpression $ parenthesized $
405+nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized
156− renderExpression x <> ", " <> renderExpression y
406+ (renderExpression x <> ", " <> renderExpression y)
157
407
408+-- | >>> renderExpression $ greatest @'[_] currentTimestamp [param (Proxy @1)]
409+-- "GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))"
158greatest
410greatest
411+ :: Expression params tables grouping ('Required nullty)
159− :: [Expression params tables grouping ('Required nullty)]
412+ -> [Expression params tables grouping ('Required nullty)]
160 -> Expression params table grouping ('Required nullty)
413 -> Expression params table grouping ('Required nullty)
161−greatest xs = UnsafeExpression $ "GREATEST("
414+greatest x xs = UnsafeExpression $ "GREATEST("
162− <> commaSeparated (renderExpression <$> xs) <> ")"
415+ <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
163
416
417+-- | >>> renderExpression $ least currentTimestamp [null_]
418+-- "LEAST(CURRENT_TIMESTAMP, NULL)"
164least
419least
420+ :: Expression params tables grouping ('Required nullty)
165− :: [Expression params tables grouping ('Required nullty)]
421+ -> [Expression params tables grouping ('Required nullty)]
166 -> Expression params table grouping ('Required nullty)
422 -> Expression params table grouping ('Required nullty)
167−least xs = UnsafeExpression $ "LEAST("
423+least x xs = UnsafeExpression $ "LEAST("
168− <> commaSeparated (renderExpression <$> xs) <> ")"
424+ <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
169
425
170unsafeBinaryOp
426unsafeBinaryOp
171 :: ByteString
427 :: ByteString
@@ -198,16 +454,15 @@ instance PGNum ty
198 signum = unsafeFunction "sign"
454 signum = unsafeFunction "sign"
199 fromInteger
455 fromInteger
200 = UnsafeExpression
456 = UnsafeExpression
201− . (<> if decimal (Proxy :: Proxy ty) then "." else "")
202 . fromString
457 . fromString
203 . show
458 . show
204
459
205−instance PGFloating ty => Fractional
460+instance (PGNum ty, PGFloating ty) => Fractional
206 (Expression params tables grouping ('Required (nullity ty))) where
461 (Expression params tables grouping ('Required (nullity ty))) where
207 (/) = unsafeBinaryOp "/"
462 (/) = unsafeBinaryOp "/"
208 fromRational x = fromInteger (numerator x) / fromInteger (denominator x)
463 fromRational x = fromInteger (numerator x) / fromInteger (denominator x)
209
464
210−instance (PGFloating ty, PGTyped ty) => Floating
465+instance (PGNum ty, PGFloating ty) => Floating
211 (Expression params tables grouping ('Required (nullity ty))) where
466 (Expression params tables grouping ('Required (nullity ty))) where
212 pi = UnsafeExpression "pi()"
467 pi = UnsafeExpression "pi()"
213 exp = unsafeFunction "exp"
468 exp = unsafeFunction "exp"
@@ -215,19 +470,7 @@ instance (PGFloating ty, PGTyped ty) => Floating
215 sqrt = unsafeFunction "sqrt"
470 sqrt = unsafeFunction "sqrt"
216 b ** x = UnsafeExpression $
471 b ** x = UnsafeExpression $
217 "power(" <> renderExpression b <> ", " <> renderExpression x <> ")"
472 "power(" <> renderExpression b <> ", " <> renderExpression x <> ")"
218− logBase b y = cast pgtype $ logBaseNumeric b y
473+ logBase b y = log y / log b
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− ]
231 sin = unsafeFunction "sin"
474 sin = unsafeFunction "sin"
232 cos = unsafeFunction "cos"
475 cos = unsafeFunction "cos"
233 tan = unsafeFunction "tan"
476 tan = unsafeFunction "tan"
@@ -241,12 +484,12 @@ instance (PGFloating ty, PGTyped ty) => Floating
241 acosh x = log (x + sqrt (x*x - 1))
484 acosh x = log (x + sqrt (x*x - 1))
242 atanh x = log ((1 + x) / (1 - x)) / 2
485 atanh x = log ((1 + x) / (1 - x)) / 2
243
486
244−atan2
487+atan2_
245 :: PGFloating float
488 :: PGFloating float
246 => Expression params tables grouping ('Required (nullity float))
489 => Expression params tables grouping ('Required (nullity float))
247 -> Expression params tables grouping ('Required (nullity float))
490 -> Expression params tables grouping ('Required (nullity float))
248 -> Expression params tables grouping ('Required (nullity float))
491 -> Expression params tables grouping ('Required (nullity float))
249−atan2 y x = UnsafeExpression $
492+atan2_ y x = UnsafeExpression $
250 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
493 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
251
494
252cast
495cast
@@ -256,19 +499,19 @@ cast
256cast ty x = UnsafeExpression $ parenthesized $
499cast ty x = UnsafeExpression $ parenthesized $
257 renderExpression x <+> "::" <+> renderTypeExpression ty
500 renderExpression x <+> "::" <+> renderTypeExpression ty
258
501
259−div
502+div_
260 :: PGIntegral int
503 :: PGIntegral int
261 => Expression params tables grouping ('Required (nullity int))
504 => Expression params tables grouping ('Required (nullity int))
262 -> Expression params tables grouping ('Required (nullity int))
505 -> Expression params tables grouping ('Required (nullity int))
263 -> Expression params tables grouping ('Required (nullity int))
506 -> Expression params tables grouping ('Required (nullity int))
264−div = unsafeBinaryOp "/"
507+div_ = unsafeBinaryOp "/"
265
508
266−mod
509+mod_
267 :: PGIntegral int
510 :: PGIntegral int
268 => Expression params tables grouping ('Required (nullity int))
511 => Expression params tables grouping ('Required (nullity int))
269 -> Expression params tables grouping ('Required (nullity int))
512 -> Expression params tables grouping ('Required (nullity int))
270 -> Expression params tables grouping ('Required (nullity int))
513 -> Expression params tables grouping ('Required (nullity int))
271−mod = unsafeBinaryOp "%"
514+mod_ = unsafeBinaryOp "%"
272
515
273trunc
516trunc
274 :: PGFloating frac
517 :: PGFloating frac
@@ -377,19 +620,19 @@ infix 4 /=*
377(>=*) = unsafeBinaryOp ">="
620(>=*) = unsafeBinaryOp ">="
378infix 4 >=*
621infix 4 >=*
379
622
380−(<*)
623+(*<)
381 :: Expression params tables grouping ('Required (nullity ty))
624 :: Expression params tables grouping ('Required (nullity ty))
382 -> Expression params tables grouping ('Required (nullity ty))
625 -> Expression params tables grouping ('Required (nullity ty))
383 -> Expression params tables grouping ('Required (nullity 'PGbool))
626 -> Expression params tables grouping ('Required (nullity 'PGbool))
384−(<*) = unsafeBinaryOp "<"
627+(*<) = unsafeBinaryOp "<"
385−infix 4 <*
628+infix 4 *<
386
629
387−(<=*)
630+(*<=)
388 :: Expression params tables grouping ('Required (nullity ty))
631 :: Expression params tables grouping ('Required (nullity ty))
389 -> Expression params tables grouping ('Required (nullity ty))
632 -> Expression params tables grouping ('Required (nullity ty))
390 -> Expression params tables grouping ('Required (nullity 'PGbool))
633 -> Expression params tables grouping ('Required (nullity 'PGbool))
391−(<=*) = unsafeBinaryOp "<="
634+(*<=) = unsafeBinaryOp "<="
392−infix 4 <=*
635+infix 4 *<=
393
636
394(>*)
637(>*)
395 :: Expression params tables grouping ('Required (nullity ty))
638 :: Expression params tables grouping ('Required (nullity ty))
@@ -456,7 +699,7 @@ aggregation
456-----------------------------------------}
699-----------------------------------------}
457
700
458data By
701data By
459− (tables :: [(Symbol,[(Symbol,ColumnType)])])
702+ (tables :: TablesType)
460 (by :: (Symbol,Symbol)) where
703 (by :: (Symbol,Symbol)) where
461 By
704 By
462 :: (tables ~ '[table ::: columns], HasColumn column columns ty)
705 :: (tables ~ '[table ::: columns], HasColumn column columns ty)
@@ -527,7 +770,7 @@ instance {-# OVERLAPPABLE #-}
527 ) => GroupedBy table column (tabcol ': bys)
770 ) => GroupedBy table column (tabcol ': bys)
528
771
529instance
772instance
530− ( tables ~ '[table ::: columns]
773+ ( HasUnique table tables columns
531 , HasColumn column columns ty
774 , HasColumn column columns ty
532 , GroupedBy table column bys
775 , GroupedBy table column bys
533 ) => IsLabel column
776 ) => IsLabel column
@@ -541,97 +784,80 @@ instance
541 ) => IsTableColumn table column
784 ) => IsTableColumn table column
542 (Expression params tables ('Grouped bys) ty) where (!) = getGroup2
785 (Expression params tables ('Grouped bys) ty) where (!) = getGroup2
543
786
544−data AllOrDistinct = All | Distinct
787+-- data AllOrDistinct = All | Distinct
545− deriving (GHC.Generic,Show,Eq,Ord,Data)
788+-- deriving (GHC.Generic,Show,Eq,Ord,Data)
546−instance NFData AllOrDistinct
789+-- instance NFData AllOrDistinct
547
790
548−renderAllOrDistinct :: AllOrDistinct -> ByteString
791+-- renderAllOrDistinct :: AllOrDistinct -> ByteString
549−renderAllOrDistinct = \case
792+-- renderAllOrDistinct = \case
550− All -> "ALL"
793+-- All -> "ALL"
551− Distinct -> "DISTINCT"
794+-- Distinct -> "DISTINCT"
552
795
553−unsafeAggregate
796+unsafeAggregate, unsafeAggregateDistinct
554 :: ByteString
797 :: ByteString
555− -> AllOrDistinct
556 -> Expression params tables 'Ungrouped ('Required xty)
798 -> Expression params tables 'Ungrouped ('Required xty)
557 -> Expression params tables ('Grouped bys) ('Required yty)
799 -> Expression params tables ('Grouped bys) ('Required yty)
558−unsafeAggregate fun allOrDistinct x = UnsafeExpression $ mconcat
800+unsafeAggregate fun x = UnsafeExpression $ mconcat
801+ [fun, "(", renderExpression x, ")"]
802+unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat
559− [fun, "(", renderAllOrDistinct allOrDistinct <+> renderExpression x, ")"]
803+ [fun, "(DISTINCT ", renderExpression x, ")"]
560
804
561−sum_
805+sum_, sumDistinct
562 :: PGNum ty
806 :: PGNum ty
563− => AllOrDistinct
564− -> Expression params tables 'Ungrouped ('Required (nullity ty))
807+ => Expression params tables 'Ungrouped ('Required (nullity ty))
565 -> Expression params tables ('Grouped bys) ('Required (nullity ty))
808 -> Expression params tables ('Grouped bys) ('Required (nullity ty))
566sum_ = unsafeAggregate "sum"
809sum_ = unsafeAggregate "sum"
567−
810+sumDistinct = unsafeAggregateDistinct "sum"
568−avgInt
811+
569− :: PGIntegral int
812+class PGAvg ty avg | ty -> avg where
570− => AllOrDistinct
813+ avg, avgDistinct
571− -> Expression params tables 'Ungrouped ('Required (nullity int))
814+ :: Expression params tables 'Ungrouped ('Required (nullity ty))
572− -> Expression params tables ('Grouped bys) ('Required (nullity 'PGnumeric))
815+ -> Expression params tables ('Grouped bys) ('Required (nullity avg))
573−avgInt = unsafeAggregate "avg"
816+ avg = unsafeAggregate "avg"
574−
817+ avgDistinct = unsafeAggregateDistinct "avg"
575−avgFloat
818+instance PGAvg 'PGint2 'PGnumeric
576− :: PGFloating float
819+instance PGAvg 'PGint4 'PGnumeric
577− => AllOrDistinct
820+instance PGAvg 'PGint8 'PGnumeric
578− -> Expression params tables 'Ungrouped ('Required (nullity float))
821+instance PGAvg 'PGnumeric 'PGnumeric
579− -> Expression params tables ('Grouped bys) ('Required (nullity 'PGfloat8))
822+instance PGAvg 'PGfloat4 'PGfloat8
580−avgFloat = unsafeAggregate "avg"
823+instance PGAvg 'PGfloat8 'PGfloat8
581−
824+instance PGAvg 'PGinterval 'PGinterval
825+
582−bitAnd
826+bitAnd, bitOr
583 :: PGIntegral int
827 :: PGIntegral int
584− => AllOrDistinct
585− -> Expression params tables 'Ungrouped ('Required (nullity int))
828+ => Expression params tables 'Ungrouped ('Required (nullity int))
586 -> Expression params tables ('Grouped bys) ('Required (nullity int))
829 -> Expression params tables ('Grouped bys) ('Required (nullity int))
587bitAnd = unsafeAggregate "bit_and"
830bitAnd = 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))
594bitOr = unsafeAggregate "bit_or"
831bitOr = unsafeAggregate "bit_or"
595
832
596−boolAnd
833+boolAnd, boolOr
597− :: AllOrDistinct
598− -> Expression params tables 'Ungrouped ('Required (nullity 'PGbool))
834+ :: Expression params tables 'Ungrouped ('Required (nullity 'PGbool))
599 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGbool))
835 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGbool))
600boolAnd = unsafeAggregate "bool_and"
836boolAnd = 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))
606boolOr = unsafeAggregate "bool_or"
837boolOr = unsafeAggregate "bool_or"
607
838
608−countStar
839+countStar, countDistinctStar
609− :: AllOrDistinct
610− -> Expression params table ('Grouped bys) ('Required ('NotNull 'PGint8))
840+ :: Expression params table ('Grouped bys) ('Required ('NotNull 'PGint8))
611−countStar allOrDistinct = UnsafeExpression $
841+countStar = UnsafeExpression $ "count(*)"
612− "count(" <> renderAllOrDistinct allOrDistinct <+> "*)"
842+countDistinctStar = UnsafeExpression $ "count(DISTINCT *)"
613
843
614count
844count
615− :: AllOrDistinct
616− -> Expression params tables 'Ungrouped ('Required ty)
845+ :: Expression params tables 'Ungrouped ('Required ty)
617 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGint8))
846 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGint8))
618count = unsafeAggregate "count"
847count = unsafeAggregate "count"
619
848
620every
849every
621− :: AllOrDistinct
622− -> Expression params tables 'Ungrouped ('Required (nullity 'PGbool))
850+ :: Expression params tables 'Ungrouped ('Required (nullity 'PGbool))
623 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGbool))
851 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGbool))
624every = unsafeAggregate "every"
852every = unsafeAggregate "every"
625
853
626jsonAgg
854jsonAgg
627− :: AllOrDistinct
628− -> Expression params tables 'Ungrouped ('Required ty)
855+ :: Expression params tables 'Ungrouped ('Required ty)
629 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjson))
856 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjson))
630jsonAgg = unsafeAggregate "json_agg"
857jsonAgg = unsafeAggregate "json_agg"
631
858
632jsonbAgg
859jsonbAgg
633− :: AllOrDistinct
634− -> Expression params tables 'Ungrouped ('Required ty)
860+ :: Expression params tables 'Ungrouped ('Required ty)
635 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjsonb))
861 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjsonb))
636jsonbAgg = unsafeAggregate "jsonb_agg"
862jsonbAgg = unsafeAggregate "jsonb_agg"
637
863
@@ -644,24 +870,17 @@ jsonObjectAgg k v = UnsafeExpression $
644 <> ", " <> renderExpression v <> ")"
870 <> ", " <> renderExpression v <> ")"
645
871
646jsonbObjectAgg
872jsonbObjectAgg
647− :: AllOrDistinct
648− -> Expression params tables 'Ungrouped ('Required ('NotNull keyty))
873+ :: Expression params tables 'Ungrouped ('Required ('NotNull keyty))
649 -> Expression params tables 'Ungrouped ('Required valty)
874 -> Expression params tables 'Ungrouped ('Required valty)
650 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjsonb))
875 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjsonb))
651−jsonbObjectAgg allOrDistinct k v = UnsafeExpression $
876+jsonbObjectAgg k v = UnsafeExpression $
652− "jsonb_object_agg(" <> renderAllOrDistinct allOrDistinct
877+ "jsonb_object_agg("
653− <+> renderExpression k <> ", " <> renderExpression v <> ")"
878+ <> renderExpression k <> ", " <> renderExpression v <> ")"
654
879
655−max_
880+max_, min_
656− :: AllOrDistinct
657− -> Expression params tables 'Ungrouped ('Required (nullity ty))
881+ :: Expression params tables 'Ungrouped ('Required (nullity ty))
658 -> Expression params tables ('Grouped bys) ('Required (nullity ty))
882 -> Expression params tables ('Grouped bys) ('Required (nullity ty))
659max_ = unsafeAggregate "max"
883max_ = unsafeAggregate "max"
660−
661−min_
662− :: AllOrDistinct
663− -> Expression params tables 'Ungrouped ('Required (nullity ty))
664− -> Expression params tables ('Grouped bys) ('Required (nullity ty))
665min_ = unsafeAggregate "min"
884min_ = unsafeAggregate "min"
666
885
667{-----------------------------------------
886{-----------------------------------------
@@ -669,8 +888,8 @@ tables
669-----------------------------------------}
888-----------------------------------------}
670
889
671newtype Table
890newtype Table
672− (schema :: [(Symbol,[(Symbol,ColumnType)])])
891+ (schema :: TablesType)
673− (columns :: [(Symbol,ColumnType)])
892+ (columns :: ColumnsType)
674 = UnsafeTable { renderTable :: ByteString }
893 = UnsafeTable { renderTable :: ByteString }
675 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
894 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
676
895
@@ -738,8 +957,8 @@ renderFromClause = \case
738
957
739data TableExpression
958data TableExpression
740 (params :: [ColumnType])
959 (params :: [ColumnType])
741− (schema :: [(Symbol,[(Symbol,ColumnType)])])
960+ (schema :: TablesType)
742− (tables :: [(Symbol,[(Symbol,ColumnType)])])
961+ (tables :: TablesType)
743 (grouping :: Grouping)
962 (grouping :: Grouping)
744 = TableExpression
963 = TableExpression
745 { fromClause :: FromClause params schema tables
964 { fromClause :: FromClause params schema tables
@@ -960,8 +1179,8 @@ statements
960-----------------------------------------}
1179-----------------------------------------}
961
1180
962newtype Definition
1181newtype Definition
963− (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
1182+ (schema0 :: TablesType)
964− (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
1183+ (schema1 :: TablesType)
965 = UnsafeDefinition { renderDefinition :: ByteString }
1184 = UnsafeDefinition { renderDefinition :: ByteString }
966 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1185 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
967
1186
@@ -971,16 +1190,16 @@ instance Category Definition where
971 renderDefinition ddl0 <+> renderDefinition ddl1
1190 renderDefinition ddl0 <+> renderDefinition ddl1
972
1191
973newtype Manipulation
1192newtype Manipulation
974− (schema :: [(Symbol,[(Symbol,ColumnType)])])
1193+ (schema :: TablesType)
975 (params :: [ColumnType])
1194 (params :: [ColumnType])
976− (columns :: [(Symbol,ColumnType)])
1195+ (columns :: ColumnsType)
977 = UnsafeManipulation { renderManipulation :: ByteString }
1196 = UnsafeManipulation { renderManipulation :: ByteString }
978 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1197 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
979
1198
980newtype Query
1199newtype Query
981− (schema :: [(Symbol,[(Symbol,ColumnType)])])
1200+ (schema :: TablesType)
982 (params :: [ColumnType])
1201 (params :: [ColumnType])
983− (columns :: [(Symbol,ColumnType)])
1202+ (columns :: ColumnsType)
984 = UnsafeQuery { renderQuery :: ByteString }
1203 = UnsafeQuery { renderQuery :: ByteString }
985 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1204 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
986
1205
@@ -1098,8 +1317,8 @@ createTable table columns constraints = UnsafeDefinition $
1098 _ -> ", " <> commaSeparated (renderTableConstraint <$> constraints)
1317 _ -> ", " <> commaSeparated (renderTableConstraint <$> constraints)
1099
1318
1100newtype TableConstraint
1319newtype TableConstraint
1101− (schema :: [(Symbol,[(Symbol,ColumnType)])])
1320+ (schema :: TablesType)
1102− (columns :: [(Symbol,ColumnType)])
1321+ (columns :: ColumnsType)
1103 = UnsafeTableConstraint { renderTableConstraint :: ByteString }
1322 = UnsafeTableConstraint { renderTableConstraint :: ByteString }
1104 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1323 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1105
1324
@@ -1224,7 +1443,7 @@ addColumnNull
1224 :: KnownSymbol column
1443 :: KnownSymbol column
1225 => Alias column
1444 => Alias column
1226 -> TypeExpression ('Required ('Null ty))
1445 -> TypeExpression ('Required ('Null ty))
1227− -> AlterTable columns ((column ::: 'Required ('Null ty)) ': columns)
1446+ -> AlterTable columns (Create column ('Required ('Null ty)) columns)
1228addColumnNull column ty = UnsafeAlterTable $
1447addColumnNull column ty = UnsafeAlterTable $
1229 "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty
1448 "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty
1230
1449
@@ -1295,9 +1514,9 @@ insertInto table insert conflict returning = UnsafeManipulation $
1295 <> renderReturningClause returning
1514 <> renderReturningClause returning
1296
1515
1297data ValuesClause
1516data ValuesClause
1298− (schema :: [(Symbol,[(Symbol,ColumnType)])])
1517+ (schema :: TablesType)
1299 (params :: [ColumnType])
1518 (params :: [ColumnType])
1300− (columns :: [(Symbol,ColumnType)])
1519+ (columns :: ColumnsType)
1301 = Values
1520 = Values
1302 (NP (Aliased (Expression params '[] 'Ungrouped)) columns)
1521 (NP (Aliased (Expression params '[] 'Ungrouped)) columns)
1303 [NP (Aliased (Expression params '[] 'Ungrouped)) columns]
1522 [NP (Aliased (Expression params '[] 'Ungrouped)) columns]
@@ -1322,8 +1541,8 @@ renderValuesClause = \case
1322
1541
1323data ReturningClause
1542data ReturningClause
1324 (params :: [ColumnType])
1543 (params :: [ColumnType])
1325− (columns :: [(Symbol,ColumnType)])
1544+ (columns :: ColumnsType)
1326− (results :: [(Symbol,ColumnType)])
1545+ (results :: ColumnsType)
1327 where
1546 where
1328 ReturningStar :: ReturningClause params columns columns
1547 ReturningStar :: ReturningClause params columns columns
1329 Returning
1548 Returning