{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# language CPP #-}
module Database.Persist.Typed
(
mkSqlSettingsFor
, SqlFor(..)
, BackendKey(..)
, SqlPersistTFor
, ConnectionPoolFor
, SqlPersistMFor
, runSqlPoolFor
, runSqlConnFor
, generalizePool
, specializePool
, generalizeQuery
, specializeQuery
, generalizeSqlBackend
, specializeSqlBackend
, toSqlKeyFor
, fromSqlKeyFor
) where
import Control.Exception hiding (throw)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Logger (NoLoggingT)
import Control.Monad.Trans.Reader (ReaderT(..), ask, asks, withReaderT)
import Control.Monad.Trans.Resource (MonadUnliftIO, ResourceT)
import qualified Data.Aeson as A
import Data.ByteString.Char8 (readInteger)
import Data.Coerce (coerce)
import Data.Conduit ((.|))
import qualified Data.Conduit.List as CL
import qualified Data.Foldable as Foldable
import Data.Foldable (toList)
import Data.Int (Int64)
import Data.List (find, inits, transpose)
import Data.Maybe (isJust)
import Data.Monoid (mappend)
import Data.Pool (Pool)
import Data.Text (Text)
import qualified Data.Text as Text
import Database.Persist.Sql hiding (deleteWhereCount, orderClause, updateWhereCount)
import Database.Persist.Sql.Types.Internal (IsPersistBackend(..))
import Database.Persist.Sql.Util
import Database.Persist.SqlBackend.Internal
import Database.Persist.TH (MkPersistSettings, mkPersistSettings)
import Language.Haskell.TH (Name, Type(..))
import Web.HttpApiData (FromHttpApiData, ToHttpApiData)
import Web.PathPieces (PathPiece)
#if MIN_VERSION_persistent(2,14,0)
import Database.Persist.Class.PersistEntity (SafeToInsert)
#else
import GHC.Exts (Constraint)
#endif
newtype SqlFor db = SqlFor { SqlFor db -> SqlBackend
unSqlFor :: SqlBackend }
instance BackendCompatible SqlBackend (SqlFor db) where
projectBackend :: SqlFor db -> SqlBackend
projectBackend = SqlFor db -> SqlBackend
forall db. SqlFor db -> SqlBackend
unSqlFor
type SqlPersistTFor db = ReaderT (SqlFor db)
type ConnectionPoolFor db = Pool (SqlFor db)
type SqlPersistMFor db = ReaderT (SqlFor db) (NoLoggingT (ResourceT IO))
specializeQuery :: forall db m a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery :: SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery = (SqlFor db -> SqlBackend)
-> SqlPersistT m a -> SqlPersistTFor db m a
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlFor db -> SqlBackend
forall db. SqlFor db -> SqlBackend
unSqlFor
generalizeQuery :: forall db m a. SqlPersistTFor db m a -> SqlPersistT m a
generalizeQuery :: SqlPersistTFor db m a -> SqlPersistT m a
generalizeQuery = (SqlBackend -> SqlFor db)
-> SqlPersistTFor db m a -> SqlPersistT m a
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlBackend -> SqlFor db
forall db. SqlBackend -> SqlFor db
SqlFor
mkSqlSettingsFor :: Name -> MkPersistSettings
mkSqlSettingsFor :: Name -> MkPersistSettings
mkSqlSettingsFor Name
n = Type -> MkPersistSettings
mkPersistSettings (Type -> Type -> Type
AppT (Name -> Type
ConT ''SqlFor) (Name -> Type
ConT Name
n))
toSqlKeyFor :: (ToBackendKey (SqlFor a) record) => Int64 -> Key record
toSqlKeyFor :: Int64 -> Key record
toSqlKeyFor = BackendKey (SqlFor a) -> Key record
forall backend record.
ToBackendKey backend record =>
BackendKey backend -> Key record
fromBackendKey (BackendKey (SqlFor a) -> Key record)
-> (Int64 -> BackendKey (SqlFor a)) -> Int64 -> Key record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BackendKey SqlBackend -> BackendKey (SqlFor a)
forall a. BackendKey SqlBackend -> BackendKey (SqlFor a)
SqlForKey (BackendKey SqlBackend -> BackendKey (SqlFor a))
-> (Int64 -> BackendKey SqlBackend)
-> Int64
-> BackendKey (SqlFor a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> BackendKey SqlBackend
SqlBackendKey
fromSqlKeyFor :: ToBackendKey (SqlFor a) record => Key record -> Int64
fromSqlKeyFor :: Key record -> Int64
fromSqlKeyFor = BackendKey SqlBackend -> Int64
unSqlBackendKey (BackendKey SqlBackend -> Int64)
-> (Key record -> BackendKey SqlBackend) -> Key record -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BackendKey (SqlFor a) -> BackendKey SqlBackend
forall a. BackendKey (SqlFor a) -> BackendKey SqlBackend
unSqlForKey (BackendKey (SqlFor a) -> BackendKey SqlBackend)
-> (Key record -> BackendKey (SqlFor a))
-> Key record
-> BackendKey SqlBackend
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> BackendKey (SqlFor a)
forall backend record.
ToBackendKey backend record =>
Key record -> BackendKey backend
toBackendKey
specializePool :: ConnectionPool -> ConnectionPoolFor db
specializePool :: ConnectionPool -> ConnectionPoolFor db
specializePool = ConnectionPool -> ConnectionPoolFor db
coerce
generalizePool :: ConnectionPoolFor db -> ConnectionPool
generalizePool :: ConnectionPoolFor db -> ConnectionPool
generalizePool = ConnectionPoolFor db -> ConnectionPool
coerce
specializeSqlBackend :: SqlBackend -> SqlFor db
specializeSqlBackend :: SqlBackend -> SqlFor db
specializeSqlBackend = SqlBackend -> SqlFor db
forall db. SqlBackend -> SqlFor db
SqlFor
generalizeSqlBackend :: SqlFor db -> SqlBackend
generalizeSqlBackend :: SqlFor db -> SqlBackend
generalizeSqlBackend = SqlFor db -> SqlBackend
forall db. SqlFor db -> SqlBackend
unSqlFor
runSqlPoolFor
:: MonadUnliftIO m
=> SqlPersistTFor db m a
-> ConnectionPoolFor db
-> m a
runSqlPoolFor :: SqlPersistTFor db m a -> ConnectionPoolFor db -> m a
runSqlPoolFor SqlPersistTFor db m a
query ConnectionPoolFor db
conn =
ReaderT SqlBackend m a -> ConnectionPool -> m a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> Pool backend -> m a
runSqlPool (SqlPersistTFor db m a -> ReaderT SqlBackend m a
forall db (m :: * -> *) a. SqlPersistTFor db m a -> SqlPersistT m a
generalizeQuery SqlPersistTFor db m a
query) (ConnectionPoolFor db -> ConnectionPool
forall db. ConnectionPoolFor db -> ConnectionPool
generalizePool ConnectionPoolFor db
conn)
runSqlConnFor
:: MonadUnliftIO m
=> SqlPersistTFor db m a
-> SqlFor db
-> m a
runSqlConnFor :: SqlPersistTFor db m a -> SqlFor db -> m a
runSqlConnFor SqlPersistTFor db m a
query SqlFor db
conn =
ReaderT SqlBackend m a -> SqlBackend -> m a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> backend -> m a
runSqlConn (SqlPersistTFor db m a -> ReaderT SqlBackend m a
forall db (m :: * -> *) a. SqlPersistTFor db m a -> SqlPersistT m a
generalizeQuery SqlPersistTFor db m a
query) (SqlFor db -> SqlBackend
forall db. SqlFor db -> SqlBackend
generalizeSqlBackend SqlFor db
conn)
instance HasPersistBackend (SqlFor a) where
type BaseBackend (SqlFor a) = SqlFor a
persistBackend :: SqlFor a -> BaseBackend (SqlFor a)
persistBackend = SqlFor a -> BaseBackend (SqlFor a)
forall a. a -> a
id
instance IsPersistBackend (SqlFor a) where
mkPersistBackend :: BaseBackend (SqlFor a) -> SqlFor a
mkPersistBackend = BaseBackend (SqlFor a) -> SqlFor a
forall a. a -> a
id
instance PersistCore (SqlFor a) where
newtype BackendKey (SqlFor a) =
SqlForKey { BackendKey (SqlFor a) -> BackendKey SqlBackend
unSqlForKey :: BackendKey SqlBackend }
deriving ( Int -> BackendKey (SqlFor a) -> ShowS
[BackendKey (SqlFor a)] -> ShowS
BackendKey (SqlFor a) -> String
(Int -> BackendKey (SqlFor a) -> ShowS)
-> (BackendKey (SqlFor a) -> String)
-> ([BackendKey (SqlFor a)] -> ShowS)
-> Show (BackendKey (SqlFor a))
forall a. Int -> BackendKey (SqlFor a) -> ShowS
forall a. [BackendKey (SqlFor a)] -> ShowS
forall a. BackendKey (SqlFor a) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackendKey (SqlFor a)] -> ShowS
$cshowList :: forall a. [BackendKey (SqlFor a)] -> ShowS
show :: BackendKey (SqlFor a) -> String
$cshow :: forall a. BackendKey (SqlFor a) -> String
showsPrec :: Int -> BackendKey (SqlFor a) -> ShowS
$cshowsPrec :: forall a. Int -> BackendKey (SqlFor a) -> ShowS
Show, ReadPrec [BackendKey (SqlFor a)]
ReadPrec (BackendKey (SqlFor a))
Int -> ReadS (BackendKey (SqlFor a))
ReadS [BackendKey (SqlFor a)]
(Int -> ReadS (BackendKey (SqlFor a)))
-> ReadS [BackendKey (SqlFor a)]
-> ReadPrec (BackendKey (SqlFor a))
-> ReadPrec [BackendKey (SqlFor a)]
-> Read (BackendKey (SqlFor a))
forall a. ReadPrec [BackendKey (SqlFor a)]
forall a. ReadPrec (BackendKey (SqlFor a))
forall a. Int -> ReadS (BackendKey (SqlFor a))
forall a. ReadS [BackendKey (SqlFor a)]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BackendKey (SqlFor a)]
$creadListPrec :: forall a. ReadPrec [BackendKey (SqlFor a)]
readPrec :: ReadPrec (BackendKey (SqlFor a))
$creadPrec :: forall a. ReadPrec (BackendKey (SqlFor a))
readList :: ReadS [BackendKey (SqlFor a)]
$creadList :: forall a. ReadS [BackendKey (SqlFor a)]
readsPrec :: Int -> ReadS (BackendKey (SqlFor a))
$creadsPrec :: forall a. Int -> ReadS (BackendKey (SqlFor a))
Read, BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
(BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool)
-> (BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool)
-> Eq (BackendKey (SqlFor a))
forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
$c/= :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
== :: BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
$c== :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
Eq, Eq (BackendKey (SqlFor a))
Eq (BackendKey (SqlFor a))
-> (BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Ordering)
-> (BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool)
-> (BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool)
-> (BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool)
-> (BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool)
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> Ord (BackendKey (SqlFor a))
BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Ordering
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
forall a. Eq (BackendKey (SqlFor a))
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
forall a.
BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Ordering
forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
min :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$cmin :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
max :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$cmax :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
>= :: BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
$c>= :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
> :: BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
$c> :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
<= :: BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
$c<= :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
< :: BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
$c< :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Bool
compare :: BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Ordering
$ccompare :: forall a.
BackendKey (SqlFor a) -> BackendKey (SqlFor a) -> Ordering
$cp1Ord :: forall a. Eq (BackendKey (SqlFor a))
Ord, Integer -> BackendKey (SqlFor a)
BackendKey (SqlFor a) -> BackendKey (SqlFor a)
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
(BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (Integer -> BackendKey (SqlFor a))
-> Num (BackendKey (SqlFor a))
forall a. Integer -> BackendKey (SqlFor a)
forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a)
forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BackendKey (SqlFor a)
$cfromInteger :: forall a. Integer -> BackendKey (SqlFor a)
signum :: BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$csignum :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a)
abs :: BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$cabs :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a)
negate :: BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$cnegate :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a)
* :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$c* :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
- :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$c- :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
+ :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$c+ :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
Num, Enum (BackendKey (SqlFor a))
Real (BackendKey (SqlFor a))
Real (BackendKey (SqlFor a))
-> Enum (BackendKey (SqlFor a))
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> (BackendKey (SqlFor a), BackendKey (SqlFor a)))
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> (BackendKey (SqlFor a), BackendKey (SqlFor a)))
-> (BackendKey (SqlFor a) -> Integer)
-> Integral (BackendKey (SqlFor a))
BackendKey (SqlFor a) -> Integer
BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> (BackendKey (SqlFor a), BackendKey (SqlFor a))
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
forall a. Enum (BackendKey (SqlFor a))
forall a. Real (BackendKey (SqlFor a))
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
forall a. BackendKey (SqlFor a) -> Integer
forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> (BackendKey (SqlFor a), BackendKey (SqlFor a))
forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
toInteger :: BackendKey (SqlFor a) -> Integer
$ctoInteger :: forall a. BackendKey (SqlFor a) -> Integer
divMod :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> (BackendKey (SqlFor a), BackendKey (SqlFor a))
$cdivMod :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> (BackendKey (SqlFor a), BackendKey (SqlFor a))
quotRem :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> (BackendKey (SqlFor a), BackendKey (SqlFor a))
$cquotRem :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> (BackendKey (SqlFor a), BackendKey (SqlFor a))
mod :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$cmod :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
div :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$cdiv :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
rem :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$crem :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
quot :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$cquot :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$cp2Integral :: forall a. Enum (BackendKey (SqlFor a))
$cp1Integral :: forall a. Real (BackendKey (SqlFor a))
Integral, BackendKey (SqlFor a) -> PersistValue
PersistValue -> Either Text (BackendKey (SqlFor a))
(BackendKey (SqlFor a) -> PersistValue)
-> (PersistValue -> Either Text (BackendKey (SqlFor a)))
-> PersistField (BackendKey (SqlFor a))
forall a. BackendKey (SqlFor a) -> PersistValue
forall a. PersistValue -> Either Text (BackendKey (SqlFor a))
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
fromPersistValue :: PersistValue -> Either Text (BackendKey (SqlFor a))
$cfromPersistValue :: forall a. PersistValue -> Either Text (BackendKey (SqlFor a))
toPersistValue :: BackendKey (SqlFor a) -> PersistValue
$ctoPersistValue :: forall a. BackendKey (SqlFor a) -> PersistValue
PersistField
, PersistField (BackendKey (SqlFor a))
Proxy (BackendKey (SqlFor a)) -> SqlType
PersistField (BackendKey (SqlFor a))
-> (Proxy (BackendKey (SqlFor a)) -> SqlType)
-> PersistFieldSql (BackendKey (SqlFor a))
forall a. PersistField (BackendKey (SqlFor a))
forall a. Proxy (BackendKey (SqlFor a)) -> SqlType
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy (BackendKey (SqlFor a)) -> SqlType
$csqlType :: forall a. Proxy (BackendKey (SqlFor a)) -> SqlType
$cp1PersistFieldSql :: forall a. PersistField (BackendKey (SqlFor a))
PersistFieldSql, Text -> Maybe (BackendKey (SqlFor a))
BackendKey (SqlFor a) -> Text
(Text -> Maybe (BackendKey (SqlFor a)))
-> (BackendKey (SqlFor a) -> Text)
-> PathPiece (BackendKey (SqlFor a))
forall a. Text -> Maybe (BackendKey (SqlFor a))
forall a. BackendKey (SqlFor a) -> Text
forall s. (Text -> Maybe s) -> (s -> Text) -> PathPiece s
toPathPiece :: BackendKey (SqlFor a) -> Text
$ctoPathPiece :: forall a. BackendKey (SqlFor a) -> Text
fromPathPiece :: Text -> Maybe (BackendKey (SqlFor a))
$cfromPathPiece :: forall a. Text -> Maybe (BackendKey (SqlFor a))
PathPiece, BackendKey (SqlFor a) -> ByteString
BackendKey (SqlFor a) -> Builder
BackendKey (SqlFor a) -> Text
(BackendKey (SqlFor a) -> Text)
-> (BackendKey (SqlFor a) -> Builder)
-> (BackendKey (SqlFor a) -> ByteString)
-> (BackendKey (SqlFor a) -> Text)
-> ToHttpApiData (BackendKey (SqlFor a))
forall a. BackendKey (SqlFor a) -> ByteString
forall a. BackendKey (SqlFor a) -> Builder
forall a. BackendKey (SqlFor a) -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: BackendKey (SqlFor a) -> Text
$ctoQueryParam :: forall a. BackendKey (SqlFor a) -> Text
toHeader :: BackendKey (SqlFor a) -> ByteString
$ctoHeader :: forall a. BackendKey (SqlFor a) -> ByteString
toEncodedUrlPiece :: BackendKey (SqlFor a) -> Builder
$ctoEncodedUrlPiece :: forall a. BackendKey (SqlFor a) -> Builder
toUrlPiece :: BackendKey (SqlFor a) -> Text
$ctoUrlPiece :: forall a. BackendKey (SqlFor a) -> Text
ToHttpApiData, ByteString -> Either Text (BackendKey (SqlFor a))
Text -> Either Text (BackendKey (SqlFor a))
(Text -> Either Text (BackendKey (SqlFor a)))
-> (ByteString -> Either Text (BackendKey (SqlFor a)))
-> (Text -> Either Text (BackendKey (SqlFor a)))
-> FromHttpApiData (BackendKey (SqlFor a))
forall a. ByteString -> Either Text (BackendKey (SqlFor a))
forall a. Text -> Either Text (BackendKey (SqlFor a))
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text (BackendKey (SqlFor a))
$cparseQueryParam :: forall a. Text -> Either Text (BackendKey (SqlFor a))
parseHeader :: ByteString -> Either Text (BackendKey (SqlFor a))
$cparseHeader :: forall a. ByteString -> Either Text (BackendKey (SqlFor a))
parseUrlPiece :: Text -> Either Text (BackendKey (SqlFor a))
$cparseUrlPiece :: forall a. Text -> Either Text (BackendKey (SqlFor a))
FromHttpApiData
, Num (BackendKey (SqlFor a))
Ord (BackendKey (SqlFor a))
Num (BackendKey (SqlFor a))
-> Ord (BackendKey (SqlFor a))
-> (BackendKey (SqlFor a) -> Rational)
-> Real (BackendKey (SqlFor a))
BackendKey (SqlFor a) -> Rational
forall a. Num (BackendKey (SqlFor a))
forall a. Ord (BackendKey (SqlFor a))
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall a. BackendKey (SqlFor a) -> Rational
toRational :: BackendKey (SqlFor a) -> Rational
$ctoRational :: forall a. BackendKey (SqlFor a) -> Rational
$cp2Real :: forall a. Ord (BackendKey (SqlFor a))
$cp1Real :: forall a. Num (BackendKey (SqlFor a))
Real, Int -> BackendKey (SqlFor a)
BackendKey (SqlFor a) -> Int
BackendKey (SqlFor a) -> [BackendKey (SqlFor a)]
BackendKey (SqlFor a) -> BackendKey (SqlFor a)
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> [BackendKey (SqlFor a)]
BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> [BackendKey (SqlFor a)]
(BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a) -> BackendKey (SqlFor a))
-> (Int -> BackendKey (SqlFor a))
-> (BackendKey (SqlFor a) -> Int)
-> (BackendKey (SqlFor a) -> [BackendKey (SqlFor a)])
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> [BackendKey (SqlFor a)])
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> [BackendKey (SqlFor a)])
-> (BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> [BackendKey (SqlFor a)])
-> Enum (BackendKey (SqlFor a))
forall a. Int -> BackendKey (SqlFor a)
forall a. BackendKey (SqlFor a) -> Int
forall a. BackendKey (SqlFor a) -> [BackendKey (SqlFor a)]
forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a)
forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> [BackendKey (SqlFor a)]
forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> [BackendKey (SqlFor a)]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> [BackendKey (SqlFor a)]
$cenumFromThenTo :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> BackendKey (SqlFor a)
-> [BackendKey (SqlFor a)]
enumFromTo :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> [BackendKey (SqlFor a)]
$cenumFromTo :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> [BackendKey (SqlFor a)]
enumFromThen :: BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> [BackendKey (SqlFor a)]
$cenumFromThen :: forall a.
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> [BackendKey (SqlFor a)]
enumFrom :: BackendKey (SqlFor a) -> [BackendKey (SqlFor a)]
$cenumFrom :: forall a. BackendKey (SqlFor a) -> [BackendKey (SqlFor a)]
fromEnum :: BackendKey (SqlFor a) -> Int
$cfromEnum :: forall a. BackendKey (SqlFor a) -> Int
toEnum :: Int -> BackendKey (SqlFor a)
$ctoEnum :: forall a. Int -> BackendKey (SqlFor a)
pred :: BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$cpred :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a)
succ :: BackendKey (SqlFor a) -> BackendKey (SqlFor a)
$csucc :: forall a. BackendKey (SqlFor a) -> BackendKey (SqlFor a)
Enum, BackendKey (SqlFor a)
BackendKey (SqlFor a)
-> BackendKey (SqlFor a) -> Bounded (BackendKey (SqlFor a))
forall a. BackendKey (SqlFor a)
forall a. a -> a -> Bounded a
maxBound :: BackendKey (SqlFor a)
$cmaxBound :: forall a. BackendKey (SqlFor a)
minBound :: BackendKey (SqlFor a)
$cminBound :: forall a. BackendKey (SqlFor a)
Bounded, [BackendKey (SqlFor a)] -> Encoding
[BackendKey (SqlFor a)] -> Value
BackendKey (SqlFor a) -> Encoding
BackendKey (SqlFor a) -> Value
(BackendKey (SqlFor a) -> Value)
-> (BackendKey (SqlFor a) -> Encoding)
-> ([BackendKey (SqlFor a)] -> Value)
-> ([BackendKey (SqlFor a)] -> Encoding)
-> ToJSON (BackendKey (SqlFor a))
forall a. [BackendKey (SqlFor a)] -> Encoding
forall a. [BackendKey (SqlFor a)] -> Value
forall a. BackendKey (SqlFor a) -> Encoding
forall a. BackendKey (SqlFor a) -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BackendKey (SqlFor a)] -> Encoding
$ctoEncodingList :: forall a. [BackendKey (SqlFor a)] -> Encoding
toJSONList :: [BackendKey (SqlFor a)] -> Value
$ctoJSONList :: forall a. [BackendKey (SqlFor a)] -> Value
toEncoding :: BackendKey (SqlFor a) -> Encoding
$ctoEncoding :: forall a. BackendKey (SqlFor a) -> Encoding
toJSON :: BackendKey (SqlFor a) -> Value
$ctoJSON :: forall a. BackendKey (SqlFor a) -> Value
A.ToJSON, Value -> Parser [BackendKey (SqlFor a)]
Value -> Parser (BackendKey (SqlFor a))
(Value -> Parser (BackendKey (SqlFor a)))
-> (Value -> Parser [BackendKey (SqlFor a)])
-> FromJSON (BackendKey (SqlFor a))
forall a. Value -> Parser [BackendKey (SqlFor a)]
forall a. Value -> Parser (BackendKey (SqlFor a))
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BackendKey (SqlFor a)]
$cparseJSONList :: forall a. Value -> Parser [BackendKey (SqlFor a)]
parseJSON :: Value -> Parser (BackendKey (SqlFor a))
$cparseJSON :: forall a. Value -> Parser (BackendKey (SqlFor a))
A.FromJSON
)
instance PersistStoreRead (SqlFor a) where
get :: Key record -> ReaderT (SqlFor a) m (Maybe record)
get Key record
k = do
SqlBackend
conn <- (SqlFor a -> SqlBackend) -> ReaderT (SqlFor a) m SqlBackend
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SqlFor a -> SqlBackend
forall db. SqlFor db -> SqlBackend
unSqlFor
let 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
$ Key record -> Maybe record
forall record. Key record -> Maybe record
dummyFromKey Key record
k
let cols :: Text
cols = Text -> [Text] -> Text
Text.intercalate Text
","
([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> (FieldDef -> Text) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text)
-> (FieldDef -> FieldNameDB) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> FieldNameDB
fieldDB) ([FieldDef] -> [Text]) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
getEntityFieldsDatabase EntityDef
t
noColumns :: Bool
noColumns :: Bool
noColumns = [FieldDef] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FieldDef] -> Bool) -> [FieldDef] -> Bool
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
getEntityFieldsDatabase EntityDef
t
let wher :: Text
wher = SqlBackend -> Key record -> Text
forall record.
PersistEntity record =>
SqlBackend -> Key record -> Text
whereStmtForKey SqlBackend
conn Key record
k
let sql :: Text
sql = [Text] -> Text
Text.concat
[ Text
"SELECT "
, if Bool
noColumns then Text
"*" else Text
cols
, Text
" FROM "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
t
, Text
" WHERE "
, Text
wher
]
(ReaderT SqlBackend (ReaderT (SqlFor a) m) (Maybe record)
-> SqlBackend -> ReaderT (SqlFor a) m (Maybe record))
-> SqlBackend
-> ReaderT SqlBackend (ReaderT (SqlFor a) m) (Maybe record)
-> ReaderT (SqlFor a) m (Maybe record)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT SqlBackend (ReaderT (SqlFor a) m) (Maybe record)
-> SqlBackend -> ReaderT (SqlFor a) m (Maybe record)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT SqlBackend
conn (ReaderT SqlBackend (ReaderT (SqlFor a) m) (Maybe record)
-> ReaderT (SqlFor a) m (Maybe record))
-> ReaderT SqlBackend (ReaderT (SqlFor a) m) (Maybe record)
-> ReaderT (SqlFor a) m (Maybe record)
forall a b. (a -> b) -> a -> b
$ Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO (Maybe record)
-> ReaderT SqlBackend (ReaderT (SqlFor a) m) (Maybe record)
forall (m :: * -> *) a.
MonadIO m =>
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> ReaderT SqlBackend m a
withRawQuery Text
sql (Key record -> [PersistValue]
forall record. PersistEntity record => Key record -> [PersistValue]
keyToValues Key record
k) (ConduitM [PersistValue] Void IO (Maybe record)
-> ReaderT SqlBackend (ReaderT (SqlFor a) m) (Maybe record))
-> ConduitM [PersistValue] Void IO (Maybe record)
-> ReaderT SqlBackend (ReaderT (SqlFor a) m) (Maybe record)
forall a b. (a -> b) -> a -> b
$ do
Maybe [PersistValue]
res <- ConduitT [PersistValue] Void IO (Maybe [PersistValue])
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
case Maybe [PersistValue]
res of
Maybe [PersistValue]
Nothing -> Maybe record -> ConduitM [PersistValue] Void IO (Maybe record)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe record
forall a. Maybe a
Nothing
Just [PersistValue]
vals ->
case [PersistValue] -> Either Text record
forall record.
PersistEntity record =>
[PersistValue] -> Either Text record
fromPersistValues ([PersistValue] -> Either Text record)
-> [PersistValue] -> Either Text record
forall a b. (a -> b) -> a -> b
$ if Bool
noColumns then [] else [PersistValue]
vals of
Left Text
e -> String -> ConduitM [PersistValue] Void IO (Maybe record)
forall a. HasCallStack => String -> a
error (String -> ConduitM [PersistValue] Void IO (Maybe record))
-> String -> ConduitM [PersistValue] Void IO (Maybe record)
forall a b. (a -> b) -> a -> b
$ String
"get " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key record -> String
forall a. Show a => a -> String
show Key record
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
e
Right record
v -> Maybe record -> ConduitM [PersistValue] Void IO (Maybe record)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe record -> ConduitM [PersistValue] Void IO (Maybe record))
-> Maybe record -> ConduitM [PersistValue] Void IO (Maybe record)
forall a b. (a -> b) -> a -> b
$ record -> Maybe record
forall a. a -> Maybe a
Just record
v
instance PersistStoreWrite (SqlFor a) where
update :: Key record -> [Update record] -> ReaderT (SqlFor a) m ()
update Key record
_ [] = () -> ReaderT (SqlFor a) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
update Key record
k [Update record]
upds = SqlPersistT m () -> ReaderT (SqlFor a) m ()
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m () -> ReaderT (SqlFor a) m ())
-> SqlPersistT m () -> ReaderT (SqlFor a) m ()
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 go'' :: Text -> PersistUpdate -> Text
go'' Text
n PersistUpdate
Assign = Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=?"
go'' Text
n PersistUpdate
Add = [Text] -> Text
Text.concat [Text
n, Text
"=", Text
n, Text
"+?"]
go'' Text
n PersistUpdate
Subtract = [Text] -> Text
Text.concat [Text
n, Text
"=", Text
n, Text
"-?"]
go'' Text
n PersistUpdate
Multiply = [Text] -> Text
Text.concat [Text
n, Text
"=", Text
n, Text
"*?"]
go'' Text
n PersistUpdate
Divide = [Text] -> Text
Text.concat [Text
n, Text
"=", Text
n, Text
"/?"]
go'' Text
_ (BackendSpecificUpdate Text
up) = String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"BackendSpecificUpdate" Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`Data.Monoid.mappend` Text
up Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"not supported"
let go' :: (Text, PersistUpdate) -> Text
go' (Text
x, PersistUpdate
pu) = Text -> PersistUpdate -> Text
go'' (SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn Text
x) PersistUpdate
pu
let wher :: Text
wher = SqlBackend -> Key record -> Text
forall record.
PersistEntity record =>
SqlBackend -> Key record -> Text
whereStmtForKey SqlBackend
conn Key record
k
let sql :: Text
sql = [Text] -> Text
Text.concat
[ Text
"UPDATE "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ record -> EntityNameDB
forall record. PersistEntity record => record -> EntityNameDB
tableDBName (record -> EntityNameDB) -> record -> EntityNameDB
forall a b. (a -> b) -> a -> b
$ Key record -> record
forall record. Key record -> record
recordTypeFromKey Key record
k
, Text
" SET "
, Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Update record -> Text) -> [Update record] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text, PersistUpdate) -> Text
go' ((Text, PersistUpdate) -> Text)
-> (Update record -> (Text, PersistUpdate))
-> Update record
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Update record -> (Text, PersistUpdate)
forall record.
PersistEntity record =>
Update record -> (Text, PersistUpdate)
go) [Update record]
upds
, Text
" WHERE "
, Text
wher
]
Text -> [PersistValue] -> SqlPersistT m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute Text
sql ([PersistValue] -> SqlPersistT m ())
-> [PersistValue] -> SqlPersistT m ()
forall a b. (a -> b) -> a -> b
$
(Update record -> PersistValue)
-> [Update record] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map Update record -> PersistValue
forall v. Update v -> PersistValue
updatePersistValue [Update record]
upds [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. Monoid a => a -> a -> a
`mappend` Key record -> [PersistValue]
forall record. PersistEntity record => Key record -> [PersistValue]
keyToValues Key record
k
where
go :: Update record -> (Text, PersistUpdate)
go Update record
x = (FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text) -> FieldNameDB -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> FieldNameDB
fieldDB (FieldDef -> FieldNameDB) -> FieldDef -> FieldNameDB
forall a b. (a -> b) -> a -> b
$ Update record -> FieldDef
forall v. PersistEntity v => Update v -> FieldDef
updateFieldDef Update record
x, Update record -> PersistUpdate
forall record. Update record -> PersistUpdate
updateUpdate Update record
x)
insert :: record -> ReaderT (SqlFor a) m (Key record)
insert record
val = SqlPersistT m (Key record) -> ReaderT (SqlFor a) m (Key record)
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m (Key record) -> ReaderT (SqlFor a) m (Key record))
-> SqlPersistT m (Key record) -> ReaderT (SqlFor a) m (Key record)
forall a b. (a -> b) -> a -> b
$ do
SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
case SqlBackend -> EntityDef -> [PersistValue] -> InsertSqlResult
connInsertSql SqlBackend
conn EntityDef
t [PersistValue]
vals of
ISRSingle Text
sql -> Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO (Key record)
-> SqlPersistT m (Key record)
forall (m :: * -> *) a.
MonadIO m =>
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> ReaderT SqlBackend m a
withRawQuery Text
sql [PersistValue]
vals (ConduitM [PersistValue] Void IO (Key record)
-> SqlPersistT m (Key record))
-> ConduitM [PersistValue] Void IO (Key record)
-> SqlPersistT m (Key record)
forall a b. (a -> b) -> a -> b
$ do
Maybe [PersistValue]
x <- ConduitT [PersistValue] Void IO (Maybe [PersistValue])
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
case Maybe [PersistValue]
x of
Just [PersistInt64 Int64
i] -> case [PersistValue] -> Either Text (Key record)
forall record.
PersistEntity record =>
[PersistValue] -> Either Text (Key record)
keyFromValues [Int64 -> PersistValue
PersistInt64 Int64
i] of
Left Text
err -> String -> ConduitM [PersistValue] Void IO (Key record)
forall a. HasCallStack => String -> a
error (String -> ConduitM [PersistValue] Void IO (Key record))
-> String -> ConduitM [PersistValue] Void IO (Key record)
forall a b. (a -> b) -> a -> b
$ String
"SQL insert: keyFromValues: PersistInt64 " String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` Int64 -> String
forall a. Show a => a -> String
show Int64
i String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` String
" " String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` Text -> String
Text.unpack Text
err
Right Key record
k -> Key record -> ConduitM [PersistValue] Void IO (Key record)
forall (m :: * -> *) a. Monad m => a -> m a
return Key record
k
Maybe [PersistValue]
Nothing -> String -> ConduitM [PersistValue] Void IO (Key record)
forall a. HasCallStack => String -> a
error String
"SQL insert did not return a result giving the generated ID"
Just [PersistValue]
vals' -> case [PersistValue] -> Either Text (Key record)
forall record.
PersistEntity record =>
[PersistValue] -> Either Text (Key record)
keyFromValues [PersistValue]
vals' of
Left Text
_ -> String -> ConduitM [PersistValue] Void IO (Key record)
forall a. HasCallStack => String -> a
error (String -> ConduitM [PersistValue] Void IO (Key record))
-> String -> ConduitM [PersistValue] Void IO (Key record)
forall a b. (a -> b) -> a -> b
$ String
"Invalid result from a SQL insert, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
vals'
Right Key record
k -> Key record -> ConduitM [PersistValue] Void IO (Key record)
forall (m :: * -> *) a. Monad m => a -> m a
return Key record
k
ISRInsertGet Text
sql1 Text
sql2 -> do
Text -> [PersistValue] -> ReaderT SqlBackend m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute Text
sql1 [PersistValue]
vals
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO (Key record)
-> SqlPersistT m (Key record)
forall (m :: * -> *) a.
MonadIO m =>
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> ReaderT SqlBackend m a
withRawQuery Text
sql2 [] (ConduitM [PersistValue] Void IO (Key record)
-> SqlPersistT m (Key record))
-> ConduitM [PersistValue] Void IO (Key record)
-> SqlPersistT m (Key record)
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
let m :: Either Text [PersistValue]
m = Either Text [PersistValue]
-> ([PersistValue] -> Either Text [PersistValue])
-> Maybe [PersistValue]
-> Either Text [PersistValue]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Text -> Either Text [PersistValue]
forall a b. a -> Either a b
Left (Text -> Either Text [PersistValue])
-> Text -> Either Text [PersistValue]
forall a b. (a -> b) -> a -> b
$ Text
"No results from ISRInsertGet: " Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` (Text, Text) -> Text
forall a. Show a => a -> Text
tshow (Text
sql1, Text
sql2))
[PersistValue] -> Either Text [PersistValue]
forall a b. b -> Either a b
Right Maybe [PersistValue]
mm
let convert :: [PersistValue] -> [PersistValue]
convert [PersistValue]
x =
case [PersistValue]
x of
[PersistByteString ByteString
i] -> case ByteString -> Maybe (Integer, ByteString)
readInteger ByteString
i of
Just (Integer
ret,ByteString
"") -> [Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue) -> Int64 -> PersistValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ret]
Maybe (Integer, ByteString)
_ -> [PersistValue]
x
[PersistValue]
_ -> [PersistValue]
x
onLeft :: Either a b -> Either a b -> Either a b
onLeft Left{} Either a b
x = Either a b
x
onLeft Either a b
x Either a b
_ = Either a b
x
case Either Text [PersistValue]
m Either Text [PersistValue]
-> ([PersistValue] -> Either Text (Key record))
-> Either Text (Key record)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[PersistValue]
x -> [PersistValue] -> Either Text (Key record)
forall record.
PersistEntity record =>
[PersistValue] -> Either Text (Key record)
keyFromValues [PersistValue]
x Either Text (Key record)
-> Either Text (Key record) -> Either Text (Key record)
forall a b. Either a b -> Either a b -> Either a b
`onLeft` [PersistValue] -> Either Text (Key record)
forall record.
PersistEntity record =>
[PersistValue] -> Either Text (Key record)
keyFromValues ([PersistValue] -> [PersistValue]
convert [PersistValue]
x)) of
Right Key record
k -> Key record -> ConduitM [PersistValue] Void IO (Key record)
forall (m :: * -> *) a. Monad m => a -> m a
return Key record
k
Left Text
err -> Text -> ConduitM [PersistValue] Void IO (Key record)
forall a. Text -> ConduitT [PersistValue] Void IO a
throw (Text -> ConduitM [PersistValue] Void IO (Key record))
-> Text -> ConduitM [PersistValue] Void IO (Key record)
forall a b. (a -> b) -> a -> b
$ Text
"ISRInsertGet: keyFromValues failed: " Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
err
ISRManyKeys Text
sql [PersistValue]
fs -> do
Text -> [PersistValue] -> ReaderT SqlBackend m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute Text
sql [PersistValue]
vals
case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
t of
Maybe CompositeDef
Nothing -> String -> SqlPersistT m (Key record)
forall a. HasCallStack => String -> a
error (String -> SqlPersistT m (Key record))
-> String -> SqlPersistT m (Key record)
forall a b. (a -> b) -> a -> b
$ String
"ISRManyKeys is used when Primary is defined " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
sql
Just CompositeDef
pdef ->
let pks :: [FieldNameHS]
pks = (FieldDef -> FieldNameHS) -> [FieldDef] -> [FieldNameHS]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> FieldNameHS
fieldHaskell ([FieldDef] -> [FieldNameHS]) -> [FieldDef] -> [FieldNameHS]
forall a b. (a -> b) -> a -> b
$ NonEmpty FieldDef -> [FieldDef]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldDef -> [FieldDef])
-> NonEmpty FieldDef -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty FieldDef
compositeFields CompositeDef
pdef
keyvals :: [PersistValue]
keyvals = ((FieldNameHS, PersistValue) -> PersistValue)
-> [(FieldNameHS, PersistValue)] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map (FieldNameHS, PersistValue) -> PersistValue
forall a b. (a, b) -> b
snd ([(FieldNameHS, PersistValue)] -> [PersistValue])
-> [(FieldNameHS, PersistValue)] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ ((FieldNameHS, PersistValue) -> Bool)
-> [(FieldNameHS, PersistValue)] -> [(FieldNameHS, PersistValue)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(FieldNameHS
a, PersistValue
_) -> let ret :: Bool
ret=Maybe FieldNameHS -> Bool
forall a. Maybe a -> Bool
isJust ((FieldNameHS -> Bool) -> [FieldNameHS] -> Maybe FieldNameHS
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (FieldNameHS -> FieldNameHS -> Bool
forall a. Eq a => a -> a -> Bool
== FieldNameHS
a) [FieldNameHS]
pks) in Bool
ret) ([(FieldNameHS, PersistValue)] -> [(FieldNameHS, PersistValue)])
-> [(FieldNameHS, PersistValue)] -> [(FieldNameHS, PersistValue)]
forall a b. (a -> b) -> a -> b
$ [FieldNameHS] -> [PersistValue] -> [(FieldNameHS, PersistValue)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((FieldDef -> FieldNameHS) -> [FieldDef] -> [FieldNameHS]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> FieldNameHS
fieldHaskell ([FieldDef] -> [FieldNameHS]) -> [FieldDef] -> [FieldNameHS]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
getEntityFieldsDatabase EntityDef
t) [PersistValue]
fs
in 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 -> SqlPersistT m (Key record)
forall (m :: * -> *) a. Monad m => a -> m a
return Key record
k
Left Text
e -> String -> SqlPersistT m (Key record)
forall a. HasCallStack => String -> a
error (String -> SqlPersistT m (Key record))
-> String -> SqlPersistT m (Key record)
forall a b. (a -> b) -> a -> b
$ String
"ISRManyKeys: unexpected keyvals result: " String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` Text -> String
Text.unpack Text
e
where
tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
throw :: Text -> ConduitT [PersistValue] Void IO a
throw = IO a -> ConduitT [PersistValue] Void IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ConduitT [PersistValue] Void IO a)
-> (Text -> IO a) -> Text -> ConduitT [PersistValue] Void IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO a) -> (Text -> IOError) -> Text -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IOError) -> (Text -> String) -> Text -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
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
$ record -> Maybe record
forall a. a -> Maybe a
Just record
val
vals :: [PersistValue]
vals = (PersistValue -> PersistValue) -> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue ([PersistValue] -> [PersistValue])
-> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
toPersistFields record
val
insertMany :: [record] -> ReaderT (SqlFor a) m [Key record]
insertMany [] = [Key record] -> ReaderT (SqlFor a) m [Key record]
forall (m :: * -> *) a. Monad m => a -> m a
return []
insertMany [record]
vals = SqlPersistT m [Key record] -> ReaderT (SqlFor a) m [Key record]
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m [Key record] -> ReaderT (SqlFor a) m [Key record])
-> SqlPersistT m [Key record] -> ReaderT (SqlFor a) m [Key record]
forall a b. (a -> b) -> a -> b
$ do
SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
case SqlBackend
-> Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
connInsertManySql SqlBackend
conn of
Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
Nothing -> (SqlBackend -> SqlFor a)
-> ReaderT (SqlFor a) m [Key record] -> SqlPersistT m [Key record]
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlBackend -> SqlFor a
forall db. SqlBackend -> SqlFor db
SqlFor (ReaderT (SqlFor a) m [Key record] -> SqlPersistT m [Key record])
-> ReaderT (SqlFor a) m [Key record] -> SqlPersistT m [Key record]
forall a b. (a -> b) -> a -> b
$ (record -> ReaderT (SqlFor a) m (Key record))
-> [record] -> ReaderT (SqlFor a) m [Key record]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM record -> ReaderT (SqlFor a) m (Key record)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert [record]
vals
Just EntityDef -> [[PersistValue]] -> InsertSqlResult
insertManyFn ->
case EntityDef -> [[PersistValue]] -> InsertSqlResult
insertManyFn EntityDef
ent [[PersistValue]]
valss of
ISRSingle Text
sql -> Text -> [PersistValue] -> SqlPersistT m [Key record]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
sql ([[PersistValue]] -> [PersistValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PersistValue]]
valss)
InsertSqlResult
_ -> String -> SqlPersistT m [Key record]
forall a. HasCallStack => String -> a
error String
"ISRSingle is expected from the connInsertManySql function"
where
ent :: EntityDef
ent = [record] -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef [record]
vals
valss :: [[PersistValue]]
valss = (record -> [PersistValue]) -> [record] -> [[PersistValue]]
forall a b. (a -> b) -> [a] -> [b]
map ((PersistValue -> PersistValue) -> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue ([PersistValue] -> [PersistValue])
-> (record -> [PersistValue]) -> record -> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
toPersistFields) [record]
vals
insertEntityMany :: [Entity record] -> ReaderT (SqlFor a) m ()
insertEntityMany [Entity record]
es' = SqlPersistT m () -> ReaderT (SqlFor a) m ()
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m () -> ReaderT (SqlFor a) m ())
-> SqlPersistT m () -> ReaderT (SqlFor a) m ()
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 entDef :: EntityDef
entDef = [record] -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef ([record] -> EntityDef) -> [record] -> EntityDef
forall a b. (a -> b) -> a -> b
$ (Entity record -> record) -> [Entity record] -> [record]
forall a b. (a -> b) -> [a] -> [b]
map Entity record -> record
forall record. Entity record -> record
entityVal [Entity record]
es'
let columnNames :: NonEmpty Text
columnNames = EntityDef -> SqlBackend -> NonEmpty Text
keyAndEntityColumnNames EntityDef
entDef SqlBackend
conn
Int
-> ([Entity record] -> SqlPersistT m ())
-> [Entity record]
-> SqlPersistT m ()
forall (m :: * -> *) a.
Monad m =>
Int
-> ([a] -> ReaderT SqlBackend m ())
-> [a]
-> ReaderT SqlBackend m ()
runChunked (NonEmpty Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Text
columnNames) [Entity record] -> SqlPersistT m ()
go [Entity record]
es'
where
go :: [Entity record] -> SqlPersistT m ()
go = Text -> [Entity record] -> SqlPersistT m ()
forall (m :: * -> *) val.
(MonadIO m, PersistEntity val) =>
Text -> [Entity val] -> ReaderT SqlBackend m ()
insrepHelper Text
"INSERT"
insertMany_ :: [record] -> ReaderT (SqlFor a) m ()
insertMany_ [] = () -> ReaderT (SqlFor a) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
insertMany_ [record]
vals0 = SqlPersistT m () -> ReaderT (SqlFor a) m ()
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m () -> ReaderT (SqlFor a) m ())
-> SqlPersistT m () -> ReaderT (SqlFor a) m ()
forall a b. (a -> b) -> a -> b
$ do
SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
case SqlBackend -> Maybe Int
connMaxParams SqlBackend
conn of
Maybe Int
Nothing -> [record] -> SqlPersistT m ()
insertMany_' [record]
vals0
Just Int
maxParams -> do
let chunkSize :: Int
chunkSize = Int
maxParams Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [FieldDef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (EntityDef -> [FieldDef]
getEntityFieldsDatabase EntityDef
t)
([record] -> SqlPersistT m ()) -> [[record]] -> SqlPersistT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [record] -> SqlPersistT m ()
insertMany_' (Int -> [record] -> [[record]]
forall a. Int -> [a] -> [[a]]
chunksOf Int
chunkSize [record]
vals0)
where
insertMany_' :: [record] -> SqlPersistT m ()
insertMany_' [record]
vals = do
SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let valss :: [[PersistValue]]
valss = (record -> [PersistValue]) -> [record] -> [[PersistValue]]
forall a b. (a -> b) -> [a] -> [b]
map ((PersistValue -> PersistValue) -> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue ([PersistValue] -> [PersistValue])
-> (record -> [PersistValue]) -> record -> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
toPersistFields) [record]
vals
let sql :: Text
sql = [Text] -> Text
Text.concat
[ Text
"INSERT INTO "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
t)
, Text
"("
, Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> (FieldDef -> Text) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text)
-> (FieldDef -> FieldNameDB) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> FieldNameDB
fieldDB) ([FieldDef] -> [Text]) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
getEntityFieldsDatabase EntityDef
t
, Text
") VALUES ("
, Text -> [Text] -> Text
Text.intercalate Text
"),(" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([[PersistValue]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[PersistValue]]
valss) (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldDef -> Text
forall a b. a -> b -> a
const Text
"?") (EntityDef -> [FieldDef]
getEntityFieldsDatabase EntityDef
t)
, Text
")"
]
Text -> [PersistValue] -> SqlPersistT m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute Text
sql ([[PersistValue]] -> [PersistValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PersistValue]]
valss)
t :: EntityDef
t = [record] -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef [record]
vals0
replace :: Key record -> record -> ReaderT (SqlFor a) m ()
replace Key record
k record
val = do
SqlBackend
conn <- (SqlFor a -> SqlBackend) -> ReaderT (SqlFor a) m SqlBackend
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SqlFor a -> SqlBackend
forall db. SqlFor db -> SqlBackend
unSqlFor
let 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
$ record -> Maybe record
forall a. a -> Maybe a
Just record
val
let wher :: Text
wher = SqlBackend -> Key record -> Text
forall record.
PersistEntity record =>
SqlBackend -> Key record -> Text
whereStmtForKey SqlBackend
conn Key record
k
let sql :: Text
sql = [Text] -> Text
Text.concat
[ Text
"UPDATE "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
t)
, Text
" SET "
, Text -> [Text] -> Text
Text.intercalate Text
"," ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SqlBackend -> Text -> Text
go SqlBackend
conn (Text -> Text) -> (FieldDef -> Text) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text)
-> (FieldDef -> FieldNameDB) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> FieldNameDB
fieldDB) ([FieldDef] -> [Text]) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
getEntityFieldsDatabase EntityDef
t)
, Text
" WHERE "
, Text
wher
]
vals :: [PersistValue]
vals = (PersistValue -> PersistValue) -> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
toPersistFields record
val) [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. Monoid a => a -> a -> a
`mappend` Key record -> [PersistValue]
forall record. PersistEntity record => Key record -> [PersistValue]
keyToValues Key record
k
SqlPersistT m () -> ReaderT (SqlFor a) m ()
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m () -> ReaderT (SqlFor a) m ())
-> SqlPersistT m () -> ReaderT (SqlFor a) m ()
forall a b. (a -> b) -> a -> b
$ Text -> [PersistValue] -> SqlPersistT m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute Text
sql [PersistValue]
vals
where
go :: SqlBackend -> Text -> Text
go SqlBackend
conn Text
x = SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn Text
x Text -> Text -> Text
`Text.append` Text
"=?"
insertKey :: Key record -> record -> ReaderT (SqlFor a) m ()
insertKey Key record
k record
v = SqlPersistT m () -> ReaderT (SqlFor a) m ()
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m () -> ReaderT (SqlFor a) m ())
-> SqlPersistT m () -> ReaderT (SqlFor a) m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Entity record] -> SqlPersistT m ()
forall (m :: * -> *) val.
(MonadIO m, PersistEntity val) =>
Text -> [Entity val] -> ReaderT SqlBackend m ()
insrepHelper Text
"INSERT" [Key record -> record -> Entity record
forall record. Key record -> record -> Entity record
Entity Key record
k record
v]
repsert :: Key record -> record -> ReaderT (SqlFor a) m ()
repsert Key record
key record
value = do
Maybe record
mExisting <- Key record -> ReaderT (SqlFor a) m (Maybe record)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key record
key
case Maybe record
mExisting of
Maybe record
Nothing -> Key record -> record -> ReaderT (SqlFor a) m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
insertKey Key record
key record
value
Just record
_ -> Key record -> record -> ReaderT (SqlFor a) m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
replace Key record
key record
value
delete :: Key record -> ReaderT (SqlFor a) m ()
delete Key record
k = do
SqlBackend
conn <- (SqlFor a -> SqlBackend) -> ReaderT (SqlFor a) m SqlBackend
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SqlFor a -> SqlBackend
forall db. SqlFor db -> SqlBackend
unSqlFor
SqlPersistT m () -> ReaderT (SqlFor a) m ()
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m () -> ReaderT (SqlFor a) m ())
-> SqlPersistT m () -> ReaderT (SqlFor a) m ()
forall a b. (a -> b) -> a -> b
$ Text -> [PersistValue] -> SqlPersistT m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute (SqlBackend -> Text
sql SqlBackend
conn) (Key record -> [PersistValue]
forall record. PersistEntity record => Key record -> [PersistValue]
keyToValues Key record
k)
where
wher :: SqlBackend -> Text
wher SqlBackend
conn = SqlBackend -> Key record -> Text
forall record.
PersistEntity record =>
SqlBackend -> Key record -> Text
whereStmtForKey SqlBackend
conn Key record
k
sql :: SqlBackend -> Text
sql SqlBackend
conn = [Text] -> Text
Text.concat
[ Text
"DELETE FROM "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ record -> EntityNameDB
forall record. PersistEntity record => record -> EntityNameDB
tableDBName (record -> EntityNameDB) -> record -> EntityNameDB
forall a b. (a -> b) -> a -> b
$ Key record -> record
forall record. Key record -> record
recordTypeFromKey Key record
k
, Text
" WHERE "
, SqlBackend -> Text
wher SqlBackend
conn
]
instance PersistQueryRead (SqlFor a) where
exists :: [Filter record] -> ReaderT (SqlFor a) m Bool
exists [Filter record]
filts =
(Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) (Int -> Bool)
-> ReaderT (SqlFor a) m Int -> ReaderT (SqlFor a) m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter record] -> ReaderT (SqlFor a) m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter record]
filts
count :: [Filter record] -> ReaderT (SqlFor a) m Int
count [Filter record]
filts = SqlPersistT m Int -> ReaderT (SqlFor a) m Int
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m Int -> ReaderT (SqlFor a) m Int)
-> SqlPersistT m Int -> ReaderT (SqlFor a) m Int
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 record] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Filter record]
filts
then Text
""
else Maybe FilterTablePrefix -> SqlBackend -> [Filter record] -> Text
forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause Maybe FilterTablePrefix
forall a. Maybe a
Nothing SqlBackend
conn [Filter record]
filts
let sql :: Text
sql = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"SELECT COUNT(*) FROM "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
t
, Text
wher
]
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO Int
-> SqlPersistT m Int
forall (m :: * -> *) a.
MonadIO m =>
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> ReaderT SqlBackend m a
withRawQuery Text
sql (SqlFor a -> [Filter record] -> [PersistValue]
forall val a.
(PersistEntity val, PersistEntityBackend val ~ SqlFor a) =>
SqlFor a -> [Filter val] -> [PersistValue]
getFiltsValues (SqlBackend -> SqlFor a
forall db. SqlBackend -> SqlFor db
SqlFor SqlBackend
conn) [Filter record]
filts) (ConduitM [PersistValue] Void IO Int -> SqlPersistT m Int)
-> ConduitM [PersistValue] Void IO Int -> SqlPersistT 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)
Just [PersistByteString ByteString
i] -> case ByteString -> Maybe (Integer, ByteString)
readInteger ByteString
i of
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 -> String -> ConduitM [PersistValue] Void IO Int
forall a. HasCallStack => String -> a
error (String -> ConduitM [PersistValue] Void IO Int)
-> String -> ConduitM [PersistValue] Void IO Int
forall a b. (a -> b) -> a -> b
$ String
"invalid number i["String -> ShowS
forall a. [a] -> [a] -> [a]
++ByteString -> String
forall a. Show a => a -> String
show ByteString
iString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"] xs[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe (Integer, ByteString) -> String
forall a. Show a => a -> String
show Maybe (Integer, ByteString)
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
Just [PersistValue]
xs -> String -> ConduitM [PersistValue] Void IO Int
forall a. HasCallStack => String -> a
error (String -> ConduitM [PersistValue] Void IO Int)
-> String -> ConduitM [PersistValue] Void IO Int
forall a b. (a -> b) -> a -> b
$ String
"count:invalid sql return xs["String -> ShowS
forall a. [a] -> [a] -> [a]
++[PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
xsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"] sql["String -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show Text
sqlString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"]"
Maybe [PersistValue]
Nothing -> String -> ConduitM [PersistValue] Void IO Int
forall a. HasCallStack => String -> a
error (String -> ConduitM [PersistValue] Void IO Int)
-> String -> ConduitM [PersistValue] Void IO Int
forall a b. (a -> b) -> a -> b
$ String
"count:invalid sql returned nothing sql["String -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show Text
sqlString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"]"
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
(SqlFor a) m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts = SqlPersistT m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
(SqlFor a) m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
(SqlFor a) m1 (Acquire (ConduitM () (Entity record) m2 ())))
-> SqlPersistT m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
(SqlFor a) m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall a b. (a -> b) -> a -> b
$ 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) (SqlFor a -> [Filter record] -> [PersistValue]
forall val a.
(PersistEntity val, PersistEntityBackend val ~ SqlFor a) =>
SqlFor a -> [Filter val] -> [PersistValue]
getFiltsValues (SqlBackend -> SqlFor a
forall db. SqlBackend -> SqlFor db
SqlFor SqlBackend
conn) [Filter record]
filts)
Acquire (ConduitM () (Entity record) m2 ())
-> SqlPersistT m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Acquire (ConduitM () (Entity record) m2 ())
-> SqlPersistT m1 (Acquire (ConduitM () (Entity record) m2 ())))
-> Acquire (ConduitM () (Entity record) m2 ())
-> SqlPersistT 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 Maybe FilterTablePrefix -> SqlBackend -> [Filter record] -> Text
forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause Maybe FilterTablePrefix
forall a. Maybe a
Nothing SqlBackend
conn [Filter record]
filts
ord :: SqlFor a -> Text
ord SqlFor a
conn =
case (SelectOpt record -> Text) -> [SelectOpt record] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> SqlFor a -> SelectOpt record -> Text
forall val a.
(PersistEntity val, PersistEntityBackend val ~ SqlFor a) =>
Bool -> SqlFor a -> SelectOpt val -> Text
orderClause Bool
False SqlFor a
conn) [SelectOpt record]
orders of
[] -> Text
""
[Text]
ords -> Text
" ORDER BY " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
ords
cols :: SqlBackend -> Text
cols = Text -> [Text] -> Text
Text.intercalate Text
", " ([Text] -> Text) -> (SqlBackend -> [Text]) -> SqlBackend -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text])
-> (SqlBackend -> NonEmpty Text) -> SqlBackend -> [Text]
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) (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 -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
t
, SqlBackend -> Text
wher SqlBackend
conn
, SqlFor a -> Text
ord (SqlBackend -> SqlFor a
forall db. SqlBackend -> SqlFor db
SqlFor SqlBackend
conn)
]
selectKeysRes :: [Filter record]
-> [SelectOpt record]
-> ReaderT (SqlFor a) m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts = SqlPersistT m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT (SqlFor a) m1 (Acquire (ConduitM () (Key record) m2 ()))
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT
(SqlFor a) m1 (Acquire (ConduitM () (Key record) m2 ())))
-> SqlPersistT m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT (SqlFor a) m1 (Acquire (ConduitM () (Key record) m2 ()))
forall a b. (a -> b) -> a -> b
$ 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) (SqlFor a -> [Filter record] -> [PersistValue]
forall val a.
(PersistEntity val, PersistEntityBackend val ~ SqlFor a) =>
SqlFor a -> [Filter val] -> [PersistValue]
getFiltsValues (SqlBackend -> SqlFor a
forall db. SqlBackend -> SqlFor db
SqlFor SqlBackend
conn) [Filter record]
filts)
Acquire (ConduitM () (Key record) m2 ())
-> SqlPersistT m1 (Acquire (ConduitM () (Key record) m2 ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Acquire (ConduitM () (Key record) m2 ())
-> SqlPersistT m1 (Acquire (ConduitM () (Key record) m2 ())))
-> Acquire (ConduitM () (Key record) m2 ())
-> SqlPersistT 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
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ SqlBackend -> EntityDef -> NonEmpty 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 Maybe FilterTablePrefix -> SqlBackend -> [Filter record] -> Text
forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause Maybe FilterTablePrefix
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) (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 -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName 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 -> SqlFor a -> SelectOpt record -> Text
forall val a.
(PersistEntity val, PersistEntityBackend val ~ SqlFor a) =>
Bool -> SqlFor a -> SelectOpt val -> Text
orderClause Bool
False (SqlBackend -> SqlFor a
forall db. SqlBackend -> SqlFor db
SqlFor 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
Text.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)]
[PersistValue]
_ -> [PersistValue] -> m2 [PersistValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [PersistValue]
xs
Just CompositeDef
pdef ->
let pks :: [FieldNameHS]
pks = (FieldDef -> FieldNameHS) -> [FieldDef] -> [FieldNameHS]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> FieldNameHS
fieldHaskell ([FieldDef] -> [FieldNameHS]) -> [FieldDef] -> [FieldNameHS]
forall a b. (a -> b) -> a -> b
$ NonEmpty FieldDef -> [FieldDef]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldDef -> [FieldDef])
-> NonEmpty FieldDef -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty FieldDef
compositeFields CompositeDef
pdef
keyvals :: [PersistValue]
keyvals = ((FieldNameHS, PersistValue) -> PersistValue)
-> [(FieldNameHS, PersistValue)] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map (FieldNameHS, PersistValue) -> PersistValue
forall a b. (a, b) -> b
snd ([(FieldNameHS, PersistValue)] -> [PersistValue])
-> [(FieldNameHS, PersistValue)] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ ((FieldNameHS, PersistValue) -> Bool)
-> [(FieldNameHS, PersistValue)] -> [(FieldNameHS, PersistValue)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(FieldNameHS
a, PersistValue
_) -> let ret :: Bool
ret=Maybe FieldNameHS -> Bool
forall a. Maybe a -> Bool
isJust ((FieldNameHS -> Bool) -> [FieldNameHS] -> Maybe FieldNameHS
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (FieldNameHS -> FieldNameHS -> Bool
forall a. Eq a => a -> a -> Bool
== FieldNameHS
a) [FieldNameHS]
pks) in Bool
ret) ([(FieldNameHS, PersistValue)] -> [(FieldNameHS, PersistValue)])
-> [(FieldNameHS, PersistValue)] -> [(FieldNameHS, PersistValue)]
forall a b. (a -> b) -> a -> b
$ [FieldNameHS] -> [PersistValue] -> [(FieldNameHS, PersistValue)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((FieldDef -> FieldNameHS) -> [FieldDef] -> [FieldNameHS]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> FieldNameHS
fieldHaskell ([FieldDef] -> [FieldNameHS]) -> [FieldDef] -> [FieldNameHS]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
getEntityFieldsDatabase 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 -> String -> m2 (Key record)
forall a. HasCallStack => String -> a
error (String -> m2 (Key record)) -> String -> m2 (Key record)
forall a b. (a -> b) -> a -> b
$ String
"selectKeysImpl: keyFromValues failed" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
err
instance PersistUniqueWrite (SqlFor db) where
upsertBy :: Unique record
-> record
-> [Update record]
-> ReaderT (SqlFor db) m (Entity record)
upsertBy Unique record
uniqueKey record
record [Update record]
updates = SqlPersistT m (Entity record)
-> ReaderT (SqlFor db) m (Entity record)
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m (Entity record)
-> ReaderT (SqlFor db) m (Entity record))
-> SqlPersistT m (Entity record)
-> ReaderT (SqlFor db) m (Entity record)
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 escape :: Text -> Text
escape = SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn
let refCol :: Text -> Text
refCol Text
n = [Text] -> Text
Text.concat [Text -> Text
escape (EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
t), Text
".", Text
n]
let mkUpdateFieldText :: Update record -> Text
mkUpdateFieldText = (FieldNameDB -> Text) -> (Text -> Text) -> Update record -> Text
forall record.
PersistEntity record =>
(FieldNameDB -> Text) -> (Text -> Text) -> Update record -> Text
mkUpdateText' (Text -> Text
escape (Text -> Text) -> (FieldNameDB -> Text) -> FieldNameDB -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNameDB -> Text
unFieldNameDB) Text -> Text
refCol
case SqlBackend
-> Maybe
(EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text)
connUpsertSql SqlBackend
conn of
Just EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql -> case [Update record]
updates of
[] -> ReaderT (SqlFor db) m (Entity record)
-> SqlPersistT m (Entity record)
forall db (m :: * -> *) a. SqlPersistTFor db m a -> SqlPersistT m a
generalizeQuery (ReaderT (SqlFor db) m (Entity record)
-> SqlPersistT m (Entity record))
-> ReaderT (SqlFor db) m (Entity record)
-> SqlPersistT m (Entity record)
forall a b. (a -> b) -> a -> b
$ Unique record
-> record
-> [Update record]
-> ReaderT (SqlFor db) m (Entity record)
forall record backend (m :: * -> *).
(PersistEntityBackend record ~ backend, PersistEntity record,
BaseBackend backend ~ backend,
BackendCompatible SqlBackend backend, MonadIO m,
PersistStoreWrite backend, PersistUniqueRead backend,
MySafeToInsert record) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
defaultUpsertBy Unique record
uniqueKey record
record [Update record]
updates
Update record
_:[Update record]
_ -> do
let upds :: Text
upds = Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Update record -> Text) -> [Update record] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Update record -> Text
mkUpdateFieldText [Update record]
updates
sql :: Text
sql = EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql EntityDef
t (Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
forall record.
PersistEntity record =>
Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
persistUniqueToFieldNames Unique record
uniqueKey) Text
upds
vals :: [PersistValue]
vals = (PersistValue -> PersistValue) -> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
toPersistFields record
record)
[PersistValue] -> [PersistValue] -> [PersistValue]
forall a. [a] -> [a] -> [a]
++ (Update record -> PersistValue)
-> [Update record] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map Update record -> PersistValue
forall v. Update v -> PersistValue
updatePersistValue [Update record]
updates
[PersistValue] -> [PersistValue] -> [PersistValue]
forall a. [a] -> [a] -> [a]
++ Unique record -> [PersistValue]
forall record.
PersistEntity record =>
Unique record -> [PersistValue]
unqs Unique record
uniqueKey
[Entity record]
x <- Text -> [PersistValue] -> ReaderT SqlBackend m [Entity record]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
sql [PersistValue]
vals
Entity record -> SqlPersistT m (Entity record)
forall (m :: * -> *) a. Monad m => a -> m a
return (Entity record -> SqlPersistT m (Entity record))
-> Entity record -> SqlPersistT m (Entity record)
forall a b. (a -> b) -> a -> b
$ [Entity record] -> Entity record
forall a. [a] -> a
head [Entity record]
x
Maybe
(EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text)
Nothing -> ReaderT (SqlFor db) m (Entity record)
-> SqlPersistT m (Entity record)
forall db (m :: * -> *) a. SqlPersistTFor db m a -> SqlPersistT m a
generalizeQuery (ReaderT (SqlFor db) m (Entity record)
-> SqlPersistT m (Entity record))
-> ReaderT (SqlFor db) m (Entity record)
-> SqlPersistT m (Entity record)
forall a b. (a -> b) -> a -> b
$ Unique record
-> record
-> [Update record]
-> ReaderT (SqlFor db) m (Entity record)
forall record backend (m :: * -> *).
(PersistEntityBackend record ~ backend, PersistEntity record,
BaseBackend backend ~ backend,
BackendCompatible SqlBackend backend, MonadIO m,
PersistStoreWrite backend, PersistUniqueRead backend,
MySafeToInsert record) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
defaultUpsertBy Unique record
uniqueKey record
record [Update record]
updates
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
$ record -> Maybe record
forall a. a -> Maybe a
Just record
record
unqs :: Unique record -> [PersistValue]
unqs Unique record
uniqueKey' = (Unique record -> [PersistValue])
-> [Unique record] -> [PersistValue]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Unique record -> [PersistValue]
forall record.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues [Unique record
uniqueKey']
deleteBy :: Unique record -> ReaderT (SqlFor db) m ()
deleteBy Unique record
uniq = SqlPersistT m () -> ReaderT (SqlFor db) m ()
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m () -> ReaderT (SqlFor db) m ())
-> SqlPersistT m () -> ReaderT (SqlFor db) m ()
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 sql' :: Text
sql' = SqlBackend -> Text
sql SqlBackend
conn
vals :: [PersistValue]
vals = Unique record -> [PersistValue]
forall record.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues Unique record
uniq
Text -> [PersistValue] -> SqlPersistT m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute Text
sql' [PersistValue]
vals
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
$ Unique record -> Maybe record
forall v. Unique v -> Maybe v
dummyFromUnique Unique record
uniq
go :: Unique record -> [FieldNameDB]
go = ((FieldNameHS, FieldNameDB) -> FieldNameDB)
-> [(FieldNameHS, FieldNameDB)] -> [FieldNameDB]
forall a b. (a -> b) -> [a] -> [b]
map (FieldNameHS, FieldNameDB) -> FieldNameDB
forall a b. (a, b) -> b
snd ([(FieldNameHS, FieldNameDB)] -> [FieldNameDB])
-> (Unique record -> [(FieldNameHS, FieldNameDB)])
-> Unique record
-> [FieldNameDB]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (FieldNameHS, FieldNameDB) -> [(FieldNameHS, FieldNameDB)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (FieldNameHS, FieldNameDB)
-> [(FieldNameHS, FieldNameDB)])
-> (Unique record -> NonEmpty (FieldNameHS, FieldNameDB))
-> Unique record
-> [(FieldNameHS, FieldNameDB)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
forall record.
PersistEntity record =>
Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
persistUniqueToFieldNames
go' :: SqlBackend -> FieldNameDB -> Text
go' SqlBackend
conn FieldNameDB
x = SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (FieldNameDB -> Text
unFieldNameDB FieldNameDB
x) Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"=?"
sql :: SqlBackend -> Text
sql SqlBackend
conn =
[Text] -> Text
Text.concat
[ Text
"DELETE FROM "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
t
, Text
" WHERE "
, Text -> [Text] -> Text
Text.intercalate Text
" AND " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldNameDB -> Text) -> [FieldNameDB] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SqlBackend -> FieldNameDB -> Text
go' SqlBackend
conn) ([FieldNameDB] -> [Text]) -> [FieldNameDB] -> [Text]
forall a b. (a -> b) -> a -> b
$ Unique record -> [FieldNameDB]
go Unique record
uniq]
instance PersistUniqueRead (SqlFor a) where
getBy :: Unique record -> ReaderT (SqlFor a) m (Maybe (Entity record))
getBy Unique record
uniq = SqlPersistT m (Maybe (Entity record))
-> ReaderT (SqlFor a) m (Maybe (Entity record))
forall db (m :: * -> *) a. SqlPersistT m a -> SqlPersistTFor db m a
specializeQuery (SqlPersistT m (Maybe (Entity record))
-> ReaderT (SqlFor a) m (Maybe (Entity record)))
-> SqlPersistT m (Maybe (Entity record))
-> ReaderT (SqlFor a) m (Maybe (Entity record))
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 sql :: Text
sql =
[Text] -> Text
Text.concat
[ Text
"SELECT "
, Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ SqlBackend -> EntityDef -> NonEmpty Text
dbColumns SqlBackend
conn EntityDef
t
, Text
" FROM "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
t
, Text
" WHERE "
, SqlBackend -> Text
sqlClause SqlBackend
conn]
uvals :: [PersistValue]
uvals = Unique record -> [PersistValue]
forall record.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues Unique record
uniq
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
-> SqlPersistT m (Maybe (Entity record))
forall (m :: * -> *) a.
MonadIO m =>
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> ReaderT SqlBackend m a
withRawQuery Text
sql [PersistValue]
uvals (ConduitM [PersistValue] Void IO (Maybe (Entity record))
-> SqlPersistT m (Maybe (Entity record)))
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
-> SqlPersistT m (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$
do Maybe [PersistValue]
row <- ConduitT [PersistValue] Void IO (Maybe [PersistValue])
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
case Maybe [PersistValue]
row of
Maybe [PersistValue]
Nothing -> Maybe (Entity record)
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Entity record)
forall a. Maybe a
Nothing
Just [] -> String -> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall a. HasCallStack => String -> a
error String
"getBy: empty row"
Just [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
err ->
IO (Maybe (Entity record))
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Entity record))
-> ConduitM [PersistValue] Void IO (Maybe (Entity record)))
-> IO (Maybe (Entity record))
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ PersistException -> IO (Maybe (Entity record))
forall e a. Exception e => e -> IO a
throwIO (PersistException -> IO (Maybe (Entity record)))
-> PersistException -> IO (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ Text -> PersistException
PersistMarshalError Text
err
Right Entity record
r -> Maybe (Entity record)
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Entity record)
-> ConduitM [PersistValue] Void IO (Maybe (Entity record)))
-> Maybe (Entity record)
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ Entity record -> Maybe (Entity record)
forall a. a -> Maybe a
Just Entity record
r
where
sqlClause :: SqlBackend -> Text
sqlClause SqlBackend
conn =
Text -> [Text] -> Text
Text.intercalate Text
" AND " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldNameDB -> Text) -> [FieldNameDB] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SqlBackend -> Text -> Text
go SqlBackend
conn (Text -> Text) -> (FieldNameDB -> Text) -> FieldNameDB -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNameDB -> Text
unFieldNameDB) ([FieldNameDB] -> [Text]) -> [FieldNameDB] -> [Text]
forall a b. (a -> b) -> a -> b
$ Unique record -> [FieldNameDB]
toFieldNames' Unique record
uniq
go :: SqlBackend -> Text -> Text
go SqlBackend
conn Text
x = SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn Text
x Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"=?"
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
$ Unique record -> Maybe record
forall v. Unique v -> Maybe v
dummyFromUnique Unique record
uniq
toFieldNames' :: Unique record -> [FieldNameDB]
toFieldNames' = ((FieldNameHS, FieldNameDB) -> FieldNameDB)
-> [(FieldNameHS, FieldNameDB)] -> [FieldNameDB]
forall a b. (a -> b) -> [a] -> [b]
map (FieldNameHS, FieldNameDB) -> FieldNameDB
forall a b. (a, b) -> b
snd ([(FieldNameHS, FieldNameDB)] -> [FieldNameDB])
-> (Unique record -> [(FieldNameHS, FieldNameDB)])
-> Unique record
-> [FieldNameDB]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (FieldNameHS, FieldNameDB) -> [(FieldNameHS, FieldNameDB)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (FieldNameHS, FieldNameDB)
-> [(FieldNameHS, FieldNameDB)])
-> (Unique record -> NonEmpty (FieldNameHS, FieldNameDB))
-> Unique record
-> [(FieldNameHS, FieldNameDB)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
forall record.
PersistEntity record =>
Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
persistUniqueToFieldNames
instance PersistQueryWrite (SqlFor db) where
deleteWhere :: [Filter record] -> ReaderT (SqlFor db) m ()
deleteWhere [Filter record]
filts = do
Int64
_ <- [Filter record] -> ReaderT (SqlFor db) m Int64
forall val (m :: * -> *) db.
(PersistEntity val, MonadIO m,
PersistEntityBackend val ~ SqlFor db) =>
[Filter val] -> ReaderT (SqlFor db) m Int64
deleteWhereCount [Filter record]
filts
() -> ReaderT (SqlFor db) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateWhere :: [Filter record] -> [Update record] -> ReaderT (SqlFor db) m ()
updateWhere [Filter record]
filts [Update record]
upds = do
Int64
_ <- [Filter record] -> [Update record] -> ReaderT (SqlFor db) m Int64
forall val (m :: * -> *) db.
(PersistEntity val, MonadIO m,
SqlFor db ~ PersistEntityBackend val) =>
[Filter val] -> [Update val] -> ReaderT (SqlFor db) m Int64
updateWhereCount [Filter record]
filts [Update record]
upds
() -> ReaderT (SqlFor db) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
deleteWhereCount :: (PersistEntity val, MonadIO m, PersistEntityBackend val ~ SqlFor db)
=> [Filter val]
-> ReaderT (SqlFor db) m Int64
deleteWhereCount :: [Filter val] -> ReaderT (SqlFor db) m Int64
deleteWhereCount [Filter val]
filts = (SqlFor db -> SqlBackend)
-> ReaderT SqlBackend m Int64 -> ReaderT (SqlFor db) m Int64
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlFor db -> SqlBackend
forall db. SqlFor db -> SqlBackend
unSqlFor (ReaderT SqlBackend m Int64 -> ReaderT (SqlFor db) m Int64)
-> ReaderT SqlBackend m Int64 -> ReaderT (SqlFor db) 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 Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause Maybe FilterTablePrefix
forall a. Maybe a
Nothing SqlBackend
conn [Filter val]
filts
sql :: Text
sql = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"DELETE FROM "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName 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
$ SqlFor db -> [Filter val] -> [PersistValue]
forall val a.
(PersistEntity val, PersistEntityBackend val ~ SqlFor a) =>
SqlFor a -> [Filter val] -> [PersistValue]
getFiltsValues (SqlBackend -> SqlFor db
forall db. SqlBackend -> SqlFor db
SqlFor SqlBackend
conn) [Filter val]
filts
updateWhereCount :: (PersistEntity val, MonadIO m, SqlFor db ~ PersistEntityBackend val)
=> [Filter val]
-> [Update val]
-> ReaderT (SqlFor db) m Int64
updateWhereCount :: [Filter val] -> [Update val] -> ReaderT (SqlFor db) m Int64
updateWhereCount [Filter val]
_ [] = Int64 -> ReaderT (SqlFor db) m Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
0
updateWhereCount [Filter val]
filts [Update val]
upds = (SqlFor db -> SqlBackend)
-> ReaderT SqlBackend m Int64 -> ReaderT (SqlFor db) m Int64
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT SqlFor db -> SqlBackend
forall db. SqlFor db -> SqlBackend
unSqlFor (ReaderT SqlBackend m Int64 -> ReaderT (SqlFor db) m Int64)
-> ReaderT SqlBackend m Int64 -> ReaderT (SqlFor db) 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 Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
forall val.
PersistEntity val =>
Maybe FilterTablePrefix -> SqlBackend -> [Filter val] -> Text
filterClause Maybe FilterTablePrefix
forall a. Maybe a
Nothing SqlBackend
conn [Filter val]
filts
let sql :: Text
sql = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"UPDATE "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
t
, Text
" SET "
, Text -> [Text] -> Text
Text.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 -> (Text, PersistUpdate) -> Text
go' SqlBackend
conn ((Text, PersistUpdate) -> Text)
-> (Update val -> (Text, PersistUpdate)) -> Update val -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Update val -> (Text, PersistUpdate)
forall record a.
(PersistEntity record, PersistEntityBackend record ~ SqlFor a) =>
Update record -> (Text, PersistUpdate)
go) [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`
SqlFor db -> [Filter val] -> [PersistValue]
forall val a.
(PersistEntity val, PersistEntityBackend val ~ SqlFor a) =>
SqlFor a -> [Filter val] -> [PersistValue]
getFiltsValues (SqlBackend -> SqlFor db
forall db. SqlBackend -> SqlFor db
SqlFor 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
go'' :: a -> PersistUpdate -> a
go'' a
n PersistUpdate
Assign = a
n a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"=?"
go'' a
n PersistUpdate
Add = [a] -> a
forall a. Monoid a => [a] -> a
mconcat [a
n, a
"=", a
n, a
"+?"]
go'' a
n PersistUpdate
Subtract = [a] -> a
forall a. Monoid a => [a] -> a
mconcat [a
n, a
"=", a
n, a
"-?"]
go'' a
n PersistUpdate
Multiply = [a] -> a
forall a. Monoid a => [a] -> a
mconcat [a
n, a
"=", a
n, a
"*?"]
go'' a
n PersistUpdate
Divide = [a] -> a
forall a. Monoid a => [a] -> a
mconcat [a
n, a
"=", a
n, a
"/?"]
go'' a
_ (BackendSpecificUpdate Text
up) = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"BackendSpecificUpdate" Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
up Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"not supported"
go' :: SqlBackend -> (Text, PersistUpdate) -> Text
go' SqlBackend
conn (Text
x, PersistUpdate
pu) = Text -> PersistUpdate -> Text
forall a. (IsString a, Monoid a) => a -> PersistUpdate -> a
go'' (SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn Text
x) PersistUpdate
pu
go :: Update record -> (Text, PersistUpdate)
go Update record
x = (Update record -> Text
forall record a.
(PersistEntity record, PersistEntityBackend record ~ SqlFor a) =>
Update record -> Text
updateField' Update record
x, Update record -> PersistUpdate
forall record. Update record -> PersistUpdate
updateUpdate Update record
x)
updateField' :: Update record -> Text
updateField' (Update EntityField record typ
f typ
_ PersistUpdate
_) = EntityField record typ -> Text
forall record typ a.
(PersistEntity record, PersistEntityBackend record ~ SqlFor a) =>
EntityField record typ -> Text
fieldName EntityField record typ
f
updateField' Update record
_ = String -> Text
forall a. HasCallStack => String -> a
error String
"BackendUpdate not implemented"
dummyFromKey :: Key record -> Maybe record
dummyFromKey :: Key record -> Maybe record
dummyFromKey = record -> Maybe record
forall a. a -> Maybe a
Just (record -> Maybe record)
-> (Key record -> record) -> Key record -> Maybe record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> record
forall record. Key record -> record
recordTypeFromKey
recordTypeFromKey :: Key record -> record
recordTypeFromKey :: Key record -> record
recordTypeFromKey Key record
_ = String -> record
forall a. HasCallStack => String -> a
error String
"dummyFromKey"
whereStmtForKey :: PersistEntity record => SqlBackend -> Key record -> Text
whereStmtForKey :: SqlBackend -> Key record -> Text
whereStmtForKey SqlBackend
conn Key record
k =
Text -> [Text] -> Text
Text.intercalate Text
" AND "
([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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=? ")
([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ SqlBackend -> EntityDef -> NonEmpty Text
dbIdColumns SqlBackend
conn EntityDef
entDef
where
entDef :: EntityDef
entDef = 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
$ Key record -> Maybe record
forall record. Key record -> Maybe record
dummyFromKey Key record
k
insrepHelper :: (MonadIO m, PersistEntity val)
=> Text
-> [Entity val]
-> ReaderT SqlBackend m ()
insrepHelper :: Text -> [Entity val] -> ReaderT SqlBackend m ()
insrepHelper Text
_ [] = () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
insrepHelper Text
command [Entity val]
es = do
SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let columnNames :: [Text]
columnNames = NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ EntityDef -> SqlBackend -> NonEmpty Text
keyAndEntityColumnNames EntityDef
entDef SqlBackend
conn
Text -> [PersistValue] -> ReaderT SqlBackend m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute (SqlBackend -> [Text] -> Text
sql SqlBackend
conn [Text]
columnNames) [PersistValue]
vals
where
entDef :: EntityDef
entDef = [val] -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef ([val] -> EntityDef) -> [val] -> EntityDef
forall a b. (a -> b) -> a -> b
$ (Entity val -> val) -> [Entity val] -> [val]
forall a b. (a -> b) -> [a] -> [b]
map Entity val -> val
forall record. Entity record -> record
entityVal [Entity val]
es
sql :: SqlBackend -> [Text] -> Text
sql SqlBackend
conn [Text]
columnNames = [Text] -> Text
Text.concat
[ Text
command
, Text
" INTO "
, SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
entDef)
, Text
"("
, Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
columnNames
, Text
") VALUES ("
, Text -> [Text] -> Text
Text.intercalate Text
"),(" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([Entity val] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entity val]
es) (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"," ([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 -> Text
forall a b. a -> b -> a
const Text
"?") [Text]
columnNames
, Text
")"
]
vals :: [PersistValue]
vals = (Entity val -> [PersistValue]) -> [Entity val] -> [PersistValue]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap Entity val -> [PersistValue]
forall record.
PersistEntity record =>
Entity record -> [PersistValue]
entityValues [Entity val]
es
data OrNull = OrNullYes | OrNullNo
filterClauseHelper :: (PersistEntity val, PersistEntityBackend val ~ SqlFor a)
=> Bool
-> Bool
-> SqlFor a
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
filterClauseHelper :: Bool
-> Bool
-> SqlFor a
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
filterClauseHelper Bool
includeTable Bool
includeWhere (SqlFor SqlBackend
conn) OrNull
orNull [Filter val]
filters =
(if Bool -> Bool
not (Text -> Bool
Text.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
Text.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
Text.concat [Text
"(", Text
x, Text
")"]
go :: Filter val -> (Text, [PersistValue])
go (BackendFilter BackendSpecificFilter (PersistEntityBackend val) val
_) = String -> (Text, [PersistValue])
forall a. HasCallStack => String -> a
error String
"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 NonEmpty FieldDef -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CompositeDef -> NonEmpty 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 String -> (Text, [PersistValue])
forall a. HasCallStack => String -> a
error (String -> (Text, [PersistValue]))
-> String -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$ String
"wrong number of entries in compositeFields vs PersistList allVals=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
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
Text.intercalate Text
" and " ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\FieldDef
a -> SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text) -> FieldNameDB -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> FieldNameDB
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
"? ") (NonEmpty FieldDef -> [FieldDef]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldDef -> [FieldDef])
-> NonEmpty FieldDef -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty 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
Text.intercalate Text
" or " ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\FieldDef
a -> SqlBackend -> Text -> Text
connEscapeRawName SqlBackend
conn (FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text) -> FieldNameDB -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> FieldNameDB
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
"? ") (NonEmpty FieldDef -> [FieldDef]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldDef -> [FieldDef])
-> NonEmpty FieldDef -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty 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 -> Text -> Text
connEscapeRawName SqlBackend
conn (FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text) -> FieldNameDB -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> FieldNameDB
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
Text.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 (NonEmpty FieldDef -> [FieldDef]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldDef -> [FieldDef])
-> NonEmpty FieldDef -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty FieldDef
compositeFields CompositeDef
pdef) [[PersistValue]]
xxs)
in (Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapSql (Text -> [Text] -> Text
Text.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 -> Text -> Text
connEscapeRawName SqlBackend
conn (FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text) -> FieldNameDB -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> FieldNameDB
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
Text.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 (NonEmpty FieldDef -> [FieldDef]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldDef -> [FieldDef])
-> NonEmpty FieldDef -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty FieldDef
compositeFields CompositeDef
pdef) [[PersistValue]]
xxs)
in (Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapSql (Text -> [Text] -> Text
Text.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 (NonEmpty FieldDef -> [FieldDef]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldDef -> [FieldDef])
-> NonEmpty FieldDef -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty 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
Text.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 -> Text -> Text
connEscapeRawName SqlBackend
conn (FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text) -> FieldNameDB -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> FieldNameDB
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
Text.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
_) -> String -> (Text, [PersistValue])
forall a. HasCallStack => String -> a
error String
"unhandled type BackendSpecificFilter for composite/non id primary keys"
([PersistValue], PersistFilter, Bool)
_ -> String -> (Text, [PersistValue])
forall a. HasCallStack => String -> a
error (String -> (Text, [PersistValue]))
-> String -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$ String
"unhandled type/filter for composite/non id primary keys pfilter=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PersistFilter -> String
forall a. Show a => a -> String
show PersistFilter
pfilter String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" persistList="String -> ShowS
forall a. [a] -> [a] -> [a]
++[PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
allVals
(Bool
True, Just CompositeDef
pdef, []) ->
String -> (Text, [PersistValue])
forall a. HasCallStack => String -> a
error (String -> (Text, [PersistValue]))
-> String -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$ String
"empty list given as filter value filter=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PersistFilter -> String
forall a. Show a => a -> String
show PersistFilter
pfilter String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" persistList=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
allVals String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" pdef=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CompositeDef -> String
forall a. Show a => a -> String
show CompositeDef
pdef
(Bool
True, Just CompositeDef
pdef, [PersistValue]
_) ->
String -> (Text, [PersistValue])
forall a. HasCallStack => String -> a
error (String -> (Text, [PersistValue]))
-> String -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$ String
"unhandled error for composite/non id primary keys filter=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PersistFilter -> String
forall a. Show a => a -> String
show PersistFilter
pfilter String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" persistList=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
allVals String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" pdef=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CompositeDef -> String
forall a. Show a => a -> String
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
Text.concat
[ Text
"("
, Text
name
, Text
" IS NULL OR "
, Text
name
, Text
" <> "
, Text
qmarks
, Text
")"
], [PersistValue]
notNullVals)
(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
Text.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
Text.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
Text.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 = String -> [PersistValue]
forall a. HasCallStack => String -> a
error (String -> [PersistValue]) -> String -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ String
"expected PersistList but found " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
other
filterValueToPersistValues :: forall a. PersistField a => FilterValue a -> [PersistValue]
filterValueToPersistValues :: FilterValue a -> [PersistValue]
filterValueToPersistValues FilterValue a
v = case FilterValue a
v of
FilterValue a
a -> (a -> PersistValue) -> [a] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map a -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue [a
a]
FilterValues [a]
as -> (a -> PersistValue) -> [a] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map a -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue [a]
as
UnsafeValue a
a -> (a -> PersistValue) -> [a] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map a -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue [a
a]
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 -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName
(EntityDef -> EntityNameDB) -> EntityDef -> EntityNameDB
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 -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityField val typ -> Text
forall record typ a.
(PersistEntity record, PersistEntityBackend record ~ SqlFor a) =>
EntityField record typ -> Text
fieldName EntityField val typ
field
qmarks :: Text
qmarks = case FilterValue typ
value of
FilterValues [typ]
x ->
let x' :: [PersistValue]
x' = (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]
x
in Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"," ((PersistValue -> Text) -> [PersistValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PersistValue -> Text
forall a b. a -> b -> a
const Text
"?") [PersistValue]
x') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
FilterValue typ
_ -> Text
"?"
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
dummyFromFilts :: [Filter v] -> Maybe v
dummyFromFilts :: [Filter v] -> Maybe v
dummyFromFilts [Filter v]
_ = Maybe v
forall a. Maybe a
Nothing
fieldName :: forall record typ a. (PersistEntity record, PersistEntityBackend record ~ SqlFor a) => EntityField record typ -> Text
fieldName :: EntityField record typ -> Text
fieldName EntityField record typ
f = FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text) -> FieldNameDB -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> FieldNameDB
fieldDB (FieldDef -> FieldNameDB) -> FieldDef -> FieldNameDB
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
getFiltsValues :: forall val a. (PersistEntity val, PersistEntityBackend val ~ SqlFor a)
=> SqlFor a -> [Filter val] -> [PersistValue]
getFiltsValues :: SqlFor a -> [Filter val] -> [PersistValue]
getFiltsValues SqlFor a
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
-> SqlFor a
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
forall val a.
(PersistEntity val, PersistEntityBackend val ~ SqlFor a) =>
Bool
-> Bool
-> SqlFor a
-> OrNull
-> [Filter val]
-> (Text, [PersistValue])
filterClauseHelper Bool
False Bool
False SqlFor a
conn OrNull
OrNullNo
orderClause :: (PersistEntity val, PersistEntityBackend val ~ SqlFor a)
=> Bool
-> SqlFor a
-> SelectOpt val
-> Text
orderClause :: Bool -> SqlFor a -> SelectOpt val -> Text
orderClause Bool
includeTable (SqlFor SqlBackend
conn) SelectOpt val
o =
case SelectOpt val
o of
Asc EntityField val typ
x -> EntityField val typ -> Text
forall record a typ.
(PersistEntityBackend record ~ SqlFor a, PersistEntity record) =>
EntityField record typ -> Text
name EntityField val typ
x
Desc EntityField val typ
x -> EntityField val typ -> Text
forall record a typ.
(PersistEntityBackend record ~ SqlFor a, 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
_ -> String -> Text
forall a. HasCallStack => String -> a
error String
"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 -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName (EntityDef -> EntityNameDB) -> EntityDef -> EntityNameDB
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 ~ SqlFor a, 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 -> Text -> Text
connEscapeRawName SqlBackend
conn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EntityField record typ -> Text
forall record typ a.
(PersistEntity record, PersistEntityBackend record ~ SqlFor a) =>
EntityField record typ -> Text
fieldName EntityField record typ
x
dummyFromUnique :: Unique v -> Maybe v
dummyFromUnique :: Unique v -> Maybe v
dummyFromUnique Unique v
_ = Maybe v
forall a. Maybe a
Nothing
runChunked
:: (Monad m)
=> Int
-> ([a] -> ReaderT SqlBackend m ())
-> [a]
-> ReaderT SqlBackend m ()
runChunked :: Int
-> ([a] -> ReaderT SqlBackend m ())
-> [a]
-> ReaderT SqlBackend m ()
runChunked Int
_ [a] -> ReaderT SqlBackend m ()
_ [] = () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runChunked Int
width [a] -> ReaderT SqlBackend m ()
m [a]
xs = do
SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
case SqlBackend -> Maybe Int
connMaxParams SqlBackend
conn of
Maybe Int
Nothing -> [a] -> ReaderT SqlBackend m ()
m [a]
xs
Just Int
maxParams -> let chunkSize :: Int
chunkSize = Int
maxParams Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
width in
([a] -> ReaderT SqlBackend m ())
-> [[a]] -> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [a] -> ReaderT SqlBackend m ()
m (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
chunksOf Int
chunkSize [a]
xs)
chunksOf :: Int -> [a] -> [[a]]
chunksOf :: Int -> [a] -> [[a]]
chunksOf Int
_ [] = []
chunksOf Int
size [a]
xs = let ([a]
chunk, [a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
size [a]
xs in [a]
chunk [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
chunksOf Int
size [a]
rest
defaultUpsertBy
:: ( PersistEntityBackend record ~ backend
, PersistEntity record
, BaseBackend backend ~ backend
, BackendCompatible SqlBackend backend
, MonadIO m
, PersistStoreWrite backend
, PersistUniqueRead backend
, MySafeToInsert record
)
=> Unique record
-> record
-> [Update record]
-> ReaderT backend m (Entity record)
defaultUpsertBy :: Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
defaultUpsertBy Unique record
uniqueKey record
record [Update record]
updates = do
Maybe (Entity record)
mrecord <- Unique record -> ReaderT backend m (Maybe (Entity record))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy Unique record
uniqueKey
ReaderT backend m (Entity record)
-> (Entity record -> ReaderT backend m (Entity record))
-> Maybe (Entity record)
-> ReaderT backend m (Entity record)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (record -> ReaderT backend m (Entity record)
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
SafeToInsert e, MonadIO m, HasCallStack) =>
e -> ReaderT backend m (Entity e)
insertEntity record
record) (Entity record
-> [Update record] -> ReaderT backend m (Entity record)
forall (m :: * -> *) backend record.
(MonadIO m, PersistStoreWrite backend, PersistEntity record,
PersistEntityBackend record ~ BaseBackend backend) =>
Entity record
-> [Update record] -> ReaderT backend m (Entity record)
`updateGetEntity` [Update record]
updates) Maybe (Entity record)
mrecord
where
updateGetEntity :: Entity record
-> [Update record] -> ReaderT backend m (Entity record)
updateGetEntity (Entity Key record
k record
_) [Update record]
upds =
(Key record -> record -> Entity record
forall record. Key record -> record -> Entity record
Entity Key record
k) (record -> Entity record)
-> ReaderT backend m record -> ReaderT backend m (Entity record)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Key record -> [Update record] -> ReaderT backend m record
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m record
updateGet Key record
k [Update record]
upds)
type MySafeToInsert a =
#if MIN_VERSION_persistent(2,14,0)
SafeToInsert a
#else
() :: Constraint
#endif