{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | This module defines the functions which are used only for backends creation.
module Database.Groundhog.Generic.Sql
  ( -- * SQL rendering utilities
    renderCond,
    defaultShowPrim,
    renderOrders,
    renderUpdates,
    renderFields,
    renderChain,
    renderExpr,
    renderExprPriority,
    renderExprExtended,
    renderPersistValue,
    mkExprWithConf,
    prerenderExpr,
    intercalateS,
    commasJoin,
    flatten,
    RenderS (..),
    Utf8 (..),
    fromUtf8,
    RenderConfig (..),
    StringLike (..),
    fromString,
    (<>),
    function,
    operator,
    parens,
    mkExpr,
    Snippet (..),
    SqlDb (..),
    FloatingSqlDb (..),
    tableName,
    mainTableName,
  )
where

import Data.Maybe (mapMaybe, maybeToList)
import Data.Semigroup (Semigroup (..))
import Data.String
import qualified Data.Text.Lazy.Builder as B
import Database.Groundhog.Core
import Database.Groundhog.Expression
import Database.Groundhog.Generic (isSimple)
import Database.Groundhog.Instances ()

class (Semigroup a, Monoid a, IsString a) => StringLike a where
  fromChar :: Char -> a

data RenderS db r = RenderS
  { RenderS db r -> Utf8
getQuery :: Utf8,
    RenderS db r -> [PersistValue] -> [PersistValue]
getValues :: [PersistValue] -> [PersistValue]
  }

instance StringLike Utf8 where
  fromChar :: Char -> Utf8
fromChar = Builder -> Utf8
Utf8 (Builder -> Utf8) -> (Char -> Builder) -> Char -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
B.singleton

-- | Escape function, priority of the outer operator. The result is a list for the embedded data which may expand to several RenderS.
newtype Snippet db r = Snippet (RenderConfig -> Int -> [RenderS db r])

newtype RenderConfig = RenderConfig
  { RenderConfig -> Utf8 -> Utf8
esc :: Utf8 -> Utf8
  }

-- | This class distinguishes databases which support SQL-specific expressions. It contains ad hoc members for features whose syntax differs across the databases.
class (DbDescriptor db, QueryRaw db ~ Snippet db) => SqlDb db where
  append :: (ExpressionOf db r a String, ExpressionOf db r b String) => a -> b -> Expr db r String
  signum' :: (ExpressionOf db r x a, Num a) => x -> Expr db r a
  quotRem' :: (ExpressionOf db r x a, ExpressionOf db r y a, Integral a) => x -> y -> (Expr db r a, Expr db r a)

  equalsOperator :: RenderS db r -> RenderS db r -> RenderS db r
  notEqualsOperator :: RenderS db r -> RenderS db r -> RenderS db r

-- | This class distinguishes databases which support trigonometry and other math functions. For example, PostgreSQL has them but Sqlite does not. It contains ad hoc members for features whose syntax differs across the databases.
class SqlDb db => FloatingSqlDb db where
  -- | Natural logarithm
  log' :: (ExpressionOf db r x a, Floating a) => x -> Expr db r a

  logBase' :: (ExpressionOf db r b a, ExpressionOf db r x a, Floating a) => b -> x -> Expr db r a

-- | If we reuse complex expression several times, prerendering it saves time. `RenderConfig` can be obtained with `mkExprWithConf`
prerenderExpr :: forall db r a. (SqlDb db, PersistField a) => RenderConfig -> Expr db r a -> Expr db r a
prerenderExpr :: RenderConfig -> Expr db r a -> Expr db r a
prerenderExpr RenderConfig
conf (Expr UntypedExpr db r
e) = UntypedExpr db r -> Expr db r a
forall db r a. UntypedExpr db r -> Expr db r a
Expr (UntypedExpr db r -> Expr db r a)
-> UntypedExpr db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ DbType -> QueryRaw db r -> UntypedExpr db r
forall db r. DbType -> QueryRaw db r -> UntypedExpr db r
ExprRaw DbType
typ (QueryRaw db r -> UntypedExpr db r)
-> QueryRaw db r -> UntypedExpr db r
forall a b. (a -> b) -> a -> b
$ (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS db r]) -> Snippet db r)
-> (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
_ Int
_ -> [RenderS db r]
prerendered
  where
    proxy :: Any db
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy db
undefined :: proxy db
    typ :: DbType
typ = Any db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any db
proxy (a
forall a. HasCallStack => a
undefined :: a)
    -- Priority of outer operation is not known. Assuming that it is high ensures that parentheses won't be missing.
    prerendered :: [RenderS db r]
prerendered = RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended RenderConfig
conf Int
forall a. Bounded a => a
maxBound UntypedExpr db r
e

-- | Helps creating an expression which depends on render configuration. It can be used in pair with `prerenderExpr`.
-- @
-- myExpr x = mkExprWithConf $ \conf _ -> let
--        x' = prerenderExpr conf x
--     in x' + x' * x'@
-- @
mkExprWithConf :: (SqlDb db, PersistField a) => (RenderConfig -> Int -> Expr db r a) -> Expr db r a
mkExprWithConf :: (RenderConfig -> Int -> Expr db r a) -> Expr db r a
mkExprWithConf RenderConfig -> Int -> Expr db r a
f = Expr db r a
expr
  where
    expr :: Expr db r a
expr = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS db r]) -> Snippet db r)
-> (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
p -> [RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
renderExprPriority RenderConfig
conf Int
p (UntypedExpr db r -> RenderS db r)
-> UntypedExpr db r -> RenderS db r
forall a b. (a -> b) -> a -> b
$ Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr (Expr db r a -> UntypedExpr db r)
-> Expr db r a -> UntypedExpr db r
forall a b. (a -> b) -> a -> b
$ RenderConfig -> Int -> Expr db r a
f RenderConfig
conf Int
p Expr db r a -> Expr db r a -> Expr db r a
forall a. a -> a -> a
`asTypeOf` Expr db r a
expr]

renderExpr :: SqlDb db => RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr :: RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf = RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
renderExprPriority RenderConfig
conf Int
0

renderExprPriority :: SqlDb db => RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
renderExprPriority :: RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
renderExprPriority RenderConfig
conf Int
p UntypedExpr db r
expr =
  case UntypedExpr db r
expr of
    ExprRaw DbType
_ (Snippet f) -> [RenderS db r] -> RenderS db r
forall a. [a] -> a
explicitHead (RenderConfig -> Int -> [RenderS db r]
f RenderConfig
conf Int
p)
    ExprField FieldChain
f ->
      let fs :: [Utf8]
fs = RenderConfig -> FieldChain -> [Utf8] -> [Utf8]
renderChain RenderConfig
conf FieldChain
f []
       in Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS ([Utf8] -> Utf8
forall a. [a] -> a
explicitHead [Utf8]
fs) [PersistValue] -> [PersistValue]
forall a. a -> a
id
    ExprPure a
a ->
      let vals :: [PersistValue] -> [PersistValue]
vals = a -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues a
a
       in PersistValue -> RenderS db r
forall db r. PersistValue -> RenderS db r
renderPersistValue (PersistValue -> RenderS db r) -> PersistValue -> RenderS db r
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> PersistValue
forall a. [a] -> a
explicitHead ([PersistValue] -> [PersistValue]
vals [])
    ExprCond Cond db r
a -> case RenderConfig -> Int -> Cond db r -> Maybe (RenderS db r)
forall db r.
SqlDb db =>
RenderConfig -> Int -> Cond db r -> Maybe (RenderS db r)
renderCondPriority RenderConfig
conf Int
p Cond db r
a of
      Maybe (RenderS db r)
Nothing -> [Char] -> RenderS db r
forall a. HasCallStack => [Char] -> a
error [Char]
"renderExprPriority: empty condition"
      Just RenderS db r
x -> RenderS db r
x
  where
    explicitHead :: [a] -> a
    explicitHead :: [a] -> a
explicitHead [a]
xs = case [a]
xs of
      [a
x] -> a
x
      [a]
xs' -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"renderExprPriority: expected one column field, found " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs')

renderExprExtended :: SqlDb db => RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended :: RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended RenderConfig
conf Int
p UntypedExpr db r
expr =
  case UntypedExpr db r
expr of
    ExprRaw DbType
_ (Snippet f) -> RenderConfig -> Int -> [RenderS db r]
f RenderConfig
conf Int
p
    ExprField FieldChain
f -> (Utf8 -> RenderS db r) -> [Utf8] -> [RenderS db r]
forall a b. (a -> b) -> [a] -> [b]
map (Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
`RenderS` [PersistValue] -> [PersistValue]
forall a. a -> a
id) ([Utf8] -> [RenderS db r]) -> [Utf8] -> [RenderS db r]
forall a b. (a -> b) -> a -> b
$ RenderConfig -> FieldChain -> [Utf8] -> [Utf8]
renderChain RenderConfig
conf FieldChain
f []
    ExprPure a
a ->
      let vals :: [PersistValue]
vals = a -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues a
a []
       in (PersistValue -> RenderS db r) -> [PersistValue] -> [RenderS db r]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> RenderS db r
forall db r. PersistValue -> RenderS db r
renderPersistValue [PersistValue]
vals
    ExprCond Cond db r
a -> Maybe (RenderS db r) -> [RenderS db r]
forall a. Maybe a -> [a]
maybeToList (Maybe (RenderS db r) -> [RenderS db r])
-> Maybe (RenderS db r) -> [RenderS db r]
forall a b. (a -> b) -> a -> b
$ RenderConfig -> Int -> Cond db r -> Maybe (RenderS db r)
forall db r.
SqlDb db =>
RenderConfig -> Int -> Cond db r -> Maybe (RenderS db r)
renderCondPriority RenderConfig
conf Int
p Cond db r
a

renderPersistValue :: PersistValue -> RenderS db r
renderPersistValue :: PersistValue -> RenderS db r
renderPersistValue (PersistCustom Utf8
s [PersistValue]
as) = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS Utf8
s ([PersistValue]
as [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. [a] -> [a] -> [a]
++)
renderPersistValue PersistValue
a = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS (Char -> Utf8
forall a. StringLike a => Char -> a
fromChar Char
'?') (PersistValue
a PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
:)

instance Semigroup (RenderS db r) where
  (RenderS Utf8
f1 [PersistValue] -> [PersistValue]
g1) <> :: RenderS db r -> RenderS db r -> RenderS db r
<> (RenderS Utf8
f2 [PersistValue] -> [PersistValue]
g2) = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS (Utf8
f1 Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
f2) ([PersistValue] -> [PersistValue]
g1 ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
g2)

instance Monoid (RenderS db r) where
  mempty :: RenderS db r
mempty = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS Utf8
forall a. Monoid a => a
mempty [PersistValue] -> [PersistValue]
forall a. a -> a
id

#if !(MIN_VERSION_base(4,11,0))
  mappend = (<>)
#endif

instance IsString (RenderS db r) where
  fromString :: [Char] -> RenderS db r
fromString [Char]
s = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS ([Char] -> Utf8
forall a. IsString a => [Char] -> a
fromString [Char]
s) [PersistValue] -> [PersistValue]
forall a. a -> a
id

instance StringLike (RenderS db r) where
  fromChar :: Char -> RenderS db r
fromChar Char
c = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS (Char -> Utf8
forall a. StringLike a => Char -> a
fromChar Char
c) [PersistValue] -> [PersistValue]
forall a. a -> a
id

-- Has bad performance. This instance exists for testing purposes and migration
instance StringLike String where
  fromChar :: Char -> [Char]
fromChar Char
c = [Char
c]

{-# INLINEABLE parens #-}
parens :: Int -> Int -> RenderS db r -> RenderS db r
parens :: Int -> Int -> RenderS db r -> RenderS db r
parens Int
p1 Int
p2 RenderS db r
expr = if Int
p1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p2 then Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
'(' RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
expr RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
')' else RenderS db r
expr

operator :: (SqlDb db, Expression db r a, Expression db r b) => Int -> String -> a -> b -> Snippet db r
operator :: Int -> [Char] -> a -> b -> Snippet db r
operator Int
pr [Char]
op a
a b
b = (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS db r]) -> Snippet db r)
-> (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
p ->
  [Int -> Int -> RenderS db r -> RenderS db r
forall db r. Int -> Int -> RenderS db r -> RenderS db r
parens Int
pr Int
p (RenderS db r -> RenderS db r) -> RenderS db r -> RenderS db r
forall a b. (a -> b) -> a -> b
$ RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
renderExprPriority RenderConfig
conf Int
pr (a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a) RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> [Char] -> RenderS db r
forall a. IsString a => [Char] -> a
fromString [Char]
op RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
renderExprPriority RenderConfig
conf Int
pr (b -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr b
b)]

function :: SqlDb db => String -> [UntypedExpr db r] -> Snippet db r
function :: [Char] -> [UntypedExpr db r] -> Snippet db r
function [Char]
func [UntypedExpr db r]
args = (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS db r]) -> Snippet db r)
-> (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
_ -> [[Char] -> RenderS db r
forall a. IsString a => [Char] -> a
fromString [Char]
func RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
'(' RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> [RenderS db r] -> RenderS db r
forall s. StringLike s => [s] -> s
commasJoin ((UntypedExpr db r -> RenderS db r)
-> [UntypedExpr db r] -> [RenderS db r]
forall a b. (a -> b) -> [a] -> [b]
map (RenderConfig -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf) [UntypedExpr db r]
args) RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
')']

mkExpr :: forall db r a. (SqlDb db, PersistField a) => Snippet db r -> Expr db r a
mkExpr :: Snippet db r -> Expr db r a
mkExpr Snippet db r
snippet = UntypedExpr db r -> Expr db r a
forall db r a. UntypedExpr db r -> Expr db r a
Expr (UntypedExpr db r -> Expr db r a)
-> UntypedExpr db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ DbType -> QueryRaw db r -> UntypedExpr db r
forall db r. DbType -> QueryRaw db r -> UntypedExpr db r
ExprRaw DbType
typ QueryRaw db r
Snippet db r
snippet
  where
    proxy :: Any db
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy db
undefined :: proxy db
    typ :: DbType
typ = Any db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any db
proxy (a
forall a. HasCallStack => a
undefined :: a)

{-# INLINEABLE renderCond #-}

-- | Renders conditions for SQL backend. Returns Nothing if the fields don't have any columns.
renderCond ::
  SqlDb db =>
  RenderConfig ->
  Cond db r ->
  Maybe (RenderS db r)
renderCond :: RenderConfig -> Cond db r -> Maybe (RenderS db r)
renderCond RenderConfig
conf = RenderConfig -> Int -> Cond db r -> Maybe (RenderS db r)
forall db r.
SqlDb db =>
RenderConfig -> Int -> Cond db r -> Maybe (RenderS db r)
renderCondPriority RenderConfig
conf Int
0

flattenNullables :: DbType -> [Bool]
flattenNullables :: DbType -> [Bool]
flattenNullables DbType
typ = DbType -> [Bool] -> [Bool]
go DbType
typ []
  where
    go :: DbType -> [Bool] -> [Bool]
    go :: DbType -> [Bool] -> [Bool]
go DbType
t [Bool]
acc = case DbType
t of
      DbEmbedded (EmbeddedDef Bool
_ [([Char], DbType)]
ts) Maybe ParentTableReference
_ -> (([Char], DbType) -> [Bool] -> [Bool])
-> [Bool] -> [([Char], DbType)] -> [Bool]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DbType -> [Bool] -> [Bool]
go (DbType -> [Bool] -> [Bool])
-> (([Char], DbType) -> DbType)
-> ([Char], DbType)
-> [Bool]
-> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], DbType) -> DbType
forall a b. (a, b) -> b
snd) [Bool]
acc [([Char], DbType)]
ts
      DbList [Char]
_ DbType
_ -> Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
acc
      DbTypePrimitive DbTypePrimitive
_ Bool
nullable Maybe [Char]
_ Maybe ParentTableReference
_ -> Bool
nullable Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
acc

{-# INLINEABLE renderCondPriority #-}

-- | Renders conditions for SQL backend. Returns Nothing if the fields don't have any columns.
renderCondPriority ::
  forall db r.
  SqlDb db =>
  RenderConfig ->
  Int ->
  Cond db r ->
  Maybe (RenderS db r)
renderCondPriority :: RenderConfig -> Int -> Cond db r -> Maybe (RenderS db r)
renderCondPriority conf :: RenderConfig
conf@RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Int
priority Cond db r
cond = Cond db r -> Int -> Maybe (RenderS db r)
go Cond db r
cond Int
priority
  where
    go :: Cond db r -> Int -> Maybe (RenderS db r)
go (And Cond db r
a Cond db r
b) Int
p = Int
-> Int -> Utf8 -> Cond db r -> Cond db r -> Maybe (RenderS db r)
perhaps Int
andP Int
p Utf8
" AND " Cond db r
a Cond db r
b
    go (Or Cond db r
a Cond db r
b) Int
p = Int
-> Int -> Utf8 -> Cond db r -> Cond db r -> Maybe (RenderS db r)
perhaps Int
orP Int
p Utf8
" OR " Cond db r
a Cond db r
b
    go (Not Cond db r
CondEmpty) Int
_ = RenderS db r -> Maybe (RenderS db r)
forall a. a -> Maybe a
Just RenderS db r
"(1=0)" -- special case for False
    go (Not Cond db r
a) Int
p = (\RenderS db r
a' -> Int -> Int -> RenderS db r -> RenderS db r
forall db r. Int -> Int -> RenderS db r -> RenderS db r
parens Int
notP Int
p (RenderS db r -> RenderS db r) -> RenderS db r -> RenderS db r
forall a b. (a -> b) -> a -> b
$ RenderS db r
"NOT " RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
a') (RenderS db r -> RenderS db r)
-> Maybe (RenderS db r) -> Maybe (RenderS db r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cond db r -> Int -> Maybe (RenderS db r)
go Cond db r
a Int
notP
    go (Compare ExprRelation
compOp UntypedExpr db r
f1 UntypedExpr db r
f2) Int
p =
      case ExprRelation
compOp of
        ExprRelation
Eq -> Int
-> RenderS db r
-> Int
-> [RenderS db r -> RenderS db r -> RenderS db r]
-> UntypedExpr db r
-> UntypedExpr db r
-> Maybe (RenderS db r)
renderCompOps Int
andP RenderS db r
" AND " Int
37 [RenderS db r -> RenderS db r -> RenderS db r]
ops UntypedExpr db r
f1 UntypedExpr db r
f2
          where
            ops :: [RenderS db r -> RenderS db r -> RenderS db r]
ops = (Bool -> RenderS db r -> RenderS db r -> RenderS db r)
-> [Bool] -> [RenderS db r -> RenderS db r -> RenderS db r]
forall a b. (a -> b) -> [a] -> [b]
map (\Bool
isNull -> if Bool
isNull then RenderS db r -> RenderS db r -> RenderS db r
forall db r.
SqlDb db =>
RenderS db r -> RenderS db r -> RenderS db r
equalsOperator else (\RenderS db r
a RenderS db r
b -> RenderS db r
a RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
'=' RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
b)) [Bool]
eitherNullable
        ExprRelation
Ne -> Int
-> RenderS db r
-> Int
-> [RenderS db r -> RenderS db r -> RenderS db r]
-> UntypedExpr db r
-> UntypedExpr db r
-> Maybe (RenderS db r)
renderCompOps Int
andP RenderS db r
" OR " Int
50 [RenderS db r -> RenderS db r -> RenderS db r]
ops UntypedExpr db r
f1 UntypedExpr db r
f2
          where
            ops :: [RenderS db r -> RenderS db r -> RenderS db r]
ops = (Bool -> RenderS db r -> RenderS db r -> RenderS db r)
-> [Bool] -> [RenderS db r -> RenderS db r -> RenderS db r]
forall a b. (a -> b) -> [a] -> [b]
map (\Bool
isNull -> if Bool
isNull then RenderS db r -> RenderS db r -> RenderS db r
forall db r.
SqlDb db =>
RenderS db r -> RenderS db r -> RenderS db r
notEqualsOperator else (\RenderS db r
a RenderS db r
b -> RenderS db r
a RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
"<>" RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
b)) [Bool]
eitherNullable
        ExprRelation
Gt -> Int
-> RenderS db r
-> Int
-> (RenderS db r -> RenderS db r -> RenderS db r)
-> UntypedExpr db r
-> UntypedExpr db r
-> Maybe (RenderS db r)
renderComp Int
orP RenderS db r
" OR " Int
38 (\RenderS db r
a RenderS db r
b -> RenderS db r
a RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
'>' RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
b) UntypedExpr db r
f1 UntypedExpr db r
f2
        ExprRelation
Lt -> Int
-> RenderS db r
-> Int
-> (RenderS db r -> RenderS db r -> RenderS db r)
-> UntypedExpr db r
-> UntypedExpr db r
-> Maybe (RenderS db r)
renderComp Int
orP RenderS db r
" OR " Int
38 (\RenderS db r
a RenderS db r
b -> RenderS db r
a RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
'<' RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
b) UntypedExpr db r
f1 UntypedExpr db r
f2
        ExprRelation
Ge -> Int
-> RenderS db r
-> Int
-> (RenderS db r -> RenderS db r -> RenderS db r)
-> UntypedExpr db r
-> UntypedExpr db r
-> Maybe (RenderS db r)
renderComp Int
orP RenderS db r
" OR " Int
38 (\RenderS db r
a RenderS db r
b -> RenderS db r
a RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
">=" RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
b) UntypedExpr db r
f1 UntypedExpr db r
f2
        ExprRelation
Le -> Int
-> RenderS db r
-> Int
-> (RenderS db r -> RenderS db r -> RenderS db r)
-> UntypedExpr db r
-> UntypedExpr db r
-> Maybe (RenderS db r)
renderComp Int
orP RenderS db r
" OR " Int
38 (\RenderS db r
a RenderS db r
b -> RenderS db r
a RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
"<=" RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
b) UntypedExpr db r
f1 UntypedExpr db r
f2
      where
        proxy :: Any db
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy db
undefined :: proxy db

        eitherNullable :: [Bool]
eitherNullable = (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
(||) (UntypedExpr db r -> [Bool]
nullables UntypedExpr db r
f1) (UntypedExpr db r -> [Bool]
nullables UntypedExpr db r
f2)

        nullables :: UntypedExpr db r -> [Bool]
nullables UntypedExpr db r
expr = case UntypedExpr db r
expr of
          ExprRaw DbType
t QueryRaw db r
_ -> DbType -> [Bool]
flattenNullables DbType
t
          ExprField (([Char]
_, DbType
t), [([Char], EmbeddedDef' [Char] DbType)]
_) -> DbType -> [Bool]
flattenNullables DbType
t
          ExprPure a
a -> DbType -> [Bool]
flattenNullables (DbType -> [Bool]) -> DbType -> [Bool]
forall a b. (a -> b) -> a -> b
$ Any db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any db
proxy a
a
          ExprCond Cond db r
_ -> [Bool
False]

        renderZip :: Int
-> (RenderS db r -> RenderS db r -> RenderS db r)
-> UntypedExpr db r
-> UntypedExpr db r
-> [RenderS db r]
renderZip Int
opP RenderS db r -> RenderS db r -> RenderS db r
op UntypedExpr db r
expr1 UntypedExpr db r
expr2 = (RenderS db r -> RenderS db r -> RenderS db r)
-> [RenderS db r] -> [RenderS db r] -> [RenderS db r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith RenderS db r -> RenderS db r -> RenderS db r
op [RenderS db r]
expr1' [RenderS db r]
expr2'
          where
            expr1' :: [RenderS db r]
expr1' = RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended RenderConfig
conf Int
opP UntypedExpr db r
expr1
            expr2' :: [RenderS db r]
expr2' = RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended RenderConfig
conf Int
opP UntypedExpr db r
expr2

        renderZip3 :: Int
-> [RenderS db r -> RenderS db r -> RenderS db r]
-> UntypedExpr db r
-> UntypedExpr db r
-> [RenderS db r]
renderZip3 Int
opP [RenderS db r -> RenderS db r -> RenderS db r]
ops UntypedExpr db r
expr1 UntypedExpr db r
expr2 = ((RenderS db r -> RenderS db r -> RenderS db r)
 -> RenderS db r -> RenderS db r -> RenderS db r)
-> [RenderS db r -> RenderS db r -> RenderS db r]
-> [RenderS db r]
-> [RenderS db r]
-> [RenderS db r]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\RenderS db r -> RenderS db r -> RenderS db r
op RenderS db r
e1 RenderS db r
e2 -> RenderS db r -> RenderS db r -> RenderS db r
op RenderS db r
e1 RenderS db r
e2) [RenderS db r -> RenderS db r -> RenderS db r]
ops [RenderS db r]
expr1' [RenderS db r]
expr2'
          where
            expr1' :: [RenderS db r]
expr1' = RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended RenderConfig
conf Int
opP UntypedExpr db r
expr1
            expr2' :: [RenderS db r]
expr2' = RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended RenderConfig
conf Int
opP UntypedExpr db r
expr2

        groupComparisons :: Int
-> RenderS db r -> Int -> [RenderS db r] -> Maybe (RenderS db r)
groupComparisons Int
interP RenderS db r
interOp Int
opP [RenderS db r]
comparisons = case [RenderS db r]
comparisons of
          [] -> Maybe (RenderS db r)
forall a. Maybe a
Nothing
          [RenderS db r
clause] -> RenderS db r -> Maybe (RenderS db r)
forall a. a -> Maybe a
Just (RenderS db r -> Maybe (RenderS db r))
-> RenderS db r -> Maybe (RenderS db r)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> RenderS db r -> RenderS db r
forall db r. Int -> Int -> RenderS db r -> RenderS db r
parens (Int
opP Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
p RenderS db r
clause -- put lower priority to make parentheses appear when the same operator is nested
          [RenderS db r]
clauses -> RenderS db r -> Maybe (RenderS db r)
forall a. a -> Maybe a
Just (RenderS db r -> Maybe (RenderS db r))
-> RenderS db r -> Maybe (RenderS db r)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> RenderS db r -> RenderS db r
forall db r. Int -> Int -> RenderS db r -> RenderS db r
parens Int
interP Int
p (RenderS db r -> RenderS db r) -> RenderS db r -> RenderS db r
forall a b. (a -> b) -> a -> b
$ RenderS db r -> [RenderS db r] -> RenderS db r
forall s. StringLike s => s -> [s] -> s
intercalateS RenderS db r
interOp [RenderS db r]
clauses

        renderComp :: Int
-> RenderS db r
-> Int
-> (RenderS db r -> RenderS db r -> RenderS db r)
-> UntypedExpr db r
-> UntypedExpr db r
-> Maybe (RenderS db r)
renderComp Int
interP RenderS db r
interOp Int
opP RenderS db r -> RenderS db r -> RenderS db r
op UntypedExpr db r
expr1 UntypedExpr db r
expr2 = Int
-> RenderS db r -> Int -> [RenderS db r] -> Maybe (RenderS db r)
groupComparisons Int
interP RenderS db r
interOp Int
opP ([RenderS db r] -> Maybe (RenderS db r))
-> [RenderS db r] -> Maybe (RenderS db r)
forall a b. (a -> b) -> a -> b
$ Int
-> (RenderS db r -> RenderS db r -> RenderS db r)
-> UntypedExpr db r
-> UntypedExpr db r
-> [RenderS db r]
renderZip Int
opP RenderS db r -> RenderS db r -> RenderS db r
op UntypedExpr db r
expr1 UntypedExpr db r
expr2
        renderCompOps :: Int
-> RenderS db r
-> Int
-> [RenderS db r -> RenderS db r -> RenderS db r]
-> UntypedExpr db r
-> UntypedExpr db r
-> Maybe (RenderS db r)
renderCompOps Int
interP RenderS db r
interOp Int
opP [RenderS db r -> RenderS db r -> RenderS db r]
ops UntypedExpr db r
expr1 UntypedExpr db r
expr2 = Int
-> RenderS db r -> Int -> [RenderS db r] -> Maybe (RenderS db r)
groupComparisons Int
interP RenderS db r
interOp Int
opP ([RenderS db r] -> Maybe (RenderS db r))
-> [RenderS db r] -> Maybe (RenderS db r)
forall a b. (a -> b) -> a -> b
$ Int
-> [RenderS db r -> RenderS db r -> RenderS db r]
-> UntypedExpr db r
-> UntypedExpr db r
-> [RenderS db r]
renderZip3 Int
opP [RenderS db r -> RenderS db r -> RenderS db r]
ops UntypedExpr db r
expr1 UntypedExpr db r
expr2
    go (CondRaw (Snippet f)) Int
p = case RenderConfig -> Int -> [RenderS db r]
f RenderConfig
conf Int
p of
      [] -> Maybe (RenderS db r)
forall a. Maybe a
Nothing
      [RenderS db r
a] -> RenderS db r -> Maybe (RenderS db r)
forall a. a -> Maybe a
Just RenderS db r
a
      [RenderS db r]
_ -> [Char] -> Maybe (RenderS db r)
forall a. HasCallStack => [Char] -> a
error [Char]
"renderCond: cannot render CondRaw with many elements"
    go Cond db r
CondEmpty Int
_ = Maybe (RenderS db r)
forall a. Maybe a
Nothing

    notP :: Int
notP = Int
35
    andP :: Int
andP = Int
30
    orP :: Int
orP = Int
20

    perhaps :: Int
-> Int -> Utf8 -> Cond db r -> Cond db r -> Maybe (RenderS db r)
perhaps Int
p Int
pOuter Utf8
op Cond db r
a Cond db r
b = Maybe (RenderS db r)
result
      where
        -- we don't know if the current operator is present until we render both operands. Rendering requires priority of the outer operator. We tie a knot to defer calculating the priority
        (Int
p', Maybe (RenderS db r)
result) = case (Cond db r -> Int -> Maybe (RenderS db r)
go Cond db r
a Int
p', Cond db r -> Int -> Maybe (RenderS db r)
go Cond db r
b Int
p') of
          (Just RenderS db r
a', Just RenderS db r
b') -> (Int
p, RenderS db r -> Maybe (RenderS db r)
forall a. a -> Maybe a
Just (RenderS db r -> Maybe (RenderS db r))
-> RenderS db r -> Maybe (RenderS db r)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> RenderS db r -> RenderS db r
forall db r. Int -> Int -> RenderS db r -> RenderS db r
parens Int
p Int
pOuter (RenderS db r -> RenderS db r) -> RenderS db r -> RenderS db r
forall a b. (a -> b) -> a -> b
$ RenderS db r
a' RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS Utf8
op [PersistValue] -> [PersistValue]
forall a. a -> a
id RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
b')
          (Just RenderS db r
a', Maybe (RenderS db r)
Nothing) -> (Int
pOuter, RenderS db r -> Maybe (RenderS db r)
forall a. a -> Maybe a
Just RenderS db r
a')
          (Maybe (RenderS db r)
Nothing, Just RenderS db r
b') -> (Int
pOuter, RenderS db r -> Maybe (RenderS db r)
forall a. a -> Maybe a
Just RenderS db r
b')
          (Maybe (RenderS db r)
Nothing, Maybe (RenderS db r)
Nothing) -> (Int
pOuter, Maybe (RenderS db r)
forall a. Maybe a
Nothing)

{-
examples of prefixes
[("val1", EmbeddedDef False _), ("val4", EmbeddedDef False _), ("val5", EmbeddedDef False _)] -> "val5$val4$val1"
[("val1", EmbeddedDef True _),  ("val4", EmbeddedDef False _), ("val5", EmbeddedDef False _)] -> ""
[("val1", EmbeddedDef False _), ("val4", EmbeddedDef True _),  ("val5", EmbeddedDef False _)] -> "val1"
[("val1", EmbeddedDef False _), ("val4", EmbeddedDef True _),  ("val5", EmbeddedDef True _)] -> "val1"
[("val1", EmbeddedDef False _), ("val4", EmbeddedDef False _), ("val5", EmbeddedDef True _)] -> "val4$val1"
-}
{-# INLINEABLE renderChain #-}
renderChain :: RenderConfig -> FieldChain -> [Utf8] -> [Utf8]
renderChain :: RenderConfig -> FieldChain -> [Utf8] -> [Utf8]
renderChain RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} (([Char], DbType)
f, [([Char], EmbeddedDef' [Char] DbType)]
prefix) [Utf8]
acc =
  case [([Char], EmbeddedDef' [Char] DbType)]
prefix of
    (([Char]
name, EmbeddedDef Bool
False [([Char], DbType)]
_) : [([Char], EmbeddedDef' [Char] DbType)]
fs) -> (Utf8 -> Utf8)
-> Maybe Utf8 -> ([Char], DbType) -> [Utf8] -> [Utf8]
forall s.
StringLike s =>
(s -> s) -> Maybe s -> ([Char], DbType) -> [s] -> [s]
flattenP Utf8 -> Utf8
esc (Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just (Utf8 -> Maybe Utf8) -> Utf8 -> Maybe Utf8
forall a b. (a -> b) -> a -> b
$ Utf8 -> [([Char], EmbeddedDef' [Char] DbType)] -> Utf8
forall p str dbType.
StringLike p =>
p -> [([Char], EmbeddedDef' str dbType)] -> p
goP ([Char] -> Utf8
forall a. IsString a => [Char] -> a
fromString [Char]
name) [([Char], EmbeddedDef' [Char] DbType)]
fs) ([Char], DbType)
f [Utf8]
acc
    [([Char], EmbeddedDef' [Char] DbType)]
_ -> (Utf8 -> Utf8) -> ([Char], DbType) -> [Utf8] -> [Utf8]
forall s.
StringLike s =>
(s -> s) -> ([Char], DbType) -> [s] -> [s]
flatten Utf8 -> Utf8
esc ([Char], DbType)
f [Utf8]
acc
  where
    goP :: p -> [([Char], EmbeddedDef' str dbType)] -> p
goP p
p (([Char]
name, EmbeddedDef Bool
False [(str, dbType)]
_) : [([Char], EmbeddedDef' str dbType)]
fs) = p -> [([Char], EmbeddedDef' str dbType)] -> p
goP ([Char] -> p
forall a. IsString a => [Char] -> a
fromString [Char]
name p -> p -> p
forall a. Semigroup a => a -> a -> a
<> Char -> p
forall a. StringLike a => Char -> a
fromChar Char
delim p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
p) [([Char], EmbeddedDef' str dbType)]
fs
    goP p
p [([Char], EmbeddedDef' str dbType)]
_ = p
p

defaultShowPrim :: PersistValue -> String
defaultShowPrim :: PersistValue -> [Char]
defaultShowPrim (PersistString [Char]
x) = [Char]
"'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
defaultShowPrim (PersistText Text
x) = [Char]
"'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
defaultShowPrim (PersistByteString ByteString
x) = [Char]
"'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
defaultShowPrim (PersistInt64 Int64
x) = Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
x
defaultShowPrim (PersistDouble Double
x) = Double -> [Char]
forall a. Show a => a -> [Char]
show Double
x
defaultShowPrim (PersistBool Bool
x) = if Bool
x then [Char]
"1" else [Char]
"0"
defaultShowPrim (PersistDay Day
x) = Day -> [Char]
forall a. Show a => a -> [Char]
show Day
x
defaultShowPrim (PersistTimeOfDay TimeOfDay
x) = TimeOfDay -> [Char]
forall a. Show a => a -> [Char]
show TimeOfDay
x
defaultShowPrim (PersistUTCTime UTCTime
x) = UTCTime -> [Char]
forall a. Show a => a -> [Char]
show UTCTime
x
defaultShowPrim (PersistZonedTime ZT
x) = ZT -> [Char]
forall a. Show a => a -> [Char]
show ZT
x
defaultShowPrim PersistValue
PersistNull = [Char]
"NULL"
defaultShowPrim (PersistCustom Utf8
_ [PersistValue]
_) = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Unexpected PersistCustom"

{-# INLINEABLE renderOrders #-}
renderOrders :: SqlDb db => RenderConfig -> [Order db r] -> RenderS db r
renderOrders :: RenderConfig -> [Order db r] -> RenderS db r
renderOrders RenderConfig
_ [] = RenderS db r
forall a. Monoid a => a
mempty
renderOrders RenderConfig
conf [Order db r]
xs = if [RenderS db r] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RenderS db r]
orders then RenderS db r
forall a. Monoid a => a
mempty else RenderS db r
" ORDER BY " RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> [RenderS db r] -> RenderS db r
forall s. StringLike s => [s] -> s
commasJoin [RenderS db r]
orders
  where
    orders :: [RenderS db r]
orders = (Order db r -> [RenderS db r]) -> [Order db r] -> [RenderS db r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Order db r -> [RenderS db r]
go [Order db r]
xs
    rend :: RenderConfig -> p -> [RenderS db r]
rend RenderConfig
conf' p
a = (UntypedExpr db r -> RenderS db r)
-> [UntypedExpr db r] -> [RenderS db r]
forall a b. (a -> b) -> [a] -> [b]
map ([RenderS db r] -> RenderS db r
forall s. StringLike s => [s] -> s
commasJoin ([RenderS db r] -> RenderS db r)
-> (UntypedExpr db r -> [RenderS db r])
-> UntypedExpr db r
-> RenderS db r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended RenderConfig
conf' Int
0) ([UntypedExpr db r] -> [RenderS db r])
-> [UntypedExpr db r] -> [RenderS db r]
forall a b. (a -> b) -> a -> b
$ p -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs p
a []
    go :: Order db r -> [RenderS db r]
go (Asc f
a) = RenderConfig -> f -> [RenderS db r]
forall p db r a.
(ProjectionDb p db, ProjectionRestriction p r, SqlDb db,
 Projection p a) =>
RenderConfig -> p -> [RenderS db r]
rend RenderConfig
conf f
a
    go (Desc f
a) = RenderConfig -> f -> [RenderS db r]
forall p db r a.
(ProjectionDb p db, ProjectionRestriction p r, SqlDb db,
 Projection p a) =>
RenderConfig -> p -> [RenderS db r]
rend RenderConfig
conf' f
a
      where
        conf' :: RenderConfig
conf' = RenderConfig
conf {esc :: Utf8 -> Utf8
esc = \Utf8
f -> RenderConfig -> Utf8 -> Utf8
esc RenderConfig
conf Utf8
f Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" DESC"}

{-# INLINEABLE renderFields #-}
-- Returns string with comma separated escaped fields like "name,age"
-- If there are other columns before renderFields result, do not put comma because the result might be an empty string. This happens when the fields have no columns like ().
-- One of the solutions is to add one more field with datatype that is known to have columns, eg renderFields id (("id", namedType (0 :: Int64)) : constrParams constr)
{-# SPECIALIZE renderFields :: (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8 #-}
renderFields :: StringLike s => (s -> s) -> [(String, DbType)] -> s
renderFields :: (s -> s) -> [([Char], DbType)] -> s
renderFields s -> s
escape = [s] -> s
forall s. StringLike s => [s] -> s
commasJoin ([s] -> s)
-> ([([Char], DbType)] -> [s]) -> [([Char], DbType)] -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], DbType) -> [s] -> [s])
-> [s] -> [([Char], DbType)] -> [s]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((s -> s) -> ([Char], DbType) -> [s] -> [s]
forall s.
StringLike s =>
(s -> s) -> ([Char], DbType) -> [s] -> [s]
flatten s -> s
escape) []

{-# SPECIALIZE flatten :: (Utf8 -> Utf8) -> (String, DbType) -> ([Utf8] -> [Utf8]) #-}
flatten :: StringLike s => (s -> s) -> (String, DbType) -> ([s] -> [s])
flatten :: (s -> s) -> ([Char], DbType) -> [s] -> [s]
flatten s -> s
escape = (s -> s) -> Maybe s -> ([Char], DbType) -> [s] -> [s]
forall s.
StringLike s =>
(s -> s) -> Maybe s -> ([Char], DbType) -> [s] -> [s]
flattenP s -> s
escape Maybe s
forall a. Maybe a
Nothing

{-# SPECIALIZE flattenP :: (Utf8 -> Utf8) -> Maybe Utf8 -> (String, DbType) -> ([Utf8] -> [Utf8]) #-}
flattenP :: StringLike s => (s -> s) -> Maybe s -> (String, DbType) -> ([s] -> [s])
flattenP :: (s -> s) -> Maybe s -> ([Char], DbType) -> [s] -> [s]
flattenP s -> s
escape Maybe s
prefix ([Char]
fname, DbType
typ) [s]
acc = DbType -> [s]
go DbType
typ
  where
    go :: DbType -> [s]
go DbType
typ' = case DbType
typ' of
      DbEmbedded EmbeddedDef' [Char] DbType
emb Maybe ParentTableReference
_ -> EmbeddedDef' [Char] DbType -> [s]
handleEmb EmbeddedDef' [Char] DbType
emb
      DbType
_ -> s -> s
escape s
fullName s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
acc
    fullName :: s
fullName = case Maybe s
prefix of
      Maybe s
Nothing -> [Char] -> s
forall a. IsString a => [Char] -> a
fromString [Char]
fname
      Just s
prefix' -> s
prefix' s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Char -> s
forall a. StringLike a => Char -> a
fromChar Char
delim s -> s -> s
forall a. Semigroup a => a -> a -> a
<> [Char] -> s
forall a. IsString a => [Char] -> a
fromString [Char]
fname
    handleEmb :: EmbeddedDef' [Char] DbType -> [s]
handleEmb (EmbeddedDef Bool
False [([Char], DbType)]
ts) = (([Char], DbType) -> [s] -> [s])
-> [s] -> [([Char], DbType)] -> [s]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((s -> s) -> Maybe s -> ([Char], DbType) -> [s] -> [s]
forall s.
StringLike s =>
(s -> s) -> Maybe s -> ([Char], DbType) -> [s] -> [s]
flattenP s -> s
escape (s -> Maybe s
forall a. a -> Maybe a
Just s
fullName)) [s]
acc [([Char], DbType)]
ts
    handleEmb (EmbeddedDef Bool
True [([Char], DbType)]
ts) = (([Char], DbType) -> [s] -> [s])
-> [s] -> [([Char], DbType)] -> [s]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((s -> s) -> Maybe s -> ([Char], DbType) -> [s] -> [s]
forall s.
StringLike s =>
(s -> s) -> Maybe s -> ([Char], DbType) -> [s] -> [s]
flattenP s -> s
escape Maybe s
forall a. Maybe a
Nothing) [s]
acc [([Char], DbType)]
ts

commasJoin :: StringLike s => [s] -> s
commasJoin :: [s] -> s
commasJoin = s -> [s] -> s
forall s. StringLike s => s -> [s] -> s
intercalateS (Char -> s
forall a. StringLike a => Char -> a
fromChar Char
',')

{-# INLINEABLE intercalateS #-}
intercalateS :: StringLike s => s -> [s] -> s
intercalateS :: s -> [s] -> s
intercalateS s
_ [] = s
forall a. Monoid a => a
mempty
intercalateS s
a (s
x : [s]
xs) = s
x s -> s -> s
forall a. Semigroup a => a -> a -> a
<> [s] -> s
go [s]
xs
  where
    go :: [s] -> s
go [] = s
forall a. Monoid a => a
mempty
    go (s
f : [s]
fs) = s
a s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
f s -> s -> s
forall a. Semigroup a => a -> a -> a
<> [s] -> s
go [s]
fs

{-# INLINEABLE renderUpdates #-}
renderUpdates :: SqlDb db => RenderConfig -> [Update db r] -> Maybe (RenderS db r)
renderUpdates :: RenderConfig -> [Update db r] -> Maybe (RenderS db r)
renderUpdates RenderConfig
conf [Update db r]
upds =
  case (Update db r -> Maybe (RenderS db r))
-> [Update db r] -> [RenderS db r]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Update db r -> Maybe (RenderS db r)
go [Update db r]
upds of
    [] -> Maybe (RenderS db r)
forall a. Maybe a
Nothing
    [RenderS db r]
xs -> RenderS db r -> Maybe (RenderS db r)
forall a. a -> Maybe a
Just (RenderS db r -> Maybe (RenderS db r))
-> RenderS db r -> Maybe (RenderS db r)
forall a b. (a -> b) -> a -> b
$ [RenderS db r] -> RenderS db r
forall s. StringLike s => [s] -> s
commasJoin [RenderS db r]
xs
  where
    go :: Update db r -> Maybe (RenderS db r)
go (Update f
field UntypedExpr db r
expr) = RenderS db r -> Maybe (RenderS db r)
guard (RenderS db r -> Maybe (RenderS db r))
-> RenderS db r -> Maybe (RenderS db r)
forall a b. (a -> b) -> a -> b
$ [RenderS db r] -> RenderS db r
forall s. StringLike s => [s] -> s
commasJoin ([RenderS db r] -> RenderS db r) -> [RenderS db r] -> RenderS db r
forall a b. (a -> b) -> a -> b
$ (RenderS db r -> RenderS db r -> RenderS db r)
-> [RenderS db r] -> [RenderS db r] -> [RenderS db r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\RenderS db r
f1 RenderS db r
f2 -> RenderS db r
f1 RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
'=' RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
f2) [RenderS db r]
fs (UntypedExpr db r -> [RenderS db r]
rend UntypedExpr db r
expr)
      where
        rend :: UntypedExpr db r -> [RenderS db r]
rend = RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended RenderConfig
conf Int
0
        fs :: [RenderS db r]
fs = (UntypedExpr db r -> [RenderS db r])
-> [UntypedExpr db r] -> [RenderS db r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UntypedExpr db r -> [RenderS db r]
rend (f -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs f
field [])
        guard :: RenderS db r -> Maybe (RenderS db r)
guard RenderS db r
a = if [RenderS db r] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RenderS db r]
fs then Maybe (RenderS db r)
forall a. Maybe a
Nothing else RenderS db r -> Maybe (RenderS db r)
forall a. a -> Maybe a
Just RenderS db r
a

-- | Returns escaped table name optionally qualified with schema
{-# SPECIALIZE tableName :: (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8 #-}
tableName :: StringLike s => (s -> s) -> EntityDef -> ConstructorDef -> s
tableName :: (s -> s) -> EntityDef -> ConstructorDef -> s
tableName s -> s
esc EntityDef
e ConstructorDef
c = (s -> s) -> EntityDef -> s -> s
forall s. StringLike s => (s -> s) -> EntityDef -> s -> s
qualifySchema s -> s
esc EntityDef
e s
tName
  where
    tName :: s
tName =
      s -> s
esc (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$
        if [ConstructorDef] -> Bool
isSimple (EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e)
          then [Char] -> s
forall a. IsString a => [Char] -> a
fromString ([Char] -> s) -> [Char] -> s
forall a b. (a -> b) -> a -> b
$ EntityDef -> [Char]
forall str dbType. EntityDef' str dbType -> str
entityName EntityDef
e
          else [Char] -> s
forall a. IsString a => [Char] -> a
fromString (EntityDef -> [Char]
forall str dbType. EntityDef' str dbType -> str
entityName EntityDef
e) s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Char -> s
forall a. StringLike a => Char -> a
fromChar Char
delim s -> s -> s
forall a. Semigroup a => a -> a -> a
<> [Char] -> s
forall a. IsString a => [Char] -> a
fromString (ConstructorDef -> [Char]
forall str dbType. ConstructorDef' str dbType -> str
constrName ConstructorDef
c)

-- | Returns escaped main table name optionally qualified with schema
{-# SPECIALIZE mainTableName :: (Utf8 -> Utf8) -> EntityDef -> Utf8 #-}
mainTableName :: StringLike s => (s -> s) -> EntityDef -> s
mainTableName :: (s -> s) -> EntityDef -> s
mainTableName s -> s
esc EntityDef
e = (s -> s) -> EntityDef -> s -> s
forall s. StringLike s => (s -> s) -> EntityDef -> s -> s
qualifySchema s -> s
esc EntityDef
e s
tName
  where
    tName :: s
tName = s -> s
esc (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ [Char] -> s
forall a. IsString a => [Char] -> a
fromString ([Char] -> s) -> [Char] -> s
forall a b. (a -> b) -> a -> b
$ EntityDef -> [Char]
forall str dbType. EntityDef' str dbType -> str
entityName EntityDef
e

{-# SPECIALIZE qualifySchema :: (Utf8 -> Utf8) -> EntityDef -> Utf8 -> Utf8 #-}
qualifySchema :: StringLike s => (s -> s) -> EntityDef -> s -> s
qualifySchema :: (s -> s) -> EntityDef -> s -> s
qualifySchema s -> s
esc EntityDef
e s
name = s -> ([Char] -> s) -> Maybe [Char] -> s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe s
name (\[Char]
sch -> s -> s
esc ([Char] -> s
forall a. IsString a => [Char] -> a
fromString [Char]
sch) s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Char -> s
forall a. StringLike a => Char -> a
fromChar Char
'.' s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
name) (Maybe [Char] -> s) -> Maybe [Char] -> s
forall a b. (a -> b) -> a -> b
$ EntityDef -> Maybe [Char]
forall str dbType. EntityDef' str dbType -> Maybe str
entitySchema EntityDef
e