{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | TODO: delete this module and get it in with SqlBackend.Internal
module Database.Persist.Sql.Orphan.PersistQuery
    ( deleteWhereCount
    , updateWhereCount
    , filterClause
    , filterClauseHelper
    , filterClauseWithVals
    , orderClause
    , FilterTablePrefix (..)
    , decorateSQLWithLimitOffset
    ) where

import Control.Exception (throwIO)
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT, ask)
import Data.ByteString.Char8 (readInteger)
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Foldable (toList)
import Data.Int (Int64)
import Data.List (find, inits, transpose)
import Data.Maybe (isJust)
import Data.Monoid (Monoid(..))
import Data.Text (Text)
import qualified Data.Text as T

import Database.Persist hiding (updateField)
import Database.Persist.Sql.Orphan.PersistStore (withRawQuery)
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Types.Internal
       (SqlBackend(..), SqlReadBackend, SqlWriteBackend)
import Database.Persist.Sql.Util
       ( commaSeparated
       , dbIdColumns
       , isIdField
       , keyAndEntityColumnNames
       , mkUpdateText
       , parseEntityValues
       , updatePersistValue
       )

-- orphaned instance for convenience of modularity
instance PersistQueryRead SqlBackend where
    count :: forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record] -> ReaderT SqlBackend m Int
count [Filter record]
filts = do
        SqlBackend
conn <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        let wher :: Text
wher = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter record]
filts
                    then Text
""
                    else forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause forall a. Maybe a
Nothing SqlBackend
conn [Filter record]
filts
        let sql :: Text
sql = forall a. Monoid a => [a] -> a
mconcat
                [ Text
"SELECT COUNT(*) FROM "
                , SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn EntityDef
t
                , Text
wher
                ]
        forall (m :: * -> *) a.
MonadIO m =>
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> ReaderT SqlBackend m a
withRawQuery Text
sql (forall val.
PersistEntity val =>
SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues SqlBackend
conn [Filter record]
filts) forall a b. (a -> b) -> a -> b
$ do
            Maybe [PersistValue]
mm <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
            case Maybe [PersistValue]
mm of
              Just [PersistInt64 Int64
i] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
              Just [PersistDouble Double
i] ->forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
i :: Int64) -- gb oracle
              Just [PersistByteString ByteString
i] -> case ByteString -> Maybe (Integer, ByteString)
readInteger ByteString
i of -- gb mssql
                                              Just (Integer
ret,ByteString
"") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ret
                                              Maybe (Integer, ByteString)
xs -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"invalid number i["forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show ByteString
iforall a. [a] -> [a] -> [a]
++[Char]
"] xs[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Maybe (Integer, ByteString)
xs forall a. [a] -> [a] -> [a]
++ [Char]
"]"
              Just [PersistValue]
xs -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"count:invalid sql  return xs["forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show [PersistValue]
xsforall a. [a] -> [a] -> [a]
++[Char]
"] sql["forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Text
sqlforall a. [a] -> [a] -> [a]
++[Char]
"]"
              Maybe [PersistValue]
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"count:invalid sql returned nothing sql["forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Text
sqlforall a. [a] -> [a] -> [a]
++[Char]
"]"
      where
        t :: EntityDef
t = forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef forall a b. (a -> b) -> a -> b
$ forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter record]
filts

    exists :: forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record] -> ReaderT SqlBackend m Bool
exists [Filter record]
filts = do
        SqlBackend
conn <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        let wher :: Text
wher = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter record]
filts
                    then Text
""
                    else forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause forall a. Maybe a
Nothing SqlBackend
conn [Filter record]
filts
        let sql :: Text
sql = forall a. Monoid a => [a] -> a
mconcat
                [ Text
"SELECT EXISTS(SELECT 1 FROM "
                , SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn EntityDef
t
                , Text
wher
                , Text
")"
                ]
        forall (m :: * -> *) a.
MonadIO m =>
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> ReaderT SqlBackend m a
withRawQuery Text
sql (forall val.
PersistEntity val =>
SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues SqlBackend
conn [Filter record]
filts) forall a b. (a -> b) -> a -> b
$ do
            Maybe [PersistValue]
mm <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
            case Maybe [PersistValue]
mm of
              Just [PersistBool Bool
b]  -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b -- Postgres
              Just [PersistInt64 Int64
i] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int64
i forall a. Ord a => a -> a -> Bool
> Int64
0 -- MySQL, SQLite
              Just [PersistDouble Double
i] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
i :: Int64) forall a. Ord a => a -> a -> Bool
> Int64
0 -- gb oracle
              Just [PersistByteString ByteString
i] -> case ByteString -> Maybe (Integer, ByteString)
readInteger ByteString
i of -- gb mssql
                                              Just (Integer
ret,ByteString
"") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer
ret forall a. Ord a => a -> a -> Bool
> Integer
0
                                              Maybe (Integer, ByteString)
xs -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"invalid number i["forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show ByteString
iforall a. [a] -> [a] -> [a]
++[Char]
"] xs[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Maybe (Integer, ByteString)
xs forall a. [a] -> [a] -> [a]
++ [Char]
"]"
              Just [PersistValue]
xs -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"PersistQuery.exists: Expected a boolean, int, double, or bytestring; got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [PersistValue]
xs forall a. [a] -> [a] -> [a]
++ [Char]
" for query: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
sql
              Maybe [PersistValue]
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"PersistQuery.exists: Expected a boolean, int, double, or bytestring; got: Nothing for query: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
sql
      where
        t :: EntityDef
t = forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef forall a b. (a -> b) -> a -> b
$ forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter record]
filts

    selectSourceRes :: forall record (m1 :: * -> *) (m2 :: * -> *).
(PersistRecordBackend record SqlBackend, MonadIO m1, MonadIO m2) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts = do
        SqlBackend
conn <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        Acquire (ConduitM () [PersistValue] m2 ())
srcRes <- forall (m1 :: * -> *) (m2 :: * -> *) env.
(MonadIO m1, MonadIO m2, BackendCompatible SqlBackend env) =>
Text
-> [PersistValue]
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ()))
rawQueryRes (SqlBackend -> Text
sql SqlBackend
conn) (forall val.
PersistEntity val =>
SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues SqlBackend
conn [Filter record]
filts)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
CL.mapM [PersistValue] -> m2 (Entity record)
parse) Acquire (ConduitM () [PersistValue] m2 ())
srcRes
      where
        (Int
limit, Int
offset, [SelectOpt record]
orders) = forall val.
PersistEntity val =>
[SelectOpt val] -> (Int, Int, [SelectOpt val])
limitOffsetOrder [SelectOpt record]
opts

        parse :: [PersistValue] -> m2 (Entity record)
parse [PersistValue]
vals =
            case forall record.
PersistEntity record =>
EntityDef -> [PersistValue] -> Either Text (Entity record)
parseEntityValues EntityDef
t [PersistValue]
vals of
                Left Text
s ->
                    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
                        Text -> PersistException
PersistMarshalError (Text
"selectSourceRes: " forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
", vals: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show [PersistValue]
vals ))
                Right Entity record
row ->
                    forall (m :: * -> *) a. Monad m => a -> m a
return Entity record
row
        t :: EntityDef
t = forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef forall a b. (a -> b) -> a -> b
$ forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter record]
filts
        wher :: SqlBackend -> Text
wher SqlBackend
conn = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter record]
filts
                    then Text
""
                    else forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause forall a. Maybe a
Nothing SqlBackend
conn [Filter record]
filts
        ord :: SqlBackend -> Text
ord SqlBackend
conn = forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [SelectOpt val] -> Text
orderClause forall a. Maybe a
Nothing SqlBackend
conn [SelectOpt record]
orders
        cols :: SqlBackend -> Text
cols = [Text] -> Text
commaSeparated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> SqlBackend -> NonEmpty Text
keyAndEntityColumnNames EntityDef
t
        sql :: SqlBackend -> Text
sql SqlBackend
conn = SqlBackend -> (Int, Int) -> Text -> Text
connLimitOffset SqlBackend
conn (Int
limit,Int
offset) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
            [ Text
"SELECT "
            , SqlBackend -> Text
cols SqlBackend
conn
            , Text
" FROM "
            , SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn EntityDef
t
            , SqlBackend -> Text
wher SqlBackend
conn
            , SqlBackend -> Text
ord SqlBackend
conn
            ]

    selectKeysRes :: forall (m1 :: * -> *) (m2 :: * -> *) record.
(MonadIO m1, MonadIO m2, PersistRecordBackend record SqlBackend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts = do
        SqlBackend
conn <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        Acquire (ConduitM () [PersistValue] m2 ())
srcRes <- forall (m1 :: * -> *) (m2 :: * -> *) env.
(MonadIO m1, MonadIO m2, BackendCompatible SqlBackend env) =>
Text
-> [PersistValue]
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ()))
rawQueryRes (SqlBackend -> Text
sql SqlBackend
conn) (forall val.
PersistEntity val =>
SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues SqlBackend
conn [Filter record]
filts)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
CL.mapM [PersistValue] -> m2 (Key record)
parse) Acquire (ConduitM () [PersistValue] m2 ())
srcRes
      where
        t :: EntityDef
t = forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef forall a b. (a -> b) -> a -> b
$ forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter record]
filts
        cols :: SqlBackend -> Text
cols SqlBackend
conn = Text -> [Text] -> Text
T.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ SqlBackend -> EntityDef -> NonEmpty Text
dbIdColumns SqlBackend
conn EntityDef
t


        wher :: SqlBackend -> Text
wher SqlBackend
conn = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter record]
filts
                    then Text
""
                    else forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause forall a. Maybe a
Nothing SqlBackend
conn [Filter record]
filts
        sql :: SqlBackend -> Text
sql SqlBackend
conn = SqlBackend -> (Int, Int) -> Text -> Text
connLimitOffset SqlBackend
conn (Int
limit,Int
offset) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
            [ Text
"SELECT "
            , SqlBackend -> Text
cols SqlBackend
conn
            , Text
" FROM "
            , SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn EntityDef
t
            , SqlBackend -> Text
wher SqlBackend
conn
            , SqlBackend -> Text
ord SqlBackend
conn
            ]

        (Int
limit, Int
offset, [SelectOpt record]
orders) = forall val.
PersistEntity val =>
[SelectOpt val] -> (Int, Int, [SelectOpt val])
limitOffsetOrder [SelectOpt record]
opts

        ord :: SqlBackend -> Text
ord SqlBackend
conn = forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [SelectOpt val] -> Text
orderClause forall a. Maybe a
Nothing SqlBackend
conn [SelectOpt record]
orders

        parse :: [PersistValue] -> m2 (Key record)
parse [PersistValue]
xs = do
            [PersistValue]
keyvals <- case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
t of
                      Maybe CompositeDef
Nothing ->
                        case [PersistValue]
xs of
                           [PersistInt64 Int64
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return [Int64 -> PersistValue
PersistInt64 Int64
x]
                           [PersistDouble Double
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return [Int64 -> PersistValue
PersistInt64 (forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
x)] -- oracle returns Double
                           [PersistValue]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [PersistValue]
xs
                      Just CompositeDef
pdef ->
                           let pks :: [FieldNameHS]
pks = forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> FieldNameHS
fieldHaskell forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty FieldDef
compositeFields CompositeDef
pdef
                               keyvals :: [PersistValue]
keyvals = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\(FieldNameHS
a, PersistValue
_) -> let ret :: Bool
ret=forall a. Maybe a -> Bool
isJust (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
== FieldNameHS
a) [FieldNameHS]
pks) in Bool
ret) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> FieldNameHS
fieldHaskell forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
getEntityFields EntityDef
t) [PersistValue]
xs
                           in forall (m :: * -> *) a. Monad m => a -> m a
return [PersistValue]
keyvals
            case forall record.
PersistEntity record =>
[PersistValue] -> Either Text (Key record)
keyFromValues [PersistValue]
keyvals of
                Right Key record
k -> forall (m :: * -> *) a. Monad m => a -> m a
return Key record
k
                Left Text
err -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"selectKeysImpl: keyFromValues failed" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Text
err
instance PersistQueryRead SqlReadBackend where
    count :: forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlReadBackend) =>
[Filter record] -> ReaderT SqlReadBackend m Int
count [Filter record]
filts = forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend forall a b. (a -> b) -> a -> b
$ forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter record]
filts
    exists :: forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlReadBackend) =>
[Filter record] -> ReaderT SqlReadBackend m Bool
exists [Filter record]
filts = forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend forall a b. (a -> b) -> a -> b
$ forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Bool
exists [Filter record]
filts
    selectSourceRes :: forall record (m1 :: * -> *) (m2 :: * -> *).
(PersistRecordBackend record SqlReadBackend, MonadIO m1,
 MonadIO m2) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlReadBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts = forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend forall a b. (a -> b) -> a -> b
$ forall backend record (m1 :: * -> *) (m2 :: * -> *).
(PersistQueryRead backend, PersistRecordBackend record backend,
 MonadIO m1, MonadIO m2) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts
    selectKeysRes :: forall (m1 :: * -> *) (m2 :: * -> *) record.
(MonadIO m1, MonadIO m2,
 PersistRecordBackend record SqlReadBackend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlReadBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts = forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend forall a b. (a -> b) -> a -> b
$ forall backend (m1 :: * -> *) (m2 :: * -> *) record.
(PersistQueryRead backend, MonadIO m1, MonadIO m2,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts
instance PersistQueryRead SqlWriteBackend where
    count :: forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlWriteBackend) =>
[Filter record] -> ReaderT SqlWriteBackend m Int
count [Filter record]
filts = forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend forall a b. (a -> b) -> a -> b
$ forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter record]
filts
    exists :: forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlWriteBackend) =>
[Filter record] -> ReaderT SqlWriteBackend m Bool
exists [Filter record]
filts = forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend forall a b. (a -> b) -> a -> b
$ forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Bool
exists [Filter record]
filts
    selectSourceRes :: forall record (m1 :: * -> *) (m2 :: * -> *).
(PersistRecordBackend record SqlWriteBackend, MonadIO m1,
 MonadIO m2) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlWriteBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts = forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend forall a b. (a -> b) -> a -> b
$ forall backend record (m1 :: * -> *) (m2 :: * -> *).
(PersistQueryRead backend, PersistRecordBackend record backend,
 MonadIO m1, MonadIO m2) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts
    selectKeysRes :: forall (m1 :: * -> *) (m2 :: * -> *) record.
(MonadIO m1, MonadIO m2,
 PersistRecordBackend record SqlWriteBackend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlWriteBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts = forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend forall a b. (a -> b) -> a -> b
$ forall backend (m1 :: * -> *) (m2 :: * -> *) record.
(PersistQueryRead backend, MonadIO m1, MonadIO m2,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts

instance PersistQueryWrite SqlBackend where
    deleteWhere :: forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record] -> ReaderT SqlBackend m ()
deleteWhere [Filter record]
filts = do
        Int64
_ <- forall val (m :: * -> *) backend.
(PersistEntity val, MonadIO m,
 PersistEntityBackend val ~ SqlBackend,
 BackendCompatible SqlBackend backend) =>
[Filter val] -> ReaderT backend m Int64
deleteWhereCount [Filter record]
filts
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
    updateWhere :: forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record] -> [Update record] -> ReaderT SqlBackend m ()
updateWhere [Filter record]
filts [Update record]
upds = do
        Int64
_ <- forall val (m :: * -> *) backend.
(PersistEntity val, MonadIO m,
 SqlBackend ~ PersistEntityBackend val,
 BackendCompatible SqlBackend backend) =>
[Filter val] -> [Update val] -> ReaderT backend m Int64
updateWhereCount [Filter record]
filts [Update record]
upds
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance PersistQueryWrite SqlWriteBackend where
    deleteWhere :: forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlWriteBackend) =>
[Filter record] -> ReaderT SqlWriteBackend m ()
deleteWhere [Filter record]
filts = forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend forall a b. (a -> b) -> a -> b
$ forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [Filter record]
filts
    updateWhere :: forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlWriteBackend) =>
[Filter record] -> [Update record] -> ReaderT SqlWriteBackend m ()
updateWhere [Filter record]
filts [Update record]
upds = forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend forall a b. (a -> b) -> a -> b
$ forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
updateWhere [Filter record]
filts [Update record]
upds

-- | Same as 'deleteWhere', but returns the number of rows affected.
--
-- @since 1.1.5
deleteWhereCount :: (PersistEntity val, MonadIO m, PersistEntityBackend val ~ SqlBackend, BackendCompatible SqlBackend backend)
                 => [Filter val]
                 -> ReaderT backend m Int64
deleteWhereCount :: forall val (m :: * -> *) backend.
(PersistEntity val, MonadIO m,
 PersistEntityBackend val ~ SqlBackend,
 BackendCompatible SqlBackend backend) =>
[Filter val] -> ReaderT backend m Int64
deleteWhereCount [Filter val]
filts = forall sup sub (m :: * -> *) a.
BackendCompatible sup sub =>
ReaderT sup m a -> ReaderT sub m a
withCompatibleBackend forall a b. (a -> b) -> a -> b
$ do
    SqlBackend
conn <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    let t :: EntityDef
t = forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef forall a b. (a -> b) -> a -> b
$ forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter val]
filts
    let wher :: Text
wher = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter val]
filts
                then Text
""
                else forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause forall a. Maybe a
Nothing SqlBackend
conn [Filter val]
filts
        sql :: Text
sql = forall a. Monoid a => [a] -> a
mconcat
            [ Text
"DELETE FROM "
            , SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn EntityDef
t
            , Text
wher
            ]
    forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m Int64
rawExecuteCount Text
sql forall a b. (a -> b) -> a -> b
$ forall val.
PersistEntity val =>
SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues SqlBackend
conn [Filter val]
filts

-- | Same as 'updateWhere', but returns the number of rows affected.
--
-- @since 1.1.5
updateWhereCount :: (PersistEntity val, MonadIO m, SqlBackend ~ PersistEntityBackend val, BackendCompatible SqlBackend backend)
                 => [Filter val]
                 -> [Update val]
                 -> ReaderT backend m Int64
updateWhereCount :: forall val (m :: * -> *) backend.
(PersistEntity val, MonadIO m,
 SqlBackend ~ PersistEntityBackend val,
 BackendCompatible SqlBackend backend) =>
[Filter val] -> [Update val] -> ReaderT backend m Int64
updateWhereCount [Filter val]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return Int64
0
updateWhereCount [Filter val]
filts [Update val]
upds = forall sup sub (m :: * -> *) a.
BackendCompatible sup sub =>
ReaderT sup m a -> ReaderT sub m a
withCompatibleBackend forall a b. (a -> b) -> a -> b
$ do
    SqlBackend
conn <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    let wher :: Text
wher = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter val]
filts
                then Text
""
                else forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause forall a. Maybe a
Nothing SqlBackend
conn [Filter val]
filts
    let sql :: Text
sql = forall a. Monoid a => [a] -> a
mconcat
            [ Text
"UPDATE "
            , SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn EntityDef
t
            , Text
" SET "
            , Text -> [Text] -> Text
T.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall record.
PersistEntity record =>
SqlBackend -> Update record -> Text
mkUpdateText SqlBackend
conn) [Update val]
upds
            , Text
wher
            ]
    let dat :: [PersistValue]
dat = forall a b. (a -> b) -> [a] -> [b]
map forall v. Update v -> PersistValue
updatePersistValue [Update val]
upds forall a. Monoid a => a -> a -> a
`Data.Monoid.mappend`
              forall val.
PersistEntity val =>
SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues SqlBackend
conn [Filter val]
filts
    forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m Int64
rawExecuteCount Text
sql [PersistValue]
dat
  where
    t :: EntityDef
t = forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef forall a b. (a -> b) -> a -> b
$ forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter val]
filts

fieldName ::  forall record typ. (PersistEntity record) => EntityField record typ -> FieldNameDB
fieldName :: forall record typ.
PersistEntity record =>
EntityField record typ -> FieldNameDB
fieldName EntityField record typ
f = FieldDef -> FieldNameDB
fieldDB forall a b. (a -> b) -> a -> b
$ forall record typ.
PersistEntity record =>
EntityField record typ -> FieldDef
persistFieldDef EntityField record typ
f

dummyFromFilts :: [Filter v] -> Maybe v
dummyFromFilts :: forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter v]
_ = forall a. Maybe a
Nothing

getFiltsValues :: forall val. (PersistEntity val)
               => SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues :: forall val.
PersistEntity val =>
SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues SqlBackend
conn = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall val.
PersistEntity val =>
Maybe FilterTablePrefix
-> Bool
-> SqlBackend
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
filterClauseHelper forall a. Maybe a
Nothing Bool
False SqlBackend
conn OrNull
OrNullNo

data OrNull = OrNullYes | OrNullNo

-- | Used when determining how to prefix a column name in a @WHERE@ clause.
--
-- @since 2.12.1.0
data FilterTablePrefix
    = PrefixTableName
    -- ^ Prefix the column with the table name. This is useful if the column
    -- name might be ambiguous.
    --
    -- @since 2.12.1.0
    | PrefixExcluded
    -- ^ Prefix the column name with the @EXCLUDED@ keyword. This is used with
    -- the Postgresql backend when doing @ON CONFLICT DO UPDATE@ clauses - see
    -- the documentation on @upsertWhere@ and @upsertManyWhere@.
    --
    -- @since 2.12.1.0

prefixByTable
    :: Maybe FilterTablePrefix
    -> Text -- ^ Table name
    -> (Text -> Text) -- ^ Prefixing function
prefixByTable :: Maybe FilterTablePrefix -> Text -> Text -> Text
prefixByTable Maybe FilterTablePrefix
tablePrefix Text
tableName =
    case Maybe FilterTablePrefix
tablePrefix of
        Just FilterTablePrefix
PrefixTableName -> ((Text
tableName forall a. Semigroup a => a -> a -> a
<> Text
".") forall a. Semigroup a => a -> a -> a
<>)
        Just FilterTablePrefix
PrefixExcluded -> ((Text
"EXCLUDED.") forall a. Semigroup a => a -> a -> a
<>)
        Maybe FilterTablePrefix
_ -> forall a. a -> a
id

filterClauseHelper
    :: (PersistEntity val)
    => Maybe FilterTablePrefix -- ^ include table name or PostgresSQL EXCLUDED
    -> Bool -- ^ include WHERE
    -> SqlBackend
    -> OrNull
    -> [Filter val]
    -> (Text, [PersistValue])
filterClauseHelper :: forall val.
PersistEntity val =>
Maybe FilterTablePrefix
-> Bool
-> SqlBackend
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
filterClauseHelper Maybe FilterTablePrefix
tablePrefix Bool
includeWhere SqlBackend
conn OrNull
orNull [Filter val]
filters =
    (if Bool -> Bool
not (Text -> Bool
T.null Text
sql) Bool -> Bool -> Bool
&& Bool
includeWhere
        then Text
" WHERE " forall a. Semigroup a => a -> a -> a
<> Text
sql
        else Text
sql, [PersistValue]
vals)
  where
    (Text
sql, [PersistValue]
vals) = [Filter val] -> (Text, [PersistValue])
combineAND [Filter val]
filters
    combineAND :: [Filter val] -> (Text, [PersistValue])
combineAND = Text -> [Filter val] -> (Text, [PersistValue])
combine Text
" AND "

    combine :: Text -> [Filter val] -> (Text, [PersistValue])
combine Text
s [Filter val]
fs =
        (Text -> [Text] -> Text
T.intercalate Text
s forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
wrapP [Text]
a, forall a. Monoid a => [a] -> a
mconcat [[PersistValue]]
b)
      where
        ([Text]
a, [[PersistValue]]
b) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Filter val -> (Text, [PersistValue])
go [Filter val]
fs
        wrapP :: Text -> Text
wrapP Text
x = [Text] -> Text
T.concat [Text
"(", Text
x, Text
")"]

    go :: Filter val -> (Text, [PersistValue])
go (BackendFilter BackendSpecificFilter (PersistEntityBackend val) val
_) = forall a. HasCallStack => [Char] -> a
error [Char]
"BackendFilter not expected"
    go (FilterAnd []) = (Text
"1=1", [])
    go (FilterAnd [Filter val]
fs) = [Filter val] -> (Text, [PersistValue])
combineAND [Filter val]
fs
    go (FilterOr []) = (Text
"1=0", [])
    go (FilterOr [Filter val]
fs)  = Text -> [Filter val] -> (Text, [PersistValue])
combine Text
" OR " [Filter val]
fs
    go (Filter EntityField val typ
field FilterValue typ
value PersistFilter
pfilter) =
        let t :: EntityDef
t = forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef forall a b. (a -> b) -> a -> b
$ forall v. [Filter v] -> Maybe v
dummyFromFilts [forall record typ.
PersistField typ =>
EntityField record typ
-> FilterValue typ -> PersistFilter -> Filter record
Filter EntityField val typ
field FilterValue typ
value PersistFilter
pfilter]
        in
            case (forall record typ.
PersistEntity record =>
EntityField record typ -> Bool
isIdField EntityField val typ
field, EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
t, [PersistValue]
allVals) of
                (Bool
True, Just CompositeDef
pdef, PersistList [PersistValue]
ys:[PersistValue]
_) ->
                    let cfields :: [FieldDef]
cfields = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty FieldDef
compositeFields CompositeDef
pdef in
                    if forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldDef]
cfields forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
ys
                    then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"wrong number of entries in compositeFields vs PersistList allVals=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [PersistValue]
allVals
                    else
                        case ([PersistValue]
allVals, PersistFilter
pfilter, PersistFilter -> Bool
isCompFilter PersistFilter
pfilter) of
                            ([PersistList [PersistValue]
xs], PersistFilter
Eq, Bool
_) ->
                                let
                                    sqlcl :: Text
sqlcl =
                                        Text -> [Text] -> Text
T.intercalate Text
" and "
                                        (forall a b. (a -> b) -> [a] -> [b]
map (\FieldDef
a -> SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn (FieldDef -> FieldNameDB
fieldDB FieldDef
a) forall a. Semigroup a => a -> a -> a
<> PersistFilter -> Text
showSqlFilter PersistFilter
pfilter forall a. Semigroup a => a -> a -> a
<> Text
"? ")  [FieldDef]
cfields)
                                in
                                    (forall {a}. (Semigroup a, IsString a) => a -> a
wrapSql Text
sqlcl, [PersistValue]
xs)
                            ([PersistList [PersistValue]
xs], PersistFilter
Ne, Bool
_) ->
                                let
                                    sqlcl :: Text
sqlcl =
                                        Text -> [Text] -> Text
T.intercalate Text
" or " (forall a b. (a -> b) -> [a] -> [b]
map (\FieldDef
a -> SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn (FieldDef -> FieldNameDB
fieldDB FieldDef
a) forall a. Semigroup a => a -> a -> a
<> PersistFilter -> Text
showSqlFilter PersistFilter
pfilter forall a. Semigroup a => a -> a -> a
<> Text
"? ")  [FieldDef]
cfields)
                                in
                                    (forall {a}. (Semigroup a, IsString a) => a -> a
wrapSql Text
sqlcl, [PersistValue]
xs)
                            ([PersistValue]
_, PersistFilter
In, Bool
_) ->
                               let xxs :: [[PersistValue]]
xxs = forall a. [[a]] -> [[a]]
transpose (forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> [PersistValue]
fromPersistList [PersistValue]
allVals)
                                   sqls :: [Text]
sqls=forall a b. (a -> b) -> [a] -> [b]
map (\(FieldDef
a,[PersistValue]
xs) -> SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn (FieldDef -> FieldNameDB
fieldDB FieldDef
a) forall a. Semigroup a => a -> a -> a
<> PersistFilter -> Text
showSqlFilter PersistFilter
pfilter forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," (forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
xs) Text
" ?") forall a. Semigroup a => a -> a -> a
<> Text
") ") (forall a b. [a] -> [b] -> [(a, b)]
zip [FieldDef]
cfields [[PersistValue]]
xxs)
                               in (forall {a}. (Semigroup a, IsString a) => a -> a
wrapSql (Text -> [Text] -> Text
T.intercalate Text
" and " (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Semigroup a, IsString a) => a -> a
wrapSql [Text]
sqls)), forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PersistValue]]
xxs)
                            ([PersistValue]
_, PersistFilter
NotIn, Bool
_) ->
                                let
                                    xxs :: [[PersistValue]]
xxs = forall a. [[a]] -> [[a]]
transpose (forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> [PersistValue]
fromPersistList [PersistValue]
allVals)
                                    sqls :: [Text]
sqls = forall a b. (a -> b) -> [a] -> [b]
map (\(FieldDef
a,[PersistValue]
xs) -> SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn (FieldDef -> FieldNameDB
fieldDB FieldDef
a) forall a. Semigroup a => a -> a -> a
<> PersistFilter -> Text
showSqlFilter PersistFilter
pfilter forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," (forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
xs) Text
" ?") forall a. Semigroup a => a -> a -> a
<> Text
") ") (forall a b. [a] -> [b] -> [(a, b)]
zip [FieldDef]
cfields [[PersistValue]]
xxs)
                                in
                                    (forall {a}. (Semigroup a, IsString a) => a -> a
wrapSql (Text -> [Text] -> Text
T.intercalate Text
" or " (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Semigroup a, IsString a) => a -> a
wrapSql [Text]
sqls)), forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PersistValue]]
xxs)
                            ([PersistList [PersistValue]
xs], PersistFilter
_, Bool
True) ->
                               let zs :: [[FieldDef]]
zs = forall a. [a] -> [a]
tail (forall a. [a] -> [[a]]
inits (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty FieldDef
compositeFields CompositeDef
pdef))
                                   sql1 :: [Text]
sql1 = forall a b. (a -> b) -> [a] -> [b]
map (\[FieldDef]
b -> forall {a}. (Semigroup a, IsString a) => a -> a
wrapSql (Text -> [Text] -> Text
T.intercalate Text
" and " (forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,FieldDef
a) -> Bool -> FieldDef -> Text
sql2 (Int
iforall a. Eq a => a -> a -> Bool
==forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldDef]
b) FieldDef
a) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [FieldDef]
b)))) [[FieldDef]]
zs
                                   sql2 :: Bool -> FieldDef -> Text
sql2 Bool
islast FieldDef
a = SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn (FieldDef -> FieldNameDB
fieldDB FieldDef
a) forall a. Semigroup a => a -> a -> a
<> (if Bool
islast then PersistFilter -> Text
showSqlFilter PersistFilter
pfilter else PersistFilter -> Text
showSqlFilter PersistFilter
Eq) forall a. Semigroup a => a -> a -> a
<> Text
"? "
                                   sqlcl :: Text
sqlcl = Text -> [Text] -> Text
T.intercalate Text
" or " [Text]
sql1
                               in (forall {a}. (Semigroup a, IsString a) => a -> a
wrapSql Text
sqlcl, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. [a] -> [a]
tail (forall a. [a] -> [[a]]
inits [PersistValue]
xs)))
                            ([PersistValue]
_, BackendSpecificFilter Text
_, Bool
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"unhandled type BackendSpecificFilter for composite/non id primary keys"
                            ([PersistValue], PersistFilter, Bool)
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unhandled type/filter for composite/non id primary keys pfilter=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PersistFilter
pfilter forall a. [a] -> [a] -> [a]
++ [Char]
" persistList="forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show [PersistValue]
allVals
                (Bool
True, Just CompositeDef
pdef, []) ->
                    forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"empty list given as filter value filter=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PersistFilter
pfilter forall a. [a] -> [a] -> [a]
++ [Char]
" persistList=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [PersistValue]
allVals forall a. [a] -> [a] -> [a]
++ [Char]
" pdef=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CompositeDef
pdef
                (Bool
True, Just CompositeDef
pdef, [PersistValue]
_) ->
                    forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unhandled error for composite/non id primary keys filter=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PersistFilter
pfilter forall a. [a] -> [a] -> [a]
++ [Char]
" persistList=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [PersistValue]
allVals forall a. [a] -> [a] -> [a]
++ [Char]
" pdef=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CompositeDef
pdef

                (Bool, Maybe CompositeDef, [PersistValue])
_ ->   case (Bool
isNull, PersistFilter
pfilter, forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
notNullVals) of
                           (Bool
True, PersistFilter
Eq, Int
_) -> (Text
name forall a. Semigroup a => a -> a -> a
<> Text
" IS NULL", [])
                           (Bool
True, PersistFilter
Ne, Int
_) -> (Text
name forall a. Semigroup a => a -> a -> a
<> Text
" IS NOT NULL", [])
                           (Bool
False, PersistFilter
Ne, Int
_) -> ([Text] -> Text
T.concat
                               [ Text
"("
                               , Text
name
                               , Text
" IS NULL OR "
                               , Text
name
                               , Text
" <> "
                               , Text
qmarks
                               , Text
")"
                               ], [PersistValue]
notNullVals)
                           -- We use 1=2 (and below 1=1) to avoid using TRUE and FALSE, since
                           -- not all databases support those words directly.
                           (Bool
_, PersistFilter
In, Int
0) -> (Text
"1=2" forall a. Semigroup a => a -> a -> a
<> Text
orNullSuffix, [])
                           (Bool
False, PersistFilter
In, Int
_) -> (Text
name forall a. Semigroup a => a -> a -> a
<> Text
" IN " forall a. Semigroup a => a -> a -> a
<> Text
qmarks forall a. Semigroup a => a -> a -> a
<> Text
orNullSuffix, [PersistValue]
allVals)
                           (Bool
True, PersistFilter
In, Int
_) -> ([Text] -> Text
T.concat
                               [ Text
"("
                               , Text
name
                               , Text
" IS NULL OR "
                               , Text
name
                               , Text
" IN "
                               , Text
qmarks
                               , Text
")"
                               ], [PersistValue]
notNullVals)
                           (Bool
False, PersistFilter
NotIn, Int
0) -> (Text
"1=1", [])
                           (Bool
True, PersistFilter
NotIn, Int
0) -> (Text
name forall a. Semigroup a => a -> a -> a
<> Text
" IS NOT NULL", [])
                           (Bool
False, PersistFilter
NotIn, Int
_) -> ([Text] -> Text
T.concat
                               [ Text
"("
                               , Text
name
                               , Text
" IS NULL OR "
                               , Text
name
                               , Text
" NOT IN "
                               , Text
qmarks
                               , Text
")"
                               ], [PersistValue]
notNullVals)
                           (Bool
True, PersistFilter
NotIn, Int
_) -> ([Text] -> Text
T.concat
                               [ Text
"("
                               , Text
name
                               , Text
" IS NOT NULL AND "
                               , Text
name
                               , Text
" NOT IN "
                               , Text
qmarks
                               , Text
")"
                               ], [PersistValue]
notNullVals)
                           (Bool, PersistFilter, Int)
_ -> (Text
name forall a. Semigroup a => a -> a -> a
<> PersistFilter -> Text
showSqlFilter PersistFilter
pfilter forall a. Semigroup a => a -> a -> a
<> Text
"?" forall a. Semigroup a => a -> a -> a
<> Text
orNullSuffix, [PersistValue]
allVals)

      where
        isCompFilter :: PersistFilter -> Bool
isCompFilter PersistFilter
Lt = Bool
True
        isCompFilter PersistFilter
Le = Bool
True
        isCompFilter PersistFilter
Gt = Bool
True
        isCompFilter PersistFilter
Ge = Bool
True
        isCompFilter PersistFilter
_ =  Bool
False

        wrapSql :: a -> a
wrapSql a
sqlcl = a
"(" forall a. Semigroup a => a -> a -> a
<> a
sqlcl forall a. Semigroup a => a -> a -> a
<> a
")"
        fromPersistList :: PersistValue -> [PersistValue]
fromPersistList (PersistList [PersistValue]
xs) = [PersistValue]
xs
        fromPersistList PersistValue
other = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"expected PersistList but found " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PersistValue
other

        filterValueToPersistValues :: forall a.  PersistField a => FilterValue a -> [PersistValue]
        filterValueToPersistValues :: forall a. PersistField a => FilterValue a -> [PersistValue]
filterValueToPersistValues = \case
            FilterValue a
a -> [forall a. PersistField a => a -> PersistValue
toPersistValue a
a]
            FilterValues [a]
as -> forall a. PersistField a => a -> PersistValue
toPersistValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as
            UnsafeValue a
x -> [forall a. PersistField a => a -> PersistValue
toPersistValue a
x]

        orNullSuffix :: Text
orNullSuffix =
            case OrNull
orNull of
                OrNull
OrNullYes -> forall a. Monoid a => [a] -> a
mconcat [Text
" OR "
                                      , Text
name
                                      , Text
" IS NULL"]
                OrNull
OrNullNo -> Text
""

        isNull :: Bool
isNull = PersistValue
PersistNull forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PersistValue]
allVals
        notNullVals :: [PersistValue]
notNullVals = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= PersistValue
PersistNull) [PersistValue]
allVals
        allVals :: [PersistValue]
allVals = forall a. PersistField a => FilterValue a -> [PersistValue]
filterValueToPersistValues FilterValue typ
value
        tn :: Text
tn = SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn forall a b. (a -> b) -> a -> b
$ forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef forall a b. (a -> b) -> a -> b
$ forall v. [Filter v] -> Maybe v
dummyFromFilts [forall record typ.
PersistField typ =>
EntityField record typ
-> FilterValue typ -> PersistFilter -> Filter record
Filter EntityField val typ
field FilterValue typ
value PersistFilter
pfilter]
        name :: Text
name = Maybe FilterTablePrefix -> Text -> Text -> Text
prefixByTable Maybe FilterTablePrefix
tablePrefix Text
tn forall a b. (a -> b) -> a -> b
$ SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn (forall record typ.
PersistEntity record =>
EntityField record typ -> FieldNameDB
fieldName EntityField val typ
field)
        qmarks :: Text
qmarks = case FilterValue typ
value of
                    FilterValue{} -> Text
"(?)"
                    UnsafeValue{} -> Text
"(?)"
                    FilterValues [typ]
xs ->
                        let parens :: a -> a
parens a
a = a
"(" forall a. Semigroup a => a -> a -> a
<> a
a forall a. Semigroup a => a -> a -> a
<> a
")"
                            commas :: [Text] -> Text
commas = Text -> [Text] -> Text
T.intercalate Text
","
                            toQs :: [a] -> [Text]
toQs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Text
"?"
                            nonNulls :: [PersistValue]
nonNulls = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= PersistValue
PersistNull) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. PersistField a => a -> PersistValue
toPersistValue [typ]
xs
                         in forall {a}. (Semigroup a, IsString a) => a -> a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
commas forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> [Text]
toQs forall a b. (a -> b) -> a -> b
$ [PersistValue]
nonNulls
        showSqlFilter :: PersistFilter -> Text
showSqlFilter PersistFilter
Eq = Text
"="
        showSqlFilter PersistFilter
Ne = Text
"<>"
        showSqlFilter PersistFilter
Gt = Text
">"
        showSqlFilter PersistFilter
Lt = Text
"<"
        showSqlFilter PersistFilter
Ge = Text
">="
        showSqlFilter PersistFilter
Le = Text
"<="
        showSqlFilter PersistFilter
In = Text
" IN "
        showSqlFilter PersistFilter
NotIn = Text
" NOT IN "
        showSqlFilter (BackendSpecificFilter Text
s) = Text
s

-- |  Render a @['Filter' record]@ into a 'Text' value suitable for inclusion
-- into a SQL query.
--
-- @since 2.12.1.0
filterClause :: (PersistEntity val)
             => Maybe FilterTablePrefix -- ^ include table name or EXCLUDED
             -> SqlBackend
             -> [Filter val]
             -> Text
filterClause :: forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause Maybe FilterTablePrefix
b SqlBackend
c = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall val.
PersistEntity val =>
Maybe FilterTablePrefix
-> Bool
-> SqlBackend
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
filterClauseHelper Maybe FilterTablePrefix
b Bool
True SqlBackend
c OrNull
OrNullNo

-- |  Render a @['Filter' record]@ into a 'Text' value suitable for inclusion
-- into a SQL query, as well as the @['PersistValue']@ to properly fill in the
-- @?@ place holders.
--
-- @since 2.12.1.0
filterClauseWithVals :: (PersistEntity val)
             => Maybe FilterTablePrefix -- ^ include table name or EXCLUDED
             -> SqlBackend
             -> [Filter val]
             -> (Text, [PersistValue])
filterClauseWithVals :: forall val.
PersistEntity val =>
Maybe FilterTablePrefix
-> SqlBackend -> [Filter val] -> (Text, [PersistValue])
filterClauseWithVals Maybe FilterTablePrefix
b SqlBackend
c  = forall val.
PersistEntity val =>
Maybe FilterTablePrefix
-> Bool
-> SqlBackend
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
filterClauseHelper Maybe FilterTablePrefix
b Bool
True SqlBackend
c OrNull
OrNullNo

-- | Render a @['SelectOpt' record]@ made up *only* of 'Asc' and 'Desc' constructors
-- into a 'Text' value suitable for inclusion into a SQL query.
--
-- @since 2.13.2.0
orderClause :: (PersistEntity val)
            => Maybe FilterTablePrefix -- ^ include table name or EXCLUDED
            -> SqlBackend
            -> [SelectOpt val]
            -> Text
orderClause :: forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [SelectOpt val] -> Text
orderClause Maybe FilterTablePrefix
includeTable SqlBackend
conn [SelectOpt val]
orders =
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SelectOpt val]
orders
        then Text
""
        else
            Text
" ORDER BY " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
","
                (forall a b. (a -> b) -> [a] -> [b]
map (\case
                    Asc  EntityField val typ
x -> forall record typ.
PersistEntity record =>
EntityField record typ -> Text
name EntityField val typ
x
                    Desc EntityField val typ
x -> forall record typ.
PersistEntity record =>
EntityField record typ -> Text
name EntityField val typ
x forall a. Semigroup a => a -> a -> a
<> Text
" DESC"
                    SelectOpt val
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"orderClause: expected Asc or Desc, not limit or offset")
                    [SelectOpt val]
orders)
  where
    dummyFromOrder :: [SelectOpt a] -> Maybe a
    dummyFromOrder :: forall a. [SelectOpt a] -> Maybe a
dummyFromOrder [SelectOpt a]
_ = forall a. Maybe a
Nothing

    tn :: Text
tn = SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn (forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef forall a b. (a -> b) -> a -> b
$ forall a. [SelectOpt a] -> Maybe a
dummyFromOrder [SelectOpt val]
orders)

    name :: (PersistEntity record)
         => EntityField record typ -> Text
    name :: forall record typ.
PersistEntity record =>
EntityField record typ -> Text
name EntityField record typ
x =
        Maybe FilterTablePrefix -> Text -> Text -> Text
prefixByTable Maybe FilterTablePrefix
includeTable Text
tn
        forall a b. (a -> b) -> a -> b
$ SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn (forall record typ.
PersistEntity record =>
EntityField record typ -> FieldNameDB
fieldName EntityField record typ
x)

-- | Generates sql for limit and offset for postgres, sqlite and mysql.
decorateSQLWithLimitOffset
    :: Text
    -> (Int,Int)
    -> Text
    -> Text
decorateSQLWithLimitOffset :: Text -> (Int, Int) -> Text -> Text
decorateSQLWithLimitOffset Text
nolimit (Int
limit,Int
offset) Text
sql =
    let
        lim :: Text
lim = case (Int
limit, Int
offset) of
                (Int
0, Int
0) -> Text
""
                (Int
0, Int
_) -> Char -> Text -> Text
T.cons Char
' ' Text
nolimit
                (Int
_, Int
_) -> Text
" LIMIT " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
limit)
        off :: Text
off = if Int
offset forall a. Eq a => a -> a -> Bool
== Int
0
                    then Text
""
                    else Text
" OFFSET " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
offset)
    in forall a. Monoid a => [a] -> a
mconcat
            [ Text
sql
            , Text
lim
            , Text
off
            ]