{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ExplicitForAll #-} 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 :: forall backend (m :: * -> *) a. HasPersistBackend backend => ReaderT (BaseBackend backend) m a -> ReaderT backend m a withBaseBackend = forall r' r (m :: * -> *) a. (r' -> r) -> ReaderT r m a -> ReaderT r' m a withReaderT forall backend. HasPersistBackend backend => backend -> BaseBackend backend 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 -- , 'PeristEntityBackend' 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 :: forall sup sub (m :: * -> *) a. BackendCompatible sup sub => ReaderT sup m a -> ReaderT sub m a withCompatibleBackend = forall r' r (m :: * -> *) a. (r' -> r) -> ReaderT r m a -> ReaderT r' m a withReaderT forall sup sub. BackendCompatible sup sub => sub -> sup 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 :: forall (m :: * -> *) backend b. (MonadIO m, MonadReader backend m) => ReaderT backend IO b -> m b liftPersist ReaderT backend IO b f = do backend env <- forall r (m :: * -> *). MonadReader r m => m r ask forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a runReaderT ReaderT backend IO b f backend 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 [] = forall (m :: * -> *) a. Monad m => a -> m a return forall k a. Map k a Map.empty getMany [Key record] ks = do [Maybe record] vs <- forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM forall backend record (m :: * -> *). (PersistStoreRead backend, MonadIO m, PersistRecordBackend record backend) => Key record -> ReaderT backend m (Maybe record) get [Key record] ks let kvs :: [(Key record, Maybe record)] kvs = forall a b. [a] -> [b] -> [(a, b)] zip [Key record] ks [Maybe record] vs let kvs' :: [(Key record, record)] kvs' = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. HasCallStack => Maybe a -> a Maybe.fromJust) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b `fmap` forall a. (a -> Bool) -> [a] -> [a] filter (\(Key record _,Maybe record v) -> forall a. Maybe a -> Bool Maybe.isJust Maybe record v) [(Key record, Maybe record)] kvs forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall k a. Ord k => [(k, a)] -> Map k a Map.fromList [(Key record, record)] 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 record = forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend, SafeToInsert record) => record -> ReaderT backend m (Key record) insert record record forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall (m :: * -> *) a. Monad m => a -> m a 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 = forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend, SafeToInsert record) => record -> ReaderT backend m (Key record) 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_ [record] x = forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend, SafeToInsert record) => [record] -> ReaderT backend m [Key record] insertMany [record] x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall (m :: * -> *) a. Monad m => a -> m a 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 = forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (\(Entity Key record k record record) -> forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend) => Key record -> record -> ReaderT backend m () insertKey Key record k record 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 = forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend) => Key record -> record -> ReaderT backend m () 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 record key [Update record] ups = do forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend) => Key record -> [Update record] -> ReaderT backend m () update Key record key [Update record] ups forall backend record (m :: * -> *). (PersistStoreRead backend, MonadIO m, PersistRecordBackend record backend) => Key record -> ReaderT backend m (Maybe record) get Key record key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall e a. Exception e => e -> IO a throwIO forall a b. (a -> b) -> a -> b $ String -> UpdateException KeyNotFound forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Key record key) forall (m :: * -> *) a. Monad m => a -> m a 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 :: forall record backend (m :: * -> *). (PersistStoreRead backend, PersistRecordBackend record backend, MonadIO m) => Key record -> ReaderT backend m record getJust Key record key = forall backend record (m :: * -> *). (PersistStoreRead backend, MonadIO m, PersistRecordBackend record backend) => Key record -> ReaderT backend m (Maybe record) get Key record key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall e a. Exception e => e -> IO a throwIO forall a b. (a -> b) -> a -> b $ Text -> PersistException PersistForeignConstraintUnmet forall a b. (a -> b) -> a -> b $ String -> Text T.pack forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Key record key) forall (m :: * -> *) a. Monad m => a -> m a 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 :: forall record backend (m :: * -> *). (PersistEntityBackend record ~ BaseBackend backend, MonadIO m, PersistEntity record, PersistStoreRead backend) => Key record -> ReaderT backend m (Entity record) getJustEntity Key record key = do record record <- forall record backend (m :: * -> *). (PersistStoreRead backend, PersistRecordBackend record backend, MonadIO m) => Key record -> ReaderT backend m record getJust Key record key forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Entity { entityKey :: Key record entityKey = Key record key , entityVal :: record entityVal = record 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 :: 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 ent1 -> Maybe (Key ent2) foreignKeyField ent1 model = case ent1 -> Maybe (Key ent2) foreignKeyField ent1 model of Maybe (Key ent2) Nothing -> forall (m :: * -> *) a. Monad m => a -> m a return forall a. Maybe a Nothing Just Key ent2 f -> forall backend record (m :: * -> *). (PersistStoreRead backend, MonadIO m, PersistRecordBackend record backend) => Key record -> ReaderT backend m (Maybe record) get Key ent2 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 :: forall ent1 ent2 backend (m :: * -> *). (PersistStoreRead backend, PersistEntity ent1, PersistRecordBackend ent2 backend, MonadIO m) => (ent1 -> Key ent2) -> ent1 -> ReaderT backend m ent2 belongsToJust ent1 -> Key ent2 getForeignKey ent1 model = forall record backend (m :: * -> *). (PersistStoreRead backend, PersistRecordBackend record backend, MonadIO m) => Key record -> ReaderT backend m record getJust forall a b. (a -> b) -> a -> b $ ent1 -> Key ent2 getForeignKey ent1 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 :: forall e backend (m :: * -> *). (PersistStoreWrite backend, PersistRecordBackend e backend, SafeToInsert e, MonadIO m, HasCallStack) => e -> ReaderT backend m (Entity e) insertEntity e e = do Key e eid <- forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend, SafeToInsert record) => record -> ReaderT backend m (Key record) insert e e forall a. a -> Maybe a -> a Maybe.fromMaybe (forall a. HasCallStack => String -> a error String errorMessage) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall e backend (m :: * -> *). (PersistStoreRead backend, PersistRecordBackend e backend, MonadIO m) => Key e -> ReaderT backend m (Maybe (Entity e)) getEntity Key e eid where errorMessage :: String errorMessage = String "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 :: forall e backend (m :: * -> *). (PersistStoreRead backend, PersistRecordBackend e backend, MonadIO m) => Key e -> ReaderT backend m (Maybe (Entity e)) getEntity Key e key = do Maybe e maybeModel <- forall backend record (m :: * -> *). (PersistStoreRead backend, MonadIO m, PersistRecordBackend record backend) => Key record -> ReaderT backend m (Maybe record) get Key e key forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Key e key forall record. Key record -> record -> Entity record `Entity`) Maybe e 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 :: forall record backend (m :: * -> *). (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, MonadIO m, PersistStoreWrite backend, SafeToInsert record, HasCallStack) => record -> ReaderT backend m record insertRecord record record = do Key record k <- forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend, SafeToInsert record) => record -> ReaderT backend m (Key record) insert record record let errorMessage :: String errorMessage = String "persistent: failed to retrieve a record despite receiving a key from the database" Maybe record mentity <- forall backend record (m :: * -> *). (PersistStoreRead backend, MonadIO m, PersistRecordBackend record backend) => Key record -> ReaderT backend m (Maybe record) get Key record k forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. a -> Maybe a -> a Maybe.fromMaybe (forall a. HasCallStack => String -> a error String errorMessage) Maybe record mentity