{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Database.Groundhog.Generic.PersistBackendHelpers
( get,
select,
selectAll,
selectStream,
selectAllStream,
getBy,
project,
projectStream,
count,
replace,
replaceBy,
update,
delete,
deleteBy,
deleteAll,
insertByAll,
countAll,
insertBy,
)
where
import Data.Either (rights)
import Data.Maybe (catMaybes, fromJust, fromMaybe, mapMaybe)
import Database.Groundhog.Core (PersistBackendConn)
import Database.Groundhog.Core hiding (PersistBackendConn (..))
import qualified Database.Groundhog.Core as Core
import Database.Groundhog.Generic (firstRow, getUniqueFields, isSimple, joinStreams, mapStream, streamToList)
import Database.Groundhog.Generic.Sql
get ::
forall conn v.
(PersistBackendConn conn, PersistEntity v, PrimitivePersistField (Key v BackendSpecific)) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
Key v BackendSpecific ->
Action conn (Maybe v)
get :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Key v BackendSpecific
-> Action conn (Maybe v)
get RenderConfig {Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
esc :: Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc (Key v BackendSpecific
k :: Key v BackendSpecific) = do
let e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
if [ConstructorDef] -> Bool
isSimple (EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e)
then do
let constr :: ConstructorDef
constr = [ConstructorDef] -> ConstructorDef
forall a. [a] -> a
head ([ConstructorDef] -> ConstructorDef)
-> [ConstructorDef] -> ConstructorDef
forall a b. (a -> b) -> a -> b
$ EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e
let fields :: Utf8
fields = (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8
forall s. StringLike s => (s -> s) -> [(String, DbType)] -> s
renderFields Utf8 -> Utf8
esc (ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
constr)
let query :: Utf8
query = Utf8
"SELECT " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
fields Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Maybe Utf8 -> Utf8
forall a. HasCallStack => Maybe a -> a
fromJust ((Utf8 -> Utf8) -> ConstructorDef -> Maybe Utf8
constrId Utf8 -> Utf8
esc ConstructorDef
constr) Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"=?"
Maybe [PersistValue]
x <- Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query [Key v BackendSpecific -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Key v BackendSpecific
k] Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue]
-> ReaderT conn IO (Maybe [PersistValue]))
-> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
case Maybe [PersistValue]
x of
Just [PersistValue]
xs -> ((v, [PersistValue]) -> Maybe v)
-> ReaderT conn IO (v, [PersistValue]) -> Action conn (Maybe v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v -> Maybe v
forall a. a -> Maybe a
Just (v -> Maybe v)
-> ((v, [PersistValue]) -> v) -> (v, [PersistValue]) -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, [PersistValue]) -> v
forall a b. (a, b) -> a
fst) (ReaderT conn IO (v, [PersistValue]) -> Action conn (Maybe v))
-> ReaderT conn IO (v, [PersistValue]) -> Action conn (Maybe v)
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> ReaderT conn IO (v, [PersistValue])
forall v (m :: * -> *).
(PersistEntity v, PersistBackend m) =>
[PersistValue] -> m (v, [PersistValue])
fromEntityPersistValues ([PersistValue] -> ReaderT conn IO (v, [PersistValue]))
-> [PersistValue] -> ReaderT conn IO (v, [PersistValue])
forall a b. (a -> b) -> a -> b
$ Int64 -> PersistValue
PersistInt64 Int64
0 PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
: [PersistValue]
xs
Maybe [PersistValue]
Nothing -> Maybe v -> Action conn (Maybe v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe v
forall a. Maybe a
Nothing
else do
let query :: Utf8
query = Utf8
"SELECT discr FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> Utf8
forall s. StringLike s => (s -> s) -> EntityDef -> s
mainTableName Utf8 -> Utf8
esc EntityDef
e Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE id=?"
Maybe [PersistValue]
x <- Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query [Key v BackendSpecific -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Key v BackendSpecific
k] Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue]
-> ReaderT conn IO (Maybe [PersistValue]))
-> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
case Maybe [PersistValue]
x of
Just [PersistValue
discr] -> do
let constructorNum :: Int
constructorNum = PersistValue -> Int
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
discr
constr :: ConstructorDef
constr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Int
constructorNum
fields :: Utf8
fields = (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8
forall s. StringLike s => (s -> s) -> [(String, DbType)] -> s
renderFields Utf8 -> Utf8
esc (ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
constr)
cQuery :: Utf8
cQuery = Utf8
"SELECT " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
fields Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Maybe Utf8 -> Utf8
forall a. HasCallStack => Maybe a -> a
fromJust ((Utf8 -> Utf8) -> ConstructorDef -> Maybe Utf8
constrId Utf8 -> Utf8
esc ConstructorDef
constr) Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"=?"
Maybe [PersistValue]
x2 <- Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
cQuery [Key v BackendSpecific -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Key v BackendSpecific
k] Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue]
-> ReaderT conn IO (Maybe [PersistValue]))
-> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
case Maybe [PersistValue]
x2 of
Just [PersistValue]
xs -> ((v, [PersistValue]) -> Maybe v)
-> ReaderT conn IO (v, [PersistValue]) -> Action conn (Maybe v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v -> Maybe v
forall a. a -> Maybe a
Just (v -> Maybe v)
-> ((v, [PersistValue]) -> v) -> (v, [PersistValue]) -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, [PersistValue]) -> v
forall a b. (a, b) -> a
fst) (ReaderT conn IO (v, [PersistValue]) -> Action conn (Maybe v))
-> ReaderT conn IO (v, [PersistValue]) -> Action conn (Maybe v)
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> ReaderT conn IO (v, [PersistValue])
forall v (m :: * -> *).
(PersistEntity v, PersistBackend m) =>
[PersistValue] -> m (v, [PersistValue])
fromEntityPersistValues ([PersistValue] -> ReaderT conn IO (v, [PersistValue]))
-> [PersistValue] -> ReaderT conn IO (v, [PersistValue])
forall a b. (a -> b) -> a -> b
$ PersistValue
discr PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
: [PersistValue]
xs
Maybe [PersistValue]
Nothing -> String -> Action conn (Maybe v)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Missing entry in constructor table"
Just [PersistValue]
x' -> String -> Action conn (Maybe v)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action conn (Maybe v))
-> String -> Action conn (Maybe v)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected number of columns returned: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
x'
Maybe [PersistValue]
Nothing -> Maybe v -> Action conn (Maybe v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe v
forall a. Maybe a
Nothing
select ::
forall conn r v c opts.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn, PersistEntity v, EntityConstr v c, HasSelectOptions opts conn r) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
(opts -> RenderS conn r) ->
Utf8 ->
opts ->
Action conn [v]
select :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> opts
-> Action conn [v]
select RenderConfig
conf Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc opts -> RenderS conn r
preColumns Utf8
noLimit opts
options = RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> opts
-> Action conn (RowStream v)
forall conn r v (c :: (* -> *) -> *) opts.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn,
PersistEntity v, EntityConstr v c, HasSelectOptions opts conn r) =>
RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> opts
-> Action conn (RowStream v)
selectStream RenderConfig
conf Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc opts -> RenderS conn r
preColumns Utf8
noLimit opts
options Action conn (RowStream v)
-> (RowStream v -> Action conn [v]) -> Action conn [v]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream v -> Action conn [v]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
selectStream ::
forall conn r v c opts.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn, PersistEntity v, EntityConstr v c, HasSelectOptions opts conn r) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
(opts -> RenderS conn r) ->
Utf8 ->
opts ->
Action conn (RowStream v)
selectStream :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> opts
-> Action conn (RowStream v)
selectStream conf :: RenderConfig
conf@RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc opts -> RenderS conn r
preColumns Utf8
noLimit opts
options = Action conn (RowStream v)
doSelectQuery
where
SelectOptions Cond conn r
cond Maybe Int
limit Maybe Int
offset [Order conn r]
ords Bool
dist [(String, QueryRaw conn r)]
_ = opts
-> SelectOptions
conn
r
(HasLimit opts)
(HasOffset opts)
(HasOrder opts)
(HasDistinct opts)
forall a db r.
HasSelectOptions a db r =>
a
-> SelectOptions
db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
getSelectOptions opts
options
e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
orders :: RenderS conn r
orders = RenderConfig -> [Order conn r] -> RenderS conn r
forall db r.
SqlDb db =>
RenderConfig -> [Order db r] -> RenderS db r
renderOrders RenderConfig
conf [Order conn r]
ords
lim :: RenderS conn r
lim = case (Maybe Int
limit, Maybe Int
offset) of
(Maybe Int
Nothing, Maybe Int
Nothing) -> RenderS conn r
forall a. Monoid a => a
mempty
(Maybe Int
Nothing, Maybe Int
o) -> Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS conn r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS (Utf8
" " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
noLimit Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" OFFSET ?") (Maybe Int -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues Maybe Int
o)
(Maybe Int
l, Maybe Int
Nothing) -> Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS conn r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS Utf8
" LIMIT ?" (Maybe Int -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues Maybe Int
l)
(Maybe Int
l, Maybe Int
o) -> Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS conn r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS Utf8
" LIMIT ? OFFSET ?" ((Maybe Int, Maybe Int) -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues (Maybe Int
l, Maybe Int
o))
cond' :: Maybe (RenderS conn r)
cond' = RenderConfig -> Cond conn r -> Maybe (RenderS conn r)
forall db r.
SqlDb db =>
RenderConfig -> Cond db r -> Maybe (RenderS db r)
renderCond RenderConfig
conf Cond conn r
cond
fields :: RenderS conn r
fields = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS conn r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS ((Utf8 -> Utf8) -> [(String, DbType)] -> Utf8
forall s. StringLike s => (s -> s) -> [(String, DbType)] -> s
renderFields Utf8 -> Utf8
esc (ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
constr)) [PersistValue] -> [PersistValue]
forall a. a -> a
id
distinctClause :: RenderS conn r
distinctClause = if Bool
dist then RenderS conn r
"DISTINCT " else RenderS conn r
forall a. Monoid a => a
mempty
RenderS Utf8
query [PersistValue] -> [PersistValue]
binds = RenderS conn r
"SELECT " RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
distinctClause RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> opts -> RenderS conn r
preColumns opts
options RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
fields RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
" FROM " RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS conn r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS ((Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr) [PersistValue] -> [PersistValue]
forall a. a -> a
id RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
whereClause RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
orders RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
lim
whereClause :: RenderS conn r
whereClause = RenderS conn r
-> (RenderS conn r -> RenderS conn r)
-> Maybe (RenderS conn r)
-> RenderS conn r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RenderS conn r
"" (RenderS conn r
" WHERE " RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<>) Maybe (RenderS conn r)
cond'
doSelectQuery :: Action conn (RowStream v)
doSelectQuery = Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query ([PersistValue] -> [PersistValue]
binds []) Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue] -> Action conn (RowStream v))
-> Action conn (RowStream v)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action conn v)
-> RowStream [PersistValue] -> Action conn (RowStream v)
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (\[PersistValue]
xs -> ((v, [PersistValue]) -> v)
-> ReaderT conn IO (v, [PersistValue]) -> Action conn v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v, [PersistValue]) -> v
forall a b. (a, b) -> a
fst (ReaderT conn IO (v, [PersistValue]) -> Action conn v)
-> ReaderT conn IO (v, [PersistValue]) -> Action conn v
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> ReaderT conn IO (v, [PersistValue])
forall v (m :: * -> *).
(PersistEntity v, PersistBackend m) =>
[PersistValue] -> m (v, [PersistValue])
fromEntityPersistValues ([PersistValue] -> ReaderT conn IO (v, [PersistValue]))
-> [PersistValue] -> ReaderT conn IO (v, [PersistValue])
forall a b. (a -> b) -> a -> b
$ Int -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Int
cNum PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
: [PersistValue]
xs)
cNum :: Int
cNum = Any v -> c Any -> Int
forall v (c :: (* -> *) -> *) (proxy :: * -> *) (a :: * -> *).
EntityConstr v c =>
proxy v -> c a -> Int
entityConstrNum (forall a. HasCallStack => a
forall (proxy :: * -> *). proxy v
undefined :: proxy v) (forall a. HasCallStack => a
forall (a :: * -> *). c a
undefined :: c a)
constr :: ConstructorDef
constr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Int
cNum
selectAll ::
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
Action conn [(AutoKey v, v)]
selectAll :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Action conn [(AutoKey v, v)]
selectAll RenderConfig
conf Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc = RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> ReaderT conn IO (Acquire (IO (Maybe (AutoKey v, v))))
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Action conn (RowStream (AutoKey v, v))
selectAllStream RenderConfig
conf Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc ReaderT conn IO (Acquire (IO (Maybe (AutoKey v, v))))
-> (Acquire (IO (Maybe (AutoKey v, v)))
-> Action conn [(AutoKey v, v)])
-> Action conn [(AutoKey v, v)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Acquire (IO (Maybe (AutoKey v, v))) -> Action conn [(AutoKey v, v)]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
selectAllStream ::
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
Action conn (RowStream (AutoKey v, v))
selectAllStream :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Action conn (RowStream (AutoKey v, v))
selectAllStream RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc = Action conn (RowStream (AutoKey v, v))
start
where
start :: Action conn (RowStream (AutoKey v, v))
start = [Action conn (RowStream (AutoKey v, v))]
-> Action conn (RowStream (AutoKey v, v))
forall conn a.
[Action conn (RowStream a)] -> Action conn (RowStream a)
joinStreams ([Action conn (RowStream (AutoKey v, v))]
-> Action conn (RowStream (AutoKey v, v)))
-> [Action conn (RowStream (AutoKey v, v))]
-> Action conn (RowStream (AutoKey v, v))
forall a b. (a -> b) -> a -> b
$ (Int -> ConstructorDef -> Action conn (RowStream (AutoKey v, v)))
-> [Int]
-> [ConstructorDef]
-> [Action conn (RowStream (AutoKey v, v))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ConstructorDef -> Action conn (RowStream (AutoKey v, v))
selectConstr [Int
0 ..] ([ConstructorDef] -> [Action conn (RowStream (AutoKey v, v))])
-> [ConstructorDef] -> [Action conn (RowStream (AutoKey v, v))]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e
selectConstr :: Int -> ConstructorDef -> Action conn (RowStream (AutoKey v, v))
selectConstr Int
cNum ConstructorDef
constr = Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query [] Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue]
-> Action conn (RowStream (AutoKey v, v)))
-> Action conn (RowStream (AutoKey v, v))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action conn (AutoKey v, v))
-> RowStream [PersistValue]
-> Action conn (RowStream (AutoKey v, v))
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (Int -> [PersistValue] -> Action conn (AutoKey v, v)
forall (m :: * -> *) b a.
(PersistEntity b, PersistBackend m, PurePersistField a) =>
Int -> [PersistValue] -> m (a, b)
mkEntity Int
cNum)
where
fields :: Utf8
fields = (Utf8 -> Utf8)
-> (Utf8 -> Utf8 -> Utf8) -> Maybe Utf8 -> Utf8 -> Utf8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Utf8 -> Utf8
forall a. a -> a
id (\Utf8
key Utf8
cont -> Utf8
key Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Char -> Utf8
forall a. StringLike a => Char -> a
fromChar Char
',' Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
cont) ((Utf8 -> Utf8) -> ConstructorDef -> Maybe Utf8
constrId Utf8 -> Utf8
esc ConstructorDef
constr) (Utf8 -> Utf8) -> Utf8 -> Utf8
forall a b. (a -> b) -> a -> b
$ (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8
forall s. StringLike s => (s -> s) -> [(String, DbType)] -> s
renderFields Utf8 -> Utf8
esc (ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
constr)
query :: Utf8
query = Utf8
"SELECT " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
fields Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr
e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
mkEntity :: Int -> [PersistValue] -> m (a, b)
mkEntity Int
cNum [PersistValue]
xs = do
let (a
k, [PersistValue]
xs') = [PersistValue] -> (a, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
xs
(b
v, [PersistValue]
_) <- [PersistValue] -> m (b, [PersistValue])
forall v (m :: * -> *).
(PersistEntity v, PersistBackend m) =>
[PersistValue] -> m (v, [PersistValue])
fromEntityPersistValues (Int -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue (Int
cNum :: Int) PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
: [PersistValue]
xs')
(a, b) -> m (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
k, b
v)
getBy ::
forall conn v u.
(PersistBackendConn conn, PersistEntity v, IsUniqueKey (Key v (Unique u))) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
Key v (Unique u) ->
Action conn (Maybe v)
getBy :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Key v (Unique u)
-> Action conn (Maybe v)
getBy conf :: RenderConfig
conf@RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc (Key v (Unique u)
k :: Key v (Unique u)) = do
[PersistValue] -> [PersistValue]
uniques <- Key v (Unique u)
-> ReaderT conn IO ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues Key v (Unique u)
k
let e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
u :: u (UniqueMarker v)
u = (Key v (Unique u) -> u (UniqueMarker v)
forall a. HasCallStack => a
undefined :: Key v (Unique u) -> u (UniqueMarker v)) Key v (Unique u)
k
uFields :: [Utf8]
uFields = RenderConfig -> FieldChain -> [Utf8] -> [Utf8]
renderChain RenderConfig
conf (Any conn -> u (UniqueMarker v) -> FieldChain
forall f a db (proxy :: * -> *).
(FieldLike f a, DbDescriptor db, ProjectionDb f db) =>
proxy db -> f -> FieldChain
fieldChain Any conn
proxy u (UniqueMarker v)
u) []
RenderS Utf8
cond [PersistValue] -> [PersistValue]
vals = RenderS Any Any -> [RenderS Any Any] -> RenderS Any Any
forall s. StringLike s => s -> [s] -> s
intercalateS RenderS Any Any
" AND " ([RenderS Any Any] -> RenderS Any Any)
-> [RenderS Any Any] -> RenderS Any Any
forall a b. (a -> b) -> a -> b
$ [Utf8] -> ([PersistValue] -> [PersistValue]) -> [RenderS Any Any]
forall conn r.
[Utf8] -> ([PersistValue] -> [PersistValue]) -> [RenderS conn r]
mkUniqueCond [Utf8]
uFields [PersistValue] -> [PersistValue]
uniques
constr :: ConstructorDef
constr = [ConstructorDef] -> ConstructorDef
forall a. [a] -> a
head ([ConstructorDef] -> ConstructorDef)
-> [ConstructorDef] -> ConstructorDef
forall a b. (a -> b) -> a -> b
$ EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e
fields :: Utf8
fields = (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8
forall s. StringLike s => (s -> s) -> [(String, DbType)] -> s
renderFields Utf8 -> Utf8
esc (ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
constr)
query :: Utf8
query = Utf8
"SELECT " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
fields Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
cond
Maybe [PersistValue]
x <- Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query ([PersistValue] -> [PersistValue]
vals []) Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue]
-> ReaderT conn IO (Maybe [PersistValue]))
-> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
case Maybe [PersistValue]
x of
Just [PersistValue]
xs -> ((v, [PersistValue]) -> Maybe v)
-> ReaderT conn IO (v, [PersistValue]) -> Action conn (Maybe v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v -> Maybe v
forall a. a -> Maybe a
Just (v -> Maybe v)
-> ((v, [PersistValue]) -> v) -> (v, [PersistValue]) -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, [PersistValue]) -> v
forall a b. (a, b) -> a
fst) (ReaderT conn IO (v, [PersistValue]) -> Action conn (Maybe v))
-> ReaderT conn IO (v, [PersistValue]) -> Action conn (Maybe v)
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> ReaderT conn IO (v, [PersistValue])
forall v (m :: * -> *).
(PersistEntity v, PersistBackend m) =>
[PersistValue] -> m (v, [PersistValue])
fromEntityPersistValues ([PersistValue] -> ReaderT conn IO (v, [PersistValue]))
-> [PersistValue] -> ReaderT conn IO (v, [PersistValue])
forall a b. (a -> b) -> a -> b
$ Int64 -> PersistValue
PersistInt64 Int64
0 PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
: [PersistValue]
xs
Maybe [PersistValue]
Nothing -> Maybe v -> Action conn (Maybe v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe v
forall a. Maybe a
Nothing
project ::
forall conn r v c p opts a'.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn, PersistEntity v, EntityConstr v c, Projection p a', ProjectionDb p conn, ProjectionRestriction p r, HasSelectOptions opts conn r) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
(opts -> RenderS conn r) ->
Utf8 ->
p ->
opts ->
Action conn [a']
project :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> p
-> opts
-> Action conn [a']
project RenderConfig
conf Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc opts -> RenderS conn r
preColumns Utf8
noLimit p
p opts
options = RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> p
-> opts
-> Action conn (RowStream a')
forall conn r v (c :: (* -> *) -> *) p opts a'.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn,
PersistEntity v, EntityConstr v c, Projection p a',
ProjectionDb p conn, ProjectionRestriction p r,
HasSelectOptions opts conn r) =>
RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> p
-> opts
-> Action conn (RowStream a')
projectStream RenderConfig
conf Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc opts -> RenderS conn r
preColumns Utf8
noLimit p
p opts
options Action conn (RowStream a')
-> (RowStream a' -> Action conn [a']) -> Action conn [a']
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream a' -> Action conn [a']
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
projectStream ::
forall conn r v c p opts a'.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn, PersistEntity v, EntityConstr v c, Projection p a', ProjectionDb p conn, ProjectionRestriction p r, HasSelectOptions opts conn r) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
(opts -> RenderS conn r) ->
Utf8 ->
p ->
opts ->
Action conn (RowStream a')
projectStream :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> p
-> opts
-> Action conn (RowStream a')
projectStream conf :: RenderConfig
conf@RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc opts -> RenderS conn r
preColumns Utf8
noLimit p
p opts
options = Action conn (RowStream a')
doSelectQuery
where
SelectOptions Cond conn r
cond Maybe Int
limit Maybe Int
offset [Order conn r]
ords Bool
dist [(String, QueryRaw conn r)]
_ = opts
-> SelectOptions
conn
r
(HasLimit opts)
(HasOffset opts)
(HasOrder opts)
(HasDistinct opts)
forall a db r.
HasSelectOptions a db r =>
a
-> SelectOptions
db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
getSelectOptions opts
options
e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
orders :: RenderS conn r
orders = RenderConfig -> [Order conn r] -> RenderS conn r
forall db r.
SqlDb db =>
RenderConfig -> [Order db r] -> RenderS db r
renderOrders RenderConfig
conf [Order conn r]
ords
lim :: RenderS conn r
lim = case (Maybe Int
limit, Maybe Int
offset) of
(Maybe Int
Nothing, Maybe Int
Nothing) -> RenderS conn r
forall a. Monoid a => a
mempty
(Maybe Int
Nothing, Maybe Int
o) -> Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS conn r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS (Utf8
" " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
noLimit Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" OFFSET ?") (Maybe Int -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues Maybe Int
o)
(Maybe Int
l, Maybe Int
Nothing) -> Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS conn r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS Utf8
" LIMIT ?" (Maybe Int -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues Maybe Int
l)
(Maybe Int
l, Maybe Int
o) -> Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS conn r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS Utf8
" LIMIT ? OFFSET ?" ((Maybe Int, Maybe Int) -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues (Maybe Int
l, Maybe Int
o))
cond' :: Maybe (RenderS conn r)
cond' = RenderConfig -> Cond conn r -> Maybe (RenderS conn r)
forall db r.
SqlDb db =>
RenderConfig -> Cond db r -> Maybe (RenderS db r)
renderCond RenderConfig
conf Cond conn r
cond
chains :: [UntypedExpr conn r]
chains = p -> [UntypedExpr conn r] -> [UntypedExpr conn r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs p
p []
fields :: RenderS conn r
fields = [RenderS conn r] -> RenderS conn r
forall s. StringLike s => [s] -> s
commasJoin ([RenderS conn r] -> RenderS conn r)
-> [RenderS conn r] -> RenderS conn r
forall a b. (a -> b) -> a -> b
$ (UntypedExpr conn r -> [RenderS conn r])
-> [UntypedExpr conn r] -> [RenderS conn r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RenderConfig -> Int -> UntypedExpr conn r -> [RenderS conn r]
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended RenderConfig
conf Int
0) [UntypedExpr conn r]
chains
distinctClause :: RenderS conn r
distinctClause = if Bool
dist then RenderS conn r
"DISTINCT " else RenderS conn r
forall a. Monoid a => a
mempty
RenderS Utf8
query [PersistValue] -> [PersistValue]
binds = RenderS conn r
"SELECT " RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
distinctClause RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> opts -> RenderS conn r
preColumns opts
options RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
fields RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
" FROM " RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS conn r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS ((Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr) [PersistValue] -> [PersistValue]
forall a. a -> a
id RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
whereClause RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
orders RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<> RenderS conn r
lim
whereClause :: RenderS conn r
whereClause = RenderS conn r
-> (RenderS conn r -> RenderS conn r)
-> Maybe (RenderS conn r)
-> RenderS conn r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RenderS conn r
"" (RenderS conn r
" WHERE " RenderS conn r -> RenderS conn r -> RenderS conn r
forall a. Semigroup a => a -> a -> a
<>) Maybe (RenderS conn r)
cond'
doSelectQuery :: Action conn (RowStream a')
doSelectQuery = Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query ([PersistValue] -> [PersistValue]
binds []) Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue] -> Action conn (RowStream a'))
-> Action conn (RowStream a')
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action conn a')
-> RowStream [PersistValue] -> Action conn (RowStream a')
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (((a', [PersistValue]) -> a')
-> ReaderT conn IO (a', [PersistValue]) -> Action conn a'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a', [PersistValue]) -> a'
forall a b. (a, b) -> a
fst (ReaderT conn IO (a', [PersistValue]) -> Action conn a')
-> ([PersistValue] -> ReaderT conn IO (a', [PersistValue]))
-> [PersistValue]
-> Action conn a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> [PersistValue] -> ReaderT conn IO (a', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult p
p)
constr :: ConstructorDef
constr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Any v -> c Any -> Int
forall v (c :: (* -> *) -> *) (proxy :: * -> *) (a :: * -> *).
EntityConstr v c =>
proxy v -> c a -> Int
entityConstrNum (forall a. HasCallStack => a
forall (proxy :: * -> *). proxy v
undefined :: proxy v) (forall a. HasCallStack => a
forall (a :: * -> *). c a
undefined :: c a)
count ::
forall conn r v c.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn, PersistEntity v, EntityConstr v c) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
Cond conn r ->
Action conn Int
count :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Cond conn r
-> Action conn Int
count conf :: RenderConfig
conf@RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Cond conn r
cond = do
let e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
cond' :: Maybe (RenderS conn r)
cond' = RenderConfig -> Cond conn r -> Maybe (RenderS conn r)
forall db r.
SqlDb db =>
RenderConfig -> Cond db r -> Maybe (RenderS db r)
renderCond RenderConfig
conf Cond conn r
cond
constr :: ConstructorDef
constr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Any v -> c Any -> Int
forall v (c :: (* -> *) -> *) (proxy :: * -> *) (a :: * -> *).
EntityConstr v c =>
proxy v -> c a -> Int
entityConstrNum (forall a. HasCallStack => a
forall (proxy :: * -> *). proxy v
undefined :: proxy v) (forall a. HasCallStack => a
forall (a :: * -> *). c a
undefined :: c a)
query :: Utf8
query = Utf8
"SELECT COUNT(*) FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
whereClause
where
whereClause :: Utf8
whereClause = Utf8 -> (RenderS conn r -> Utf8) -> Maybe (RenderS conn r) -> Utf8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Utf8
"" (\RenderS conn r
c -> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> RenderS conn r -> Utf8
forall db r. RenderS db r -> Utf8
getQuery RenderS conn r
c) Maybe (RenderS conn r)
cond'
Maybe [PersistValue]
x <- Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query ([PersistValue]
-> (RenderS conn r -> [PersistValue])
-> Maybe (RenderS conn r)
-> [PersistValue]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (RenderS conn r -> [PersistValue] -> [PersistValue]
forall db r. RenderS db r -> [PersistValue] -> [PersistValue]
`getValues` []) Maybe (RenderS conn r)
cond') Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue]
-> ReaderT conn IO (Maybe [PersistValue]))
-> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
case Maybe [PersistValue]
x of
Just [PersistValue
num] -> Int -> Action conn Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Action conn Int) -> Int -> Action conn Int
forall a b. (a -> b) -> a -> b
$ PersistValue -> Int
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
num
Just [PersistValue]
xs -> String -> Action conn Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action conn Int) -> String -> Action conn Int
forall a b. (a -> b) -> a -> b
$ String
"requested 1 column, returned " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
xs)
Maybe [PersistValue]
Nothing -> String -> Action conn Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"COUNT returned no rows"
replace ::
forall conn r v.
(PersistBackendConn conn, PersistEntity v, PrimitivePersistField (Key v BackendSpecific)) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
(Utf8 -> [PersistValue] -> Action conn ()) ->
(Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS conn r) ->
Key v BackendSpecific ->
v ->
Action conn ()
replace :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (Utf8 -> [PersistValue] -> Action conn ())
-> (Bool
-> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS conn r)
-> Key v BackendSpecific
-> v
-> Action conn ()
replace RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8 -> [PersistValue] -> Action conn ()
execFunc Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS conn r
insertIntoConstructorTable Key v BackendSpecific
k v
v = do
[PersistValue]
vals <- v -> Action conn [PersistValue]
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
v -> Action conn [PersistValue]
toEntityPersistValues' v
v
let e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy v
v
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
constructorNum :: Int
constructorNum = PersistValue -> Int
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue ([PersistValue] -> PersistValue
forall a. [a] -> a
head [PersistValue]
vals)
constr :: ConstructorDef
constr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Int
constructorNum
k' :: PersistValue
k' = Key v BackendSpecific -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Key v BackendSpecific
k
RenderS Utf8
upds [PersistValue] -> [PersistValue]
updsVals = [RenderS Any Any] -> RenderS Any Any
forall s. StringLike s => [s] -> s
commasJoin ([RenderS Any Any] -> RenderS Any Any)
-> [RenderS Any Any] -> RenderS Any Any
forall a b. (a -> b) -> a -> b
$ (Utf8 -> PersistValue -> RenderS Any Any)
-> [Utf8] -> [PersistValue] -> [RenderS Any Any]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Utf8 -> PersistValue -> RenderS Any Any
forall db r. Utf8 -> PersistValue -> RenderS db r
f [Utf8]
fields ([PersistValue] -> [RenderS Any Any])
-> [PersistValue] -> [RenderS Any Any]
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> [PersistValue]
forall a. [a] -> [a]
tail [PersistValue]
vals
where
fields :: [Utf8]
fields = ((String, DbType) -> [Utf8] -> [Utf8])
-> [Utf8] -> [(String, DbType)] -> [Utf8]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Utf8 -> Utf8) -> (String, DbType) -> [Utf8] -> [Utf8]
forall s.
StringLike s =>
(s -> s) -> (String, DbType) -> [s] -> [s]
flatten Utf8 -> Utf8
esc) [] ([(String, DbType)] -> [Utf8]) -> [(String, DbType)] -> [Utf8]
forall a b. (a -> b) -> a -> b
$ ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
constr
f :: Utf8 -> PersistValue -> RenderS db r
f Utf8
f1 PersistValue
f2 = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS Utf8
f1 [PersistValue] -> [PersistValue]
forall a. a -> a
id RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
'=' RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> PersistValue -> RenderS db r
forall db r. PersistValue -> RenderS db r
renderPersistValue PersistValue
f2
updateQuery :: Utf8
updateQuery = Utf8
"UPDATE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" SET " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
upds Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> String -> Utf8
forall a. IsString a => String -> a
fromString (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ ConstructorDef -> Maybe String
forall str dbType. ConstructorDef' str dbType -> Maybe str
constrAutoKeyName ConstructorDef
constr) Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"=?"
if [ConstructorDef] -> Bool
isSimple (EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e)
then Utf8 -> [PersistValue] -> Action conn ()
execFunc Utf8
updateQuery ([PersistValue] -> [PersistValue]
updsVals [PersistValue
k'])
else do
let query :: Utf8
query = Utf8
"SELECT discr FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> Utf8
forall s. StringLike s => (s -> s) -> EntityDef -> s
mainTableName Utf8 -> Utf8
esc EntityDef
e Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE id=?"
Maybe Int
x <- Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query [PersistValue
k'] Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue] -> ReaderT conn IO (Maybe Int))
-> ReaderT conn IO (Maybe Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe [PersistValue] -> Maybe Int)
-> ReaderT conn IO (Maybe [PersistValue])
-> ReaderT conn IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([PersistValue] -> Int) -> Maybe [PersistValue] -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([PersistValue] -> Int) -> Maybe [PersistValue] -> Maybe Int)
-> ([PersistValue] -> Int) -> Maybe [PersistValue] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ PersistValue -> Int
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue (PersistValue -> Int)
-> ([PersistValue] -> PersistValue) -> [PersistValue] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> PersistValue
forall a. [a] -> a
head) (ReaderT conn IO (Maybe [PersistValue])
-> ReaderT conn IO (Maybe Int))
-> (RowStream [PersistValue]
-> ReaderT conn IO (Maybe [PersistValue]))
-> RowStream [PersistValue]
-> ReaderT conn IO (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowStream [PersistValue] -> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
case Maybe Int
x of
Just Int
discr -> do
let cName :: Utf8
cName = (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr
if Int
discr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
constructorNum
then Utf8 -> [PersistValue] -> Action conn ()
execFunc Utf8
updateQuery ([PersistValue] -> [PersistValue]
updsVals [PersistValue
k'])
else do
let RenderS Utf8
insQuery [PersistValue] -> [PersistValue]
vals' = Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS conn r
insertIntoConstructorTable Bool
True Utf8
cName ConstructorDef
constr (PersistValue
k' PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
: [PersistValue] -> [PersistValue]
forall a. [a] -> [a]
tail [PersistValue]
vals)
Utf8 -> [PersistValue] -> Action conn ()
execFunc Utf8
insQuery ([PersistValue] -> [PersistValue]
vals' [])
let oldConstr :: ConstructorDef
oldConstr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Int
discr
let delQuery :: Utf8
delQuery = Utf8
"DELETE FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
oldConstr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Maybe Utf8 -> Utf8
forall a. HasCallStack => Maybe a -> a
fromJust ((Utf8 -> Utf8) -> ConstructorDef -> Maybe Utf8
constrId Utf8 -> Utf8
esc ConstructorDef
oldConstr) Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"=?"
Utf8 -> [PersistValue] -> Action conn ()
execFunc Utf8
delQuery [PersistValue
k']
let updateDiscrQuery :: Utf8
updateDiscrQuery = Utf8
"UPDATE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> Utf8
forall s. StringLike s => (s -> s) -> EntityDef -> s
mainTableName Utf8 -> Utf8
esc EntityDef
e Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" SET discr=? WHERE id=?"
Utf8 -> [PersistValue] -> Action conn ()
execFunc Utf8
updateDiscrQuery [[PersistValue] -> PersistValue
forall a. [a] -> a
head [PersistValue]
vals, PersistValue
k']
Maybe Int
Nothing -> () -> Action conn ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
replaceBy ::
forall conn v u.
(PersistBackendConn conn, PersistEntity v, IsUniqueKey (Key v (Unique u))) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn ()) ->
u (UniqueMarker v) ->
v ->
Action conn ()
replaceBy :: RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> u (UniqueMarker v)
-> v
-> Action conn ()
replaceBy conf :: RenderConfig
conf@RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn ()
execFunc u (UniqueMarker v)
u v
v = do
[PersistValue] -> [PersistValue]
uniques <- Key v (Unique u)
-> ReaderT conn IO ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues (v -> Key v (Unique u)
forall uKey v u. (IsUniqueKey uKey, uKey ~ Key v u) => v -> uKey
extractUnique v
v Key v (Unique u) -> Key v (Unique u) -> Key v (Unique u)
forall a. a -> a -> a
`asTypeOf` (u (UniqueMarker v) -> Key v (Unique u)
forall a. HasCallStack => a
undefined :: u (UniqueMarker v) -> Key v (Unique u)) u (UniqueMarker v)
u)
[PersistValue]
vals <- v -> Action conn [PersistValue]
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
v -> Action conn [PersistValue]
toEntityPersistValues' v
v
let e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
uFields :: [Utf8]
uFields = RenderConfig -> FieldChain -> [Utf8] -> [Utf8]
renderChain RenderConfig
conf (Any conn -> u (UniqueMarker v) -> FieldChain
forall f a db (proxy :: * -> *).
(FieldLike f a, DbDescriptor db, ProjectionDb f db) =>
proxy db -> f -> FieldChain
fieldChain Any conn
proxy u (UniqueMarker v)
u) []
RenderS Utf8
cond [PersistValue] -> [PersistValue]
condVals = RenderS Any Any -> [RenderS Any Any] -> RenderS Any Any
forall s. StringLike s => s -> [s] -> s
intercalateS RenderS Any Any
" AND " ([RenderS Any Any] -> RenderS Any Any)
-> [RenderS Any Any] -> RenderS Any Any
forall a b. (a -> b) -> a -> b
$ [Utf8] -> ([PersistValue] -> [PersistValue]) -> [RenderS Any Any]
forall conn r.
[Utf8] -> ([PersistValue] -> [PersistValue]) -> [RenderS conn r]
mkUniqueCond [Utf8]
uFields [PersistValue] -> [PersistValue]
uniques
constr :: ConstructorDef
constr = [ConstructorDef] -> ConstructorDef
forall a. [a] -> a
head ([ConstructorDef] -> ConstructorDef)
-> [ConstructorDef] -> ConstructorDef
forall a b. (a -> b) -> a -> b
$ EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e
RenderS Utf8
upds [PersistValue] -> [PersistValue]
updsVals = [RenderS Any Any] -> RenderS Any Any
forall s. StringLike s => [s] -> s
commasJoin ([RenderS Any Any] -> RenderS Any Any)
-> [RenderS Any Any] -> RenderS Any Any
forall a b. (a -> b) -> a -> b
$ (Utf8 -> PersistValue -> RenderS Any Any)
-> [Utf8] -> [PersistValue] -> [RenderS Any Any]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Utf8 -> PersistValue -> RenderS Any Any
forall db r. Utf8 -> PersistValue -> RenderS db r
f [Utf8]
fields ([PersistValue] -> [RenderS Any Any])
-> [PersistValue] -> [RenderS Any Any]
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> [PersistValue]
forall a. [a] -> [a]
tail [PersistValue]
vals
where
fields :: [Utf8]
fields = ((String, DbType) -> [Utf8] -> [Utf8])
-> [Utf8] -> [(String, DbType)] -> [Utf8]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Utf8 -> Utf8) -> (String, DbType) -> [Utf8] -> [Utf8]
forall s.
StringLike s =>
(s -> s) -> (String, DbType) -> [s] -> [s]
flatten Utf8 -> Utf8
esc) [] ([(String, DbType)] -> [Utf8]) -> [(String, DbType)] -> [Utf8]
forall a b. (a -> b) -> a -> b
$ ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
constr
f :: Utf8 -> PersistValue -> RenderS db r
f Utf8
f1 PersistValue
f2 = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS Utf8
f1 [PersistValue] -> [PersistValue]
forall a. a -> a
id RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
'=' RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> PersistValue -> RenderS db r
forall db r. PersistValue -> RenderS db r
renderPersistValue PersistValue
f2
updateQuery :: Utf8
updateQuery = Utf8
"UPDATE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" SET " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
upds Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
cond
Utf8 -> [PersistValue] -> Action conn ()
execFunc Utf8
updateQuery ([PersistValue] -> [PersistValue]
updsVals ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
condVals ([PersistValue] -> [PersistValue])
-> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ [])
update ::
forall conn r v c.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn, PersistEntity v, EntityConstr v c) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn ()) ->
[Update conn r] ->
Cond conn r ->
Action conn ()
update :: RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> [Update conn r]
-> Cond conn r
-> Action conn ()
update conf :: RenderConfig
conf@RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn ()
execFunc [Update conn r]
upds Cond conn r
cond = do
let e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
case RenderConfig -> [Update conn r] -> Maybe (RenderS conn r)
forall db r.
SqlDb db =>
RenderConfig -> [Update db r] -> Maybe (RenderS db r)
renderUpdates RenderConfig
conf [Update conn r]
upds of
Just RenderS conn r
upds' -> do
let cond' :: Maybe (RenderS conn r)
cond' = RenderConfig -> Cond conn r -> Maybe (RenderS conn r)
forall db r.
SqlDb db =>
RenderConfig -> Cond db r -> Maybe (RenderS db r)
renderCond RenderConfig
conf Cond conn r
cond
constr :: ConstructorDef
constr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Any v -> c Any -> Int
forall v (c :: (* -> *) -> *) (proxy :: * -> *) (a :: * -> *).
EntityConstr v c =>
proxy v -> c a -> Int
entityConstrNum (forall a. HasCallStack => a
forall (proxy :: * -> *). proxy v
undefined :: proxy v) (forall a. HasCallStack => a
forall (a :: * -> *). c a
undefined :: c a)
query :: Utf8
query = Utf8
"UPDATE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" SET " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
whereClause
where
whereClause :: Utf8
whereClause = Utf8 -> (RenderS conn r -> Utf8) -> Maybe (RenderS conn r) -> Utf8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RenderS conn r -> Utf8
forall db r. RenderS db r -> Utf8
getQuery RenderS conn r
upds') (\RenderS conn r
c -> RenderS conn r -> Utf8
forall db r. RenderS db r -> Utf8
getQuery RenderS conn r
upds' Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> RenderS conn r -> Utf8
forall db r. RenderS db r -> Utf8
getQuery RenderS conn r
c) Maybe (RenderS conn r)
cond'
Utf8 -> [PersistValue] -> Action conn ()
execFunc Utf8
query (RenderS conn r -> [PersistValue] -> [PersistValue]
forall db r. RenderS db r -> [PersistValue] -> [PersistValue]
getValues RenderS conn r
upds' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall a. Semigroup a => a -> a -> a
<> ([PersistValue] -> [PersistValue])
-> (RenderS conn r -> [PersistValue] -> [PersistValue])
-> Maybe (RenderS conn r)
-> [PersistValue]
-> [PersistValue]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [PersistValue] -> [PersistValue]
forall a. Monoid a => a
mempty RenderS conn r -> [PersistValue] -> [PersistValue]
forall db r. RenderS db r -> [PersistValue] -> [PersistValue]
getValues Maybe (RenderS conn r)
cond' ([PersistValue] -> [PersistValue])
-> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ [])
Maybe (RenderS conn r)
Nothing -> () -> Action conn ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
delete ::
forall conn r v c.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn, PersistEntity v, EntityConstr v c) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn ()) ->
Cond conn r ->
Action conn ()
delete :: RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> Cond conn r
-> Action conn ()
delete conf :: RenderConfig
conf@RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn ()
execFunc Cond conn r
cond = Utf8 -> [PersistValue] -> Action conn ()
execFunc Utf8
query ([PersistValue]
-> (RenderS conn r -> [PersistValue])
-> Maybe (RenderS conn r)
-> [PersistValue]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((([PersistValue] -> [PersistValue])
-> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ []) (([PersistValue] -> [PersistValue]) -> [PersistValue])
-> (RenderS conn r -> [PersistValue] -> [PersistValue])
-> RenderS conn r
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderS conn r -> [PersistValue] -> [PersistValue]
forall db r. RenderS db r -> [PersistValue] -> [PersistValue]
getValues) Maybe (RenderS conn r)
cond')
where
e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
constr :: ConstructorDef
constr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Any v -> c Any -> Int
forall v (c :: (* -> *) -> *) (proxy :: * -> *) (a :: * -> *).
EntityConstr v c =>
proxy v -> c a -> Int
entityConstrNum (forall a. HasCallStack => a
forall (proxy :: * -> *). proxy v
undefined :: proxy v) (forall a. HasCallStack => a
forall (a :: * -> *). c a
undefined :: c a)
cond' :: Maybe (RenderS conn r)
cond' = RenderConfig -> Cond conn r -> Maybe (RenderS conn r)
forall db r.
SqlDb db =>
RenderConfig -> Cond db r -> Maybe (RenderS db r)
renderCond RenderConfig
conf Cond conn r
cond
whereClause :: Utf8
whereClause = Utf8 -> (RenderS conn r -> Utf8) -> Maybe (RenderS conn r) -> Utf8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Utf8
"" (\RenderS conn r
c -> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> RenderS conn r -> Utf8
forall db r. RenderS db r -> Utf8
getQuery RenderS conn r
c) Maybe (RenderS conn r)
cond'
query :: Utf8
query =
if [ConstructorDef] -> Bool
isSimple (EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e)
then Utf8
"DELETE FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
whereClause
else
Utf8
"DELETE FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> Utf8
forall s. StringLike s => (s -> s) -> EntityDef -> s
mainTableName Utf8 -> Utf8
esc EntityDef
e Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE id IN(SELECT " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Maybe Utf8 -> Utf8
forall a. HasCallStack => Maybe a -> a
fromJust ((Utf8 -> Utf8) -> ConstructorDef -> Maybe Utf8
constrId Utf8 -> Utf8
esc ConstructorDef
constr) Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
whereClause Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
")"
insertByAll ::
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
Bool ->
v ->
Action conn (Either (AutoKey v) (AutoKey v))
insertByAll :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Bool
-> v
-> Action conn (Either (AutoKey v) (AutoKey v))
insertByAll RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Bool
manyNulls v
v = do
let e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy v
v
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
(Int
constructorNum, [(String, [PersistValue] -> [PersistValue])]
uniques) = v -> (Int, [(String, [PersistValue] -> [PersistValue])])
forall v.
PersistEntity v =>
v -> (Int, [(String, [PersistValue] -> [PersistValue])])
getUniques v
v
constr :: ConstructorDef
constr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Int
constructorNum
uniqueDefs :: [UniqueDef' String (Either (String, DbType) String)]
uniqueDefs = ConstructorDef
-> [UniqueDef' String (Either (String, DbType) String)]
forall str dbType.
ConstructorDef' str dbType
-> [UniqueDef' str (Either (str, dbType) str)]
constrUniques ConstructorDef
constr
query :: Utf8
query = Utf8
"SELECT " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8 -> Maybe Utf8 -> Utf8
forall a. a -> Maybe a -> a
fromMaybe Utf8
"1" ((Utf8 -> Utf8) -> ConstructorDef -> Maybe Utf8
constrId Utf8 -> Utf8
esc ConstructorDef
constr) Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
cond
conds :: [RenderS Any Any]
conds = [Maybe (RenderS Any Any)] -> [RenderS Any Any]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (RenderS Any Any)] -> [RenderS Any Any])
-> [Maybe (RenderS Any Any)] -> [RenderS Any Any]
forall a b. (a -> b) -> a -> b
$ ([Utf8]
-> (String, [PersistValue] -> [PersistValue])
-> Maybe (RenderS Any Any))
-> [[Utf8]]
-> [(String, [PersistValue] -> [PersistValue])]
-> [Maybe (RenderS Any Any)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[Utf8]
uFields (String
_, [PersistValue] -> [PersistValue]
uVals) -> ([PersistValue] -> [PersistValue])
-> RenderS Any Any -> Maybe (RenderS Any Any)
checkNulls [PersistValue] -> [PersistValue]
uVals (RenderS Any Any -> Maybe (RenderS Any Any))
-> RenderS Any Any -> Maybe (RenderS Any Any)
forall a b. (a -> b) -> a -> b
$ RenderS Any Any -> [RenderS Any Any] -> RenderS Any Any
forall s. StringLike s => s -> [s] -> s
intercalateS RenderS Any Any
" AND " ([RenderS Any Any] -> RenderS Any Any)
-> [RenderS Any Any] -> RenderS Any Any
forall a b. (a -> b) -> a -> b
$ [Utf8] -> ([PersistValue] -> [PersistValue]) -> [RenderS Any Any]
forall conn r.
[Utf8] -> ([PersistValue] -> [PersistValue]) -> [RenderS conn r]
mkUniqueCond [Utf8]
uFields [PersistValue] -> [PersistValue]
uVals) ((UniqueDef' String (Either (String, DbType) String)
-> Maybe [Utf8])
-> [UniqueDef' String (Either (String, DbType) String)] -> [[Utf8]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe UniqueDef' String (Either (String, DbType) String) -> Maybe [Utf8]
f [UniqueDef' String (Either (String, DbType) String)]
uniqueDefs) [(String, [PersistValue] -> [PersistValue])]
uniques
where
f :: UniqueDef' String (Either (String, DbType) String) -> Maybe [Utf8]
f u :: UniqueDef' String (Either (String, DbType) String)
u@(UniqueDef Maybe String
_ UniqueType
_ [Either (String, DbType) String]
uFields) =
if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [Either (String, DbType) String] -> [String]
forall a b. [Either a b] -> [b]
rights [Either (String, DbType) String]
uFields
then [Utf8] -> Maybe [Utf8]
forall a. a -> Maybe a
Just ([Utf8] -> Maybe [Utf8]) -> [Utf8] -> Maybe [Utf8]
forall a b. (a -> b) -> a -> b
$ ((String, DbType) -> [Utf8] -> [Utf8])
-> [Utf8] -> [(String, DbType)] -> [Utf8]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Utf8 -> Utf8) -> (String, DbType) -> [Utf8] -> [Utf8]
forall s.
StringLike s =>
(s -> s) -> (String, DbType) -> [s] -> [s]
flatten Utf8 -> Utf8
esc) [] ([(String, DbType)] -> [Utf8]) -> [(String, DbType)] -> [Utf8]
forall a b. (a -> b) -> a -> b
$ UniqueDef' String (Either (String, DbType) String)
-> [(String, DbType)]
forall str field. UniqueDef' str (Either field str) -> [field]
getUniqueFields UniqueDef' String (Either (String, DbType) String)
u
else Maybe [Utf8]
forall a. Maybe a
Nothing
checkNulls :: ([PersistValue] -> [PersistValue])
-> RenderS Any Any -> Maybe (RenderS Any Any)
checkNulls [PersistValue] -> [PersistValue]
uVals RenderS Any Any
x = if Bool
manyNulls Bool -> Bool -> Bool
&& PersistValue -> [PersistValue] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem PersistValue
PersistNull ([PersistValue] -> [PersistValue]
uVals []) then Maybe (RenderS Any Any)
forall a. Maybe a
Nothing else RenderS Any Any -> Maybe (RenderS Any Any)
forall a. a -> Maybe a
Just RenderS Any Any
x
RenderS Utf8
cond [PersistValue] -> [PersistValue]
vals = RenderS Any Any -> [RenderS Any Any] -> RenderS Any Any
forall s. StringLike s => s -> [s] -> s
intercalateS RenderS Any Any
" OR " [RenderS Any Any]
conds
if [RenderS Any Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RenderS Any Any]
conds
then AutoKey v -> Either (AutoKey v) (AutoKey v)
forall a b. b -> Either a b
Right (AutoKey v -> Either (AutoKey v) (AutoKey v))
-> ReaderT conn IO (AutoKey v)
-> Action conn (Either (AutoKey v) (AutoKey v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> ReaderT conn IO (AutoKey v)
forall conn v (m :: * -> *).
(PersistBackendConn conn, PersistEntity v, PersistBackend m,
Conn m ~ conn) =>
v -> m (AutoKey v)
Core.insert v
v
else do
Maybe [PersistValue]
x <- Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query ([PersistValue] -> [PersistValue]
vals []) Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue]
-> ReaderT conn IO (Maybe [PersistValue]))
-> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
case Maybe [PersistValue]
x of
Maybe [PersistValue]
Nothing -> AutoKey v -> Either (AutoKey v) (AutoKey v)
forall a b. b -> Either a b
Right (AutoKey v -> Either (AutoKey v) (AutoKey v))
-> ReaderT conn IO (AutoKey v)
-> Action conn (Either (AutoKey v) (AutoKey v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> ReaderT conn IO (AutoKey v)
forall conn v (m :: * -> *).
(PersistBackendConn conn, PersistEntity v, PersistBackend m,
Conn m ~ conn) =>
v -> m (AutoKey v)
Core.insert v
v
Just [PersistValue]
xs -> Either (AutoKey v) (AutoKey v)
-> Action conn (Either (AutoKey v) (AutoKey v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (AutoKey v) (AutoKey v)
-> Action conn (Either (AutoKey v) (AutoKey v)))
-> Either (AutoKey v) (AutoKey v)
-> Action conn (Either (AutoKey v) (AutoKey v))
forall a b. (a -> b) -> a -> b
$ AutoKey v -> Either (AutoKey v) (AutoKey v)
forall a b. a -> Either a b
Left (AutoKey v -> Either (AutoKey v) (AutoKey v))
-> AutoKey v -> Either (AutoKey v) (AutoKey v)
forall a b. (a -> b) -> a -> b
$ (AutoKey v, [PersistValue]) -> AutoKey v
forall a b. (a, b) -> a
fst ((AutoKey v, [PersistValue]) -> AutoKey v)
-> (AutoKey v, [PersistValue]) -> AutoKey v
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> (AutoKey v, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
xs
deleteBy ::
forall conn v.
(PersistBackendConn conn, PersistEntity v, PrimitivePersistField (Key v BackendSpecific)) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn ()) ->
Key v BackendSpecific ->
Action conn ()
deleteBy :: RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> Key v BackendSpecific
-> Action conn ()
deleteBy RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn ()
execFunc Key v BackendSpecific
k = Utf8 -> [PersistValue] -> Action conn ()
execFunc Utf8
query [Key v BackendSpecific -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Key v BackendSpecific
k]
where
e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy ((forall u. Key v u -> v
forall a. HasCallStack => a
undefined :: Key v u -> v) Key v BackendSpecific
k)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
constr :: ConstructorDef
constr = [ConstructorDef] -> ConstructorDef
forall a. [a] -> a
head ([ConstructorDef] -> ConstructorDef)
-> [ConstructorDef] -> ConstructorDef
forall a b. (a -> b) -> a -> b
$ EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e
idName :: Utf8
idName =
if [ConstructorDef] -> Bool
isSimple (EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e)
then Maybe Utf8 -> Utf8
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Utf8 -> Utf8) -> Maybe Utf8 -> Utf8
forall a b. (a -> b) -> a -> b
$ (Utf8 -> Utf8) -> ConstructorDef -> Maybe Utf8
constrId Utf8 -> Utf8
esc ConstructorDef
constr
else Utf8
"id"
query :: Utf8
query = Utf8
"DELETE FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> Utf8
forall s. StringLike s => (s -> s) -> EntityDef -> s
mainTableName Utf8 -> Utf8
esc EntityDef
e Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
idName Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"=?"
deleteAll ::
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn ()) ->
v ->
Action conn ()
deleteAll :: RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> v
-> Action conn ()
deleteAll RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn ()
execFunc (v
_ :: v) = Utf8 -> [PersistValue] -> Action conn ()
execFunc Utf8
query []
where
e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
query :: Utf8
query = Utf8
"DELETE FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> Utf8
forall s. StringLike s => (s -> s) -> EntityDef -> s
mainTableName Utf8 -> Utf8
esc EntityDef
e
countAll ::
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
v ->
Action conn Int
countAll :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> v
-> Action conn Int
countAll RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc (v
_ :: v) = do
let e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy (v
forall a. HasCallStack => a
undefined :: v)
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
query :: Utf8
query = Utf8
"SELECT COUNT(*) FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> Utf8
forall s. StringLike s => (s -> s) -> EntityDef -> s
mainTableName Utf8 -> Utf8
esc EntityDef
e
Maybe [PersistValue]
x <- Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query [] Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue]
-> ReaderT conn IO (Maybe [PersistValue]))
-> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
case Maybe [PersistValue]
x of
Just [PersistValue
num] -> Int -> Action conn Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Action conn Int) -> Int -> Action conn Int
forall a b. (a -> b) -> a -> b
$ PersistValue -> Int
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
num
Just [PersistValue]
xs -> String -> Action conn Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action conn Int) -> String -> Action conn Int
forall a b. (a -> b) -> a -> b
$ String
"requested 1 column, returned " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
xs)
Maybe [PersistValue]
Nothing -> String -> Action conn Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"COUNT returned no rows"
insertBy ::
forall conn v u.
(PersistBackendConn conn, PersistEntity v, IsUniqueKey (Key v (Unique u))) =>
RenderConfig ->
(Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
Bool ->
u (UniqueMarker v) ->
v ->
Action conn (Either (AutoKey v) (AutoKey v))
insertBy :: RenderConfig
-> (Utf8
-> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Bool
-> u (UniqueMarker v)
-> v
-> Action conn (Either (AutoKey v) (AutoKey v))
insertBy conf :: RenderConfig
conf@RenderConfig {Utf8 -> Utf8
esc :: Utf8 -> Utf8
esc :: RenderConfig -> Utf8 -> Utf8
..} Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Bool
manyNulls u (UniqueMarker v)
u v
v = do
[PersistValue] -> [PersistValue]
uniques <- Key v (Unique u)
-> ReaderT conn IO ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues (v -> Key v (Unique u)
forall uKey v u. (IsUniqueKey uKey, uKey ~ Key v u) => v -> uKey
extractUnique v
v Key v (Unique u) -> Key v (Unique u) -> Key v (Unique u)
forall a. a -> a -> a
`asTypeOf` (u (UniqueMarker v) -> Key v (Unique u)
forall a. HasCallStack => a
undefined :: u (UniqueMarker v) -> Key v (Unique u)) u (UniqueMarker v)
u)
let e :: EntityDef
e = Any conn -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any conn
proxy v
v
proxy :: Any conn
proxy = forall a. HasCallStack => a
forall (proxy :: * -> *). proxy conn
undefined :: proxy conn
uFields :: [Utf8]
uFields = RenderConfig -> FieldChain -> [Utf8] -> [Utf8]
renderChain RenderConfig
conf (Any conn -> u (UniqueMarker v) -> FieldChain
forall f a db (proxy :: * -> *).
(FieldLike f a, DbDescriptor db, ProjectionDb f db) =>
proxy db -> f -> FieldChain
fieldChain Any conn
proxy u (UniqueMarker v)
u) []
RenderS Utf8
cond [PersistValue] -> [PersistValue]
vals = RenderS Any Any -> [RenderS Any Any] -> RenderS Any Any
forall s. StringLike s => s -> [s] -> s
intercalateS RenderS Any Any
" AND " ([RenderS Any Any] -> RenderS Any Any)
-> [RenderS Any Any] -> RenderS Any Any
forall a b. (a -> b) -> a -> b
$ [Utf8] -> ([PersistValue] -> [PersistValue]) -> [RenderS Any Any]
forall conn r.
[Utf8] -> ([PersistValue] -> [PersistValue]) -> [RenderS conn r]
mkUniqueCond [Utf8]
uFields [PersistValue] -> [PersistValue]
uniques
checkNulls :: ([PersistValue] -> [PersistValue]) -> Bool
checkNulls [PersistValue] -> [PersistValue]
uVals = Bool
manyNulls Bool -> Bool -> Bool
&& PersistValue -> [PersistValue] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem PersistValue
PersistNull ([PersistValue] -> [PersistValue]
uVals [])
constr :: ConstructorDef
constr = [ConstructorDef] -> ConstructorDef
forall a. [a] -> a
head ([ConstructorDef] -> ConstructorDef)
-> [ConstructorDef] -> ConstructorDef
forall a b. (a -> b) -> a -> b
$ EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e
query :: Utf8
query = Utf8
"SELECT " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8 -> Maybe Utf8 -> Utf8
forall a. a -> Maybe a -> a
fromMaybe Utf8
"1" ((Utf8 -> Utf8) -> ConstructorDef -> Maybe Utf8
constrId Utf8 -> Utf8
esc ConstructorDef
constr) Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
esc EntityDef
e ConstructorDef
constr Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
cond
if ([PersistValue] -> [PersistValue]) -> Bool
checkNulls [PersistValue] -> [PersistValue]
uniques
then AutoKey v -> Either (AutoKey v) (AutoKey v)
forall a b. b -> Either a b
Right (AutoKey v -> Either (AutoKey v) (AutoKey v))
-> ReaderT conn IO (AutoKey v)
-> Action conn (Either (AutoKey v) (AutoKey v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> ReaderT conn IO (AutoKey v)
forall conn v (m :: * -> *).
(PersistBackendConn conn, PersistEntity v, PersistBackend m,
Conn m ~ conn) =>
v -> m (AutoKey v)
Core.insert v
v
else do
Maybe [PersistValue]
x <- Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])
queryFunc Utf8
query ([PersistValue] -> [PersistValue]
vals []) Action conn (RowStream [PersistValue])
-> (RowStream [PersistValue]
-> ReaderT conn IO (Maybe [PersistValue]))
-> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT conn IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
case Maybe [PersistValue]
x of
Maybe [PersistValue]
Nothing -> AutoKey v -> Either (AutoKey v) (AutoKey v)
forall a b. b -> Either a b
Right (AutoKey v -> Either (AutoKey v) (AutoKey v))
-> ReaderT conn IO (AutoKey v)
-> Action conn (Either (AutoKey v) (AutoKey v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> ReaderT conn IO (AutoKey v)
forall conn v (m :: * -> *).
(PersistBackendConn conn, PersistEntity v, PersistBackend m,
Conn m ~ conn) =>
v -> m (AutoKey v)
Core.insert v
v
Just [PersistValue
k] -> Either (AutoKey v) (AutoKey v)
-> Action conn (Either (AutoKey v) (AutoKey v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (AutoKey v) (AutoKey v)
-> Action conn (Either (AutoKey v) (AutoKey v)))
-> Either (AutoKey v) (AutoKey v)
-> Action conn (Either (AutoKey v) (AutoKey v))
forall a b. (a -> b) -> a -> b
$ AutoKey v -> Either (AutoKey v) (AutoKey v)
forall a b. a -> Either a b
Left (AutoKey v -> Either (AutoKey v) (AutoKey v))
-> AutoKey v -> Either (AutoKey v) (AutoKey v)
forall a b. (a -> b) -> a -> b
$ (AutoKey v, [PersistValue]) -> AutoKey v
forall a b. (a, b) -> a
fst ((AutoKey v, [PersistValue]) -> AutoKey v)
-> (AutoKey v, [PersistValue]) -> AutoKey v
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> (AutoKey v, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue
k]
Just [PersistValue]
xs -> String -> Action conn (Either (AutoKey v) (AutoKey v))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action conn (Either (AutoKey v) (AutoKey v)))
-> String -> Action conn (Either (AutoKey v) (AutoKey v))
forall a b. (a -> b) -> a -> b
$ String
"unexpected query result: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
xs
constrId :: (Utf8 -> Utf8) -> ConstructorDef -> Maybe Utf8
constrId :: (Utf8 -> Utf8) -> ConstructorDef -> Maybe Utf8
constrId Utf8 -> Utf8
escape = (String -> Utf8) -> Maybe String -> Maybe Utf8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Utf8 -> Utf8
escape (Utf8 -> Utf8) -> (String -> Utf8) -> String -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Utf8
forall a. IsString a => String -> a
fromString) (Maybe String -> Maybe Utf8)
-> (ConstructorDef -> Maybe String) -> ConstructorDef -> Maybe Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorDef -> Maybe String
forall str dbType. ConstructorDef' str dbType -> Maybe str
constrAutoKeyName
toEntityPersistValues' :: (PersistBackendConn conn, PersistEntity v) => v -> Action conn [PersistValue]
toEntityPersistValues' :: v -> Action conn [PersistValue]
toEntityPersistValues' = (([PersistValue] -> [PersistValue]) -> [PersistValue])
-> ReaderT conn IO ([PersistValue] -> [PersistValue])
-> Action conn [PersistValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([PersistValue] -> [PersistValue])
-> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ []) (ReaderT conn IO ([PersistValue] -> [PersistValue])
-> Action conn [PersistValue])
-> (v -> ReaderT conn IO ([PersistValue] -> [PersistValue]))
-> v
-> Action conn [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ReaderT conn IO ([PersistValue] -> [PersistValue])
forall v (m :: * -> *).
(PersistEntity v, PersistBackend m) =>
v -> m ([PersistValue] -> [PersistValue])
toEntityPersistValues
mkUniqueCond :: [Utf8] -> ([PersistValue] -> [PersistValue]) -> [RenderS conn r]
mkUniqueCond :: [Utf8] -> ([PersistValue] -> [PersistValue]) -> [RenderS conn r]
mkUniqueCond [Utf8]
u [PersistValue] -> [PersistValue]
vals = (Utf8 -> PersistValue -> RenderS conn r)
-> [Utf8] -> [PersistValue] -> [RenderS conn r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Utf8 -> PersistValue -> RenderS conn r
forall db r. Utf8 -> PersistValue -> RenderS db r
f [Utf8]
u ([PersistValue] -> [PersistValue]
vals [])
where
f :: Utf8 -> PersistValue -> RenderS db r
f Utf8
a PersistValue
PersistNull = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS (Utf8
a Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" IS NULL") [PersistValue] -> [PersistValue]
forall a. a -> a
id
f Utf8
a PersistValue
x = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS (Utf8
a Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"=?") (PersistValue
x PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
:)