git.iko.soy/squeal
on dev help sign in
NULLs
7485e50Eitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+2−2
compare with dev
unifiedsplit
@@ -35,8 +35,8 @@ import Squeel.PostgreSQL.Schema
35newtype Connection db = Connection { unConnection :: LibPQ.Connection }
35newtype Connection db = Connection { unConnection :: LibPQ.Connection }
36
36
37newtype PQ
37newtype PQ
38− (db0 :: [(Symbol,[(Symbol,PGType)])])
38+ (db0 :: [(Symbol,[(Symbol,NullityType)])])
39− (db1 :: [(Symbol,[(Symbol,PGType)])])
39+ (db1 :: [(Symbol,[(Symbol,NullityType)])])
40 (m :: * -> *)
40 (m :: * -> *)
41 (x :: *) =
41 (x :: *) =
42 PQ { runPQ :: Connection db0 -> m (x, Connection db1) }
42 PQ { runPQ :: Connection db0 -> m (x, Connection db1) }
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+44−4
@@ -9,6 +9,7 @@
9 , PolyKinds
9 , PolyKinds
10 , RankNTypes
10 , RankNTypes
11 , ScopedTypeVariables
11 , ScopedTypeVariables
12+ , TypeFamilies
12 , TypeOperators
13 , TypeOperators
13#-}
14#-}
14
15
@@ -23,6 +24,10 @@ module Squeel.PostgreSQL.Schema
23 , KnownPGType (..)
24 , KnownPGType (..)
24 , KnownColumns (..)
25 , KnownColumns (..)
25 , renderAliased
26 , renderAliased
27+ , NullityType (..)
28+ , NullifyType
29+ , NullifyColumns
30+ , NullifyTable
26 , module GHC.OverloadedLabels
31 , module GHC.OverloadedLabels
27 , module GHC.TypeLits
32 , module GHC.TypeLits
28 ) where
33 ) where
@@ -134,24 +139,59 @@ instance KnownPGType 'PGUuid where renderPGType _ = "uuid"
134instance KnownPGType 'PGJson where renderPGType _ = "json"
139instance KnownPGType 'PGJson where renderPGType _ = "json"
135instance KnownPGType 'PGJsonb where renderPGType _ = "jsonb"
140instance KnownPGType 'PGJsonb where renderPGType _ = "jsonb"
136
141
137−class KnownColumns (columns :: [(Symbol,PGType)]) where
142+class KnownColumns (columns :: [(Symbol,NullityType)]) where
138 renderColumns :: Proxy# columns -> ByteString
143 renderColumns :: Proxy# columns -> ByteString
139instance
144instance
140 ( KnownSymbol column
145 ( KnownSymbol column
141 , KnownPGType ty
146 , KnownPGType ty
142− ) => KnownColumns '[column ::: ty] where
147+ ) => KnownColumns '[column ::: 'NotNull ty] where
143 renderColumns _ =
148 renderColumns _ =
144 fromString (symbolVal' (proxy# :: Proxy# column))
149 fromString (symbolVal' (proxy# :: Proxy# column))
145 <> " "
150 <> " "
146 <> renderPGType (proxy# :: Proxy# ty)
151 <> renderPGType (proxy# :: Proxy# ty)
152+ <> " NOT NULL"
153+instance
154+ ( KnownSymbol column
155+ , KnownPGType ty
156+ ) => KnownColumns '[column ::: 'Null ty] where
157+ renderColumns _ =
158+ fromString (symbolVal' (proxy# :: Proxy# column))
159+ <> " "
160+ <> renderPGType (proxy# :: Proxy# ty)
161+ <> " NULL"
162+instance
163+ ( KnownSymbol column
164+ , KnownPGType ty
165+ , KnownColumns (columnsHead ': columnsTail)
166+ ) => KnownColumns ((column ::: 'NotNull ty) ': columnsHead ': columnsTail) where
167+ renderColumns _ =
168+ fromString (symbolVal' (proxy# :: Proxy# column))
169+ <> " "
170+ <> renderPGType (proxy# :: Proxy# ty)
171+ <> " NOT NULL, "
172+ <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))
147instance
173instance
148 ( KnownSymbol column
174 ( KnownSymbol column
149 , KnownPGType ty
175 , KnownPGType ty
150 , KnownColumns (columnsHead ': columnsTail)
176 , KnownColumns (columnsHead ': columnsTail)
151− ) => KnownColumns ((column ::: ty) ': columnsHead ': columnsTail) where
177+ ) => KnownColumns ((column ::: 'Null ty) ': columnsHead ': columnsTail) where
152 renderColumns _ =
178 renderColumns _ =
153 fromString (symbolVal' (proxy# :: Proxy# column))
179 fromString (symbolVal' (proxy# :: Proxy# column))
154 <> " "
180 <> " "
155 <> renderPGType (proxy# :: Proxy# ty)
181 <> renderPGType (proxy# :: Proxy# ty)
156− <> ", "
182+ <> " NULL, "
157 <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))
183 <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))
184+
185+data NullityType = Null PGType | NotNull PGType
186+
187+type family NullifyType nullty where
188+ NullifyType ('Null ty) = 'Null ty
189+ NullifyType ('NotNull ty) = 'Null ty
190+
191+type family NullifyColumns columns where
192+ NullifyColumns '[] = '[]
193+ NullifyColumns ((column ::: ty) ': columns) =
194+ (column ::: (NullifyType ty)) ': (NullifyColumns columns)
195+
196+type family NullifyTable table where
197+ NullifyTable (table ::: columns) = table ::: NullifyColumns columns
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+71−34
@@ -28,9 +28,9 @@ import qualified Data.ByteString as ByteString
28import Squeel.PostgreSQL.Schema
28import Squeel.PostgreSQL.Schema
29
29
30newtype Expression
30newtype Expression
31− (params :: [PGType])
31+ (params :: [NullityType])
32− (tables :: [(Symbol,[(Symbol,PGType)])])
32+ (tables :: [(Symbol,[(Symbol,NullityType)])])
33− (ty :: PGType)
33+ (ty :: NullityType)
34 = UnsafeExpression { renderExpression :: ByteString }
34 = UnsafeExpression { renderExpression :: ByteString }
35
35
36class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
36class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
@@ -94,7 +94,7 @@ unsafeFunction
94unsafeFunction fn x = UnsafeExpression $ mconcat
94unsafeFunction fn x = UnsafeExpression $ mconcat
95 [fn, "(", renderExpression x, ")"]
95 [fn, "(", renderExpression x, ")"]
96
96
97−instance PGNum ty => Num (Expression params tables ty) where
97+instance PGNum ty => Num (Expression params tables (nullity ty)) where
98 (+) = unsafeBinaryOp "+"
98 (+) = unsafeBinaryOp "+"
99 (-) = unsafeBinaryOp "-"
99 (-) = unsafeBinaryOp "-"
100 (*) = unsafeBinaryOp "*"
100 (*) = unsafeBinaryOp "*"
@@ -102,7 +102,7 @@ instance PGNum ty => Num (Expression params tables ty) where
102 signum = unsafeFunction "sign"
102 signum = unsafeFunction "sign"
103 fromInteger = UnsafeExpression . fromString . show
103 fromInteger = UnsafeExpression . fromString . show
104
104
105−instance IsString (Expression params tables 'PGText) where
105+instance IsString (Expression params tables (nullity 'PGText)) where
106 fromString str = UnsafeExpression $
106 fromString str = UnsafeExpression $
107 "E\'" <> fromString (escape =<< str) <> "\'"
107 "E\'" <> fromString (escape =<< str) <> "\'"
108 where
108 where
@@ -117,7 +117,7 @@ instance IsString (Expression params tables 'PGText) where
117 '\\' -> "\\\\"
117 '\\' -> "\\\\"
118 c -> [c]
118 c -> [c]
119
119
120−instance Boolean (Expression params tables 'PGBool) where
120+instance Boolean (Expression params tables ('NotNull 'PGBool)) where
121 true = UnsafeExpression "TRUE"
121 true = UnsafeExpression "TRUE"
122 false = UnsafeExpression "FALSE"
122 false = UnsafeExpression "FALSE"
123 notB = unsafeUnaryOp "NOT"
123 notB = unsafeUnaryOp "NOT"
@@ -125,10 +125,10 @@ instance Boolean (Expression params tables 'PGBool) where
125 (||*) = unsafeBinaryOp "OR"
125 (||*) = unsafeBinaryOp "OR"
126
126
127type instance BooleanOf (Expression params tables ty) =
127type instance BooleanOf (Expression params tables ty) =
128− Expression params tables 'PGBool
128+ Expression params tables ('NotNull 'PGBool)
129
129
130caseWhenThenElse
130caseWhenThenElse
131− :: [(Expression params tables 'PGBool, Expression params tables ty)]
131+ :: [(Expression params tables ('NotNull 'PGBool), Expression params tables ty)]
132 -> Expression params tables ty
132 -> Expression params tables ty
133 -> Expression params tables ty
133 -> Expression params tables ty
134caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
134caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
@@ -158,9 +158,9 @@ instance OrdB (Expression params tables ty) where
158 (<=*) = unsafeBinaryOp "<="
158 (<=*) = unsafeBinaryOp "<="
159
159
160newtype TableRef
160newtype TableRef
161− (params :: [PGType])
161+ (params :: [NullityType])
162− (schema :: [(Symbol,[(Symbol,PGType)])])
162+ (schema :: [(Symbol,[(Symbol,NullityType)])])
163− (tables :: [(Symbol,[(Symbol,PGType)])])
163+ (tables :: [(Symbol,[(Symbol,NullityType)])])
164 = UnsafeTableRef { renderTableRef :: ByteString }
164 = UnsafeTableRef { renderTableRef :: ByteString }
165
165
166class KnownSymbol table => HasTable table tables columns
166class KnownSymbol table => HasTable table tables columns
@@ -182,7 +182,7 @@ crossJoin tab tabs = UnsafeTableRef $
182
182
183innerJoin
183innerJoin
184 :: TableRef params schema '[table]
184 :: TableRef params schema '[table]
185− -> Expression params (table ': tables) 'PGBool
185+ -> Expression params (table ': tables) ('NotNull 'PGBool)
186 -> TableRef params schema tables
186 -> TableRef params schema tables
187 -> TableRef params schema (table ': tables)
187 -> TableRef params schema (table ': tables)
188innerJoin tab on tabs = UnsafeTableRef $
188innerJoin tab on tabs = UnsafeTableRef $
@@ -192,10 +192,47 @@ innerJoin tab on tabs = UnsafeTableRef $
192 <> " ON " <>
192 <> " ON " <>
193 renderExpression on
193 renderExpression on
194
194
195+leftOuterJoin
196+ :: TableRef params schema '[right]
197+ -> Expression params (right ': tables) ('NotNull 'PGBool)
198+ -> TableRef params schema (left : tables)
199+ -> TableRef params schema (NullifyTable right ': left ': tables)
200+leftOuterJoin tab on tabs = UnsafeTableRef $
201+ renderTableRef tabs
202+ <> " LEFT OUTER JOIN " <>
203+ renderTableRef tab
204+ <> " ON " <>
205+ renderExpression on
206+
207+rightOuterJoin
208+ :: TableRef params schema '[right]
209+ -> Expression params (right ': tables) ('NotNull 'PGBool)
210+ -> TableRef params schema (left : tables)
211+ -> TableRef params schema (right ': NullifyTable left ': tables)
212+rightOuterJoin tab on tabs = UnsafeTableRef $
213+ renderTableRef tabs
214+ <> " RIGHT OUTER JOIN " <>
215+ renderTableRef tab
216+ <> " ON " <>
217+ renderExpression on
218+
219+fullOuterJoin
220+ :: TableRef params schema '[right]
221+ -> Expression params (right ': tables) ('NotNull 'PGBool)
222+ -> TableRef params schema (left : tables)
223+ -> TableRef params schema
224+ (NullifyTable right ': NullifyTable left ': tables)
225+fullOuterJoin tab on tabs = UnsafeTableRef $
226+ renderTableRef tabs
227+ <> " FULL OUTER JOIN " <>
228+ renderTableRef tab
229+ <> " ON " <>
230+ renderExpression on
231+
195data Clauses params tables = Clauses
232data Clauses params tables = Clauses
196− { whereClause :: Maybe (Expression params tables 'PGBool)
233+ { whereClause :: Maybe (Expression params tables ('NotNull 'PGBool))
197− , limitClause :: Maybe (Expression params '[] 'PGInt8)
234+ , limitClause :: Maybe (Expression params '[] ('NotNull 'PGInt8))
198− , offsetClause :: Maybe (Expression params '[] 'PGInt8)
235+ , offsetClause :: Maybe (Expression params '[] ('NotNull 'PGInt8))
199 }
236 }
200
237
201instance Monoid (Clauses params tables) where
238instance Monoid (Clauses params tables) where
@@ -219,9 +256,9 @@ instance Monoid (Clauses params tables) where
219 }
256 }
220
257
221data TableExpression
258data TableExpression
222− (params :: [PGType])
259+ (params :: [NullityType])
223− (schema :: [(Symbol,[(Symbol,PGType)])])
260+ (schema :: [(Symbol,[(Symbol,NullityType)])])
224− (tables :: [(Symbol,[(Symbol,PGType)])])
261+ (tables :: [(Symbol,[(Symbol,NullityType)])])
225 = TableExpression
262 = TableExpression
226 { tableRef :: TableRef params schema tables
263 { tableRef :: TableRef params schema tables
227 , clauses :: Clauses params tables
264 , clauses :: Clauses params tables
@@ -249,30 +286,30 @@ instance (HasTable table schema columns, table ~ table')
249 fromLabel p = TableExpression (getTable p) mempty
286 fromLabel p = TableExpression (getTable p) mempty
250
287
251where_
288where_
252− :: Expression params tables 'PGBool
289+ :: Expression params tables ('NotNull 'PGBool)
253 -> TableExpression params schema tables
290 -> TableExpression params schema tables
254 -> TableExpression params schema tables
291 -> TableExpression params schema tables
255where_ wh (TableExpression tabs clauses1) = TableExpression tabs
292where_ wh (TableExpression tabs clauses1) = TableExpression tabs
256 (clauses1 <> Clauses (Just wh) Nothing Nothing)
293 (clauses1 <> Clauses (Just wh) Nothing Nothing)
257
294
258limit
295limit
259− :: Expression params '[] 'PGInt8
296+ :: Expression params '[] ('NotNull 'PGInt8)
260 -> TableExpression params schema tables
297 -> TableExpression params schema tables
261 -> TableExpression params schema tables
298 -> TableExpression params schema tables
262limit lim (TableExpression tabs clauses1) = TableExpression tabs
299limit lim (TableExpression tabs clauses1) = TableExpression tabs
263 (clauses1 <> Clauses Nothing (Just lim) Nothing)
300 (clauses1 <> Clauses Nothing (Just lim) Nothing)
264
301
265offset
302offset
266− :: Expression params '[] 'PGInt8
303+ :: Expression params '[] ('NotNull 'PGInt8)
267 -> TableExpression params schema tables
304 -> TableExpression params schema tables
268 -> TableExpression params schema tables
305 -> TableExpression params schema tables
269offset off (TableExpression tabs clauses1) = TableExpression tabs
306offset off (TableExpression tabs clauses1) = TableExpression tabs
270 (clauses1 <> Clauses Nothing Nothing (Just off))
307 (clauses1 <> Clauses Nothing Nothing (Just off))
271
308
272newtype Selection
309newtype Selection
273− (params :: [PGType])
310+ (params :: [NullityType])
274− (schema :: [(Symbol,[(Symbol,PGType)])])
311+ (schema :: [(Symbol,[(Symbol,NullityType)])])
275− (columns :: [(Symbol,PGType)])
312+ (columns :: [(Symbol,NullityType)])
276 = UnsafeSelection
313 = UnsafeSelection
277 { renderSelection :: ByteString }
314 { renderSelection :: ByteString }
278
315
@@ -282,12 +319,12 @@ starFrom
282 -> Selection params schema columns
319 -> Selection params schema columns
283starFrom tabs = UnsafeSelection $ "* FROM " <> renderTabulation tabs
320starFrom tabs = UnsafeSelection $ "* FROM " <> renderTabulation tabs
284
321
285−tableStarFrom
322+dotStarFrom
286 :: HasTable table tables columns
323 :: HasTable table tables columns
287 => Alias table
324 => Alias table
288 -> TableExpression params schema tables
325 -> TableExpression params schema tables
289 -> Selection params schema columns
326 -> Selection params schema columns
290−Alias tab `tableStarFrom` tabs = UnsafeSelection $
327+Alias tab `dotStarFrom` tabs = UnsafeSelection $
291 fromString (symbolVal' tab) <> ".* FROM" <> renderTabulation tabs
328 fromString (symbolVal' tab) <> ".* FROM" <> renderTabulation tabs
292
329
293from
330from
@@ -303,17 +340,17 @@ list `from` tabs = UnsafeSelection $
303 . rmap (Const . renderAliased renderExpression)
340 . rmap (Const . renderAliased renderExpression)
304
341
305newtype Statement
342newtype Statement
306− (params :: [PGType])
343+ (params :: [NullityType])
307− (schema0 :: [(Symbol,[(Symbol,PGType)])])
344+ (schema0 :: [(Symbol,[(Symbol,NullityType)])])
308− (schema1 :: [(Symbol,[(Symbol,PGType)])])
345+ (schema1 :: [(Symbol,[(Symbol,NullityType)])])
309− (columns :: [(Symbol,PGType)])
346+ (columns :: [(Symbol,NullityType)])
310 = UnsafeStatement { renderStatement :: ByteString }
347 = UnsafeStatement { renderStatement :: ByteString }
311
348
312newtype PreparedStatement
349newtype PreparedStatement
313− (params :: [PGType])
350+ (params :: [NullityType])
314− (schema0 :: [(Symbol,[(Symbol,PGType)])])
351+ (schema0 :: [(Symbol,[(Symbol,NullityType)])])
315− (schema1 :: [(Symbol,[(Symbol,PGType)])])
352+ (schema1 :: [(Symbol,[(Symbol,NullityType)])])
316− (columns :: [(Symbol,PGType)])
353+ (columns :: [(Symbol,NullityType)])
317 = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
354 = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
318
355
319select
356select