{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
module Database.Persist.Class.PersistUnique
( PersistUniqueRead(..)
, PersistUniqueWrite(..)
, OnlyOneUniqueKey(..)
, onlyOneUniqueDef
, AtLeastOneUniqueKey(..)
, atLeastOneUniqueDef
, NoUniqueKeysError
, MultipleUniqueKeysError
, getByValue
, getByValueUniques
, insertBy
, insertUniqueEntity
, replaceUnique
, checkUnique
, checkUniqueUpdateable
, onlyUnique
, defaultUpsertBy
, defaultPutMany
, persistUniqueKeyValues
)
where
import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Reader (ReaderT)
import Data.Function (on)
import Data.List (deleteFirstsBy, (\\))
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import GHC.TypeLits (ErrorMessage(..))
import Database.Persist.Class.PersistEntity
import Database.Persist.Class.PersistStore
import Database.Persist.Types
class PersistStoreRead backend => PersistUniqueRead backend where
getBy
:: forall record m. (MonadIO m, PersistRecordBackend record backend)
=> Unique record -> ReaderT backend m (Maybe (Entity record))
class (PersistUniqueRead backend, PersistStoreWrite backend) =>
PersistUniqueWrite backend where
deleteBy
:: forall record m. (MonadIO m, PersistRecordBackend record backend)
=> Unique record -> ReaderT backend m ()
insertUnique
:: forall record m. (MonadIO m, PersistRecordBackend record backend)
=> record -> ReaderT backend m (Maybe (Key record))
insertUnique record
datum = do
Maybe (Unique record)
conflict <- record -> ReaderT backend m (Maybe (Unique record))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
PersistUniqueRead backend) =>
record -> ReaderT backend m (Maybe (Unique record))
checkUnique record
datum
case Maybe (Unique record)
conflict of
Maybe (Unique record)
Nothing -> Key record -> Maybe (Key record)
forall a. a -> Maybe a
Just (Key record -> Maybe (Key record))
-> ReaderT backend m (Key record)
-> ReaderT backend m (Maybe (Key record))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` record -> ReaderT backend m (Key record)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert record
datum
Just Unique record
_ -> Maybe (Key record) -> ReaderT backend m (Maybe (Key record))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Key record)
forall a. Maybe a
Nothing
upsert
:: forall record m. (MonadIO m, PersistRecordBackend record backend, OnlyOneUniqueKey record)
=> record
-> [Update record]
-> ReaderT backend m (Entity record)
upsert record
record [Update record]
updates = do
Unique record
uniqueKey <- record -> ReaderT backend m (Unique record)
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueWrite backend,
PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> ReaderT backend m (Unique record)
onlyUnique record
record
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
upsertBy Unique record
uniqueKey record
record [Update record]
updates
upsertBy
:: forall record m. (MonadIO m, PersistRecordBackend record backend)
=> Unique record
-> record
-> [Update record]
-> ReaderT backend m (Entity record)
upsertBy = Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
PersistEntity record, MonadIO m, PersistStoreWrite backend,
PersistUniqueRead backend) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
defaultUpsertBy
putMany
:: forall record m.
( MonadIO m
, PersistRecordBackend record backend
)
=> [record]
-> ReaderT backend m ()
putMany = [record] -> ReaderT backend m ()
forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
PersistEntity record, MonadIO m, PersistStoreWrite backend,
PersistUniqueRead backend) =>
[record] -> ReaderT backend m ()
defaultPutMany
class PersistEntity record => OnlyOneUniqueKey record where
onlyUniqueP :: record -> Unique record
onlyOneUniqueDef
:: (OnlyOneUniqueKey record, Monad proxy)
=> proxy record
-> UniqueDef
onlyOneUniqueDef :: proxy record -> UniqueDef
onlyOneUniqueDef proxy record
prxy =
case EntityDef -> [UniqueDef]
getEntityUniques (proxy record -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef proxy record
prxy) of
[UniqueDef
uniq] -> UniqueDef
uniq
[UniqueDef]
_ -> [Char] -> UniqueDef
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible due to OnlyOneUniqueKey constraint"
type NoUniqueKeysError ty =
'Text "The entity "
':<>: 'ShowType ty
':<>: 'Text " does not have any unique keys."
':$$: 'Text "The function you are trying to call requires a unique key "
':<>: 'Text "to be defined on the entity."
type MultipleUniqueKeysError ty =
'Text "The entity "
':<>: 'ShowType ty
':<>: 'Text " has multiple unique keys."
':$$: 'Text "The function you are trying to call requires only a single "
':<>: 'Text "unique key."
':$$: 'Text "There is probably a variant of the function with 'By' "
':<>: 'Text "appended that will allow you to select a unique key "
':<>: 'Text "for the operation."
class PersistEntity record => AtLeastOneUniqueKey record where
requireUniquesP :: record -> NonEmpty (Unique record)
atLeastOneUniqueDef
:: (AtLeastOneUniqueKey record, Monad proxy)
=> proxy record
-> NonEmpty UniqueDef
atLeastOneUniqueDef :: proxy record -> NonEmpty UniqueDef
atLeastOneUniqueDef proxy record
prxy =
case EntityDef -> [UniqueDef]
getEntityUniques (proxy record -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef proxy record
prxy) of
(UniqueDef
x:[UniqueDef]
xs) -> UniqueDef
x UniqueDef -> [UniqueDef] -> NonEmpty UniqueDef
forall a. a -> [a] -> NonEmpty a
:| [UniqueDef]
xs
[UniqueDef]
_ ->
[Char] -> NonEmpty UniqueDef
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible due to AtLeastOneUniqueKey record constraint"
insertBy
:: forall record backend m.
( MonadIO m
, PersistUniqueWrite backend
, PersistRecordBackend record backend
, AtLeastOneUniqueKey record
)
=> record -> ReaderT backend m (Either (Entity record) (Key record))
insertBy :: record -> ReaderT backend m (Either (Entity record) (Key record))
insertBy record
val = do
Maybe (Entity record)
res <- record -> ReaderT backend m (Maybe (Entity record))
forall record (m :: * -> *) backend.
(MonadIO m, PersistUniqueRead backend,
PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
record -> ReaderT backend m (Maybe (Entity record))
getByValue record
val
case Maybe (Entity record)
res of
Maybe (Entity record)
Nothing -> Key record -> Either (Entity record) (Key record)
forall a b. b -> Either a b
Right (Key record -> Either (Entity record) (Key record))
-> ReaderT backend m (Key record)
-> ReaderT backend m (Either (Entity record) (Key record))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` record -> ReaderT backend m (Key record)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert record
val
Just Entity record
z -> Either (Entity record) (Key record)
-> ReaderT backend m (Either (Entity record) (Key record))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Entity record) (Key record)
-> ReaderT backend m (Either (Entity record) (Key record)))
-> Either (Entity record) (Key record)
-> ReaderT backend m (Either (Entity record) (Key record))
forall a b. (a -> b) -> a -> b
$ Entity record -> Either (Entity record) (Key record)
forall a b. a -> Either a b
Left Entity record
z
insertUniqueEntity
:: forall record backend m
. ( MonadIO m
, PersistRecordBackend record backend
, PersistUniqueWrite backend
)
=> record
-> ReaderT backend m (Maybe (Entity record))
insertUniqueEntity :: record -> ReaderT backend m (Maybe (Entity record))
insertUniqueEntity record
datum =
(Key record -> Entity record)
-> Maybe (Key record) -> Maybe (Entity record)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Key record
key -> Key record -> record -> Entity record
forall record. Key record -> record -> Entity record
Entity Key record
key record
datum) (Maybe (Key record) -> Maybe (Entity record))
-> ReaderT backend m (Maybe (Key record))
-> ReaderT backend m (Maybe (Entity record))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` record -> ReaderT backend m (Maybe (Key record))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique record
datum
onlyUnique
:: forall record backend m.
( MonadIO m
, PersistUniqueWrite backend
, PersistRecordBackend record backend
, OnlyOneUniqueKey record
)
=> record -> ReaderT backend m (Unique record)
onlyUnique :: record -> ReaderT backend m (Unique record)
onlyUnique = Unique record -> ReaderT backend m (Unique record)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unique record -> ReaderT backend m (Unique record))
-> (record -> Unique record)
-> record
-> ReaderT backend m (Unique record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> Unique record
forall record. OnlyOneUniqueKey record => record -> Unique record
onlyUniqueP
getByValue
:: forall record m backend.
( MonadIO m
, PersistUniqueRead backend
, PersistRecordBackend record backend
, AtLeastOneUniqueKey record
)
=> record -> ReaderT backend m (Maybe (Entity record))
getByValue :: record -> ReaderT backend m (Maybe (Entity record))
getByValue record
record = do
let uniqs :: NonEmpty (Unique record)
uniqs = record -> NonEmpty (Unique record)
forall record.
AtLeastOneUniqueKey record =>
record -> NonEmpty (Unique record)
requireUniquesP record
record
[Unique record] -> ReaderT backend m (Maybe (Entity record))
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueRead backend,
PersistRecordBackend record backend) =>
[Unique record] -> ReaderT backend m (Maybe (Entity record))
getByValueUniques (NonEmpty (Unique record) -> [Unique record]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty (Unique record)
uniqs)
getByValueUniques
:: forall record backend m.
( MonadIO m
, PersistUniqueRead backend
, PersistRecordBackend record backend
)
=> [Unique record]
-> ReaderT backend m (Maybe (Entity record))
getByValueUniques :: [Unique record] -> ReaderT backend m (Maybe (Entity record))
getByValueUniques [Unique record]
uniqs =
[Unique record] -> ReaderT backend m (Maybe (Entity record))
forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueRead backend, PersistEntity record,
PersistEntityBackend record ~ BaseBackend backend) =>
[Unique record] -> ReaderT backend m (Maybe (Entity record))
checkUniques [Unique record]
uniqs
where
checkUniques :: [Unique record] -> ReaderT backend m (Maybe (Entity record))
checkUniques [] = Maybe (Entity record) -> ReaderT backend m (Maybe (Entity record))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Entity record)
forall a. Maybe a
Nothing
checkUniques (Unique record
x:[Unique record]
xs) = do
Maybe (Entity record)
y <- Unique record -> ReaderT backend m (Maybe (Entity record))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy Unique record
x
case Maybe (Entity record)
y of
Maybe (Entity record)
Nothing -> [Unique record] -> ReaderT backend m (Maybe (Entity record))
checkUniques [Unique record]
xs
Just Entity record
z -> Maybe (Entity record) -> ReaderT backend m (Maybe (Entity record))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Entity record)
-> ReaderT backend m (Maybe (Entity record)))
-> Maybe (Entity record)
-> ReaderT backend m (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ Entity record -> Maybe (Entity record)
forall a. a -> Maybe a
Just Entity record
z
replaceUnique
:: forall record backend m. ( MonadIO m
, Eq (Unique record)
, PersistRecordBackend record backend
, PersistUniqueWrite backend )
=> Key record -> record -> ReaderT backend m (Maybe (Unique record))
replaceUnique :: Key record -> record -> ReaderT backend m (Maybe (Unique record))
replaceUnique Key record
key record
datumNew = Key record -> ReaderT backend m record
forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key record
key ReaderT backend m record
-> (record -> ReaderT backend m (Maybe (Unique record)))
-> ReaderT backend m (Maybe (Unique record))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= record -> ReaderT backend m (Maybe (Unique record))
replaceOriginal
where
uniqueKeysNew :: [Unique record]
uniqueKeysNew = record -> [Unique record]
forall record. PersistEntity record => record -> [Unique record]
persistUniqueKeys record
datumNew
replaceOriginal :: record -> ReaderT backend m (Maybe (Unique record))
replaceOriginal record
original = do
Maybe (Unique record)
conflict <- [Unique record] -> ReaderT backend m (Maybe (Unique record))
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueRead backend,
PersistRecordBackend record backend) =>
[Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeys [Unique record]
changedKeys
case Maybe (Unique record)
conflict of
Maybe (Unique record)
Nothing -> Key record -> record -> ReaderT backend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
replace Key record
key record
datumNew ReaderT backend m ()
-> ReaderT backend m (Maybe (Unique record))
-> ReaderT backend m (Maybe (Unique record))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Unique record) -> ReaderT backend m (Maybe (Unique record))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Unique record)
forall a. Maybe a
Nothing
(Just Unique record
conflictingKey) -> Maybe (Unique record) -> ReaderT backend m (Maybe (Unique record))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Unique record)
-> ReaderT backend m (Maybe (Unique record)))
-> Maybe (Unique record)
-> ReaderT backend m (Maybe (Unique record))
forall a b. (a -> b) -> a -> b
$ Unique record -> Maybe (Unique record)
forall a. a -> Maybe a
Just Unique record
conflictingKey
where
changedKeys :: [Unique record]
changedKeys = [Unique record]
uniqueKeysNew [Unique record] -> [Unique record] -> [Unique record]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Unique record]
uniqueKeysOriginal
uniqueKeysOriginal :: [Unique record]
uniqueKeysOriginal = record -> [Unique record]
forall record. PersistEntity record => record -> [Unique record]
persistUniqueKeys record
original
checkUnique
:: forall record backend m. ( MonadIO m
, PersistRecordBackend record backend
, PersistUniqueRead backend)
=> record -> ReaderT backend m (Maybe (Unique record))
checkUnique :: record -> ReaderT backend m (Maybe (Unique record))
checkUnique = [Unique record] -> ReaderT backend m (Maybe (Unique record))
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueRead backend,
PersistRecordBackend record backend) =>
[Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeys ([Unique record] -> ReaderT backend m (Maybe (Unique record)))
-> (record -> [Unique record])
-> record
-> ReaderT backend m (Maybe (Unique record))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> [Unique record]
forall record. PersistEntity record => record -> [Unique record]
persistUniqueKeys
checkUniqueKeys
:: forall record backend m. ( MonadIO m
, PersistUniqueRead backend
, PersistRecordBackend record backend)
=> [Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeys :: [Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeys [] = Maybe (Unique record) -> ReaderT backend m (Maybe (Unique record))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Unique record)
forall a. Maybe a
Nothing
checkUniqueKeys (Unique record
x:[Unique record]
xs) = do
Maybe (Entity record)
y <- Unique record -> ReaderT backend m (Maybe (Entity record))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy Unique record
x
case Maybe (Entity record)
y of
Maybe (Entity record)
Nothing -> [Unique record] -> ReaderT backend m (Maybe (Unique record))
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueRead backend,
PersistRecordBackend record backend) =>
[Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeys [Unique record]
xs
Just Entity record
_ -> Maybe (Unique record) -> ReaderT backend m (Maybe (Unique record))
forall (m :: * -> *) a. Monad m => a -> m a
return (Unique record -> Maybe (Unique record)
forall a. a -> Maybe a
Just Unique record
x)
checkUniqueUpdateable
:: forall record backend m. ( MonadIO m
, PersistRecordBackend record backend
, PersistUniqueRead backend)
=> Entity record -> ReaderT backend m (Maybe (Unique record))
checkUniqueUpdateable :: Entity record -> ReaderT backend m (Maybe (Unique record))
checkUniqueUpdateable (Entity Key record
key record
record) = Key record
-> [Unique record] -> ReaderT backend m (Maybe (Unique record))
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueRead backend,
PersistRecordBackend record backend) =>
Key record
-> [Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeysUpdateable Key record
key (record -> [Unique record]
forall record. PersistEntity record => record -> [Unique record]
persistUniqueKeys record
record)
checkUniqueKeysUpdateable
:: forall record backend m. ( MonadIO m
, PersistUniqueRead backend
, PersistRecordBackend record backend)
=> Key record -> [Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeysUpdateable :: Key record
-> [Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeysUpdateable Key record
_ [] = Maybe (Unique record) -> ReaderT backend m (Maybe (Unique record))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Unique record)
forall a. Maybe a
Nothing
checkUniqueKeysUpdateable Key record
key (Unique record
x:[Unique record]
xs) = do
Maybe (Entity record)
y <- Unique record -> ReaderT backend m (Maybe (Entity record))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy Unique record
x
case Maybe (Entity record)
y of
Maybe (Entity record)
Nothing -> Key record
-> [Unique record] -> ReaderT backend m (Maybe (Unique record))
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueRead backend,
PersistRecordBackend record backend) =>
Key record
-> [Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeysUpdateable Key record
key [Unique record]
xs
Just (Entity Key record
k record
_)
| Key record
key Key record -> Key record -> Bool
forall a. Eq a => a -> a -> Bool
== Key record
k -> Key record
-> [Unique record] -> ReaderT backend m (Maybe (Unique record))
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueRead backend,
PersistRecordBackend record backend) =>
Key record
-> [Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeysUpdateable Key record
key [Unique record]
xs
Just Entity record
_ -> Maybe (Unique record) -> ReaderT backend m (Maybe (Unique record))
forall (m :: * -> *) a. Monad m => a -> m a
return (Unique record -> Maybe (Unique record)
forall a. a -> Maybe a
Just Unique record
x)
defaultUpsertBy
:: ( PersistEntityBackend record ~ BaseBackend backend
, PersistEntity record
, MonadIO m
, PersistStoreWrite backend
, PersistUniqueRead backend
)
=> Unique record
-> record
-> [Update record]
-> ReaderT backend m (Entity record)
defaultUpsertBy :: Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
defaultUpsertBy Unique record
uniqueKey record
record [Update record]
updates = do
Maybe (Entity record)
mrecord <- Unique record -> ReaderT backend m (Maybe (Entity record))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy Unique record
uniqueKey
ReaderT backend m (Entity record)
-> (Entity record -> ReaderT backend m (Entity record))
-> Maybe (Entity record)
-> ReaderT backend m (Entity record)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (record -> ReaderT backend m (Entity record)
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
MonadIO m) =>
e -> ReaderT backend m (Entity e)
insertEntity record
record) (Entity record
-> [Update record] -> ReaderT backend m (Entity record)
forall (m :: * -> *) backend record.
(MonadIO m, PersistStoreWrite backend, PersistEntity record,
PersistEntityBackend record ~ BaseBackend backend) =>
Entity record
-> [Update record] -> ReaderT backend m (Entity record)
`updateGetEntity` [Update record]
updates) Maybe (Entity record)
mrecord
where
updateGetEntity :: Entity record
-> [Update record] -> ReaderT backend m (Entity record)
updateGetEntity (Entity Key record
k record
_) [Update record]
upds =
(Key record -> record -> Entity record
forall record. Key record -> record -> Entity record
Entity Key record
k) (record -> Entity record)
-> ReaderT backend m record -> ReaderT backend m (Entity record)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (Key record -> [Update record] -> ReaderT backend m record
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m record
updateGet Key record
k [Update record]
upds)
defaultPutMany
:: forall record backend m. ( PersistEntityBackend record ~ BaseBackend backend
, PersistEntity record
, MonadIO m
, PersistStoreWrite backend
, PersistUniqueRead backend
)
=> [record]
-> ReaderT backend m ()
defaultPutMany :: [record] -> ReaderT backend m ()
defaultPutMany [] = () -> ReaderT backend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
defaultPutMany rsD :: [record]
rsD@(record
e:[record]
_) = do
case record -> [Unique record]
forall record. PersistEntity record => record -> [Unique record]
persistUniqueKeys record
e of
[] -> [record] -> ReaderT backend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ [record]
rsD
[Unique record]
_ -> ReaderT backend m ()
go
where
go :: ReaderT backend m ()
go = do
let rs :: [record]
rs = (([PersistValue], record) -> record)
-> [([PersistValue], record)] -> [record]
forall a b. (a -> b) -> [a] -> [b]
map ([PersistValue], record) -> record
forall a b. (a, b) -> b
snd
([([PersistValue], record)] -> [record])
-> ([record] -> [([PersistValue], record)]) -> [record] -> [record]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [PersistValue] record -> [([PersistValue], record)]
forall k a. Map k a -> [(k, a)]
Map.toList
(Map [PersistValue] record -> [([PersistValue], record)])
-> ([record] -> Map [PersistValue] record)
-> [record]
-> [([PersistValue], record)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([PersistValue], record)] -> Map [PersistValue] record
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
([([PersistValue], record)] -> Map [PersistValue] record)
-> ([record] -> [([PersistValue], record)])
-> [record]
-> Map [PersistValue] record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (record -> ([PersistValue], record))
-> [record] -> [([PersistValue], record)]
forall a b. (a -> b) -> [a] -> [b]
map (\record
r -> (record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
persistUniqueKeyValues record
r, record
r))
([record] -> [record]) -> [record] -> [record]
forall a b. (a -> b) -> a -> b
$ [record]
rsD
[Maybe (Entity record)]
mEsOld <- (record -> ReaderT backend m (Maybe (Entity record)))
-> [record] -> ReaderT backend m [Maybe (Entity record)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Unique record] -> ReaderT backend m (Maybe (Entity record))
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueRead backend,
PersistRecordBackend record backend) =>
[Unique record] -> ReaderT backend m (Maybe (Entity record))
getByValueUniques ([Unique record] -> ReaderT backend m (Maybe (Entity record)))
-> (record -> [Unique record])
-> record
-> ReaderT backend m (Maybe (Entity record))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> [Unique record]
forall record. PersistEntity record => record -> [Unique record]
persistUniqueKeys) [record]
rs
let merge :: Maybe a -> b -> Maybe (a, b)
merge (Just a
x) b
y = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
x, b
y)
merge Maybe a
_ b
_ = Maybe (a, b)
forall a. Maybe a
Nothing
let mEsOldAndRs :: [Maybe (Entity record, record)]
mEsOldAndRs = (Maybe (Entity record) -> record -> Maybe (Entity record, record))
-> [Maybe (Entity record)]
-> [record]
-> [Maybe (Entity record, record)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Maybe (Entity record) -> record -> Maybe (Entity record, record)
forall a b. Maybe a -> b -> Maybe (a, b)
merge [Maybe (Entity record)]
mEsOld [record]
rs
let esOldAndRs :: [(Entity record, record)]
esOldAndRs = [Maybe (Entity record, record)] -> [(Entity record, record)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Entity record, record)]
mEsOldAndRs
let esOld :: [Entity record]
esOld = ((Entity record, record) -> Entity record)
-> [(Entity record, record)] -> [Entity record]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Entity record, record) -> Entity record
forall a b. (a, b) -> a
fst [(Entity record, record)]
esOldAndRs
let rsOld :: [record]
rsOld = (Entity record -> record) -> [Entity record] -> [record]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity record -> record
forall record. Entity record -> record
entityVal [Entity record]
esOld
let rsNew :: [record]
rsNew = (record -> record -> Bool) -> [record] -> [record] -> [record]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy ([PersistValue] -> [PersistValue] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([PersistValue] -> [PersistValue] -> Bool)
-> (record -> [PersistValue]) -> record -> record -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
persistUniqueKeyValues) [record]
rs [record]
rsOld
let rsUpd :: [record]
rsUpd = ((Entity record, record) -> record)
-> [(Entity record, record)] -> [record]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Entity record, record) -> record
forall a b. (a, b) -> b
snd [(Entity record, record)]
esOldAndRs
let ksOld :: [Key record]
ksOld = (Entity record -> Key record) -> [Entity record] -> [Key record]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity record -> Key record
forall record. Entity record -> Key record
entityKey [Entity record]
esOld
let krs :: [(Key record, record)]
krs = [Key record] -> [record] -> [(Key record, record)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key record]
ksOld [record]
rsUpd
[record] -> ReaderT backend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ [record]
rsNew
((Key record, record) -> ReaderT backend m ())
-> [(Key record, record)] -> ReaderT backend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Key record -> record -> ReaderT backend m ())
-> (Key record, record) -> ReaderT backend m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key record -> record -> ReaderT backend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
replace) [(Key record, record)]
krs
persistUniqueKeyValues :: PersistEntity record => record -> [PersistValue]
persistUniqueKeyValues :: record -> [PersistValue]
persistUniqueKeyValues = (Unique record -> [PersistValue])
-> [Unique record] -> [PersistValue]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Unique record -> [PersistValue]
forall record.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues ([Unique record] -> [PersistValue])
-> (record -> [Unique record]) -> record -> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> [Unique record]
forall record. PersistEntity record => record -> [Unique record]
persistUniqueKeys