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

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

module Database.Persist.Sql.Orphan.PersistQuery
    ( deleteWhereCount
    , updateWhereCount
    , decorateSQLWithLimitOffset
    ) where

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

import Database.Persist hiding (updateField)
import Database.Persist.Sql.Util (
    entityColumnNames, parseEntityValues, isIdField, updatePersistValue
  , mkUpdateText, commaSeparated, dbIdColumns)
import Database.Persist.Sql.Types
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Orphan.PersistStore (withRawQuery)

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

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

    selectSourceRes :: [Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts = do
        SqlBackend
conn <- ReaderT SqlBackend m1 SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        Acquire (ConduitM () [PersistValue] m2 ())
srcRes <- Text
-> [PersistValue]
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () [PersistValue] m2 ()))
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) (SqlBackend -> [Filter record] -> [PersistValue]
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues SqlBackend
conn [Filter record]
filts)
        Acquire (ConduitM () (Entity record) m2 ())
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Acquire (ConduitM () (Entity record) m2 ())
 -> ReaderT
      SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ())))
-> Acquire (ConduitM () (Entity record) m2 ())
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall a b. (a -> b) -> a -> b
$ (ConduitM () [PersistValue] m2 ()
 -> ConduitM () (Entity record) m2 ())
-> Acquire (ConduitM () [PersistValue] m2 ())
-> Acquire (ConduitM () (Entity record) m2 ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ConduitM () [PersistValue] m2 ()
-> ConduitM [PersistValue] (Entity record) m2 ()
-> ConduitM () (Entity record) m2 ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ([PersistValue] -> m2 (Entity record))
-> ConduitM [PersistValue] (Entity record) m2 ()
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) = [SelectOpt record] -> (Int, Int, [SelectOpt record])
forall val.
PersistEntity val =>
[SelectOpt val] -> (Int, Int, [SelectOpt val])
limitOffsetOrder [SelectOpt record]
opts

        parse :: [PersistValue] -> m2 (Entity record)
parse [PersistValue]
vals = case EntityDef -> [PersistValue] -> Either Text (Entity record)
forall record.
PersistEntity record =>
EntityDef -> [PersistValue] -> Either Text (Entity record)
parseEntityValues EntityDef
t [PersistValue]
vals of
                       Left Text
s -> IO (Entity record) -> m2 (Entity record)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Entity record) -> m2 (Entity record))
-> IO (Entity record) -> m2 (Entity record)
forall a b. (a -> b) -> a -> b
$ PersistException -> IO (Entity record)
forall e a. Exception e => e -> IO a
throwIO (PersistException -> IO (Entity record))
-> PersistException -> IO (Entity record)
forall a b. (a -> b) -> a -> b
$ Text -> PersistException
PersistMarshalError Text
s
                       Right Entity record
row -> Entity record -> m2 (Entity record)
forall (m :: * -> *) a. Monad m => a -> m a
return Entity record
row
        t :: EntityDef
t = Maybe record -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Maybe record -> EntityDef) -> Maybe record -> EntityDef
forall a b. (a -> b) -> a -> b
$ [Filter record] -> Maybe record
forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter record]
filts
        wher :: SqlBackend -> Text
wher SqlBackend
conn = if [Filter record] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter record]
filts
                    then Text
""
                    else Bool -> SqlBackend -> [Filter record] -> Text
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
Bool -> SqlBackend -> [Filter val] -> Text
filterClause Bool
False SqlBackend
conn [Filter record]
filts
        ord :: SqlBackend -> Text
ord SqlBackend
conn =
            case (SelectOpt record -> Text) -> [SelectOpt record] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> SqlBackend -> SelectOpt record -> Text
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
Bool -> SqlBackend -> SelectOpt val -> Text
orderClause Bool
False SqlBackend
conn) [SelectOpt record]
orders of
                [] -> Text
""
                [Text]
ords -> Text
" ORDER BY " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," [Text]
ords
        cols :: SqlBackend -> Text
cols = [Text] -> Text
commaSeparated ([Text] -> Text) -> (SqlBackend -> [Text]) -> SqlBackend -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> SqlBackend -> [Text]
entityColumnNames EntityDef
t
        sql :: SqlBackend -> Text
sql SqlBackend
conn = SqlBackend -> (Int, Int) -> Bool -> Text -> Text
connLimitOffset SqlBackend
conn (Int
limit,Int
offset) (Bool -> Bool
not ([SelectOpt record] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SelectOpt record]
orders)) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"SELECT "
            , SqlBackend -> Text
cols SqlBackend
conn
            , Text
" FROM "
            , SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
t
            , SqlBackend -> Text
wher SqlBackend
conn
            , SqlBackend -> Text
ord SqlBackend
conn
            ]

    selectKeysRes :: [Filter record]
-> [SelectOpt record]
-> ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts = do
        SqlBackend
conn <- ReaderT SqlBackend m1 SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        Acquire (ConduitM () [PersistValue] m2 ())
srcRes <- Text
-> [PersistValue]
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () [PersistValue] m2 ()))
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) (SqlBackend -> [Filter record] -> [PersistValue]
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues SqlBackend
conn [Filter record]
filts)
        Acquire (ConduitM () (Key record) m2 ())
-> ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Acquire (ConduitM () (Key record) m2 ())
 -> ReaderT
      SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ())))
-> Acquire (ConduitM () (Key record) m2 ())
-> ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
forall a b. (a -> b) -> a -> b
$ (ConduitM () [PersistValue] m2 ()
 -> ConduitM () (Key record) m2 ())
-> Acquire (ConduitM () [PersistValue] m2 ())
-> Acquire (ConduitM () (Key record) m2 ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ConduitM () [PersistValue] m2 ()
-> ConduitM [PersistValue] (Key record) m2 ()
-> ConduitM () (Key record) m2 ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ([PersistValue] -> m2 (Key record))
-> ConduitM [PersistValue] (Key record) m2 ()
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 = Maybe record -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Maybe record -> EntityDef) -> Maybe record -> EntityDef
forall a b. (a -> b) -> a -> b
$ [Filter record] -> Maybe record
forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter record]
filts
        cols :: SqlBackend -> Text
cols SqlBackend
conn = Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ SqlBackend -> EntityDef -> [Text]
dbIdColumns SqlBackend
conn EntityDef
t


        wher :: SqlBackend -> Text
wher SqlBackend
conn = if [Filter record] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter record]
filts
                    then Text
""
                    else Bool -> SqlBackend -> [Filter record] -> Text
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
Bool -> SqlBackend -> [Filter val] -> Text
filterClause Bool
False SqlBackend
conn [Filter record]
filts
        sql :: SqlBackend -> Text
sql SqlBackend
conn = SqlBackend -> (Int, Int) -> Bool -> Text -> Text
connLimitOffset SqlBackend
conn (Int
limit,Int
offset) (Bool -> Bool
not ([SelectOpt record] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SelectOpt record]
orders)) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"SELECT "
            , SqlBackend -> Text
cols SqlBackend
conn
            , Text
" FROM "
            , SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
t
            , SqlBackend -> Text
wher SqlBackend
conn
            , SqlBackend -> Text
ord SqlBackend
conn
            ]

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

        ord :: SqlBackend -> Text
ord SqlBackend
conn =
            case (SelectOpt record -> Text) -> [SelectOpt record] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> SqlBackend -> SelectOpt record -> Text
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
Bool -> SqlBackend -> SelectOpt val -> Text
orderClause Bool
False SqlBackend
conn) [SelectOpt record]
orders of
                [] -> Text
""
                [Text]
ords -> Text
" ORDER BY " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," [Text]
ords

        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] -> [PersistValue] -> m2 [PersistValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int64 -> PersistValue
PersistInt64 Int64
x]
                           [PersistDouble Double
x] -> [PersistValue] -> m2 [PersistValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int64 -> PersistValue
PersistInt64 (Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
x)] -- oracle returns Double
                           [PersistValue]
_ -> [PersistValue] -> m2 [PersistValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [PersistValue]
xs
                      Just CompositeDef
pdef ->
                           let pks :: [HaskellName]
pks = (FieldDef -> HaskellName) -> [FieldDef] -> [HaskellName]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> HaskellName
fieldHaskell ([FieldDef] -> [HaskellName]) -> [FieldDef] -> [HaskellName]
forall a b. (a -> b) -> a -> b
$ CompositeDef -> [FieldDef]
compositeFields CompositeDef
pdef
                               keyvals :: [PersistValue]
keyvals = ((HaskellName, PersistValue) -> PersistValue)
-> [(HaskellName, PersistValue)] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map (HaskellName, PersistValue) -> PersistValue
forall a b. (a, b) -> b
snd ([(HaskellName, PersistValue)] -> [PersistValue])
-> [(HaskellName, PersistValue)] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ ((HaskellName, PersistValue) -> Bool)
-> [(HaskellName, PersistValue)] -> [(HaskellName, PersistValue)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(HaskellName
a, PersistValue
_) -> let ret :: Bool
ret=Maybe HaskellName -> Bool
forall a. Maybe a -> Bool
isJust ((HaskellName -> Bool) -> [HaskellName] -> Maybe HaskellName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (HaskellName -> HaskellName -> Bool
forall a. Eq a => a -> a -> Bool
== HaskellName
a) [HaskellName]
pks) in Bool
ret) ([(HaskellName, PersistValue)] -> [(HaskellName, PersistValue)])
-> [(HaskellName, PersistValue)] -> [(HaskellName, PersistValue)]
forall a b. (a -> b) -> a -> b
$ [HaskellName] -> [PersistValue] -> [(HaskellName, PersistValue)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((FieldDef -> HaskellName) -> [FieldDef] -> [HaskellName]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> HaskellName
fieldHaskell ([FieldDef] -> [HaskellName]) -> [FieldDef] -> [HaskellName]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityFields EntityDef
t) [PersistValue]
xs
                           in [PersistValue] -> m2 [PersistValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [PersistValue]
keyvals
            case [PersistValue] -> Either Text (Key record)
forall record.
PersistEntity record =>
[PersistValue] -> Either Text (Key record)
keyFromValues [PersistValue]
keyvals of
                Right Key record
k -> Key record -> m2 (Key record)
forall (m :: * -> *) a. Monad m => a -> m a
return Key record
k
                Left Text
err -> [Char] -> m2 (Key record)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m2 (Key record)) -> [Char] -> m2 (Key record)
forall a b. (a -> b) -> a -> b
$ [Char]
"selectKeysImpl: keyFromValues failed" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
err
instance PersistQueryRead SqlReadBackend where
    count :: [Filter record] -> ReaderT SqlReadBackend m Int
count [Filter record]
filts = (SqlReadBackend -> SqlBackend)
-> ReaderT SqlBackend m Int -> ReaderT SqlReadBackend m Int
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlReadBackend -> SqlBackend
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (ReaderT SqlBackend m Int -> ReaderT SqlReadBackend m Int)
-> ReaderT SqlBackend m Int -> ReaderT SqlReadBackend m Int
forall a b. (a -> b) -> a -> b
$ [Filter record] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter record]
filts
    exists :: [Filter record] -> ReaderT SqlReadBackend m Bool
exists [Filter record]
filts = (SqlReadBackend -> SqlBackend)
-> ReaderT SqlBackend m Bool -> ReaderT SqlReadBackend m Bool
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlReadBackend -> SqlBackend
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (ReaderT SqlBackend m Bool -> ReaderT SqlReadBackend m Bool)
-> ReaderT SqlBackend m Bool -> ReaderT SqlReadBackend m Bool
forall a b. (a -> b) -> a -> b
$ [Filter record] -> ReaderT SqlBackend m Bool
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Bool
exists [Filter record]
filts
    selectSourceRes :: [Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlReadBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts = (SqlReadBackend -> SqlBackend)
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
     SqlReadBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlReadBackend -> SqlBackend
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (ReaderT
   SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
 -> ReaderT
      SqlReadBackend m1 (Acquire (ConduitM () (Entity record) m2 ())))
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
     SqlReadBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall a b. (a -> b) -> a -> b
$ [Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
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 :: [Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlReadBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts = (SqlReadBackend -> SqlBackend)
-> ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT
     SqlReadBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlReadBackend -> SqlBackend
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
 -> ReaderT
      SqlReadBackend m1 (Acquire (ConduitM () (Key record) m2 ())))
-> ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT
     SqlReadBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
forall a b. (a -> b) -> a -> b
$ [Filter record]
-> [SelectOpt record]
-> ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
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 :: [Filter record] -> ReaderT SqlWriteBackend m Int
count [Filter record]
filts = (SqlWriteBackend -> SqlBackend)
-> ReaderT SqlBackend m Int -> ReaderT SqlWriteBackend m Int
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlWriteBackend -> SqlBackend
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (ReaderT SqlBackend m Int -> ReaderT SqlWriteBackend m Int)
-> ReaderT SqlBackend m Int -> ReaderT SqlWriteBackend m Int
forall a b. (a -> b) -> a -> b
$ [Filter record] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter record]
filts
    exists :: [Filter record] -> ReaderT SqlWriteBackend m Bool
exists [Filter record]
filts = (SqlWriteBackend -> SqlBackend)
-> ReaderT SqlBackend m Bool -> ReaderT SqlWriteBackend m Bool
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlWriteBackend -> SqlBackend
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (ReaderT SqlBackend m Bool -> ReaderT SqlWriteBackend m Bool)
-> ReaderT SqlBackend m Bool -> ReaderT SqlWriteBackend m Bool
forall a b. (a -> b) -> a -> b
$ [Filter record] -> ReaderT SqlBackend m Bool
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Bool
exists [Filter record]
filts
    selectSourceRes :: [Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlWriteBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts = (SqlWriteBackend -> SqlBackend)
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
     SqlWriteBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlWriteBackend -> SqlBackend
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (ReaderT
   SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
 -> ReaderT
      SqlWriteBackend m1 (Acquire (ConduitM () (Entity record) m2 ())))
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
     SqlWriteBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall a b. (a -> b) -> a -> b
$ [Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
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 :: [Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlWriteBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts = (SqlWriteBackend -> SqlBackend)
-> ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT
     SqlWriteBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlWriteBackend -> SqlBackend
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
 -> ReaderT
      SqlWriteBackend m1 (Acquire (ConduitM () (Key record) m2 ())))
-> ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT
     SqlWriteBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
forall a b. (a -> b) -> a -> b
$ [Filter record]
-> [SelectOpt record]
-> ReaderT SqlBackend m1 (Acquire (ConduitM () (Key record) m2 ()))
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 :: [Filter record] -> ReaderT SqlBackend m ()
deleteWhere [Filter record]
filts = do
        Int64
_ <- [Filter record] -> ReaderT SqlBackend m 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
        () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    updateWhere :: [Filter record] -> [Update record] -> ReaderT SqlBackend m ()
updateWhere [Filter record]
filts [Update record]
upds = do
        Int64
_ <- [Filter record] -> [Update record] -> ReaderT SqlBackend m 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
        () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance PersistQueryWrite SqlWriteBackend where
    deleteWhere :: [Filter record] -> ReaderT SqlWriteBackend m ()
deleteWhere [Filter record]
filts = (SqlWriteBackend -> SqlBackend)
-> ReaderT SqlBackend m () -> ReaderT SqlWriteBackend m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlWriteBackend -> SqlBackend
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (ReaderT SqlBackend m () -> ReaderT SqlWriteBackend m ())
-> ReaderT SqlBackend m () -> ReaderT SqlWriteBackend m ()
forall a b. (a -> b) -> a -> b
$ [Filter record] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [Filter record]
filts
    updateWhere :: [Filter record] -> [Update record] -> ReaderT SqlWriteBackend m ()
updateWhere [Filter record]
filts [Update record]
upds = (SqlWriteBackend -> SqlBackend)
-> ReaderT SqlBackend m () -> ReaderT SqlWriteBackend m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlWriteBackend -> SqlBackend
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (ReaderT SqlBackend m () -> ReaderT SqlWriteBackend m ())
-> ReaderT SqlBackend m () -> ReaderT SqlWriteBackend m ()
forall a b. (a -> b) -> a -> b
$ [Filter record] -> [Update record] -> ReaderT SqlBackend m ()
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 :: [Filter val] -> ReaderT backend m Int64
deleteWhereCount [Filter val]
filts = (backend -> SqlBackend)
-> ReaderT SqlBackend m Int64 -> ReaderT backend m Int64
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend (ReaderT SqlBackend m Int64 -> ReaderT backend m Int64)
-> ReaderT SqlBackend m Int64 -> ReaderT backend m Int64
forall a b. (a -> b) -> a -> b
$ do
    SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    let t :: EntityDef
t = Maybe val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Maybe val -> EntityDef) -> Maybe val -> EntityDef
forall a b. (a -> b) -> a -> b
$ [Filter val] -> Maybe val
forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter val]
filts
    let wher :: Text
wher = if [Filter val] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter val]
filts
                then Text
""
                else Bool -> SqlBackend -> [Filter val] -> Text
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
Bool -> SqlBackend -> [Filter val] -> Text
filterClause Bool
False SqlBackend
conn [Filter val]
filts
        sql :: Text
sql = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"DELETE FROM "
            , SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
t
            , Text
wher
            ]
    Text -> [PersistValue] -> ReaderT SqlBackend m Int64
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m Int64
rawExecuteCount Text
sql ([PersistValue] -> ReaderT SqlBackend m Int64)
-> [PersistValue] -> ReaderT SqlBackend m Int64
forall a b. (a -> b) -> a -> b
$ SqlBackend -> [Filter val] -> [PersistValue]
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
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 :: [Filter val] -> [Update val] -> ReaderT backend m Int64
updateWhereCount [Filter val]
_ [] = Int64 -> ReaderT backend m Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
0
updateWhereCount [Filter val]
filts [Update val]
upds = (backend -> SqlBackend)
-> ReaderT SqlBackend m Int64 -> ReaderT backend m Int64
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend (ReaderT SqlBackend m Int64 -> ReaderT backend m Int64)
-> ReaderT SqlBackend m Int64 -> ReaderT backend m Int64
forall a b. (a -> b) -> a -> b
$ do
    SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    let wher :: Text
wher = if [Filter val] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter val]
filts
                then Text
""
                else Bool -> SqlBackend -> [Filter val] -> Text
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
Bool -> SqlBackend -> [Filter val] -> Text
filterClause Bool
False SqlBackend
conn [Filter val]
filts
    let sql :: Text
sql = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"UPDATE "
            , SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
t
            , Text
" SET "
            , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Update val -> Text) -> [Update val] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SqlBackend -> Update val -> Text
forall record.
PersistEntity record =>
SqlBackend -> Update record -> Text
mkUpdateText SqlBackend
conn) [Update val]
upds
            , Text
wher
            ]
    let dat :: [PersistValue]
dat = (Update val -> PersistValue) -> [Update val] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map Update val -> PersistValue
forall v. Update v -> PersistValue
updatePersistValue [Update val]
upds [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. Monoid a => a -> a -> a
`Data.Monoid.mappend`
              SqlBackend -> [Filter val] -> [PersistValue]
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
SqlBackend -> [Filter val] -> [PersistValue]
getFiltsValues SqlBackend
conn [Filter val]
filts
    Text -> [PersistValue] -> ReaderT SqlBackend m Int64
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m Int64
rawExecuteCount Text
sql [PersistValue]
dat
  where
    t :: EntityDef
t = Maybe val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Maybe val -> EntityDef) -> Maybe val -> EntityDef
forall a b. (a -> b) -> a -> b
$ [Filter val] -> Maybe val
forall v. [Filter v] -> Maybe v
dummyFromFilts [Filter val]
filts

fieldName ::  forall record typ. (PersistEntity record, PersistEntityBackend record ~ SqlBackend) => EntityField record typ -> DBName
fieldName :: EntityField record typ -> DBName
fieldName EntityField record typ
f = FieldDef -> DBName
fieldDB (FieldDef -> DBName) -> FieldDef -> DBName
forall a b. (a -> b) -> a -> b
$ EntityField record typ -> FieldDef
forall record typ.
PersistEntity record =>
EntityField record typ -> FieldDef
persistFieldDef EntityField record typ
f

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

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

data OrNull = OrNullYes | OrNullNo

filterClauseHelper :: (PersistEntity val, PersistEntityBackend val ~ SqlBackend)
             => Bool -- ^ include table name?
             -> Bool -- ^ include WHERE?
             -> SqlBackend
             -> OrNull
             -> [Filter val]
             -> (Text, [PersistValue])
filterClauseHelper :: Bool
-> Bool
-> SqlBackend
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
filterClauseHelper Bool
includeTable 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 " Text -> Text -> Text
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 ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
wrapP [Text]
a, [[PersistValue]] -> [PersistValue]
forall a. Monoid a => [a] -> a
mconcat [[PersistValue]]
b)
      where
        ([Text]
a, [[PersistValue]]
b) = [(Text, [PersistValue])] -> ([Text], [[PersistValue]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Text, [PersistValue])] -> ([Text], [[PersistValue]]))
-> [(Text, [PersistValue])] -> ([Text], [[PersistValue]])
forall a b. (a -> b) -> a -> b
$ (Filter val -> (Text, [PersistValue]))
-> [Filter val] -> [(Text, [PersistValue])]
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
_) = [Char] -> (Text, [PersistValue])
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 = Maybe val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Maybe val -> EntityDef) -> Maybe val -> EntityDef
forall a b. (a -> b) -> a -> b
$ [Filter val] -> Maybe val
forall v. [Filter v] -> Maybe v
dummyFromFilts [EntityField val typ
-> FilterValue typ -> PersistFilter -> Filter val
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 (EntityField val typ -> Bool
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]
_) ->
                    if [FieldDef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CompositeDef -> [FieldDef]
compositeFields CompositeDef
pdef) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
ys
                       then [Char] -> (Text, [PersistValue])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Text, [PersistValue]))
-> [Char] -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$ [Char]
"wrong number of entries in compositeFields vs PersistList allVals=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> [Char]
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 " ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\FieldDef
a -> SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (FieldDef -> DBName
fieldDB FieldDef
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PersistFilter -> Text
showSqlFilter PersistFilter
pfilter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"? ")  (CompositeDef -> [FieldDef]
compositeFields CompositeDef
pdef))
                           in (Text -> Text
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 " ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\FieldDef
a -> SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (FieldDef -> DBName
fieldDB FieldDef
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PersistFilter -> Text
showSqlFilter PersistFilter
pfilter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"? ")  (CompositeDef -> [FieldDef]
compositeFields CompositeDef
pdef))
                           in (Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapSql Text
sqlcl,[PersistValue]
xs)
                        ([PersistValue]
_, PersistFilter
In, Bool
_) ->
                           let xxs :: [[PersistValue]]
xxs = [[PersistValue]] -> [[PersistValue]]
forall a. [[a]] -> [[a]]
transpose ((PersistValue -> [PersistValue])
-> [PersistValue] -> [[PersistValue]]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> [PersistValue]
fromPersistList [PersistValue]
allVals)
                               sqls :: [Text]
sqls=((FieldDef, [PersistValue]) -> Text)
-> [(FieldDef, [PersistValue])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(FieldDef
a,[PersistValue]
xs) -> SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (FieldDef -> DBName
fieldDB FieldDef
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PersistFilter -> Text
showSqlFilter PersistFilter
pfilter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," (Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
xs) Text
" ?") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") ") ([FieldDef] -> [[PersistValue]] -> [(FieldDef, [PersistValue])]
forall a b. [a] -> [b] -> [(a, b)]
zip (CompositeDef -> [FieldDef]
compositeFields CompositeDef
pdef) [[PersistValue]]
xxs)
                           in (Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapSql (Text -> [Text] -> Text
T.intercalate Text
" and " ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapSql [Text]
sqls)), [[PersistValue]] -> [PersistValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PersistValue]]
xxs)
                        ([PersistValue]
_, PersistFilter
NotIn, Bool
_) ->
                           let xxs :: [[PersistValue]]
xxs = [[PersistValue]] -> [[PersistValue]]
forall a. [[a]] -> [[a]]
transpose ((PersistValue -> [PersistValue])
-> [PersistValue] -> [[PersistValue]]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> [PersistValue]
fromPersistList [PersistValue]
allVals)
                               sqls :: [Text]
sqls=((FieldDef, [PersistValue]) -> Text)
-> [(FieldDef, [PersistValue])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(FieldDef
a,[PersistValue]
xs) -> SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (FieldDef -> DBName
fieldDB FieldDef
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PersistFilter -> Text
showSqlFilter PersistFilter
pfilter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," (Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
xs) Text
" ?") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") ") ([FieldDef] -> [[PersistValue]] -> [(FieldDef, [PersistValue])]
forall a b. [a] -> [b] -> [(a, b)]
zip (CompositeDef -> [FieldDef]
compositeFields CompositeDef
pdef) [[PersistValue]]
xxs)
                           in (Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapSql (Text -> [Text] -> Text
T.intercalate Text
" or " ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapSql [Text]
sqls)), [[PersistValue]] -> [PersistValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PersistValue]]
xxs)
                        ([PersistList [PersistValue]
xs], PersistFilter
_, Bool
True) ->
                           let zs :: [[FieldDef]]
zs = [[FieldDef]] -> [[FieldDef]]
forall a. [a] -> [a]
tail ([FieldDef] -> [[FieldDef]]
forall a. [a] -> [[a]]
inits (CompositeDef -> [FieldDef]
compositeFields CompositeDef
pdef))
                               sql1 :: [Text]
sql1 = ([FieldDef] -> Text) -> [[FieldDef]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\[FieldDef]
b -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapSql (Text -> [Text] -> Text
T.intercalate Text
" and " (((Int, FieldDef) -> Text) -> [(Int, FieldDef)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,FieldDef
a) -> Bool -> FieldDef -> Text
sql2 (Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==[FieldDef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldDef]
b) FieldDef
a) ([Int] -> [FieldDef] -> [(Int, FieldDef)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [FieldDef]
b)))) [[FieldDef]]
zs
                               sql2 :: Bool -> FieldDef -> Text
sql2 Bool
islast FieldDef
a = SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (FieldDef -> DBName
fieldDB FieldDef
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
islast then PersistFilter -> Text
showSqlFilter PersistFilter
pfilter else PersistFilter -> Text
showSqlFilter PersistFilter
Eq) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"? "
                               sqlcl :: Text
sqlcl = Text -> [Text] -> Text
T.intercalate Text
" or " [Text]
sql1
                           in (Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapSql Text
sqlcl, [[PersistValue]] -> [PersistValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PersistValue]] -> [[PersistValue]]
forall a. [a] -> [a]
tail ([PersistValue] -> [[PersistValue]]
forall a. [a] -> [[a]]
inits [PersistValue]
xs)))
                        ([PersistValue]
_, BackendSpecificFilter Text
_, Bool
_) -> [Char] -> (Text, [PersistValue])
forall a. HasCallStack => [Char] -> a
error [Char]
"unhandled type BackendSpecificFilter for composite/non id primary keys"
                        ([PersistValue], PersistFilter, Bool)
_ -> [Char] -> (Text, [PersistValue])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Text, [PersistValue]))
-> [Char] -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$ [Char]
"unhandled type/filter for composite/non id primary keys pfilter=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PersistFilter -> [Char]
forall a. Show a => a -> [Char]
show PersistFilter
pfilter [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" persistList="[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[PersistValue] -> [Char]
forall a. Show a => a -> [Char]
show [PersistValue]
allVals
                 (Bool
True, Just CompositeDef
pdef, []) ->
                     [Char] -> (Text, [PersistValue])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Text, [PersistValue]))
-> [Char] -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$ [Char]
"empty list given as filter value filter=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PersistFilter -> [Char]
forall a. Show a => a -> [Char]
show PersistFilter
pfilter [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" persistList=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> [Char]
forall a. Show a => a -> [Char]
show [PersistValue]
allVals [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" pdef=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CompositeDef -> [Char]
forall a. Show a => a -> [Char]
show CompositeDef
pdef
                 (Bool
True, Just CompositeDef
pdef, [PersistValue]
_) ->
                     [Char] -> (Text, [PersistValue])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Text, [PersistValue]))
-> [Char] -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$ [Char]
"unhandled error for composite/non id primary keys filter=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PersistFilter -> [Char]
forall a. Show a => a -> [Char]
show PersistFilter
pfilter [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" persistList=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> [Char]
forall a. Show a => a -> [Char]
show [PersistValue]
allVals [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" pdef=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CompositeDef -> [Char]
forall a. Show a => a -> [Char]
show CompositeDef
pdef

                 (Bool, Maybe CompositeDef, [PersistValue])
_ ->   case (Bool
isNull, PersistFilter
pfilter, [PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
notNullVals) of
                            (Bool
True, PersistFilter
Eq, Int
_) -> (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" IS NULL", [])
                            (Bool
True, PersistFilter
Ne, Int
_) -> (Text
name Text -> Text -> Text
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
orNullSuffix, [])
                            (Bool
False, PersistFilter
In, Int
_) -> (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" IN " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qmarks Text -> Text -> Text
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 Text -> Text -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PersistFilter -> Text
showSqlFilter PersistFilter
pfilter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?" Text -> Text -> 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
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
sqlcl a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
        fromPersistList :: PersistValue -> [PersistValue]
fromPersistList (PersistList [PersistValue]
xs) = [PersistValue]
xs
        fromPersistList PersistValue
other = [Char] -> [PersistValue]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [PersistValue]) -> [Char] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ [Char]
"expected PersistList but found " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PersistValue -> [Char]
forall a. Show a => a -> [Char]
show PersistValue
other

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

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

        isNull :: Bool
isNull = PersistValue
PersistNull PersistValue -> [PersistValue] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PersistValue]
allVals
        notNullVals :: [PersistValue]
notNullVals = (PersistValue -> Bool) -> [PersistValue] -> [PersistValue]
forall a. (a -> Bool) -> [a] -> [a]
filter (PersistValue -> PersistValue -> Bool
forall a. Eq a => a -> a -> Bool
/= PersistValue
PersistNull) [PersistValue]
allVals
        allVals :: [PersistValue]
allVals = FilterValue typ -> [PersistValue]
forall a. PersistField a => FilterValue a -> [PersistValue]
filterValueToPersistValues FilterValue typ
value
        tn :: Text
tn = SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB
           (EntityDef -> DBName) -> EntityDef -> DBName
forall a b. (a -> b) -> a -> b
$ Maybe val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Maybe val -> EntityDef) -> Maybe val -> EntityDef
forall a b. (a -> b) -> a -> b
$ [Filter val] -> Maybe val
forall v. [Filter v] -> Maybe v
dummyFromFilts [EntityField val typ
-> FilterValue typ -> PersistFilter -> Filter val
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 =
            (if Bool
includeTable
                then ((Text
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
                else Text -> Text
forall a. a -> a
id)
            (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityField val typ -> DBName
forall record typ.
(PersistEntity record, PersistEntityBackend record ~ SqlBackend) =>
EntityField record typ -> DBName
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
"(" a -> a -> a
forall a. Semigroup a => a -> a -> 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 :: [b] -> [Text]
toQs = (b -> Text) -> [b] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> Text) -> [b] -> [Text]) -> (b -> Text) -> [b] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> b -> Text
forall a b. a -> b -> a
const Text
"?"
                            nonNulls :: [PersistValue]
nonNulls = (PersistValue -> Bool) -> [PersistValue] -> [PersistValue]
forall a. (a -> Bool) -> [a] -> [a]
filter (PersistValue -> PersistValue -> Bool
forall a. Eq a => a -> a -> Bool
/= PersistValue
PersistNull) ([PersistValue] -> [PersistValue])
-> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ (typ -> PersistValue) -> [typ] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map typ -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue [typ]
xs
                         in Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
parens (Text -> Text)
-> ([PersistValue] -> Text) -> [PersistValue] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
commas ([Text] -> Text)
-> ([PersistValue] -> [Text]) -> [PersistValue] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [Text]
forall b. [b] -> [Text]
toQs ([PersistValue] -> Text) -> [PersistValue] -> Text
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

filterClause :: (PersistEntity val, PersistEntityBackend val ~ SqlBackend)
             => Bool -- ^ include table name?
             -> SqlBackend
             -> [Filter val]
             -> Text
filterClause :: Bool -> SqlBackend -> [Filter val] -> Text
filterClause Bool
b SqlBackend
c = (Text, [PersistValue]) -> Text
forall a b. (a, b) -> a
fst ((Text, [PersistValue]) -> Text)
-> ([Filter val] -> (Text, [PersistValue])) -> [Filter val] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Bool
-> SqlBackend
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
forall val.
(PersistEntity val, PersistEntityBackend val ~ SqlBackend) =>
Bool
-> Bool
-> SqlBackend
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
filterClauseHelper Bool
b Bool
True SqlBackend
c OrNull
OrNullNo

orderClause :: (PersistEntity val, PersistEntityBackend val ~ SqlBackend)
            => Bool -- ^ include the table name
            -> SqlBackend
            -> SelectOpt val
            -> Text
orderClause :: Bool -> SqlBackend -> SelectOpt val -> Text
orderClause Bool
includeTable SqlBackend
conn SelectOpt val
o =
    case SelectOpt val
o of
        Asc  EntityField val typ
x -> EntityField val typ -> Text
forall record typ.
(PersistEntityBackend record ~ SqlBackend, PersistEntity record) =>
EntityField record typ -> Text
name EntityField val typ
x
        Desc EntityField val typ
x -> EntityField val typ -> Text
forall record typ.
(PersistEntityBackend record ~ SqlBackend, PersistEntity record) =>
EntityField record typ -> Text
name EntityField val typ
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" DESC"
        SelectOpt val
_ -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"orderClause: expected Asc or Desc, not limit or offset"
  where
    dummyFromOrder :: SelectOpt a -> Maybe a
    dummyFromOrder :: SelectOpt a -> Maybe a
dummyFromOrder SelectOpt a
_ = Maybe a
forall a. Maybe a
Nothing

    tn :: Text
tn = SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB (EntityDef -> DBName) -> EntityDef -> DBName
forall a b. (a -> b) -> a -> b
$ Maybe val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Maybe val -> EntityDef) -> Maybe val -> EntityDef
forall a b. (a -> b) -> a -> b
$ SelectOpt val -> Maybe val
forall a. SelectOpt a -> Maybe a
dummyFromOrder SelectOpt val
o

    name :: (PersistEntityBackend record ~ SqlBackend, PersistEntity record)
         => EntityField record typ -> Text
    name :: EntityField record typ -> Text
name EntityField record typ
x =
        (if Bool
includeTable
            then ((Text
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
            else Text -> Text
forall a. a -> a
id)
        (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityField record typ -> DBName
forall record typ.
(PersistEntity record, PersistEntityBackend record ~ SqlBackend) =>
EntityField record typ -> DBName
fieldName EntityField record typ
x

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