{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | This helper module contains generic versions of PersistBackend functions
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

-- | It may call the passed function multiple times
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 ->
  -- | function to run query
  (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 ->
  -- | function to execute query
  (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 -- the entries in the constructor table are deleted because of the reference on delete cascade
          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 ->
  -- | function to run query
  (Utf8 -> [PersistValue] -> Action conn (RowStream [PersistValue])) ->
  -- | allow multiple duplication of uniques with nulls
  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
      -- skip condition if any value is NULL. It allows to insert many values with duplicate unique key
      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"
    -- the entries in the constructor table are deleted because of the reference on delete cascade
    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
      -- skip condition if any value is NULL. It allows to insert many values with duplicate unique key
      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 [])
      -- this is safe because unique keys exist only for entities with one constructor
      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]
:)