@@ -33,7 +33,7 @@ import Data.Map as Map
3333import Data.Symbol (class IsSymbol, reflectSymbol)
3434import Type.Function (type (#))
3535import Effect.Aff (Aff, throwError)
36−import Foreign (Foreign, ForeignError(..), unsafeToForeign)
36+import Foreign (Foreign, ForeignError(..))
3737import Prim.Boolean (True, False)
3838import Prim.Row (class Cons, class Lacks, class Union, class Nub) as Row
3939import Prim.RowList as RL
@@ -43,7 +43,7 @@ import Prim.TypeError (class Fail, Beside, Text, Quote)
4343import Record (get) as Record
4444import Type.Proxy (Proxy(..))
4545import Type.RowList (class ListToRow)
46−import Yoga.JSON (class ReadForeign, readImpl)
46+import Yoga.JSON (class ReadForeign, class WriteForeign, readImpl, writeImpl)
4747import Yoga.Postgres as PG
4848
4949-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -75,9 +75,6 @@ data References
7575data ForeignKey :: Symbol -> Type -> Symbol -> Type -> Type
7676data ForeignKey table references col a
7777
78−data DefaultExpr :: Symbol -> Type -> Type
79−data DefaultExpr expr a
80−
8178-- Internal: used by LEFT JOIN to mark columns as nullable
8279data Nullable :: Type -> Type
8380data Nullable a
@@ -128,6 +125,21 @@ instance ReadForeign PGDate where
128125 jsDate :: JSDate.JSDate
129126 jsDate = unsafeCoerce f
130127
128+newtype TimestampTZ = TimestampTZ DateTime
129+
130+derive instance Newtype TimestampTZ _
131+derive instance Eq TimestampTZ
132+derive instance Ord TimestampTZ
133+instance Show TimestampTZ where
134+ show (TimestampTZ dt) = "(TimestampTZ " <> show dt <> ")"
135+
136+instance ReadForeign TimestampTZ where
137+ readImpl f =
138+ except $ note (pure (ForeignError "Invalid timestamp")) (JSDate.toDateTime jsDate <#> TimestampTZ)
139+ where
140+ jsDate :: JSDate.JSDate
141+ jsDate = unsafeCoerce f
142+
131143newtype PGTime = PGTime Time
132144
133145derive instance Newtype PGTime _
@@ -231,7 +243,6 @@ instance ExtractType a typ => ExtractType (PrimaryKey a) typ
231243else instance ExtractType a typ => ExtractType (AutoIncrement a) typ
232244else instance ExtractType a typ => ExtractType (Unique a) typ
233245else instance ExtractType a typ => ExtractType (Default val a) typ
234−else instance ExtractType a typ => ExtractType (DefaultExpr expr a) typ
235246else instance ExtractType a typ => ExtractType (ForeignKey t r c a) typ
236247else instance ExtractType a typ => ExtractType (Nullable a) (Maybe typ)
237248else instance ExtractType a a
@@ -264,6 +275,9 @@ instance PGTypeName BigInt where
264275instance PGTypeName PGUUID where
265276 pgTypeName _ = "UUID"
266277
278+instance PGTypeName TimestampTZ where
279+ pgTypeName _ = "TIMESTAMPTZ"
280+
267281instance PGTypeName PGDate where
268282 pgTypeName _ = "DATE"
269283
@@ -301,8 +315,17 @@ instance Reflectable sym String => RenderDefaultValue sym String where
301315instance Reflectable val Int => RenderDefaultValue val Int where
302316 renderDefaultValue _ _ = "DEFAULT " <> show (reflectType (Proxy :: Proxy val))
303317
304−instance Reflectable val Boolean => RenderDefaultValue val Boolean where
305− renderDefaultValue _ _ = if reflectType (Proxy :: Proxy val) then "DEFAULT true" else "DEFAULT false"
318+instance RenderDefaultValue "true" Boolean where
319+ renderDefaultValue _ _ = "DEFAULT true"
320+
321+instance RenderDefaultValue "false" Boolean where
322+ renderDefaultValue _ _ = "DEFAULT false"
323+
324+instance RenderDefaultValue "now()" TimestampTZ where
325+ renderDefaultValue _ _ = "DEFAULT now()"
326+
327+instance RenderDefaultValue "gen_random_uuid()" PGUUID where
328+ renderDefaultValue _ _ = "DEFAULT gen_random_uuid()"
306329
307330class RenderConstraint a where
308331 renderConstraint :: Proxy a -> String
@@ -319,11 +342,6 @@ else instance RenderConstraint a => RenderConstraint (Unique a) where
319342else instance (RenderDefaultValue val a, RenderConstraint a) => RenderConstraint (Default val a) where
320343 renderConstraint _ = joinConstraints (renderDefaultValue (Proxy :: Proxy val) (Proxy :: Proxy a)) (renderConstraint (Proxy :: Proxy a))
321344
322−else instance (IsSymbol expr, RenderConstraint a) => RenderConstraint (DefaultExpr expr a) where
323− renderConstraint _ = joinConstraints
324− ("DEFAULT " <> reflectSymbol (Proxy :: Proxy expr))
325− (renderConstraint (Proxy :: Proxy a))
326−
327345else instance (IsSymbol table, IsSymbol col, RenderConstraint a) => RenderConstraint (ForeignKey table References col a) where
328346 renderConstraint _ = joinConstraints
329347 ("REFERENCES " <> reflectSymbol (Proxy :: Proxy table) <> "(" <> reflectSymbol (Proxy :: Proxy col) <> ")")
@@ -395,8 +413,6 @@ instance IsAutoGenerated (AutoIncrement a) where
395413 isAutoGenerated _ = true
396414else instance IsAutoGenerated (Default v a) where
397415 isAutoGenerated _ = true
398−else instance IsAutoGenerated (DefaultExpr expr a) where
399− isAutoGenerated _ = true
400416else instance IsAutoGenerated a => IsAutoGenerated (PrimaryKey a) where
401417 isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)
402418else instance IsAutoGenerated a => IsAutoGenerated (Unique a) where
@@ -2716,7 +2732,6 @@ class IsAutoGeneratedTC constraints result | constraints -> result
27162732
27172733instance IsAutoGeneratedTC (AutoIncrement a) True
27182734else instance IsAutoGeneratedTC (Default s a) True
2719−else instance IsAutoGeneratedTC (DefaultExpr expr a) True
27202735else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (PrimaryKey a) result
27212736else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (Unique a) result
27222737else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (ForeignKey t r c a) result
@@ -2775,10 +2790,14 @@ instance FieldToPGValue a => FieldToPGValue (Maybe a) where
27752790 fieldToPGValue = toNullable >>> unsafeCoerce
27762791else instance FieldToPGValue DateTime where
27772792 fieldToPGValue = JSDate.fromDateTime >>> unsafeCoerce
2793+else instance FieldToPGValue TimestampTZ where
2794+ fieldToPGValue (TimestampTZ dt) = JSDate.fromDateTime dt # unsafeCoerce
27782795else instance FieldToPGValue PGDate where
27792796 fieldToPGValue (PGDate d) = JSDate.fromDateTime (DateTime d bottom) # unsafeCoerce
2780−else instance FieldToPGValue a where
2797+else instance FieldToPGValue PGUUID where
27812798 fieldToPGValue = unsafeCoerce
2799+else instance WriteForeign a => FieldToPGValue a where
2800+ fieldToPGValue = writeImpl >>> unsafeCoerce
27822801
27832802class RecordValuesRL :: RL.RowList Type -> Row Type -> Constraint
27842803class RecordValuesRL rl row where
@@ -2858,6 +2877,9 @@ fromAs _ = Q { sql: reflectSymbol (Proxy :: Proxy name) <> " " <> reflectSymbol
28582877into :: forall name cols tables. IsSymbol name => Row.Cons name cols () tables => Proxy (Table name cols) -> Q tables () () (into :: Unit)
28592878into _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
28602879
2880+update :: forall name cols tables. IsSymbol name => Row.Cons name cols () tables => Proxy (Table name cols) -> Q tables () () (update :: Unit)
2881+update _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
2882+
28612883selectAll
28622884 :: forall tables name cols result r p stage stage'
28632885 . SingleTable tables name cols
@@ -3198,6 +3220,7 @@ set
31983220 => ValidateSetColumnsRL setRL cols
31993221 => SetClauseRL setRL
32003222 => RecordValuesRL setRL setRow
3223+ => HasClause "update" stage
32013224 => Row.Lacks "select" stage
32023225 => Row.Lacks "insert" stage
32033226 => Row.Lacks "into" stage
@@ -3465,6 +3488,66 @@ exceptAll
34653488 -> Q tables1 result params SetOpStage
34663489exceptAll (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") EXCEPT ALL (" <> q2.sql <> ")", values: q1.values <> q2.values }
34673490
3491+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3492+-- CTE (WITH clause) support
3493+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3494+
3495+newtype WithCTEs :: Row (Row Type) -> Row Type -> Type
3496+newtype WithCTEs cteTables cteParams = WithCTEs
3497+ { sql :: String, values :: Array PG.PGValue }
3498+
3499+-- Wrap a complete SELECT query as a named CTE
3500+cte
3501+ :: forall @name tables result params stage cteTables
3502+ . IsSymbol name
3503+ => HasClause "select" stage
3504+ => Row.Cons name result () cteTables
3505+ => Q tables result params stage
3506+ -> WithCTEs cteTables params
3507+cte (Q q) = WithCTEs
3508+ { sql: reflectSymbol (Proxy :: Proxy name) <> " AS (" <> q.sql <> ")"
3509+ , values: q.values
3510+ }
3511+
3512+-- Add another named CTE to an accumulator
3513+andCTE
3514+ :: forall @name tables result params stage cteTables cteParams cteTables' cteParams'
3515+ . IsSymbol name
3516+ => HasClause "select" stage
3517+ => Row.Lacks name cteTables
3518+ => Row.Cons name result cteTables cteTables'
3519+ => Row.Union cteParams params cteParams'
3520+ => Row.Nub cteParams' cteParams'
3521+ => Q tables result params stage
3522+ -> WithCTEs cteTables cteParams
3523+ -> WithCTEs cteTables' cteParams'
3524+andCTE (Q q) (WithCTEs w) = WithCTEs
3525+ { sql: w.sql <> ", " <> reflectSymbol (Proxy :: Proxy name) <> " AS (" <> q.sql <> ")"
3526+ , values: w.values <> q.values
3527+ }
3528+
3529+-- Start main query FROM a named CTE; cteTables becomes available as tables
3530+fromCTE
3531+ :: forall @name result restTables cteTables cteParams
3532+ . IsSymbol name
3533+ => Row.Cons name result restTables cteTables
3534+ => WithCTEs cteTables cteParams
3535+ -> Q cteTables () () ()
3536+fromCTE _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
3537+
3538+-- Finalize: prepend WITH clause and merge params
3539+with_
3540+ :: forall cteTables cteParams mainParams allParams result stage
3541+ . Row.Union cteParams mainParams allParams
3542+ => Row.Nub allParams allParams
3543+ => WithCTEs cteTables cteParams
3544+ -> Q cteTables result mainParams stage
3545+ -> Q cteTables result allParams stage
3546+with_ (WithCTEs w) (Q q) = Q
3547+ { sql: "WITH " <> w.sql <> " " <> q.sql
3548+ , values: w.values <> q.values
3549+ }
3550+
34683551-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
34693552-- Query execution
34703553-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -3480,12 +3563,13 @@ instance
34803563 ( IsSymbol name
34813564 , Row.Cons name typ rest row
34823565 , Row.Lacks name rest
3566+ , FieldToPGValue typ
34833567 , ParamsToArray tail row
34843568 ) =>
34853569 ParamsToArray (RL.Cons name typ tail) row where
34863570 paramsToArray _ rec =
34873571 [ { name: reflectSymbol (Proxy :: Proxy name)
3488− , value: unsafeToForeign (Record.get (Proxy :: Proxy name) rec)
3572+ , value: unsafeCoerce (fieldToPGValue (Record.get (Proxy :: Proxy name) rec))
34893573 }
34903574 ]
34913575 <> paramsToArray (Proxy :: Proxy tail) rec