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

module Rel8.Statement.Delete
  ( Delete(..)
  , delete
  , ppDelete
  )
where

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

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

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

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Query ( Query )
import Rel8.Schema.Name ( Selects )
import Rel8.Schema.Table ( TableSchema, ppTable )
import Rel8.Statement.Returning ( Returning, decodeReturning, ppReturning )
import Rel8.Statement.Using ( ppUsing )
import Rel8.Statement.Where ( ppWhere )

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


-- | The constituent parts of a @DELETE@ statement.
type Delete :: Type -> Type
data Delete a where
  Delete :: Selects names exprs =>
    { ()
from :: TableSchema names
      -- ^ Which table to delete from.
    , ()
using :: Query using
      -- ^ @USING@ clause — this can be used to join against other tables,
      -- and its results can be referenced in the @WHERE@ clause
    , ()
deleteWhere :: using -> exprs -> Expr Bool
      -- ^ Which rows should be selected for deletion.
    , ()
returning :: Returning names a
      -- ^ What to return from the @DELETE@ statement.
    }
    -> Delete a


ppDelete :: Delete a -> Doc
ppDelete :: Delete a -> Doc
ppDelete Delete {Query using
TableSchema names
Returning names a
using -> exprs -> Expr Bool
returning :: Returning names a
deleteWhere :: using -> exprs -> Expr Bool
using :: Query using
from :: TableSchema names
$sel:returning:Delete :: ()
$sel:deleteWhere:Delete :: ()
$sel:using:Delete :: ()
$sel:from:Delete :: ()
..} = case Query using -> Maybe (Doc, using)
forall a. Query a -> Maybe (Doc, a)
ppUsing Query using
using of
  Maybe (Doc, using)
Nothing ->
    String -> Doc
text String
"DELETE FROM" Doc -> Doc -> Doc
<+> TableSchema names -> Doc
forall a. TableSchema a -> Doc
ppTable TableSchema names
from Doc -> Doc -> Doc
$$
    String -> Doc
text String
"WHERE false"
  Just (Doc
usingDoc, using
i) ->
    String -> Doc
text String
"DELETE FROM" Doc -> Doc -> Doc
<+> TableSchema names -> Doc
forall a. TableSchema a -> Doc
ppTable TableSchema names
from Doc -> Doc -> Doc
$$
    Doc
usingDoc Doc -> Doc -> Doc
$$
    TableSchema names -> (exprs -> Expr Bool) -> Doc
forall names exprs.
Selects names exprs =>
TableSchema names -> (exprs -> Expr Bool) -> Doc
ppWhere TableSchema names
from (using -> exprs -> Expr Bool
deleteWhere using
i) Doc -> Doc -> Doc
$$
    TableSchema names -> Returning names a -> Doc
forall names a. TableSchema names -> Returning names a -> Doc
ppReturning TableSchema names
from Returning names a
returning


-- | Run a 'Delete' statement.
delete :: Delete a -> Hasql.Statement () a
delete :: Delete a -> Statement () a
delete d :: Delete a
d@Delete {Returning names a
returning :: Returning names a
$sel:returning:Delete :: ()
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 = Delete a -> Doc
forall a. Delete a -> Doc
ppDelete Delete a
d