{-# LANGUAGE OverloadedStrings #-}

-- | Rendering Haskell values as inline SQL literals for statements that cannot
-- use parameter binding, such as migrations and seed upserts.
module Arbiter.Core.SqlLiterals
  ( textLiteral
  , quoteIdentifier
  , doubleLiteral
  , intLiteral
  ) where

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

-- | A single-quoted SQL text literal, escaping embedded quotes.
textLiteral :: Text -> Text
textLiteral :: Text -> Text
textLiteral Text
text = 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
text 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
<> String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
value) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'::double precision"
  | Bool
otherwise = String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
value)

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