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

module Rel8.Statement.Insert
  ( Insert(..)
  , insert
  , ppInsert
  , ppInto
  )
where

-- base
import Data.Foldable ( toList )
import Data.Kind ( Type )
import Prelude

-- hasql
import qualified Hasql.Encoders as Hasql
import qualified Hasql.Statement as Hasql

-- opaleye
import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye

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

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

-- text
import qualified Data.Text as Text ( pack )
import Data.Text.Encoding ( encodeUtf8 )


-- | 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 names
      -- ^ 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


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


ppInto :: Table Name a => TableSchema a -> Doc
ppInto :: TableSchema a -> Doc
ppInto table :: TableSchema a
table@TableSchema {a
columns :: forall names. TableSchema names -> names
columns :: a
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 (t :: * -> *) a. Foldable t => t a -> [a]
toList (a -> NonEmpty String
forall a. Table Name a => a -> NonEmpty String
showNames a
columns)))


-- | Run an 'Insert' statement.
insert :: Insert a -> Hasql.Statement () a
insert :: Insert a -> Statement () a
insert i :: Insert a
i@Insert {Returning names a
returning :: Returning names a
$sel:returning:Insert :: ()
returning} = ByteString -> Params () -> Result a -> Bool -> Statement () a
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Hasql.Statement ByteString
bytes Params ()
params Result a
decode Bool
prepare
  where
    bytes :: ByteString
bytes = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
sql
    params :: Params ()
params = Params ()
Hasql.noParams
    decode :: Result a
decode = Returning names a -> Result a
forall names a. Returning names a -> Result a
decodeReturning Returning names a
returning
    prepare :: Bool
prepare = Bool
False
    sql :: String
sql = Doc -> String
forall a. Show a => a -> String
show Doc
doc
    doc :: Doc
doc = Insert a -> Doc
forall a. Insert a -> Doc
ppInsert Insert a
i