Mark Eibes
2021-07-15T17:35:31Z

Extreme.purs

| data OnConflict = OnConflictDoNothing | OnConflictDoUpdate
|
| -- | typeclass-alias for `genericShowInsert` constraints
| class GenericShowInsertOnConflict t r where
| genericShowInsertOnConflict
| ∷ { ph ∷ String }
| → Table t
| → Array { | r }
| -> OnConflict
| → String
|
| instance
| ( TableColumnNames rl
| , RL.RowToList r rl
| , CanInsertColumnsIntoTable rl t
| , RowListLength rl
| ) ⇒ GenericShowInsertOnConflict t r
| where
| genericShowInsertOnConflict { ph } table rs onConflict =
| let
| onConflictDo = case onConflict of
| OnConflictDoNothing -> "NOTHING"
| OnConflictDoUpdate -> "UPDATE"
| cols = joinWith ", " $ tableColumnNames (Proxy ∷ Proxy rl)
| len = rowListLength (Proxy ∷ Proxy rl)
| placeholders = mkPlaceholders ph 1 len $ Array.length rs
| in
| ["INSERT INTO ", tableName table, " (", cols, ") VALUES ", placeholders, " ON CONFLICT DO ", onConflictDo, ";"]
| # joinWith ""
|
| genericInsertOnConflict_
| ∷ ∀ t r a b
| . GenericShowInsertOnConflict t r
| ⇒ HFoldl (RecordToArrayForeign b) (Array Foreign) { | r } (Array Foreign)
| ⇒ { ph ∷ String, exec ∷ String → Array Foreign → a }
| → Proxy b
| → Table t
| → Array { | r }
| -> OnConflict
| → a
| genericInsertOnConflict_ { ph, exec } b table rs onConflict = do
| let
| q = genericShowInsertOnConflict { ph } table rs onConflict
| l = rs >>= hfoldl (RecordToArrayForeign b) ([] ∷ Array Foreign)
| exec q l
|
|
| class GenericInsertOnConflict ∷ ∀ k. k → (Type → Type) → Row Type → Row Type → Constraint
| class Monad m <= GenericInsertOnConflict b m t r | t → r, b → m where
| genericInsertOnConflict
| ∷ Proxy b
| → Table t
| → Array { | r }
| -> OnConflict
| → m Unit
|
| instance
| ( HFoldl
| (RecordToArrayForeign BackendPGClass)
| (Array Foreign)
| { | r }
| (Array Foreign)
| , MonadSeldaPG m
| , GenericShowInsertOnConflict t r
| ) ⇒
| GenericInsertOnConflict BackendPGClass m t r where
| genericInsertOnConflict = genericInsertOnConflict_ { exec, ph: "$" }
| where
| exec q l =
| when (not $ Array.null l) do
| conn ← ask
| PostgreSQL.PG.execute conn (PostgreSQL.Query q) l
|
| insertOnConflict_ ∷
| ∀ m t r.
| GenericInsertOnConflict BackendPGClass m t r ⇒
| MonadSeldaPG m ⇒
| Table t → Array { | r } -> OnConflict → m Unit
| insertOnConflict_ = genericInsertOnConflict (Proxy ∷ Proxy BackendPGClass)