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

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

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

-- opaleye
import qualified Opaleye.Internal.Tag as Opaleye

-- 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 (Statement)
import Rel8.Statement.Returning (Returning, ppReturning, runReturning)
import Rel8.Statement.Using ( ppUsing )
import Rel8.Statement.Where ( ppWhere )

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


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


-- | Build a @DELETE@ 'Statement'.
delete :: Delete a -> Statement a
delete :: forall a. Delete a -> Statement a
delete statement :: Delete a
statement@Delete {Returning names a
$sel:returning:Delete :: ()
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 (Delete a -> State Tag Doc
forall a. Delete a -> State Tag Doc
ppDelete Delete a
statement) Returning names a
returning


ppDelete :: Delete a -> State Opaleye.Tag Doc
ppDelete :: forall a. Delete a -> State Tag Doc
ppDelete Delete {TableSchema names
Query using
Returning names a
using -> exprs -> Expr Bool
$sel:from:Delete :: ()
$sel:using:Delete :: ()
$sel:deleteWhere:Delete :: ()
$sel:returning:Delete :: ()
from :: TableSchema names
using :: Query using
deleteWhere :: using -> exprs -> Expr Bool
returning :: Returning names a
..} = do
  Maybe (Doc, using)
musing <- Query using -> State Tag (Maybe (Doc, using))
forall a. Query a -> State Tag (Maybe (Doc, a))
ppUsing Query using
using
  Doc -> State Tag Doc
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> State Tag Doc) -> Doc -> State Tag Doc
forall a b. (a -> b) -> a -> b
$ case Maybe (Doc, using)
musing 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