{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Internal to the arbiter packages. Not covered by the PVP.
--
-- Haskell values rendered as inline SQL literals.
module Arbiter.Core.SqlLiterals
  ( textLiteral
  , quoteIdentifier
  , doubleLiteral
  , intLiteral
  , defaultMaxAttemptsSQL
  , attemptsLeftSQL
  , attemptsSpentSQL
  , minMaxAttemptsSQL
  , maxIdentifierBytes
  , sharedTable
  , lockGroupKeyOnConflictSQL
  , dollarQuote
  ) where

import Data.Text (Text)
import Data.Text qualified as T
import NeatInterpolation (text)

import Arbiter.Core.Enum (showText)
import Arbiter.Core.Job.Types (defaultMaxAttempts, minMaxAttempts)

-- | A single-quoted SQL text literal, escaping embedded quotes.
textLiteral :: Text -> Text
textLiteral :: Text -> Text
textLiteral Text
raw = Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"'" Text
"''" Text
raw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

-- | A double-quoted SQL identifier, doubling embedded quotes.
quoteIdentifier :: Text -> Text
quoteIdentifier :: Text -> Text
quoteIdentifier Text
ident = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\"\"" Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

-- | A @double precision@ literal. Non-finite values are emitted quoted and cast.
doubleLiteral :: Double -> Text
doubleLiteral :: Double -> Text
doubleLiteral Double
value
  | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
value Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
value = Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a. Show a => a -> Text
showText Double
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'::double precision"
  | Bool
otherwise = Double -> Text
forall a. Show a => a -> Text
showText Double
value

-- | An integer literal.
intLiteral :: (Integral a) => a -> Text
intLiteral :: forall a. Integral a => a -> Text
intLiteral a
value = Integer -> Text
forall a. Show a => a -> Text
showText (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
value)

-- | 'defaultMaxAttempts' as a SQL literal.
defaultMaxAttemptsSQL :: Text
defaultMaxAttemptsSQL :: Text
defaultMaxAttemptsSQL = Int32 -> Text
forall a. Integral a => a -> Text
intLiteral Int32
defaultMaxAttempts

-- | Whether a row has attempts left. @col@ prefixes each column.
attemptsLeftSQL :: Text -> Text
attemptsLeftSQL :: Text -> Text
attemptsLeftSQL Text
col = [text|${col}attempts < COALESCE(${col}max_attempts, ${defaultMaxAttemptsSQL})|]

-- | Whether a row has spent its attempts. @col@ prefixes each column.
attemptsSpentSQL :: Text -> Text
attemptsSpentSQL :: Text -> Text
attemptsSpentSQL Text
col = [text|${col}attempts >= COALESCE(${col}max_attempts, ${defaultMaxAttemptsSQL})|]

-- | 'minMaxAttempts' as a SQL literal.
minMaxAttemptsSQL :: Text
minMaxAttemptsSQL :: Text
minMaxAttemptsSQL = Int32 -> Text
forall a. Integral a => a -> Text
intLiteral Int32
minMaxAttempts

-- | The PostgreSQL identifier limit in bytes (@NAMEDATALEN - 1@).
maxIdentifierBytes :: Int
maxIdentifierBytes :: Int
maxIdentifierBytes = Int
63

-- | A schema-qualified shared table. The table name stays unquoted.
sharedTable :: Text -> Text -> Text
sharedTable :: Text -> Text -> Text
sharedTable Text
schemaName Text
tableName = Text -> Text
quoteIdentifier Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName

-- | An ON CONFLICT clause that row-locks an existing group key and writes nothing.
-- @DO UPDATE@ takes the lock. @WHERE FALSE@ skips the write.
lockGroupKeyOnConflictSQL :: Text
lockGroupKeyOnConflictSQL :: Text
lockGroupKeyOnConflictSQL = Text
"ON CONFLICT (group_key) DO UPDATE SET group_key = EXCLUDED.group_key WHERE FALSE"

-- | The plpgsql function-body delimiter.
dollarQuote :: Text
dollarQuote :: Text
dollarQuote = Text
"$$"