{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE ViewPatterns #-}

-- | Description: Translate delete statements.
module Squeal.QuasiQuotes.Delete (
  toSquealDelete,
) where

import Control.Monad (when)
import Data.Maybe (isJust)
import Language.Haskell.TH.Syntax (Exp(AppE, ConE, LabelE, VarE), Q)
import Prelude
  ( Applicative(pure), Maybe(Just, Nothing), MonadFail(fail), ($), (<$>)
  )
import Squeal.QuasiQuotes.Common
  ( getIdentText, renderPGTAExpr, renderPGTTableRef, renderPGTTargetList
  )
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as Text
import qualified PostgresqlSyntax.Ast as PGT_AST
import qualified Squeal.PostgreSQL as S


toSquealDelete :: PGT_AST.DeleteStmt -> Q Exp
toSquealDelete :: DeleteStmt -> Q Exp
toSquealDelete
  ( PGT_AST.DeleteStmt
      Maybe WithClause
maybeWithClause
      RelationExprOptAlias
relationExprOptAlias
      Maybe UsingClause
maybeUsingClause
      Maybe WhereOrCurrentClause
maybeWhereClause
      Maybe ReturningClause
maybeReturningClause
    ) = do
    Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe WithClause -> Bool
forall a. Maybe a -> Bool
isJust Maybe WithClause
maybeWithClause) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
      String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"WITH clauses are not supported in DELETE statements yet."
    -- whereOrCurrentClause with cursor is not supported yet

    targetTableExp <- RelationExprOptAlias -> Q Exp
renderPGTRelationExprOptAlias' RelationExprOptAlias
relationExprOptAlias

    usingClauseExp <-
      case maybeUsingClause of
        Maybe UsingClause
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.NoUsing
        Just UsingClause
usingClause -> Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'S.Using) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UsingClause -> Q Exp
renderPGTTableRef UsingClause
usingClause

    whereConditionExp <-
      case maybeWhereClause of
        Maybe WhereOrCurrentClause
Nothing ->
          String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
            String
"DELETE statements must have a WHERE clause for safety. Use WHERE TRUE to delete all rows."
        Just (PGT_AST.ExprWhereOrCurrentClause AExpr
whereAExpr) -> AExpr -> Q Exp
renderPGTAExpr AExpr
whereAExpr
        Just (PGT_AST.CursorWhereOrCurrentClause CursorName
_) -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"WHERE CURRENT OF is not supported."

    returningClauseExp <-
      case maybeReturningClause of
        Maybe ReturningClause
Nothing -> Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'S.Returning_ Exp -> Exp -> Exp
`AppE` Name -> Exp
ConE 'S.Nil
        Just ReturningClause
returningClause -> Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'S.Returning) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReturningClause -> Q Exp
renderPGTTargetList ReturningClause
returningClause

    pure
      ( VarE 'S.deleteFrom
          `AppE` targetTableExp
          `AppE` usingClauseExp
          `AppE` whereConditionExp
          `AppE` returningClauseExp
      )


renderPGTRelationExprOptAlias' :: PGT_AST.RelationExprOptAlias -> Q Exp
renderPGTRelationExprOptAlias' :: RelationExprOptAlias -> Q Exp
renderPGTRelationExprOptAlias' (PGT_AST.RelationExprOptAlias RelationExpr
relationExpr Maybe (Bool, CursorName)
maybeAlias) = do
  (tableName, schemaName) <-
    case RelationExpr
relationExpr of
      PGT_AST.SimpleRelationExpr (PGT_AST.SimpleQualifiedName CursorName
ident) Bool
_ ->
        (Text, Maybe Text) -> Q (Text, Maybe Text)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CursorName -> Text
getIdentText CursorName
ident, Maybe Text
forall a. Maybe a
Nothing)
      PGT_AST.SimpleRelationExpr
        ( PGT_AST.IndirectedQualifiedName
            CursorName
schemaIdent
            (PGT_AST.AttrNameIndirectionEl CursorName
tableIdent NE.:| [])
          )
        Bool
_ ->
          (Text, Maybe Text) -> Q (Text, Maybe Text)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CursorName -> Text
getIdentText CursorName
tableIdent, Text -> Maybe Text
forall a. a -> Maybe a
Just (CursorName -> Text
getIdentText CursorName
schemaIdent))
      RelationExpr
_ -> String -> Q (Text, Maybe Text)
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unsupported relation expression in DELETE statement."

  let
    aliasName = case Maybe (Bool, CursorName)
maybeAlias of
      Just (Bool
_, CursorName
colId) -> CursorName -> Text
getIdentText CursorName
colId
      Maybe (Bool, CursorName)
Nothing -> Text
tableName

  let
    qualifiedAlias = case Maybe Text
schemaName of
      Maybe Text
Nothing -> String -> Exp
LabelE (Text -> String
Text.unpack Text
tableName)
      Just Text
schema ->
        Name -> Exp
VarE '(S.!)
          Exp -> Exp -> Exp
`AppE` String -> Exp
LabelE (Text -> String
Text.unpack Text
schema)
          Exp -> Exp -> Exp
`AppE` String -> Exp
LabelE (Text -> String
Text.unpack Text
tableName)

  pure $ VarE 'S.as `AppE` qualifiedAlias `AppE` LabelE (Text.unpack aliasName)