persistent-2.18.0.0: Database/Persist/Class/PersistStore.hs
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE TypeOperators #-}
module Database.Persist.Class.PersistStore
( HasPersistBackend (..)
, withBaseBackend
, IsPersistBackend (..)
, PersistRecordBackend
, liftPersist
, PersistCore (..)
, PersistStoreRead (..)
, PersistStoreWrite (..)
, getEntity
, getJust
, getJustEntity
, belongsTo
, belongsToJust
, insertEntity
, insertRecord
, ToBackendKey (..)
, BackendCompatible (..)
, withCompatibleBackend
) where
import Control.Exception (throwIO)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader (ask), runReaderT)
import Control.Monad.Trans.Reader (ReaderT, withReaderT)
import qualified Data.Aeson as A
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text as T
import GHC.Stack
import Database.Persist.Class.PersistEntity
import Database.Persist.Class.PersistField
import Database.Persist.Types
-- | Class which allows the plucking of a @BaseBackend backend@ from some larger type.
-- For example,
-- @
-- instance HasPersistBackend (SqlReadBackend, Int) where
-- type BaseBackend (SqlReadBackend, Int) = SqlBackend
-- persistBackend = unSqlReadBackend . fst
-- @
class HasPersistBackend backend where
type BaseBackend backend
persistBackend :: backend -> BaseBackend backend
-- | Run a query against a larger backend by plucking out @BaseBackend backend@
--
-- This is a helper for reusing existing queries when expanding the backend type.
--
-- @since 2.12.0
withBaseBackend
:: (HasPersistBackend backend)
=> ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend = withReaderT persistBackend
-- | Class which witnesses that @backend@ is essentially the same as @BaseBackend backend@.
-- That is, they're isomorphic and @backend@ is just some wrapper over @BaseBackend backend@.
class (HasPersistBackend backend) => IsPersistBackend backend where
-- | This function is how we actually construct and tag a backend as having read or write capabilities.
-- It should be used carefully and only when actually constructing a @backend@. Careless use allows us
-- to accidentally run a write query against a read-only database.
mkPersistBackend :: BaseBackend backend -> backend
-- NB: there is a deliberate *lack* of an equivalent to 'withBaseBackend' for
-- 'IsPersistentBackend'. We don't want it to be easy for the user to construct
-- a backend when they're not meant to.
-- | This class witnesses that two backend are compatible, and that you can
-- convert from the @sub@ backend into the @sup@ backend. This is similar
-- to the 'HasPersistBackend' and 'IsPersistBackend' classes, but where you
-- don't want to fix the type associated with the 'PersistEntityBackend' of
-- a record.
--
-- Generally speaking, where you might have:
--
-- @
-- foo ::
-- ( 'PersistEntity' record
-- , 'PersistEntityBackend' record ~ 'BaseBackend' backend
-- , 'IsSqlBackend' backend
-- )
-- @
--
-- this can be replaced with:
--
-- @
-- foo ::
-- ( 'PersistEntity' record,
-- , 'PersistEntityBackend' record ~ backend
-- , 'BackendCompatible' 'SqlBackend' backend
-- )
-- @
--
-- This works for 'SqlReadBackend' because of the @instance 'BackendCompatible' 'SqlBackend' 'SqlReadBackend'@, without needing to go through the 'BaseBackend' type family.
--
-- Likewise, functions that are currently hardcoded to use 'SqlBackend' can be generalized:
--
-- @
-- -- before:
-- asdf :: 'ReaderT' 'SqlBackend' m ()
-- asdf = pure ()
--
-- -- after:
-- asdf' :: 'BackendCompatible' SqlBackend backend => ReaderT backend m ()
-- asdf' = 'withCompatibleBackend' asdf
-- @
--
-- @since 2.7.1
class BackendCompatible sup sub where
projectBackend :: sub -> sup
-- | Run a query against a compatible backend, by projecting the backend
--
-- This is a helper for using queries which run against a specific backend type
-- that your backend is compatible with.
--
-- @since 2.12.0
withCompatibleBackend
:: (BackendCompatible sup sub)
=> ReaderT sup m a -> ReaderT sub m a
withCompatibleBackend = withReaderT projectBackend
-- | A convenient alias for common type signatures
type PersistRecordBackend record backend =
(PersistEntity record, PersistEntityBackend record ~ BaseBackend backend)
liftPersist
:: (MonadIO m, MonadReader backend m)
=> ReaderT backend IO b -> m b
liftPersist f = do
env <- ask
liftIO $ runReaderT f env
-- | 'ToBackendKey' converts a 'PersistEntity' 'Key' into a 'BackendKey'
-- This can be used by each backend to convert between a 'Key' and a plain
-- Haskell type. For Sql, that is done with 'toSqlKey' and 'fromSqlKey'.
--
-- By default, a 'PersistEntity' uses the default 'BackendKey' for its Key
-- and is an instance of ToBackendKey
--
-- A 'Key' that instead uses a custom type will not be an instance of
-- 'ToBackendKey'.
class
( PersistEntity record
, PersistEntityBackend record ~ backend
, PersistCore backend
) =>
ToBackendKey backend record
where
toBackendKey :: Key record -> BackendKey backend
fromBackendKey :: BackendKey backend -> Key record
class PersistCore backend where
data BackendKey backend
class
( Show (BackendKey backend)
, Read (BackendKey backend)
, Eq (BackendKey backend)
, Ord (BackendKey backend)
, PersistCore backend
, PersistField (BackendKey backend)
, A.ToJSON (BackendKey backend)
, A.FromJSON (BackendKey backend)
) =>
PersistStoreRead backend
where
-- | Get a record by identifier, if available.
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > getSpj :: MonadIO m => ReaderT SqlBackend m (Maybe User)
-- > getSpj = get spjId
--
-- > mspj <- getSpj
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will get this:
--
-- > +------+-----+
-- > | name | age |
-- > +------+-----+
-- > | SPJ | 40 |
-- > +------+-----+
get
:: forall record m
. (MonadIO m, PersistRecordBackend record backend)
=> Key record -> ReaderT backend m (Maybe record)
-- | Get many records by their respective identifiers, if available.
--
-- @since 2.8.1
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>:
--
-- > getUsers :: MonadIO m => ReaderT SqlBackend m (Map (Key User) User)
-- > getUsers = getMany allkeys
--
-- > musers <- getUsers
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will get these records:
--
-- > +----+-------+-----+
-- > | id | name | age |
-- > +----+-------+-----+
-- > | 1 | SPJ | 40 |
-- > +----+-------+-----+
-- > | 2 | Simon | 41 |
-- > +----+-------+-----+
getMany
:: forall record m
. (MonadIO m, PersistRecordBackend record backend)
=> [Key record] -> ReaderT backend m (Map (Key record) record)
getMany [] = return Map.empty
getMany ks = do
vs <- mapM get ks
let
kvs = zip ks vs
let
kvs' = (fmap Maybe.fromJust) `fmap` filter (\(_, v) -> Maybe.isJust v) kvs
return $ Map.fromList kvs'
class
( Show (BackendKey backend)
, Read (BackendKey backend)
, Eq (BackendKey backend)
, Ord (BackendKey backend)
, PersistStoreRead backend
, PersistField (BackendKey backend)
, A.ToJSON (BackendKey backend)
, A.FromJSON (BackendKey backend)
) =>
PersistStoreWrite backend
where
-- | Create a new record in the database, returning an automatically created
-- key (in SQL an auto-increment id).
--
-- === __Example usage__
--
-- Using <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, let's insert a new user 'John'.
--
-- > insertJohn :: MonadIO m => ReaderT SqlBackend m (Key User)
-- > insertJohn = insert $ User "John" 30
--
-- > johnId <- insertJohn
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |40 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
-- > |3 |John |30 |
-- > +-----+------+-----+
insert
:: forall record m
. (MonadIO m, PersistRecordBackend record backend, SafeToInsert record)
=> record -> ReaderT backend m (Key record)
-- | Same as 'insert', but doesn't return a @Key@.
--
-- === __Example usage__
--
-- with <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > insertJohn :: MonadIO m => ReaderT SqlBackend m (Key User)
-- > insertJohn = insert_ $ User "John" 30
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |40 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
-- > |3 |John |30 |
-- > +-----+------+-----+
insert_
:: forall record m
. (MonadIO m, PersistRecordBackend record backend, SafeToInsert record)
=> record -> ReaderT backend m ()
insert_ record = insert record >> return ()
-- | Create multiple records in the database and return their 'Key's.
--
-- If you don't need the inserted 'Key's, use 'insertMany_'.
--
-- The MongoDB and PostgreSQL backends insert all records and
-- retrieve their keys in one database query.
--
-- The SQLite and MySQL backends use the slow, default implementation of
-- @mapM insert@.
--
-- === __Example usage__
--
-- with <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > insertUsers :: MonadIO m => ReaderT SqlBackend m [Key User]
-- > insertUsers = insertMany [User "John" 30, User "Nick" 32, User "Jane" 20]
--
-- > userIds <- insertUsers
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |40 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
-- > |3 |John |30 |
-- > +-----+------+-----+
-- > |4 |Nick |32 |
-- > +-----+------+-----+
-- > |5 |Jane |20 |
-- > +-----+------+-----+
insertMany
:: forall record m
. (MonadIO m, PersistRecordBackend record backend, SafeToInsert record)
=> [record] -> ReaderT backend m [Key record]
insertMany = mapM insert
-- | Same as 'insertMany', but doesn't return any 'Key's.
--
-- The MongoDB, PostgreSQL, SQLite and MySQL backends insert all records in
-- one database query.
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > insertUsers_ :: MonadIO m => ReaderT SqlBackend m ()
-- > insertUsers_ = insertMany_ [User "John" 30, User "Nick" 32, User "Jane" 20]
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |40 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
-- > |3 |John |30 |
-- > +-----+------+-----+
-- > |4 |Nick |32 |
-- > +-----+------+-----+
-- > |5 |Jane |20 |
-- > +-----+------+-----+
insertMany_
:: forall record m
. (MonadIO m, PersistRecordBackend record backend, SafeToInsert record)
=> [record] -> ReaderT backend m ()
insertMany_ x = insertMany x >> return ()
-- | Same as 'insertMany_', but takes an 'Entity' instead of just a record.
--
-- Useful when migrating data from one entity to another
-- and want to preserve ids.
--
-- The MongoDB, PostgreSQL, SQLite and MySQL backends insert all records in
-- one database query.
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > insertUserEntityMany :: MonadIO m => ReaderT SqlBackend m ()
-- > insertUserEntityMany = insertEntityMany [SnakeEntity, EvaEntity]
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |40 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
-- > |3 |Snake |38 |
-- > +-----+------+-----+
-- > |4 |Eva |38 |
-- > +-----+------+-----+
insertEntityMany
:: forall record m
. (MonadIO m, PersistRecordBackend record backend)
=> [Entity record] -> ReaderT backend m ()
insertEntityMany = mapM_ (\(Entity k record) -> insertKey k record)
-- | Create a new record in the database using the given key.
--
-- === __Example usage__
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > insertAliceKey :: MonadIO m => Key User -> ReaderT SqlBackend m ()
-- > insertAliceKey key = insertKey key $ User "Alice" 20
--
-- > insertAliceKey $ UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 3}}
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |40 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
-- > |3 |Alice |20 |
-- > +-----+------+-----+
insertKey
:: forall record m
. (MonadIO m, PersistRecordBackend record backend)
=> Key record -> record -> ReaderT backend m ()
-- | Put the record in the database with the given key.
-- Unlike 'replace', if a record with the given key does not
-- exist then a new record will be inserted.
--
-- === __Example usage__
--
-- We try to explain 'upsertBy' using <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>.
--
-- First, we insert Philip to <#dataset-persist-store-1 dataset-1>.
--
-- > insertPhilip :: MonadIO m => ReaderT SqlBackend m (Key User)
-- > insertPhilip = insert $ User "Philip" 42
--
-- > philipId <- insertPhilip
--
-- This query will produce:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |40 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
-- > |3 |Philip|42 |
-- > +-----+------+-----+
--
-- > repsertHaskell :: MonadIO m => Key record -> ReaderT SqlBackend m ()
-- > repsertHaskell id = repsert id $ User "Haskell" 81
--
-- > repsertHaskell philipId
--
-- This query will replace Philip's record with Haskell's one:
--
-- > +-----+-----------------+--------+
-- > |id |name |age |
-- > +-----+-----------------+--------+
-- > |1 |SPJ |40 |
-- > +-----+-----------------+--------+
-- > |2 |Simon |41 |
-- > +-----+-----------------+--------+
-- > |3 |Philip -> Haskell|42 -> 81|
-- > +-----+-----------------+--------+
--
-- 'repsert' inserts the given record if the key doesn't exist.
--
-- > repsertXToUnknown :: MonadIO m => ReaderT SqlBackend m ()
-- > repsertXToUnknown = repsert unknownId $ User "X" 999
--
-- For example, applying the above query to <#dataset-persist-store-1 dataset-1> will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |40 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
-- > |3 |X |999 |
-- > +-----+------+-----+
repsert
:: forall record m
. (MonadIO m, PersistRecordBackend record backend)
=> Key record -> record -> ReaderT backend m ()
-- | Put many entities into the database.
--
-- Batch version of 'repsert' for SQL backends.
--
-- Useful when migrating data from one entity to another
-- and want to preserve ids.
--
-- @since 2.8.1
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > repsertManyUsers :: MonadIO m =>ReaderT SqlBackend m ()
-- > repsertManyusers = repsertMany [(simonId, User "Philip" 20), (unknownId999, User "Mr. X" 999)]
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+----------------+---------+
-- > |id |name |age |
-- > +-----+----------------+---------+
-- > |1 |SPJ |40 |
-- > +-----+----------------+---------+
-- > |2 |Simon -> Philip |41 -> 20 |
-- > +-----+----------------+---------+
-- > |999 |Mr. X |999 |
-- > +-----+----------------+---------+
repsertMany
:: forall record m
. (MonadIO m, PersistRecordBackend record backend)
=> [(Key record, record)] -> ReaderT backend m ()
repsertMany = mapM_ (uncurry repsert)
-- | Replace the record in the database with the given
-- key. Note that the result is undefined if such record does
-- not exist, so you must use 'insertKey' or 'repsert' in
-- these cases.
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1 schama-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > replaceSpj :: MonadIO m => User -> ReaderT SqlBackend m ()
-- > replaceSpj record = replace spjId record
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |Mike |45 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
replace
:: forall record m
. (MonadIO m, PersistRecordBackend record backend)
=> Key record -> record -> ReaderT backend m ()
-- | Delete a specific record by identifier. Does nothing if record does
-- not exist.
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > deleteSpj :: MonadIO m => ReaderT SqlBackend m ()
-- > deleteSpj = delete spjId
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
delete
:: forall record m
. (MonadIO m, PersistRecordBackend record backend)
=> Key record -> ReaderT backend m ()
-- | Update individual fields on a specific record.
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > updateSpj :: MonadIO m => [Update User] -> ReaderT SqlBackend m ()
-- > updateSpj updates = update spjId updates
--
-- > updateSpj [UserAge +=. 100]
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |140 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
update
:: forall record m
. (MonadIO m, PersistRecordBackend record backend)
=> Key record -> [Update record] -> ReaderT backend m ()
-- | Update individual fields on a specific record, and retrieve the
-- updated value from the database.
--
-- Note that this function will throw an exception if the given key is not
-- found in the database.
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > updateGetSpj :: MonadIO m => [Update User] -> ReaderT SqlBackend m User
-- > updateGetSpj updates = updateGet spjId updates
--
-- > spj <- updateGetSpj [UserAge +=. 100]
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |140 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
updateGet
:: forall record m
. (MonadIO m, PersistRecordBackend record backend)
=> Key record -> [Update record] -> ReaderT backend m record
updateGet key ups = do
update key ups
get key >>= maybe (liftIO $ throwIO $ KeyNotFound $ show key) return
-- | Same as 'get', but for a non-null (not Maybe) foreign key.
-- Unsafe unless your database is enforcing that the foreign key is valid.
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > getJustSpj :: MonadIO m => ReaderT SqlBackend m User
-- > getJustSpj = getJust spjId
--
-- > spj <- getJust spjId
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will get this record:
--
-- > +----+------+-----+
-- > | id | name | age |
-- > +----+------+-----+
-- > | 1 | SPJ | 40 |
-- > +----+------+-----+
--
-- > getJustUnknown :: MonadIO m => ReaderT SqlBackend m User
-- > getJustUnknown = getJust unknownId
--
-- mrx <- getJustUnknown
--
-- This just throws an error.
getJust
:: forall record backend m
. ( PersistStoreRead backend
, PersistRecordBackend record backend
, MonadIO m
)
=> Key record -> ReaderT backend m record
getJust key =
get key
>>= maybe
(liftIO $ throwIO $ PersistForeignConstraintUnmet $ T.pack $ show key)
return
-- | Same as 'getJust', but returns an 'Entity' instead of just the record.
--
-- @since 2.6.1
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > getJustEntitySpj :: MonadIO m => ReaderT SqlBackend m (Entity User)
-- > getJustEntitySpj = getJustEntity spjId
--
-- > spjEnt <- getJustEntitySpj
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will get this entity:
--
-- > +----+------+-----+
-- > | id | name | age |
-- > +----+------+-----+
-- > | 1 | SPJ | 40 |
-- > +----+------+-----+
getJustEntity
:: forall record backend m
. ( PersistEntityBackend record ~ BaseBackend backend
, MonadIO m
, PersistEntity record
, PersistStoreRead backend
)
=> Key record -> ReaderT backend m (Entity record)
getJustEntity key = do
record <- getJust key
return $
Entity
{ entityKey = key
, entityVal = record
}
-- | Curry this to make a convenience function that loads an associated model.
--
-- > foreign = belongsTo foreignId
belongsTo
:: forall ent1 ent2 backend m
. ( PersistStoreRead backend
, PersistEntity ent1
, PersistRecordBackend ent2 backend
, MonadIO m
)
=> (ent1 -> Maybe (Key ent2)) -> ent1 -> ReaderT backend m (Maybe ent2)
belongsTo foreignKeyField model = case foreignKeyField model of
Nothing -> return Nothing
Just f -> get f
-- | Same as 'belongsTo', but uses @getJust@ and therefore is similarly unsafe.
belongsToJust
:: forall ent1 ent2 backend m
. ( PersistStoreRead backend
, PersistEntity ent1
, PersistRecordBackend ent2 backend
, MonadIO m
)
=> (ent1 -> Key ent2) -> ent1 -> ReaderT backend m ent2
belongsToJust getForeignKey model = getJust $ getForeignKey model
-- | Like @insert@, but returns the complete @Entity@.
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > insertHaskellEntity :: MonadIO m => ReaderT SqlBackend m (Entity User)
-- > insertHaskellEntity = insertEntity $ User "Haskell" 81
--
-- > haskellEnt <- insertHaskellEntity
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +----+---------+-----+
-- > | id | name | age |
-- > +----+---------+-----+
-- > | 1 | SPJ | 40 |
-- > +----+---------+-----+
-- > | 2 | Simon | 41 |
-- > +----+---------+-----+
-- > | 3 | Haskell | 81 |
-- > +----+---------+-----+
insertEntity
:: forall e backend m
. ( PersistStoreWrite backend
, PersistRecordBackend e backend
, SafeToInsert e
, MonadIO m
, HasCallStack
)
=> e -> ReaderT backend m (Entity e)
insertEntity e = do
eid <- insert e
Maybe.fromMaybe (error errorMessage) <$> getEntity eid
where
errorMessage =
"persistent: failed to get record from database despite receiving key from the database"
-- | Like @get@, but returns the complete @Entity@.
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > getSpjEntity :: MonadIO m => ReaderT SqlBackend m (Maybe (Entity User))
-- > getSpjEntity = getEntity spjId
--
-- > mSpjEnt <- getSpjEntity
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will get this entity:
--
-- > +----+------+-----+
-- > | id | name | age |
-- > +----+------+-----+
-- > | 1 | SPJ | 40 |
-- > +----+------+-----+
getEntity
:: forall e backend m
. ( PersistStoreRead backend
, PersistRecordBackend e backend
, MonadIO m
)
=> Key e -> ReaderT backend m (Maybe (Entity e))
getEntity key = do
maybeModel <- get key
return $ fmap (key `Entity`) maybeModel
-- | Like 'insertEntity' but just returns the record instead of 'Entity'.
--
-- @since 2.6.1
--
-- === __Example usage__
--
-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>,
--
-- > insertDaveRecord :: MonadIO m => ReaderT SqlBackend m User
-- > insertDaveRecord = insertRecord $ User "Dave" 50
--
-- > dave <- insertDaveRecord
--
-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this:
--
-- > +-----+------+-----+
-- > |id |name |age |
-- > +-----+------+-----+
-- > |1 |SPJ |40 |
-- > +-----+------+-----+
-- > |2 |Simon |41 |
-- > +-----+------+-----+
-- > |3 |Dave |50 |
-- > +-----+------+-----+
insertRecord
:: forall record backend m
. ( PersistEntityBackend record ~ BaseBackend backend
, PersistEntity record
, MonadIO m
, PersistStoreWrite backend
, SafeToInsert record
, HasCallStack
)
=> record -> ReaderT backend m record
insertRecord record = do
k <- insert record
let
errorMessage =
"persistent: failed to retrieve a record despite receiving a key from the database"
mentity <- get k
return $ Maybe.fromMaybe (error errorMessage) mentity