@@ -2,36 +2,47 @@ module Yoga.Postgres.Schema where
22
33import Prelude
44
5−import Data.Array as Array
5+import Control.Monad.Except (except, runExcept)
66import Data.Array (intercalate, mapWithIndex, foldl)
7−import Data.DateTime (DateTime)
7+import Data.Array as Array
8+import Data.Date (Date, day, month, year)
9+import Data.DateTime (DateTime(..))
10+import Data.Either (Either(..), note)
11+import Data.Enum (fromEnum, toEnum)
12+import Data.Int as Int
813import Data.JSDate as JSDate
9−import Data.Maybe (Maybe(..))
14+import Data.List.Types (NonEmptyList)
15+import Data.Map as Map
16+import Data.Maybe (Maybe(..), fromMaybe)
1017import Data.Newtype (class Newtype)
1118import Data.Nullable (toNullable)
12−import JS.BigInt (BigInt)
13−import Unsafe.Coerce (unsafeCoerce)
19+import Data.Number as Number
1420import Data.Reflectable (class Reflectable, reflectType)
15−import Data.String.Regex (regex, replace') as Regex
16−import Data.String.Regex (Regex) as Regex
21+import Data.String.CodeUnits as SCU
22+import Data.String.Common as Str
23+import Data.String.Pattern (Pattern(..))
24+import Data.String.Regex (Regex, regex, replace') as Regex
1725import Data.String.Regex.Flags (global) as Regex
18−import Control.Monad.Except (runExcept)
19−import Data.Either (Either(..))
20−import Data.Map as Map
2126import Data.Symbol (class IsSymbol, reflectSymbol)
22−import Type.Function (type (#))
23−import Effect.Aff (Aff)
24−import Foreign (Foreign, unsafeToForeign)
27+import Data.Time (Time(..))
28+import Data.Traversable (traverse)
29+import Data.UUID (UUID)
30+import Data.UUID as UUID
31+import Effect.Aff (Aff, throwError)
32+import Effect.Exception (error) as Exception
33+import Foreign (Foreign, ForeignError(..))
34+import JS.BigInt (BigInt)
2535import Prim.Boolean (True, False)
2636import Prim.Row (class Cons, class Lacks, class Union, class Nub) as Row
27−import Prim.RowList as RL
2837import Prim.RowList (class RowToList)
38+import Prim.RowList as RL
2939import Prim.Symbol (class Cons, class Append) as Symbol
3040import Prim.TypeError (class Fail, Beside, Text, Quote)
3141import Record (get) as Record
3242import Type.Proxy (Proxy(..))
3343import Type.RowList (class ListToRow)
34−import Yoga.JSON (class ReadForeign, readImpl)
44+import Unsafe.Coerce (unsafeCoerce)
45+import Yoga.JSON (class ReadForeign, class WriteForeign, readImpl, writeImpl)
3546import Yoga.Postgres as PG
3647
3748-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -57,15 +68,15 @@ data Unique a
5768
5869data Default :: forall k. k -> Type -> Type
5970data Default val a
71+data DefaultExpr :: Symbol -> Type -> Type
72+data DefaultExpr expression a
73+
6074
6175data References
6276
6377data ForeignKey :: Symbol -> Type -> Symbol -> Type -> Type
6478data ForeignKey table references col a
6579
66−data DefaultExpr :: Symbol -> Type -> Type
67−data DefaultExpr expr a
68−
6980-- Internal: used by LEFT JOIN to mark columns as nullable
7081data Nullable :: Type -> Type
7182data Nullable a
@@ -81,21 +92,177 @@ derive instance Newtype Jsonb _
8192instance ReadForeign Jsonb where
8293 readImpl = pure <<< Jsonb
8394
95+instance WriteForeign Jsonb where
96+ writeImpl (Jsonb value) = value
97+
98+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
99+-- PGUUID: newtype over Data.UUID.UUID for Postgres integration
100+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
101+
102+newtype PGUUID = PGUUID UUID
103+
104+derive instance Newtype PGUUID _
105+derive newtype instance Eq PGUUID
106+derive newtype instance Ord PGUUID
107+derive newtype instance Show PGUUID
108+
109+instance ReadForeign PGUUID where
110+ readImpl f = do
111+ s :: String <- readImpl f
112+ pure (unsafeCoerce s)
113+
114+instance WriteForeign PGUUID where
115+ writeImpl (PGUUID uuid) = writeImpl (UUID.toString uuid)
116+
84117-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
85−-- UUID type for Postgres
118+-- PGDate / PGTime: newtypes for DATE and TIME columns
86119-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
87120
88−newtype UUID = UUID String
121+newtype PGDate = PGDate Date
122+
123+derive instance Newtype PGDate _
124+derive instance Eq PGDate
125+derive instance Ord PGDate
126+instance Show PGDate where
127+ show (PGDate d) = "(PGDate " <> show d <> ")"
128+
129+instance ReadForeign PGDate where
130+ readImpl f =
131+ except $ note (pure (ForeignError "Invalid date")) (JSDate.toDate jsDate <#> PGDate)
132+ where
133+ jsDate :: JSDate.JSDate
134+ jsDate = unsafeCoerce f
135+
136+instance WriteForeign PGDate where
137+ writeImpl (PGDate date) =
138+ writeImpl
139+ ( show (fromEnum (year date))
140+ <> "-"
141+ <> pad2 (fromEnum (month date))
142+ <> "-"
143+ <> pad2 (fromEnum (day date))
144+ )
145+ where
146+ pad2 n = if n < 10 then "0" <> show n else show n
147+
148+newtype TimestampTZ = TimestampTZ DateTime
149+
150+derive instance Newtype TimestampTZ _
151+derive instance Eq TimestampTZ
152+derive instance Ord TimestampTZ
153+instance Show TimestampTZ where
154+ show (TimestampTZ dt) = "(TimestampTZ " <> show dt <> ")"
155+
156+instance ReadForeign TimestampTZ where
157+ readImpl f =
158+ except $ note (pure (ForeignError "Invalid timestamp")) (JSDate.toDateTime jsDate <#> TimestampTZ)
159+ where
160+ jsDate :: JSDate.JSDate
161+ jsDate = unsafeCoerce f
162+
163+newtype PGTime = PGTime Time
164+
165+derive instance Newtype PGTime _
166+derive instance Eq PGTime
167+derive instance Ord PGTime
168+instance Show PGTime where
169+ show (PGTime t) = "(PGTime " <> show t <> ")"
170+
171+instance ReadForeign PGTime where
172+ readImpl f = do
173+ s :: String <- readImpl f
174+ except $ note (pure (ForeignError ("Invalid time: " <> s))) (parseTime s)
175+ where
176+ parseTime str = do
177+ let parts = Str.split (Pattern ":") str
178+ case parts of
179+ [ hStr, mStr, sStr ] -> do
180+ h <- Int.fromString hStr >>= toEnum
181+ mi <- Int.fromString mStr >>= toEnum
182+ let secParts = Str.split (Pattern ".") sStr
183+ s <- Int.fromString (fromMaybe sStr (Array.head secParts)) >>= toEnum
184+ let fraction = fromMaybe "" (Array.index secParts 1)
185+ let milliseconds = case SCU.length fraction of
186+ 0 -> "0"
187+ 1 -> fraction <> "00"
188+ 2 -> fraction <> "0"
189+ _ -> SCU.take 3 fraction
190+ let ms = fromMaybe bottom (Int.fromString milliseconds >>= toEnum)
191+ pure (PGTime (Time h mi s ms))
192+ _ -> Nothing
193+
194+instance WriteForeign PGTime where
195+ writeImpl (PGTime (Time hour minute second millisecond)) =
196+ writeImpl
197+ ( pad2 (fromEnum hour)
198+ <> ":"
199+ <> pad2 (fromEnum minute)
200+ <> ":"
201+ <> pad2 (fromEnum second)
202+ <> "."
203+ <> pad3 (fromEnum millisecond)
204+ )
205+ where
206+ pad2 n = if n < 10 then "0" <> show n else show n
207+ pad3 n
208+ | n < 10 = "00" <> show n
209+ | n < 100 = "0" <> show n
210+ | otherwise = show n
211+
212+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
213+-- Point: geometric point "(x,y)"
214+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
215+
216+newtype Point = Point { x :: Number, y :: Number }
217+
218+derive instance Newtype Point _
219+derive instance Eq Point
89220
90−derive instance Newtype UUID _
91−derive newtype instance Eq UUID
92−derive newtype instance Ord UUID
93−derive newtype instance Show UUID
221+instance Show Point where
222+ show (Point { x, y }) = "(Point " <> show x <> " " <> show y <> ")"
94223
95−instance ReadForeign UUID where
224+instance ReadForeign Point where
96225 readImpl f = do
97226 s :: String <- readImpl f
98− pure (UUID s)
227+ except $ note (pure (ForeignError ("Invalid point: " <> s))) (parsePoint s)
228+ where
229+ parsePoint str = do
230+ let inner = SCU.drop 1 (SCU.dropRight 1 str)
231+ let parts = Str.split (Pattern ",") inner
232+ case parts of
233+ [ xStr, yStr ] -> do
234+ x <- Number.fromString xStr
235+ y <- Number.fromString yStr
236+ pure (Point { x, y })
237+ _ -> Nothing
238+
239+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
240+-- TSVector / TSQuery: full-text search types
241+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
242+
243+newtype TSVector = TSVector String
244+
245+derive instance Newtype TSVector _
246+derive newtype instance Eq TSVector
247+derive newtype instance Ord TSVector
248+derive newtype instance Show TSVector
249+
250+instance ReadForeign TSVector where
251+ readImpl f = do
252+ s :: String <- readImpl f
253+ pure (TSVector s)
254+
255+newtype TSQuery = TSQuery String
256+
257+derive instance Newtype TSQuery _
258+derive newtype instance Eq TSQuery
259+derive newtype instance Ord TSQuery
260+derive newtype instance Show TSQuery
261+
262+instance ReadForeign TSQuery where
263+ readImpl f = do
264+ s :: String <- readImpl f
265+ pure (TSQuery s)
99266
100267-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
101268-- Nullability: inferred from Maybe
@@ -120,7 +287,7 @@ instance ExtractType a typ => ExtractType (PrimaryKey a) typ
120287else instance ExtractType a typ => ExtractType (AutoIncrement a) typ
121288else instance ExtractType a typ => ExtractType (Unique a) typ
122289else instance ExtractType a typ => ExtractType (Default val a) typ
123−else instance ExtractType a typ => ExtractType (DefaultExpr expr a) typ
290+else instance ExtractType a typ => ExtractType (DefaultExpr expression a) typ
124291else instance ExtractType a typ => ExtractType (ForeignKey t r c a) typ
125292else instance ExtractType a typ => ExtractType (Nullable a) (Maybe typ)
126293else instance ExtractType a a
@@ -150,9 +317,27 @@ instance PGTypeName DateTime where
150317instance PGTypeName BigInt where
151318 pgTypeName _ = "BIGINT"
152319
153−instance PGTypeName UUID where
320+instance PGTypeName PGUUID where
154321 pgTypeName _ = "UUID"
155322
323+instance PGTypeName TimestampTZ where
324+ pgTypeName _ = "TIMESTAMPTZ"
325+
326+instance PGTypeName PGDate where
327+ pgTypeName _ = "DATE"
328+
329+instance PGTypeName PGTime where
330+ pgTypeName _ = "TIME"
331+
332+instance PGTypeName Point where
333+ pgTypeName _ = "POINT"
334+
335+instance PGTypeName TSVector where
336+ pgTypeName _ = "TSVECTOR"
337+
338+instance PGTypeName TSQuery where
339+ pgTypeName _ = "TSQUERY"
340+
156341instance PGTypeName Jsonb where
157342 pgTypeName _ = "JSONB"
158343
@@ -175,8 +360,24 @@ instance Reflectable sym String => RenderDefaultValue sym String where
175360instance Reflectable val Int => RenderDefaultValue val Int where
176361 renderDefaultValue _ _ = "DEFAULT " <> show (reflectType (Proxy :: Proxy val))
177362
178−instance Reflectable val Boolean => RenderDefaultValue val Boolean where
179− renderDefaultValue _ _ = if reflectType (Proxy :: Proxy val) then "DEFAULT true" else "DEFAULT false"
363+instance RenderDefaultValue True Boolean where
364+ renderDefaultValue _ _ = "DEFAULT true"
365+
366+instance RenderDefaultValue False Boolean where
367+ renderDefaultValue _ _ = "DEFAULT false"
368+
369+instance RenderDefaultValue "true" Boolean where
370+ renderDefaultValue _ _ = "DEFAULT true"
371+
372+instance RenderDefaultValue "false" Boolean where
373+ renderDefaultValue _ _ = "DEFAULT false"
374+
375+instance RenderDefaultValue "now()" TimestampTZ where
376+ renderDefaultValue _ _ = "DEFAULT now()"
377+
378+instance RenderDefaultValue "gen_random_uuid()" PGUUID where
379+ renderDefaultValue _ _ = "DEFAULT gen_random_uuid()"
380+
180381
181382class RenderConstraint a where
182383 renderConstraint :: Proxy a -> String
@@ -193,11 +394,10 @@ else instance RenderConstraint a => RenderConstraint (Unique a) where
193394else instance (RenderDefaultValue val a, RenderConstraint a) => RenderConstraint (Default val a) where
194395 renderConstraint _ = joinConstraints (renderDefaultValue (Proxy :: Proxy val) (Proxy :: Proxy a)) (renderConstraint (Proxy :: Proxy a))
195396
196−else instance (IsSymbol expr, RenderConstraint a) => RenderConstraint (DefaultExpr expr a) where
397+else instance (IsSymbol expression, RenderConstraint a) => RenderConstraint (DefaultExpr expression a) where
197398 renderConstraint _ = joinConstraints
198− ("DEFAULT " <> reflectSymbol (Proxy :: Proxy expr))
399+ ("DEFAULT " <> reflectSymbol (Proxy :: Proxy expression))
199400 (renderConstraint (Proxy :: Proxy a))
200−
201401else instance (IsSymbol table, IsSymbol col, RenderConstraint a) => RenderConstraint (ForeignKey table References col a) where
202402 renderConstraint _ = joinConstraints
203403 ("REFERENCES " <> reflectSymbol (Proxy :: Proxy table) <> "(" <> reflectSymbol (Proxy :: Proxy col) <> ")")
@@ -258,6 +458,11 @@ instance
258458 let columns = renderColumnsRL (Proxy :: Proxy rl)
259459 "CREATE TABLE " <> tableName <> " (" <> intercalate ", " columns <> ")"
260460
461+createTableDDLIfNotExists :: forall @a. CreateTableDDL a => String
462+createTableDDLIfNotExists = do
463+ let ddl = createTableDDL @a
464+ "CREATE TABLE IF NOT EXISTS" <> SCU.drop 12 ddl
465+
261466-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
262467-- INSERT SQL generation
263468-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -269,7 +474,7 @@ instance IsAutoGenerated (AutoIncrement a) where
269474 isAutoGenerated _ = true
270475else instance IsAutoGenerated (Default v a) where
271476 isAutoGenerated _ = true
272−else instance IsAutoGenerated (DefaultExpr expr a) where
477+else instance IsAutoGenerated (DefaultExpr expression a) where
273478 isAutoGenerated _ = true
274479else instance IsAutoGenerated a => IsAutoGenerated (PrimaryKey a) where
275480 isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)
@@ -314,15 +519,18 @@ instance
314519 insertSQLFor = do
315520 let tableName = reflectSymbol (Proxy :: Proxy name)
316521 let cols = insertColumnsRL (Proxy :: Proxy rl)
317− let placeholders = cols # mapWithIndex \i _ -> "$" <> show (i + 1)
318− "INSERT INTO " <> tableName
319− <> " ("
320− <> intercalate ", " cols
321− <> ")"
322− <> " VALUES ("
323− <> intercalate ", " placeholders
324− <> ")"
325− <> " RETURNING *"
522+ if Array.null cols then
523+ "INSERT INTO " <> tableName <> " DEFAULT VALUES RETURNING *"
524+ else do
525+ let placeholders = cols # mapWithIndex \i _ -> "$" <> show (i + 1)
526+ "INSERT INTO " <> tableName
527+ <> " ("
528+ <> intercalate ", " cols
529+ <> ")"
530+ <> " VALUES ("
531+ <> intercalate ", " placeholders
532+ <> ")"
533+ <> " RETURNING *"
326534
327535-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
328536-- SELECT SQL generation
@@ -777,6 +985,15 @@ else instance
777985 ) =>
778986 ParseSelectHandleAS "as" afterKeyword colRef tables accRL outRL
779987
988+-- Bare alias (no AS keyword): "name n" means "name AS n"
989+else instance
990+ ( ResolveColumn colRef tables entry
991+ , ExtractType entry typ
992+ , SkipSpaces afterKeyword rest
993+ , ParseSelectExpectEnd rest tables (RL.Cons keyword typ accRL) outRL
994+ ) =>
995+ ParseSelectHandleAS keyword afterKeyword colRef tables accRL outRL
996+
780997class ParseSelectExpectEnd :: Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
781998class ParseSelectExpectEnd sym tables accRL outRL | sym tables accRL -> outRL
782999
@@ -875,11 +1092,66 @@ instance ResolveAggregateArg "*" tables Star
8751092else instance ResolveAggregateArg "" tables Star
8761093else instance
8771094 ( SkipSpaces args trimmedFront
878− , ExtractWord trimmedFront col _rest
879− , ResolveAggregateArgCol col tables argType
1095+ , ExtractIdent trimmedFront col rest
1096+ , ResolveAggregateArgDispatch col rest tables argType
8801097 ) =>
8811098 ResolveAggregateArg args tables argType
8821099
1100+-- ExtractIdent: like ExtractWord but also stops at "(" so we can detect nested function calls
1101+class ExtractIdent :: Symbol -> Symbol -> Symbol -> Constraint
1102+class ExtractIdent sym word rest | sym -> word rest
1103+
1104+instance ExtractIdent "" "" ""
1105+else instance
1106+ ( Symbol.Cons h t sym
1107+ , ExtractIdentGo h t "" word rest
1108+ ) =>
1109+ ExtractIdent sym word rest
1110+
1111+class ExtractIdentGo :: Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> Constraint
1112+class ExtractIdentGo head tail acc word rest | head tail acc -> word rest
1113+
1114+instance (SkipSpaces tail rest) => ExtractIdentGo " " tail acc acc rest
1115+else instance Symbol.Cons "," tail rest => ExtractIdentGo "," tail acc acc rest
1116+else instance Symbol.Append "(" tail rest => ExtractIdentGo "(" tail acc acc rest
1117+else instance Symbol.Append acc h word => ExtractIdentGo h "" acc word ""
1118+else instance
1119+ ( Symbol.Append acc h acc'
1120+ , Symbol.Cons nextH nextT tail
1121+ , ExtractIdentGo nextH nextT acc' word rest
1122+ ) =>
1123+ ExtractIdentGo h tail acc word rest
1124+
1125+-- After extracting the identifier, check if followed by "(" (nested function call) or not (column ref)
1126+class ResolveAggregateArgDispatch :: Symbol -> Symbol -> Row (Row Type) -> Type -> Constraint
1127+class ResolveAggregateArgDispatch col rest tables argType | col rest tables -> argType
1128+
1129+instance
1130+ ResolveAggregateArgCol col tables argType =>
1131+ ResolveAggregateArgDispatch col "" tables argType
1132+
1133+else instance
1134+ ( Symbol.Cons h t rest
1135+ , ResolveAggregateArgDispatchByHead h t col tables argType
1136+ ) =>
1137+ ResolveAggregateArgDispatch col rest tables argType
1138+
1139+class ResolveAggregateArgDispatchByHead :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> Type -> Constraint
1140+class ResolveAggregateArgDispatchByHead head tail col tables argType | head tail col tables -> argType
1141+
1142+-- Nested function call: col(...)
1143+instance
1144+ ( ExtractUntilParen tail innerArgs _afterParen
1145+ , ResolveAggregateArg innerArgs tables innerArgType
1146+ , AggregateReturnType col innerArgType argType
1147+ ) =>
1148+ ResolveAggregateArgDispatchByHead "(" tail col tables argType
1149+
1150+-- Not a function call: column reference
1151+else instance
1152+ ResolveAggregateArgCol col tables argType =>
1153+ ResolveAggregateArgDispatchByHead h t col tables argType
1154+
8831155class ResolveAggregateArgCol :: Symbol -> Row (Row Type) -> Type -> Constraint
8841156class ResolveAggregateArgCol col tables argType | col tables -> argType
8851157
@@ -964,8 +1236,8 @@ else instance
9641236class AggregateReturnTypeC :: Symbol -> Type -> Type -> Constraint
9651237class AggregateReturnTypeC funcName argType returnType | funcName argType -> returnType
9661238
967−instance AggregateReturnTypeC "COUNT" argType Int
968−else instance AggregateReturnTypeC "count" argType Int
1239+instance AggregateReturnTypeC "COUNT" argType BigInt
1240+else instance AggregateReturnTypeC "count" argType BigInt
9691241else instance AggregateReturnTypeC "COALESCE" argType argType
9701242else instance AggregateReturnTypeC "coalesce" argType argType
9711243else instance
@@ -1448,8 +1720,12 @@ else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut pa
14481720else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "u" word currentType tables paramsIn currentTypeOut paramsOut
14491721else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "V" word currentType tables paramsIn currentTypeOut paramsOut
14501722else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "v" word currentType tables paramsIn currentTypeOut paramsOut
1723+else instance FlushWhereWordP word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "P" word currentType tables paramsIn currentTypeOut paramsOut
1724+else instance FlushWhereWordP word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "p" word currentType tables paramsIn currentTypeOut paramsOut
1725+else instance FlushWhereWordR word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "R" word currentType tables paramsIn currentTypeOut paramsOut
1726+else instance FlushWhereWordR word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "r" word currentType tables paramsIn currentTypeOut paramsOut
14511727
1452−-- Catch-all: column reference (letters without keywords like g, h, p, q, r, w, x, y, z)
1728+-- Catch-all: column reference (letters without keywords like g, h, q, w, x, y, z)
14531729else instance
14541730 ( ResolveColumn word tables entry
14551731 , ExtractType entry typ
@@ -1522,7 +1798,8 @@ else instance
15221798class FlushWhereWordD :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
15231799class FlushWhereWordD word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
15241800
1525−instance FlushWhereWordD "date" currentType tables paramsIn currentType paramsIn
1801+instance FlushWhereWordD "DATE" currentType tables paramsIn currentType paramsIn
1802+else instance FlushWhereWordD "date" currentType tables paramsIn currentType paramsIn
15261803else instance
15271804 ( ResolveColumn word tables entry
15281805 , ExtractType entry typ
@@ -1637,7 +1914,9 @@ else instance
16371914class FlushWhereWordS :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
16381915class FlushWhereWordS word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
16391916
1640−instance FlushWhereWordS "SUM" currentType tables paramsIn currentType paramsIn
1917+instance FlushWhereWordS "SMALLINT" currentType tables paramsIn currentType paramsIn
1918+else instance FlushWhereWordS "smallint" currentType tables paramsIn currentType paramsIn
1919+else instance FlushWhereWordS "SUM" currentType tables paramsIn currentType paramsIn
16411920else instance FlushWhereWordS "sum" currentType tables paramsIn currentType paramsIn
16421921else instance FlushWhereWordS "STRING_AGG" currentType tables paramsIn String paramsIn
16431922else instance FlushWhereWordS "string_agg" currentType tables paramsIn String paramsIn
@@ -1658,6 +1937,16 @@ else instance FlushWhereWordT "true" currentType tables paramsIn currentType par
16581937else instance FlushWhereWordT "text" currentType tables paramsIn currentType paramsIn
16591938else instance FlushWhereWordT "timestamptz" currentType tables paramsIn currentType paramsIn
16601939else instance FlushWhereWordT "timestamp" currentType tables paramsIn currentType paramsIn
1940+else instance FlushWhereWordT "TIME" currentType tables paramsIn currentType paramsIn
1941+else instance FlushWhereWordT "time" currentType tables paramsIn currentType paramsIn
1942+else instance FlushWhereWordT "tsvector" currentType tables paramsIn currentType paramsIn
1943+else instance FlushWhereWordT "TSVECTOR" currentType tables paramsIn currentType paramsIn
1944+else instance FlushWhereWordT "tsquery" currentType tables paramsIn currentType paramsIn
1945+else instance FlushWhereWordT "TSQUERY" currentType tables paramsIn currentType paramsIn
1946+else instance FlushWhereWordT "to_tsvector" currentType tables paramsIn String paramsIn
1947+else instance FlushWhereWordT "TO_TSVECTOR" currentType tables paramsIn String paramsIn
1948+else instance FlushWhereWordT "to_tsquery" currentType tables paramsIn String paramsIn
1949+else instance FlushWhereWordT "TO_TSQUERY" currentType tables paramsIn String paramsIn
16611950else instance
16621951 ( ResolveColumn word tables entry
16631952 , ExtractType entry typ
@@ -1689,6 +1978,32 @@ else instance
16891978 ) =>
16901979 FlushWhereWordV word currentType tables paramsIn unwrapped paramsIn
16911980
1981+class FlushWhereWordP :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
1982+class FlushWhereWordP word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
1983+
1984+instance FlushWhereWordP "point" currentType tables paramsIn currentType paramsIn
1985+else instance FlushWhereWordP "POINT" currentType tables paramsIn currentType paramsIn
1986+else instance FlushWhereWordP "plainto_tsquery" currentType tables paramsIn currentType paramsIn
1987+else instance FlushWhereWordP "PLAINTO_TSQUERY" currentType tables paramsIn currentType paramsIn
1988+else instance
1989+ ( ResolveColumn word tables entry
1990+ , ExtractType entry typ
1991+ , UnwrapMaybe typ unwrapped
1992+ ) =>
1993+ FlushWhereWordP word currentType tables paramsIn unwrapped paramsIn
1994+
1995+class FlushWhereWordR :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
1996+class FlushWhereWordR word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
1997+
1998+instance FlushWhereWordR "real" currentType tables paramsIn currentType paramsIn
1999+else instance FlushWhereWordR "REAL" currentType tables paramsIn currentType paramsIn
2000+else instance
2001+ ( ResolveColumn word tables entry
2002+ , ExtractType entry typ
2003+ , UnwrapMaybe typ unwrapped
2004+ ) =>
2005+ FlushWhereWordR word currentType tables paramsIn unwrapped paramsIn
2006+
16922007-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
16932008-- ValidateColumnList: comma-separated column references
16942009-- Used by GROUP BY, DISTINCT ON, ON CONFLICT target
@@ -2342,13 +2657,85 @@ else instance
23422657 , SkipSpaces rest1 rest2
23432658 , ExpectChar rest2 "=" rest3
23442659 , SkipSpaces rest3 rest4
2345− , ExtractWord rest4 excRef rest5
2346− , ValidateExcludedRef excRef colName
2347− , SkipSpaces rest5 rest6
2348− , ParseAssignmentsContinue rest6 cols
2660+ , SkipExpression rest4 rest5
2661+ , ParseAssignmentsContinue rest5 cols
23492662 ) =>
23502663 ParseAssignments sym cols
23512664
2665+-- | Skip a SQL expression on the RHS of an assignment.
2666+-- | Handles balanced parentheses so that e.g. now() and
2667+-- | COALESCE(EXCLUDED.value, '') are consumed as a single expression.
2668+-- | Stops at an unparenthesised comma or end-of-string.
2669+class SkipExpression :: Symbol -> Symbol -> Constraint
2670+class SkipExpression sym rest | sym -> rest
2671+
2672+instance SkipExpression "" ""
2673+else instance
2674+ ( Symbol.Cons h t sym
2675+ , SkipExpressionGo h t rest
2676+ ) =>
2677+ SkipExpression sym rest
2678+
2679+class SkipExpressionGo :: Symbol -> Symbol -> Symbol -> Constraint
2680+class SkipExpressionGo head tail rest | head tail -> rest
2681+
2682+-- Comma at depth 0 → stop, keep comma in rest
2683+instance Symbol.Cons "," tail rest => SkipExpressionGo "," tail rest
2684+-- Open paren → enter nested expression
2685+else instance
2686+ ( SkipNested tail rest1
2687+ , SkipExpression rest1 rest
2688+ ) =>
2689+ SkipExpressionGo "(" tail rest
2690+-- Space → skip and continue (expressions can have spaces, e.g. "EXCLUDED.col")
2691+else instance (SkipSpaces tail rest1, SkipExpressionAfterSpace rest1 rest) => SkipExpressionGo " " tail rest
2692+-- End of string after this char
2693+else instance SkipExpressionGo h "" ""
2694+-- Regular char → continue
2695+else instance (Symbol.Cons h2 t2 tail, SkipExpressionGo h2 t2 rest) => SkipExpressionGo h tail rest
2696+
2697+-- | After a space in an expression, check if we've hit a comma or a new assignment (word = ...).
2698+-- | If the next word is a column name followed by '=', this is a new assignment, so stop.
2699+-- | Otherwise, continue the expression.
2700+class SkipExpressionAfterSpace :: Symbol -> Symbol -> Constraint
2701+class SkipExpressionAfterSpace sym rest | sym -> rest
2702+
2703+instance SkipExpressionAfterSpace "" ""
2704+else instance
2705+ ( Symbol.Cons h t sym
2706+ , SkipExpressionAfterSpaceGo h t sym rest
2707+ ) =>
2708+ SkipExpressionAfterSpace sym rest
2709+
2710+class SkipExpressionAfterSpaceGo :: Symbol -> Symbol -> Symbol -> Symbol -> Constraint
2711+class SkipExpressionAfterSpaceGo head tail sym rest | head tail sym -> rest
2712+
2713+-- Comma → stop
2714+instance Symbol.Cons "," tail rest => SkipExpressionAfterSpaceGo "," tail sym rest
2715+-- Otherwise continue the expression
2716+else instance (SkipExpressionGo h tail rest) => SkipExpressionAfterSpaceGo h tail sym rest
2717+
2718+-- | Skip a parenthesised group (after the opening paren has been consumed).
2719+-- | Handles nesting.
2720+class SkipNested :: Symbol -> Symbol -> Constraint
2721+class SkipNested sym rest | sym -> rest
2722+
2723+instance
2724+ ( Symbol.Cons h t sym
2725+ , SkipNestedGo h t rest
2726+ ) =>
2727+ SkipNested sym rest
2728+
2729+class SkipNestedGo :: Symbol -> Symbol -> Symbol -> Constraint
2730+class SkipNestedGo head tail rest | head tail -> rest
2731+
2732+-- Close paren → done
2733+instance SkipNestedGo ")" tail tail
2734+-- Open paren → recurse
2735+else instance (SkipNested tail rest1, SkipNested rest1 rest) => SkipNestedGo "(" tail rest
2736+-- Any other char → continue
2737+else instance (SkipNested tail rest) => SkipNestedGo h tail rest
2738+
23522739class ParseAssignmentsContinue :: Symbol -> Row Type -> Constraint
23532740class ParseAssignmentsContinue sym cols
23542741
@@ -2411,7 +2798,7 @@ class IsAutoGeneratedTC constraints result | constraints -> result
24112798
24122799instance IsAutoGeneratedTC (AutoIncrement a) True
24132800else instance IsAutoGeneratedTC (Default s a) True
2414−else instance IsAutoGeneratedTC (DefaultExpr expr a) True
2801+else instance IsAutoGeneratedTC (DefaultExpr expression a) True
24152802else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (PrimaryKey a) result
24162803else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (Unique a) result
24172804else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (ForeignKey t r c a) result
@@ -2467,11 +2854,19 @@ class FieldToPGValue a where
24672854 fieldToPGValue :: a -> PG.PGValue
24682855
24692856instance FieldToPGValue a => FieldToPGValue (Maybe a) where
2470− fieldToPGValue = toNullable >>> unsafeCoerce
2857+ fieldToPGValue = case _ of
2858+ Nothing -> unsafeCoerce (toNullable Nothing)
2859+ Just value -> fieldToPGValue value
24712860else instance FieldToPGValue DateTime where
24722861 fieldToPGValue = JSDate.fromDateTime >>> unsafeCoerce
2473−else instance FieldToPGValue a where
2862+else instance FieldToPGValue TimestampTZ where
2863+ fieldToPGValue (TimestampTZ dt) = JSDate.fromDateTime dt # unsafeCoerce
2864+else instance FieldToPGValue PGDate where
2865+ fieldToPGValue = writeImpl >>> unsafeCoerce
2866+else instance FieldToPGValue PGUUID where
24742867 fieldToPGValue = unsafeCoerce
2868+else instance WriteForeign a => FieldToPGValue a where
2869+ fieldToPGValue = writeImpl >>> unsafeCoerce
24752870
24762871class RecordValuesRL :: RL.RowList Type -> Row Type -> Constraint
24772872class RecordValuesRL rl row where
@@ -2539,6 +2934,20 @@ else instance HasAnyDMLRL (RL.Cons "delete" Unit rest)
25392934else instance HasAnyDMLRL rest => HasAnyDMLRL (RL.Cons label typ rest)
25402935else instance Fail (Text "WHERE requires a preceding SELECT, UPDATE (set), or DELETE") => HasAnyDMLRL RL.Nil
25412936
2937+class HasMutation :: Row Type -> Constraint
2938+class HasMutation stage
2939+
2940+instance (RL.RowToList stage rl, HasMutationRL rl) => HasMutation stage
2941+
2942+class HasMutationRL :: RL.RowList Type -> Constraint
2943+class HasMutationRL rl
2944+
2945+instance HasMutationRL (RL.Cons "insert" Unit rest)
2946+else instance HasMutationRL (RL.Cons "set" Unit rest)
2947+else instance HasMutationRL (RL.Cons "delete" Unit rest)
2948+else instance HasMutationRL rest => HasMutationRL (RL.Cons label typ rest)
2949+else instance Fail (Text "RETURNING requires a preceding INSERT, UPDATE (set), or DELETE") => HasMutationRL RL.Nil
2950+
25422951toSQL :: forall tables result params stage. Q tables result params stage -> String
25432952toSQL (Q q) = q.sql
25442953
@@ -2548,6 +2957,12 @@ from _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
25482957fromAs :: forall @alias name cols tables. IsSymbol name => IsSymbol alias => Row.Cons alias cols () tables => Proxy (Table name cols) -> Q tables () () ()
25492958fromAs _ = Q { sql: reflectSymbol (Proxy :: Proxy name) <> " " <> reflectSymbol (Proxy :: Proxy alias), values: [] }
25502959
2960+into :: forall name cols tables. IsSymbol name => Row.Cons name cols () tables => Proxy (Table name cols) -> Q tables () () (into :: Unit)
2961+into _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
2962+
2963+update :: forall name cols tables. IsSymbol name => Row.Cons name cols () tables => Proxy (Table name cols) -> Q tables () () (update :: Unit)
2964+update _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
2965+
25512966selectAll
25522967 :: forall tables name cols result r p stage stage'
25532968 . SingleTable tables name cols
@@ -2555,6 +2970,7 @@ selectAll
25552970 => StripColumns cols result
25562971 => Row.Lacks "select" stage
25572972 => Row.Lacks "insert" stage
2973+ => Row.Lacks "into" stage
25582974 => Row.Lacks "set" stage
25592975 => Row.Lacks "delete" stage
25602976 => Row.Lacks "where" stage
@@ -2572,6 +2988,7 @@ select
25722988 => ParseSelect sel tables result
25732989 => Row.Lacks "select" stage
25742990 => Row.Lacks "insert" stage
2991+ => Row.Lacks "into" stage
25752992 => Row.Lacks "set" stage
25762993 => Row.Lacks "delete" stage
25772994 => Row.Lacks "where" stage
@@ -2589,6 +3006,7 @@ selectDistinct
25893006 => ParseSelect sel tables result
25903007 => Row.Lacks "select" stage
25913008 => Row.Lacks "insert" stage
3009+ => Row.Lacks "into" stage
25923010 => Row.Lacks "set" stage
25933011 => Row.Lacks "delete" stage
25943012 => Row.Lacks "where" stage
@@ -2609,6 +3027,7 @@ selectDistinctOn
26093027 => ParseSelect sel tables result
26103028 => Row.Lacks "select" stage
26113029 => Row.Lacks "insert" stage
3030+ => Row.Lacks "into" stage
26123031 => Row.Lacks "set" stage
26133032 => Row.Lacks "delete" stage
26143033 => Row.Lacks "where" stage
@@ -2813,13 +3232,17 @@ insert rec _ = Q { sql, values }
28133232 tableName = reflectSymbol (Proxy :: Proxy name)
28143233 colNames = columnNamesRL (Proxy :: Proxy userRowRL)
28153234 placeholders = colNames # mapWithIndex \i _ -> "$" <> show (i + 1)
2816− sql = "INSERT INTO " <> tableName
2817− <> " ("
2818− <> intercalate ", " colNames
2819− <> ")"
2820− <> " VALUES ("
2821− <> intercalate ", " placeholders
2822− <> ")"
3235+ sql =
3236+ if Array.null colNames then
3237+ "INSERT INTO " <> tableName <> " DEFAULT VALUES"
3238+ else
3239+ "INSERT INTO " <> tableName
3240+ <> " ("
3241+ <> intercalate ", " colNames
3242+ <> ")"
3243+ <> " VALUES ("
3244+ <> intercalate ", " placeholders
3245+ <> ")"
28233246 values = recordValuesRL (Proxy :: Proxy userRowRL) rec
28243247
28253248-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -2831,6 +3254,7 @@ returning
28313254 . SingleTable tables name cols
28323255 => IsSymbol sel
28333256 => ParseSelect sel tables result
3257+ => HasMutation stage
28343258 => Row.Lacks "returning" stage
28353259 => Row.Lacks "select" stage
28363260 => Row.Cons "returning" Unit stage stage'
@@ -2842,6 +3266,7 @@ returningAll
28423266 :: forall tables name cols result p stage stage'
28433267 . SingleTable tables name cols
28443268 => StripColumns cols result
3269+ => HasMutation stage
28453270 => Row.Lacks "returning" stage
28463271 => Row.Lacks "select" stage
28473272 => Row.Cons "returning" Unit stage stage'
@@ -2884,8 +3309,10 @@ set
28843309 => ValidateSetColumnsRL setRL cols
28853310 => SetClauseRL setRL
28863311 => RecordValuesRL setRL setRow
3312+ => HasClause "update" stage
28873313 => Row.Lacks "select" stage
28883314 => Row.Lacks "insert" stage
3315+ => Row.Lacks "into" stage
28893316 => Row.Lacks "set" stage
28903317 => Row.Lacks "delete" stage
28913318 => Row.Cons "set" Unit stage stage'
@@ -2909,6 +3336,7 @@ delete
29093336 => IsSymbol name
29103337 => Row.Lacks "select" stage
29113338 => Row.Lacks "insert" stage
3339+ => Row.Lacks "into" stage
29123340 => Row.Lacks "set" stage
29133341 => Row.Lacks "delete" stage
29143342 => Row.Cons "delete" Unit stage stage'
@@ -3149,6 +3577,66 @@ exceptAll
31493577 -> Q tables1 result params SetOpStage
31503578exceptAll (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") EXCEPT ALL (" <> q2.sql <> ")", values: q1.values <> q2.values }
31513579
3580+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3581+-- CTE (WITH clause) support
3582+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3583+
3584+newtype WithCTEs :: Row (Row Type) -> Row Type -> Type
3585+newtype WithCTEs cteTables cteParams = WithCTEs
3586+ { sql :: String, values :: Array PG.PGValue }
3587+
3588+-- Wrap a complete SELECT query as a named CTE
3589+cte
3590+ :: forall @name tables result params stage cteTables
3591+ . IsSymbol name
3592+ => HasClause "select" stage
3593+ => Row.Cons name result () cteTables
3594+ => Q tables result params stage
3595+ -> WithCTEs cteTables params
3596+cte (Q q) = WithCTEs
3597+ { sql: reflectSymbol (Proxy :: Proxy name) <> " AS (" <> q.sql <> ")"
3598+ , values: q.values
3599+ }
3600+
3601+-- Add another named CTE to an accumulator
3602+andCTE
3603+ :: forall @name tables result params stage cteTables cteParams cteTables' cteParams'
3604+ . IsSymbol name
3605+ => HasClause "select" stage
3606+ => Row.Lacks name cteTables
3607+ => Row.Cons name result cteTables cteTables'
3608+ => Row.Union cteParams params cteParams'
3609+ => Row.Nub cteParams' cteParams'
3610+ => Q tables result params stage
3611+ -> WithCTEs cteTables cteParams
3612+ -> WithCTEs cteTables' cteParams'
3613+andCTE (Q q) (WithCTEs w) = WithCTEs
3614+ { sql: w.sql <> ", " <> reflectSymbol (Proxy :: Proxy name) <> " AS (" <> q.sql <> ")"
3615+ , values: w.values <> q.values
3616+ }
3617+
3618+-- Start main query FROM a named CTE; cteTables becomes available as tables
3619+fromCTE
3620+ :: forall @name result restTables cteTables cteParams
3621+ . IsSymbol name
3622+ => Row.Cons name result restTables cteTables
3623+ => WithCTEs cteTables cteParams
3624+ -> Q cteTables () () ()
3625+fromCTE _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
3626+
3627+-- Finalize: prepend WITH clause and merge params
3628+with_
3629+ :: forall cteTables cteParams mainParams allParams result stage
3630+ . Row.Union cteParams mainParams allParams
3631+ => Row.Nub allParams allParams
3632+ => WithCTEs cteTables cteParams
3633+ -> Q cteTables result mainParams stage
3634+ -> Q cteTables result allParams stage
3635+with_ (WithCTEs w) (Q q) = Q
3636+ { sql: "WITH " <> w.sql <> " " <> q.sql
3637+ , values: w.values <> q.values
3638+ }
3639+
31523640-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
31533641-- Query execution
31543642-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -3164,28 +3652,34 @@ instance
31643652 ( IsSymbol name
31653653 , Row.Cons name typ rest row
31663654 , Row.Lacks name rest
3655+ , FieldToPGValue typ
31673656 , ParamsToArray tail row
31683657 ) =>
31693658 ParamsToArray (RL.Cons name typ tail) row where
31703659 paramsToArray _ rec =
31713660 [ { name: reflectSymbol (Proxy :: Proxy name)
3172− , value: unsafeToForeign (Record.get (Proxy :: Proxy name) rec)
3661+ , value: unsafeCoerce (fieldToPGValue (Record.get (Proxy :: Proxy name) rec))
31733662 }
31743663 ]
31753664 <> paramsToArray (Proxy :: Proxy tail) rec
31763665
31773666namedParamRegex :: Regex.Regex
3178−namedParamRegex = case Regex.regex "\\$[a-zA-Z_][a-zA-Z0-9_]*" Regex.global of
3667+namedParamRegex = case Regex.regex "\\$[a-zA-Z_][a-zA-Z0-9_]*(::[a-zA-Z_]+)?" Regex.global of
31793668 Right r -> r
31803669 Left _ -> unsafeCoerce unit
31813670
3671+stripCast :: String -> String
3672+stripCast s = case SCU.indexOf (Pattern "::") s of
3673+ Nothing -> s
3674+ Just i -> SCU.take i s
3675+
31823676replaceNamedParams :: Int -> Array { name :: String, value :: Foreign } -> String -> { sql :: String, values :: Array PG.PGValue }
31833677replaceNamedParams offset entries sql = do
31843678 let indexed = entries # mapWithIndex \i e -> { idx: offset + i + 1, name: e.name, value: e.value }
31853679 let replacements = indexed # foldl (\m e -> Map.insert ("$" <> e.name) ("$" <> show e.idx) m) Map.empty
31863680 let
31873681 sql' = Regex.replace' namedParamRegex
3188− ( \match _ -> case Map.lookup match replacements of
3682+ ( \match _ -> case Map.lookup (stripCast match) replacements of
31893683 Nothing -> match
31903684 Just v -> v
31913685 )
@@ -3206,7 +3700,9 @@ runQuery conn params (Q q) = do
32063700 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
32073701 let allValues = q.values <> values
32083702 result <- PG.query (PG.SQL sql) allValues conn
3209− pure (unsafeDecodeRows result.rows)
3703+ case decodeRows result.rows of
3704+ Left errs -> throwError (Exception.error ("Row decode failed: " <> show errs))
3705+ Right rows -> pure rows
32103706
32113707runQueryOne
32123708 :: forall tables result params paramsRL stage
@@ -3222,7 +3718,11 @@ runQueryOne conn params (Q q) = do
32223718 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
32233719 let allValues = q.values <> values
32243720 result <- PG.queryOne (PG.SQL sql) allValues conn
3225− pure (result <#> unsafeDecodeRow)
3721+ case result of
3722+ Nothing -> pure Nothing
3723+ Just row -> case decodeRow row of
3724+ Left errs -> throwError (Exception.error ("Row decode failed: " <> show errs))
3725+ Right a -> pure (Just a)
32263726
32273727runExecute
32283728 :: forall tables params paramsRL stage
@@ -3254,7 +3754,9 @@ runQueryTx txn params (Q q) = do
32543754 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
32553755 let allValues = q.values <> values
32563756 result <- PG.txQuery (PG.SQL sql) allValues txn
3257− pure (unsafeDecodeRows result.rows)
3757+ case decodeRows result.rows of
3758+ Left errs -> throwError (Exception.error ("Row decode failed: " <> show errs))
3759+ Right rows -> pure rows
32583760
32593761runExecuteTx
32603762 :: forall tables params paramsRL stage
@@ -3270,10 +3772,9 @@ runExecuteTx txn params (Q q) = do
32703772 let allValues = q.values <> values
32713773 PG.txExecute (PG.SQL sql) allValues txn
32723774
3273−unsafeDecodeRows :: forall a. ReadForeign a => Array Foreign -> Array a
3274−unsafeDecodeRows = map unsafeDecodeRow
32753775
3276−unsafeDecodeRow :: forall a. ReadForeign a => Foreign -> a
3277−unsafeDecodeRow f = case runExcept (readImpl f) of
3278− Left _ -> unsafeCoerce unit
3279− Right a -> a
3776+decodeRows :: forall a. ReadForeign a => Array Foreign -> Either (NonEmptyList ForeignError) (Array a)
3777+decodeRows = traverse (readImpl >>> runExcept)
3778+
3779+decodeRow :: forall a. ReadForeign a => Foreign -> Either (NonEmptyList ForeignError) a
3780+decodeRow = readImpl >>> runExcept