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)