{-# language DuplicateRecordFields #-}
{-# language FlexibleContexts #-}
{-# language GADTs #-}
{-# language NamedFieldPuns #-}
{-# language RecordWildCards #-}
{-# language StandaloneKindSignatures #-}
{-# language StrictData #-}

module Rel8.Internal.Statement.Insert
  ( Insert(..)
  , insert
  , ppInsert
  , ppInto
  )
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.Tag as Opaleye

-- pretty
import Text.PrettyPrint ( Doc, (<+>), ($$), parens, text )

-- rel8
import Rel8.Internal.Query ( Query )
import Rel8.Internal.Schema.Name ( Name, Selects, ppColumn )
import Rel8.Internal.Schema.Table ( TableSchema(..), ppTable )
import Rel8.Internal.Statement (Statement)
import Rel8.Internal.Statement.OnConflict ( OnConflict, ppOnConflict )
import Rel8.Internal.Statement.Returning (Returning, ppReturning, runReturning)
import Rel8.Internal.Statement.Select ( ppRows )
import Rel8.Internal.Table ( Table )
import Rel8.Internal.Table.Name ( showNames )

-- transformers
import Control.Monad.Trans.State.Strict (State)


-- | The constituent parts of a SQL @INSERT@ statement.
type Insert :: Type -> Type
data Insert a where
  Insert :: Selects names exprs =>
    { ()
into :: TableSchema names
      -- ^ Which table to insert into.
    , ()
rows :: Query exprs
      -- ^ The rows to insert. This can be an arbitrary query — use
      -- 'Rel8.values' insert a static list of rows.
    , ()
onConflict :: OnConflict exprs
      -- ^ What to do if the inserted rows conflict with data already in the
      -- table.
    , ()
returning :: Returning names a
      -- ^ What information to return on completion.
    }
    -> Insert a


-- | Build an @INSERT@ 'Statement'.
insert :: Insert a -> Statement a
insert :: forall a. Insert a -> Statement a
insert statement :: Insert a
statement@Insert {Returning names a
returning :: ()
returning :: Returning names a
returning} =
  State Tag Doc -> Returning names a -> Statement a
forall names a. State Tag Doc -> Returning names a -> Statement a
runReturning (Insert a -> State Tag Doc
forall a. Insert a -> State Tag Doc
ppInsert Insert a
statement) Returning names a
returning


ppInsert :: Insert a -> State Opaleye.Tag Doc
ppInsert :: forall a. Insert a -> State Tag Doc
ppInsert Insert {TableSchema names
OnConflict exprs
Query exprs
Returning names a
into :: ()
rows :: ()
onConflict :: ()
returning :: ()
into :: TableSchema names
rows :: Query exprs
onConflict :: OnConflict exprs
returning :: Returning names a
..} = do
  rows' <- Query exprs -> State Tag Doc
forall a. Table Expr a => Query a -> State Tag Doc
ppRows Query exprs
rows
  pure $
    text "INSERT INTO" <+>
    ppInto into $$
    rows' $$
    ppOnConflict into onConflict $$
    ppReturning into returning


ppInto :: Table Name a => TableSchema a -> Doc
ppInto :: forall a. Table Name a => TableSchema a -> Doc
ppInto table :: TableSchema a
table@TableSchema {a
columns :: a
columns :: forall names. TableSchema names -> names
columns} =
  TableSchema a -> Doc
forall a. TableSchema a -> Doc
ppTable TableSchema a
table Doc -> Doc -> Doc
<+>
  Doc -> Doc
parens ((String -> Doc) -> [String] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
Opaleye.commaV String -> Doc
ppColumn (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (a -> NonEmpty String
forall a. Table Name a => a -> NonEmpty String
showNames a
columns)))