{-# LANGUAGE
DeriveGeneric
, DerivingStrategies
, FlexibleContexts
, FlexibleInstances
, GADTs
, GeneralizedNewtypeDeriving
, LambdaCase
, MultiParamTypeClasses
, OverloadedStrings
, PatternSynonyms
, QuantifiedConstraints
, RankNTypes
, ScopedTypeVariables
, TypeApplications
, TypeFamilies
, TypeInType
, TypeOperators
, UndecidableInstances
#-}
module Squeal.PostgreSQL.Manipulation.Insert
(
insertInto
, insertInto_
, QueryClause (..)
, pattern Values_
, inlineValues
, inlineValues_
, ConflictClause (..)
, ConflictTarget (..)
, ConflictAction (..)
) where
import Data.ByteString hiding (foldr)
import qualified Generics.SOP as SOP
import qualified Generics.SOP.Record as SOP
import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Expression.Default
import Squeal.PostgreSQL.Expression.Inline
import Squeal.PostgreSQL.Expression.Logic
import Squeal.PostgreSQL.Manipulation
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Query
import Squeal.PostgreSQL.Query.Table
import Squeal.PostgreSQL.Type.Schema
insertInto
:: ( Has sch db schema
, Has tab schema ('Table table)
, SOP.SListI (TableToColumns table)
, SOP.SListI row )
=> QualifiedAlias sch tab
-> QueryClause with db params (TableToColumns table)
-> ConflictClause tab with db params table
-> ReturningClause with db params '[tab ::: TableToRow table] row
-> Manipulation with db params row
insertInto tab qry conflict ret = UnsafeManipulation $
"INSERT" <+> "INTO" <+> renderSQL tab
<+> renderSQL qry
<> renderSQL conflict
<> renderSQL ret
insertInto_
:: ( Has sch db schema
, Has tab schema ('Table table)
, SOP.SListI (TableToColumns table) )
=> QualifiedAlias sch tab
-> QueryClause with db params (TableToColumns table)
-> Manipulation with db params '[]
insertInto_ tab qry =
insertInto tab qry OnConflictDoRaise (Returning_ Nil)
data QueryClause with db params columns where
Values
:: SOP.SListI columns
=> NP (Aliased (Optional (Expression 'Ungrouped '[] with db params '[]))) columns
-> [NP (Aliased (Optional (Expression 'Ungrouped '[] with db params '[]))) columns]
-> QueryClause with db params columns
Select
:: SOP.SListI columns
=> NP (Aliased (Optional (Expression grp '[] with db params from))) columns
-> TableExpression grp '[] with db params from
-> QueryClause with db params columns
Subquery
:: ColumnsToRow columns ~ row
=> Query '[] with db params row
-> QueryClause with db params columns
instance RenderSQL (QueryClause with db params columns) where
renderSQL = \case
Values row0 rows ->
parenthesized (renderCommaSeparated renderSQLPart row0)
<+> "VALUES"
<+> commaSeparated
( parenthesized
. renderCommaSeparated renderValuePart <$> row0 : rows )
Select row0 tab ->
parenthesized (renderCommaSeparatedMaybe renderSQLPartMaybe row0)
<+> "SELECT"
<+> renderCommaSeparatedMaybe renderValuePartMaybe row0
<+> renderSQL tab
Subquery qry -> renderQuery qry
where
renderSQLPartMaybe, renderValuePartMaybe
:: Aliased (Optional (Expression grp '[] with db params from)) column
-> Maybe ByteString
renderSQLPartMaybe = \case
Default `As` _ -> Nothing
Set _ `As` name -> Just $ renderSQL name
renderValuePartMaybe = \case
Default `As` _ -> Nothing
Set value `As` _ -> Just $ renderExpression value
renderSQLPart, renderValuePart
:: Aliased (Optional (Expression grp '[] with db params from)) column
-> ByteString
renderSQLPart (_ `As` name) = renderSQL name
renderValuePart (value `As` _) = renderSQL value
pattern Values_
:: SOP.SListI columns
=> NP (Aliased (Optional (Expression 'Ungrouped '[] with db params '[]))) columns
-> QueryClause with db params columns
pattern Values_ vals = Values vals []
inlineValues_
:: ( SOP.IsRecord hask xs
, SOP.AllZip InlineColumn xs columns )
=> hask
-> QueryClause with db params columns
inlineValues_ = Values_ . inlineColumns
inlineValues
:: ( SOP.IsRecord hask xs
, SOP.AllZip InlineColumn xs columns )
=> hask
-> [hask]
-> QueryClause with db params columns
inlineValues hask hasks = Values (inlineColumns hask) (inlineColumns <$> hasks)
data ConflictClause tab with db params table where
OnConflictDoRaise :: ConflictClause tab with db params table
OnConflict
:: ConflictTarget table
-> ConflictAction tab with db params table
-> ConflictClause tab with db params table
instance SOP.SListI (TableToColumns table)
=> RenderSQL (ConflictClause tab with db params table) where
renderSQL = \case
OnConflictDoRaise -> ""
OnConflict target action -> " ON CONFLICT"
<+> renderSQL target <+> renderSQL action
data ConflictAction tab with db params table where
DoNothing :: ConflictAction tab with db params table
DoUpdate
:: ( row ~ TableToRow table
, from ~ '[tab ::: row, "excluded" ::: row]
, Updatable table updates )
=> NP (Aliased (Optional (Expression 'Ungrouped '[] with db params from))) updates
-> [Condition 'Ungrouped '[] with db params from]
-> ConflictAction tab with db params table
instance RenderSQL (ConflictAction tab with db params table) where
renderSQL = \case
DoNothing -> "DO NOTHING"
DoUpdate updates whs'
-> "DO UPDATE SET"
<+> renderCommaSeparated renderUpdate updates
<> case whs' of
[] -> ""
wh:whs -> " WHERE" <+> renderSQL (foldr (.&&) wh whs)
renderUpdate
:: (forall x. RenderSQL (expr x))
=> Aliased (Optional expr) ty
-> ByteString
renderUpdate (expr `As` col) = renderSQL col <+> "=" <+> renderSQL expr
data ConflictTarget table where
OnConstraint
:: Has con constraints constraint
=> Alias con
-> ConflictTarget (constraints :=> columns)
instance RenderSQL (ConflictTarget constraints) where
renderSQL (OnConstraint con) =
"ON" <+> "CONSTRAINT" <+> renderSQL con