content: {-# language DuplicateRecordFields #-}
  {-# language FlexibleContexts #-}
  {-# language GADTs #-}
  {-# language LambdaCase #-}
  {-# language NamedFieldPuns #-}
  {-# language OverloadedStrings #-}
  {-# language RecordWildCards #-}
  {-# language StandaloneKindSignatures #-}
  {-# language StrictData #-}
  {-# language TypeOperators #-}
  
  module Rel8.Statement.OnConflict
    ( OnConflict(..)
    , Upsert(..)
    , ppOnConflict
    )
  where
  
  -- base
  import Data.Foldable ( toList )
  import Data.Kind ( Type )
  import Prelude
  
  -- opaleye
  import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
  import qualified Opaleye.Internal.Sql as Opaleye
  
  -- pretty
  import Text.PrettyPrint ( Doc, (<+>), ($$), parens, text )
  
  -- rel8
  import Rel8.Expr ( Expr )
  import Rel8.Expr.Opaleye (toPrimExpr)
  import Rel8.Schema.Name ( Name, Selects, ppColumn )
  import Rel8.Schema.Table ( TableSchema(..) )
  import Rel8.Statement.Set ( ppSet )
  import Rel8.Statement.Where ( ppWhere )
  import Rel8.Table ( Table, toColumns )
  import Rel8.Table.Cols ( Cols( Cols ) )
  import Rel8.Table.Name ( showNames )
  import Rel8.Table.Opaleye (attributes, view)
  import Rel8.Table.Projection ( Projecting, Projection, apply )
  
  
  -- | 'OnConflict' represents the @ON CONFLICT@ clause of an @INSERT@
  -- statement. This specifies what ought to happen when one or more of the
  -- rows proposed for insertion conflict with an existing row in the table.
  type OnConflict :: Type -> Type
  data OnConflict names
    = Abort
      -- ^ Abort the transaction if there are conflicting rows (Postgres' default)
    | DoNothing
      -- ^ @ON CONFLICT DO NOTHING@
    | DoUpdate (Upsert names)
      -- ^ @ON CONFLICT DO UPDATE@
  
  
  -- | The @ON CONFLICT (...) DO UPDATE@ clause of an @INSERT@ statement, also
  -- known as \"upsert\".
  --
  -- When an existing row conflicts with a row proposed for insertion,
  -- @ON CONFLICT DO UPDATE@ allows you to instead update this existing row. The
  -- conflicting row proposed for insertion is then \"excluded\", but its values
  -- can still be referenced from the @SET@ and @WHERE@ clauses of the @UPDATE@
  -- statement.
  --
  -- Upsert in Postgres a \"conflict target\" to be specified — this is the
  -- @UNIQUE@ index from conflicts with which we would like to recover. Indexes
  -- are specified by listing the columns that comprise them along with an
  -- optional predicate in the case of partial indexes.
  type Upsert :: Type -> Type
  data Upsert names where
    Upsert :: (Selects names exprs, Projecting names index, excluded ~ exprs) =>
      { index :: Projection names index
        -- ^ The set of columns comprising the @UNIQUE@ index that forms our
        -- conflict target, projected from the set of columns for the whole
        -- table
      , predicate :: Maybe (exprs -> Expr Bool)
        -- ^ An optional predicate used to specify a
        -- [partial index](https://www.postgresql.org/docs/current/indexes-partial.html).
      , set :: excluded -> exprs -> exprs
        -- ^ How to update each selected row.
      , updateWhere :: excluded -> exprs -> Expr Bool
        -- ^ Which rows to select for update.
      }
      -> Upsert names
  
  
  ppOnConflict :: TableSchema names -> OnConflict names -> Doc
  ppOnConflict schema = \case
    Abort -> mempty
    DoNothing -> text "ON CONFLICT DO NOTHING"
    DoUpdate upsert -> ppUpsert schema upsert
  
  
  ppUpsert :: TableSchema names -> Upsert names -> Doc
  ppUpsert schema@TableSchema {columns} Upsert {..} =
    text "ON CONFLICT" <+>
    ppIndex columns index <+> foldMap (ppPredicate columns) predicate <+>
    text "DO UPDATE" $$
    ppSet schema (set excluded) $$
    ppWhere schema (updateWhere excluded)
    where
      excluded = attributes TableSchema
        { name = "excluded"
        , columns
        }
  
  
  ppIndex :: (Table Name names, Projecting names index)
    => names -> Projection names index -> Doc
  ppIndex columns index =
    parens $ Opaleye.commaV ppColumn $ toList $
      showNames $ Cols $ apply index $ toColumns columns
  
  
  ppPredicate :: Selects names exprs
    => names -> (exprs -> Expr Bool) -> Doc
  ppPredicate schema where_ = text "WHERE" <+> ppExpr condition
    where
      ppExpr = Opaleye.ppSqlExpr . Opaleye.sqlExpr . toPrimExpr
      condition = where_ (view schema)
  