@@ -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,6 +68,9 @@ 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
@@ -78,6 +92,178 @@ derive instance Newtype Jsonb _
7892instance ReadForeign Jsonb where
7993 readImpl = pure <<< Jsonb
8094
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+
117+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
118+-- PGDate / PGTime: newtypes for DATE and TIME columns
119+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
120+
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
220+
221+instance Show Point where
222+ show (Point { x, y }) = "(Point " <> show x <> " " <> show y <> ")"
223+
224+instance ReadForeign Point where
225+ readImpl f = do
226+ s :: String <- readImpl f
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)
266+
81267-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
82268-- Nullability: inferred from Maybe
83269-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -101,6 +287,7 @@ instance ExtractType a typ => ExtractType (PrimaryKey a) typ
101287else instance ExtractType a typ => ExtractType (AutoIncrement a) typ
102288else instance ExtractType a typ => ExtractType (Unique a) typ
103289else instance ExtractType a typ => ExtractType (Default val a) typ
290+else instance ExtractType a typ => ExtractType (DefaultExpr expression a) typ
104291else instance ExtractType a typ => ExtractType (ForeignKey t r c a) typ
105292else instance ExtractType a typ => ExtractType (Nullable a) (Maybe typ)
106293else instance ExtractType a a
@@ -130,6 +317,27 @@ instance PGTypeName DateTime where
130317instance PGTypeName BigInt where
131318 pgTypeName _ = "BIGINT"
132319
320+instance PGTypeName PGUUID where
321+ pgTypeName _ = "UUID"
322+
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+
133341instance PGTypeName Jsonb where
134342 pgTypeName _ = "JSONB"
135343
@@ -152,8 +360,24 @@ instance Reflectable sym String => RenderDefaultValue sym String where
152360instance Reflectable val Int => RenderDefaultValue val Int where
153361 renderDefaultValue _ _ = "DEFAULT " <> show (reflectType (Proxy :: Proxy val))
154362
155−instance Reflectable val Boolean => RenderDefaultValue val Boolean where
156− 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+
157381
158382class RenderConstraint a where
159383 renderConstraint :: Proxy a -> String
@@ -170,6 +394,10 @@ else instance RenderConstraint a => RenderConstraint (Unique a) where
170394else instance (RenderDefaultValue val a, RenderConstraint a) => RenderConstraint (Default val a) where
171395 renderConstraint _ = joinConstraints (renderDefaultValue (Proxy :: Proxy val) (Proxy :: Proxy a)) (renderConstraint (Proxy :: Proxy a))
172396
397+else instance (IsSymbol expression, RenderConstraint a) => RenderConstraint (DefaultExpr expression a) where
398+ renderConstraint _ = joinConstraints
399+ ("DEFAULT " <> reflectSymbol (Proxy :: Proxy expression))
400+ (renderConstraint (Proxy :: Proxy a))
173401else instance (IsSymbol table, IsSymbol col, RenderConstraint a) => RenderConstraint (ForeignKey table References col a) where
174402 renderConstraint _ = joinConstraints
175403 ("REFERENCES " <> reflectSymbol (Proxy :: Proxy table) <> "(" <> reflectSymbol (Proxy :: Proxy col) <> ")")
@@ -230,6 +458,11 @@ instance
230458 let columns = renderColumnsRL (Proxy :: Proxy rl)
231459 "CREATE TABLE " <> tableName <> " (" <> intercalate ", " columns <> ")"
232460
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+
233466-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
234467-- INSERT SQL generation
235468-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -241,6 +474,8 @@ instance IsAutoGenerated (AutoIncrement a) where
241474 isAutoGenerated _ = true
242475else instance IsAutoGenerated (Default v a) where
243476 isAutoGenerated _ = true
477+else instance IsAutoGenerated (DefaultExpr expression a) where
478+ isAutoGenerated _ = true
244479else instance IsAutoGenerated a => IsAutoGenerated (PrimaryKey a) where
245480 isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)
246481else instance IsAutoGenerated a => IsAutoGenerated (Unique a) where
@@ -284,15 +519,18 @@ instance
284519 insertSQLFor = do
285520 let tableName = reflectSymbol (Proxy :: Proxy name)
286521 let cols = insertColumnsRL (Proxy :: Proxy rl)
287− let placeholders = cols # mapWithIndex \i _ -> "$" <> show (i + 1)
288− "INSERT INTO " <> tableName
289− <> " ("
290− <> intercalate ", " cols
291− <> ")"
292− <> " VALUES ("
293− <> intercalate ", " placeholders
294− <> ")"
295− <> " 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 *"
296534
297535-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
298536-- SELECT SQL generation
@@ -747,6 +985,15 @@ else instance
747985 ) =>
748986 ParseSelectHandleAS "as" afterKeyword colRef tables accRL outRL
749987
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+
750997class ParseSelectExpectEnd :: Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
751998class ParseSelectExpectEnd sym tables accRL outRL | sym tables accRL -> outRL
752999
@@ -845,11 +1092,66 @@ instance ResolveAggregateArg "*" tables Star
8451092else instance ResolveAggregateArg "" tables Star
8461093else instance
8471094 ( SkipSpaces args trimmedFront
848− , ExtractWord trimmedFront col _rest
849− , ResolveAggregateArgCol col tables argType
1095+ , ExtractIdent trimmedFront col rest
1096+ , ResolveAggregateArgDispatch col rest tables argType
8501097 ) =>
8511098 ResolveAggregateArg args tables argType
8521099
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+
8531155class ResolveAggregateArgCol :: Symbol -> Row (Row Type) -> Type -> Constraint
8541156class ResolveAggregateArgCol col tables argType | col tables -> argType
8551157
@@ -934,8 +1236,8 @@ else instance
9341236class AggregateReturnTypeC :: Symbol -> Type -> Type -> Constraint
9351237class AggregateReturnTypeC funcName argType returnType | funcName argType -> returnType
9361238
937−instance AggregateReturnTypeC "COUNT" argType Int
938−else instance AggregateReturnTypeC "count" argType Int
1239+instance AggregateReturnTypeC "COUNT" argType BigInt
1240+else instance AggregateReturnTypeC "count" argType BigInt
9391241else instance AggregateReturnTypeC "COALESCE" argType argType
9401242else instance AggregateReturnTypeC "coalesce" argType argType
9411243else instance
@@ -1418,8 +1720,12 @@ else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut pa
14181720else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "u" word currentType tables paramsIn currentTypeOut paramsOut
14191721else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "V" word currentType tables paramsIn currentTypeOut paramsOut
14201722else 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
14211727
1422−-- 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)
14231729else instance
14241730 ( ResolveColumn word tables entry
14251731 , ExtractType entry typ
@@ -1492,7 +1798,8 @@ else instance
14921798class FlushWhereWordD :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
14931799class FlushWhereWordD word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
14941800
1495−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
14961803else instance
14971804 ( ResolveColumn word tables entry
14981805 , ExtractType entry typ
@@ -1607,7 +1914,9 @@ else instance
16071914class FlushWhereWordS :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
16081915class FlushWhereWordS word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
16091916
1610−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
16111920else instance FlushWhereWordS "sum" currentType tables paramsIn currentType paramsIn
16121921else instance FlushWhereWordS "STRING_AGG" currentType tables paramsIn String paramsIn
16131922else instance FlushWhereWordS "string_agg" currentType tables paramsIn String paramsIn
@@ -1628,6 +1937,16 @@ else instance FlushWhereWordT "true" currentType tables paramsIn currentType par
16281937else instance FlushWhereWordT "text" currentType tables paramsIn currentType paramsIn
16291938else instance FlushWhereWordT "timestamptz" currentType tables paramsIn currentType paramsIn
16301939else 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
16311950else instance
16321951 ( ResolveColumn word tables entry
16331952 , ExtractType entry typ
@@ -1659,6 +1978,32 @@ else instance
16591978 ) =>
16601979 FlushWhereWordV word currentType tables paramsIn unwrapped paramsIn
16611980
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+
16622007-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
16632008-- ValidateColumnList: comma-separated column references
16642009-- Used by GROUP BY, DISTINCT ON, ON CONFLICT target
@@ -2312,13 +2657,85 @@ else instance
23122657 , SkipSpaces rest1 rest2
23132658 , ExpectChar rest2 "=" rest3
23142659 , SkipSpaces rest3 rest4
2315− , ExtractWord rest4 excRef rest5
2316− , ValidateExcludedRef excRef colName
2317− , SkipSpaces rest5 rest6
2318− , ParseAssignmentsContinue rest6 cols
2660+ , SkipExpression rest4 rest5
2661+ , ParseAssignmentsContinue rest5 cols
23192662 ) =>
23202663 ParseAssignments sym cols
23212664
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+
23222739class ParseAssignmentsContinue :: Symbol -> Row Type -> Constraint
23232740class ParseAssignmentsContinue sym cols
23242741
@@ -2381,6 +2798,7 @@ class IsAutoGeneratedTC constraints result | constraints -> result
23812798
23822799instance IsAutoGeneratedTC (AutoIncrement a) True
23832800else instance IsAutoGeneratedTC (Default s a) True
2801+else instance IsAutoGeneratedTC (DefaultExpr expression a) True
23842802else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (PrimaryKey a) result
23852803else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (Unique a) result
23862804else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (ForeignKey t r c a) result
@@ -2436,11 +2854,19 @@ class FieldToPGValue a where
24362854 fieldToPGValue :: a -> PG.PGValue
24372855
24382856instance FieldToPGValue a => FieldToPGValue (Maybe a) where
2439− fieldToPGValue = toNullable >>> unsafeCoerce
2857+ fieldToPGValue = case _ of
2858+ Nothing -> unsafeCoerce (toNullable Nothing)
2859+ Just value -> fieldToPGValue value
24402860else instance FieldToPGValue DateTime where
24412861 fieldToPGValue = JSDate.fromDateTime >>> unsafeCoerce
2442−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
24432867 fieldToPGValue = unsafeCoerce
2868+else instance WriteForeign a => FieldToPGValue a where
2869+ fieldToPGValue = writeImpl >>> unsafeCoerce
24442870
24452871class RecordValuesRL :: RL.RowList Type -> Row Type -> Constraint
24462872class RecordValuesRL rl row where
@@ -2508,6 +2934,20 @@ else instance HasAnyDMLRL (RL.Cons "delete" Unit rest)
25082934else instance HasAnyDMLRL rest => HasAnyDMLRL (RL.Cons label typ rest)
25092935else instance Fail (Text "WHERE requires a preceding SELECT, UPDATE (set), or DELETE") => HasAnyDMLRL RL.Nil
25102936
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+
25112951toSQL :: forall tables result params stage. Q tables result params stage -> String
25122952toSQL (Q q) = q.sql
25132953
@@ -2517,6 +2957,12 @@ from _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
25172957fromAs :: forall @alias name cols tables. IsSymbol name => IsSymbol alias => Row.Cons alias cols () tables => Proxy (Table name cols) -> Q tables () () ()
25182958fromAs _ = Q { sql: reflectSymbol (Proxy :: Proxy name) <> " " <> reflectSymbol (Proxy :: Proxy alias), values: [] }
25192959
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+
25202966selectAll
25212967 :: forall tables name cols result r p stage stage'
25222968 . SingleTable tables name cols
@@ -2524,6 +2970,7 @@ selectAll
25242970 => StripColumns cols result
25252971 => Row.Lacks "select" stage
25262972 => Row.Lacks "insert" stage
2973+ => Row.Lacks "into" stage
25272974 => Row.Lacks "set" stage
25282975 => Row.Lacks "delete" stage
25292976 => Row.Lacks "where" stage
@@ -2541,6 +2988,7 @@ select
25412988 => ParseSelect sel tables result
25422989 => Row.Lacks "select" stage
25432990 => Row.Lacks "insert" stage
2991+ => Row.Lacks "into" stage
25442992 => Row.Lacks "set" stage
25452993 => Row.Lacks "delete" stage
25462994 => Row.Lacks "where" stage
@@ -2558,6 +3006,7 @@ selectDistinct
25583006 => ParseSelect sel tables result
25593007 => Row.Lacks "select" stage
25603008 => Row.Lacks "insert" stage
3009+ => Row.Lacks "into" stage
25613010 => Row.Lacks "set" stage
25623011 => Row.Lacks "delete" stage
25633012 => Row.Lacks "where" stage
@@ -2578,6 +3027,7 @@ selectDistinctOn
25783027 => ParseSelect sel tables result
25793028 => Row.Lacks "select" stage
25803029 => Row.Lacks "insert" stage
3030+ => Row.Lacks "into" stage
25813031 => Row.Lacks "set" stage
25823032 => Row.Lacks "delete" stage
25833033 => Row.Lacks "where" stage
@@ -2782,13 +3232,17 @@ insert rec _ = Q { sql, values }
27823232 tableName = reflectSymbol (Proxy :: Proxy name)
27833233 colNames = columnNamesRL (Proxy :: Proxy userRowRL)
27843234 placeholders = colNames # mapWithIndex \i _ -> "$" <> show (i + 1)
2785− sql = "INSERT INTO " <> tableName
2786− <> " ("
2787− <> intercalate ", " colNames
2788− <> ")"
2789− <> " VALUES ("
2790− <> intercalate ", " placeholders
2791− <> ")"
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+ <> ")"
27923246 values = recordValuesRL (Proxy :: Proxy userRowRL) rec
27933247
27943248-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -2800,6 +3254,7 @@ returning
28003254 . SingleTable tables name cols
28013255 => IsSymbol sel
28023256 => ParseSelect sel tables result
3257+ => HasMutation stage
28033258 => Row.Lacks "returning" stage
28043259 => Row.Lacks "select" stage
28053260 => Row.Cons "returning" Unit stage stage'
@@ -2811,6 +3266,7 @@ returningAll
28113266 :: forall tables name cols result p stage stage'
28123267 . SingleTable tables name cols
28133268 => StripColumns cols result
3269+ => HasMutation stage
28143270 => Row.Lacks "returning" stage
28153271 => Row.Lacks "select" stage
28163272 => Row.Cons "returning" Unit stage stage'
@@ -2853,8 +3309,10 @@ set
28533309 => ValidateSetColumnsRL setRL cols
28543310 => SetClauseRL setRL
28553311 => RecordValuesRL setRL setRow
3312+ => HasClause "update" stage
28563313 => Row.Lacks "select" stage
28573314 => Row.Lacks "insert" stage
3315+ => Row.Lacks "into" stage
28583316 => Row.Lacks "set" stage
28593317 => Row.Lacks "delete" stage
28603318 => Row.Cons "set" Unit stage stage'
@@ -2878,6 +3336,7 @@ delete
28783336 => IsSymbol name
28793337 => Row.Lacks "select" stage
28803338 => Row.Lacks "insert" stage
3339+ => Row.Lacks "into" stage
28813340 => Row.Lacks "set" stage
28823341 => Row.Lacks "delete" stage
28833342 => Row.Cons "delete" Unit stage stage'
@@ -3118,6 +3577,66 @@ exceptAll
31183577 -> Q tables1 result params SetOpStage
31193578exceptAll (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") EXCEPT ALL (" <> q2.sql <> ")", values: q1.values <> q2.values }
31203579
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+
31213640-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
31223641-- Query execution
31233642-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -3133,28 +3652,34 @@ instance
31333652 ( IsSymbol name
31343653 , Row.Cons name typ rest row
31353654 , Row.Lacks name rest
3655+ , FieldToPGValue typ
31363656 , ParamsToArray tail row
31373657 ) =>
31383658 ParamsToArray (RL.Cons name typ tail) row where
31393659 paramsToArray _ rec =
31403660 [ { name: reflectSymbol (Proxy :: Proxy name)
3141− , value: unsafeToForeign (Record.get (Proxy :: Proxy name) rec)
3661+ , value: unsafeCoerce (fieldToPGValue (Record.get (Proxy :: Proxy name) rec))
31423662 }
31433663 ]
31443664 <> paramsToArray (Proxy :: Proxy tail) rec
31453665
31463666namedParamRegex :: Regex.Regex
3147−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
31483668 Right r -> r
31493669 Left _ -> unsafeCoerce unit
31503670
3671+stripCast :: String -> String
3672+stripCast s = case SCU.indexOf (Pattern "::") s of
3673+ Nothing -> s
3674+ Just i -> SCU.take i s
3675+
31513676replaceNamedParams :: Int -> Array { name :: String, value :: Foreign } -> String -> { sql :: String, values :: Array PG.PGValue }
31523677replaceNamedParams offset entries sql = do
31533678 let indexed = entries # mapWithIndex \i e -> { idx: offset + i + 1, name: e.name, value: e.value }
31543679 let replacements = indexed # foldl (\m e -> Map.insert ("$" <> e.name) ("$" <> show e.idx) m) Map.empty
31553680 let
31563681 sql' = Regex.replace' namedParamRegex
3157− ( \match _ -> case Map.lookup match replacements of
3682+ ( \match _ -> case Map.lookup (stripCast match) replacements of
31583683 Nothing -> match
31593684 Just v -> v
31603685 )
@@ -3175,7 +3700,9 @@ runQuery conn params (Q q) = do
31753700 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
31763701 let allValues = q.values <> values
31773702 result <- PG.query (PG.SQL sql) allValues conn
3178− 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
31793706
31803707runQueryOne
31813708 :: forall tables result params paramsRL stage
@@ -3191,7 +3718,11 @@ runQueryOne conn params (Q q) = do
31913718 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
31923719 let allValues = q.values <> values
31933720 result <- PG.queryOne (PG.SQL sql) allValues conn
3194− 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)
31953726
31963727runExecute
31973728 :: forall tables params paramsRL stage
@@ -3223,7 +3754,9 @@ runQueryTx txn params (Q q) = do
32233754 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
32243755 let allValues = q.values <> values
32253756 result <- PG.txQuery (PG.SQL sql) allValues txn
3226− 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
32273760
32283761runExecuteTx
32293762 :: forall tables params paramsRL stage
@@ -3239,10 +3772,9 @@ runExecuteTx txn params (Q q) = do
32393772 let allValues = q.values <> values
32403773 PG.txExecute (PG.SQL sql) allValues txn
32413774
3242−unsafeDecodeRows :: forall a. ReadForeign a => Array Foreign -> Array a
3243−unsafeDecodeRows = map unsafeDecodeRow
32443775
3245−unsafeDecodeRow :: forall a. ReadForeign a => Foreign -> a
3246−unsafeDecodeRow f = case runExcept (readImpl f) of
3247− Left _ -> unsafeCoerce unit
3248− 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