{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# language CPP #-}

-- | This module defines types and helpers for type-safe access to multiple
-- database schema.
module Database.Persist.Typed
    ( -- * Schema Definition
      mkSqlSettingsFor
    , SqlFor(..)
    , BackendKey(..)
      -- * Specialized aliases
    , SqlPersistTFor
    , ConnectionPoolFor
    , SqlPersistMFor
      -- * Running specialized queries
    , runSqlPoolFor
    , runSqlConnFor
      -- * Specializing and generalizing
    , generalizePool
    , specializePool
    , generalizeQuery
    , specializeQuery
    , generalizeSqlBackend
    , specializeSqlBackend
      -- * Key functions
    , 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

-- | A wrapper around 'SqlBackend' type. To specialize this to a specific
-- database, fill in the type parameter.
--
-- @since 0.0.1.0
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

-- | This type signature represents a database query for a specific database.
-- You will likely want to specialize this to your own application for
-- readability:
--
-- @
-- data MainDb
--
-- type MainQueryT = 'SqlPersistTFor' MainDb
--
-- getStuff :: 'MonadIO' m => StuffId -> MainQueryT m (Maybe Stuff)
-- @
--
-- @since 0.0.1.0
type SqlPersistTFor db = ReaderT (SqlFor db)

-- | A 'Pool' of database connections that are specialized to a specific
-- database.
--
-- @since 0.0.1.0
type ConnectionPoolFor db = Pool (SqlFor db)
--
-- | A specialization of 'SqlPersistM' that uses the underlying @db@ database
-- type.
--
-- @since 0.0.1.0
type SqlPersistMFor db = ReaderT (SqlFor db) (NoLoggingT (ResourceT IO))

-- | Specialize a query to a specific database. You should define aliases for
-- this function for each database you use.
--
-- @
-- data MainDb
--
-- data AccountDb
--
-- mainQuery :: 'ReaderT' 'SqlBackend' m a -> 'ReaderT' ('SqlFor' MainDb) m a
-- mainQuery = 'specializeQuery'
--
-- accountQuery :: 'ReaderT' 'SqlBackend' m a -> 'ReaderT' ('SqlFor' AccountDb) m a
-- accountQuery = 'specializeQuery'
-- @
--
-- @since 0.0.1.0
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

-- | Generalizes a query from a specific database to one that is database
-- agnostic.
--
-- @since 0.0.1.0
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

-- | Use the 'SqlFor' type for the database connection backend. Use this instead
-- of 'sqlSettings' and provide a quoted type name.
--
-- @
-- data MainDb
--
-- share [ mkPersist (mkSqlSettingsFor ''MainDb), mkMigrate "migrateAll" ] [persistLowerCase|
--
-- User
--     name Text
--     age  Int
--
--     deriving Show Eq
-- |]
-- @
--
-- The entities generated will have the 'PersistEntityBackend' defined to be
-- @'SqlFor' MainDb@ instead of 'SqlBackend'. This is what provides the type
-- safety.
--
-- @since 0.0.1.0
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))

-- | Persistent's @toSqlKey@ and @fromSqlKey@ hardcode the 'SqlBackend', so we
-- have to reimplement them here.
--
-- @since 0.0.1.0
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

-- | Persistent's @toSqlKey@ and @fromSqlKey@ hardcode the 'SqlBackend', so we
-- have to reimplement them here.
--
-- @since 0.0.1.0
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

-- | Specialize a 'ConnectionPool' to a @'Pool' ('SqlFor' db)@. You should apply
-- this whenever you create or initialize the database connection pooling to
-- avoid potentially mixing the database pools up.
--
-- @since 0.0.1.0
specializePool :: ConnectionPool -> ConnectionPoolFor db
specializePool :: ConnectionPool -> ConnectionPoolFor db
specializePool = ConnectionPool -> ConnectionPoolFor db
coerce

-- | Generalize a @'Pool' ('SqlFor' db)@ to an ordinary 'ConnectionPool'. This
-- renders the pool unusable for model-specific code that relies on the type
-- safety, but allows you to use it for general-purpose SQL queries.
--
-- @since 0.0.1.0
generalizePool :: ConnectionPoolFor db -> ConnectionPool
generalizePool :: ConnectionPoolFor db -> ConnectionPool
generalizePool = ConnectionPoolFor db -> ConnectionPool
coerce

-- | Specializes a 'SqlBackend' for a specific database.
--
-- @since 0.0.1.0
specializeSqlBackend :: SqlBackend -> SqlFor db
specializeSqlBackend :: SqlBackend -> SqlFor db
specializeSqlBackend = SqlBackend -> SqlFor db
forall db. SqlBackend -> SqlFor db
SqlFor

-- | Generalizes a 'SqlFor' backend to be database agnostic.
--
-- @since 0.0.1.0
generalizeSqlBackend :: SqlFor db -> SqlBackend
generalizeSqlBackend :: SqlFor db -> SqlBackend
generalizeSqlBackend = SqlFor db -> SqlBackend
forall db. SqlFor db -> SqlBackend
unSqlFor

-- | Run a 'SqlPersistTFor' action on an appropriate database.
--
-- @since 0.0.1.0
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)

-- | Run a 'SqlPersistTFor' action on the appropriate database connection.
--
-- @since 0.0.1.0
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)

-- The following instances are almost entirely copy-pasted from the Persistent
-- library for SqlBackend.
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

                    -- TODO: figure out something better for MySQL
                    let convert :: [PersistValue] -> [PersistValue]
convert [PersistValue]
x =
                            case [PersistValue]
x of
                                [PersistByteString ByteString
i] -> case ByteString -> Maybe (Integer, ByteString)
readInteger ByteString
i of -- mssql
                                                        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
                        -- Yes, it's just <|>. Older bases don't have the
                        -- instance for Either.
                        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
            ]

-- orphaned instance for convenience of modularity
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) -- gb oracle
              Just [PersistByteString ByteString
i] -> case ByteString -> Maybe (Integer, ByteString)
readInteger ByteString
i of -- gb mssql
                                              Just (Integer
ret,ByteString
"") -> Int -> ConduitM [PersistValue] Void IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConduitM [PersistValue] Void IO Int)
-> Int -> ConduitM [PersistValue] Void IO Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ret
                                              Maybe (Integer, ByteString)
xs -> 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)] -- oracle returns Double
                           [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 ()
    --
-- Here be dragons! These are functions, types, and helpers that were vendored
-- from Persistent.

-- | Same as 'deleteWhere', but returns the number of rows affected.
--
--
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

-- | Same as 'updateWhere', but returns the number of rows affected.
--
-- @since 1.1.5
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 -- ^ include table name?
             -> Bool -- ^ include WHERE?
             -> 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)
                            -- We use 1=2 (and below 1=1) to avoid using TRUE and FALSE, since
                            -- not all databases support those words directly.
                            (Bool
_, PersistFilter
In, Int
0) -> (Text
"1=2" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
orNullSuffix, [])
                            (Bool
False, PersistFilter
In, Int
_) -> (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" IN " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qmarks Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
orNullSuffix, [PersistValue]
allVals)
                            (Bool
True, PersistFilter
In, Int
_) -> ([Text] -> Text
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 -- ^ include the table name
            -> 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

-- escape :: DBName -> Text.Text
-- escape (DBName s) = Text.pack $ '"' : escapeQuote (Text.unpack s) ++ "\""
--   where
--     escapeQuote ""       = ""
--     escapeQuote ('"':xs) = "\"\"" ++ escapeQuote xs
--     escapeQuote (x:xs)   = x : escapeQuote xs

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)

-- Implement this here to avoid depending on the split package
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

-- | The slow but generic 'upsertBy' implementation for any 'PersistUniqueRead'.
-- * Lookup corresponding entities (if any) 'getBy'.
-- * If the record exists, update using 'updateGet'.
-- * If it does not exist, insert using 'insertEntity'.
-- @since 2.11
defaultUpsertBy
    :: ( PersistEntityBackend record ~ backend
       , PersistEntity record
       , BaseBackend backend ~ backend
       , BackendCompatible SqlBackend backend
       , MonadIO m
       , PersistStoreWrite backend
       , PersistUniqueRead backend
       , MySafeToInsert record
       )
    => Unique record   -- ^ uniqueness constraint to find by
    -> record          -- ^ new record to insert
    -> [Update record] -- ^ updates to perform if the record already exists
    -> ReaderT backend m (Entity record) -- ^ the record in the database after the operation
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