Safe Haskell | None |
---|---|
Language | Haskell98 |
Database.Persist.Sql
Contents
- data InsertSqlResult
- data Connection = Connection {
- connPrepare :: Text -> IO Statement
- connInsertSql :: EntityDef SqlType -> [PersistValue] -> InsertSqlResult
- connStmtMap :: IORef (Map Text Statement)
- connClose :: IO ()
- connMigrateSql :: [EntityDef SqlType] -> (Text -> IO Statement) -> EntityDef SqlType -> IO (Either [Text] [(Bool, Text)])
- connBegin :: (Text -> IO Statement) -> IO ()
- connCommit :: (Text -> IO Statement) -> IO ()
- connRollback :: (Text -> IO Statement) -> IO ()
- connEscapeName :: DBName -> Text
- connNoLimit :: Text
- connRDBMS :: Text
- connLimitOffset :: (Int, Int) -> Bool -> Text -> Text
- data Statement = Statement {
- stmtFinalize :: IO ()
- stmtReset :: IO ()
- stmtExecute :: [PersistValue] -> IO Int64
- stmtQuery :: forall m. MonadResource m => [PersistValue] -> Source m [PersistValue]
- data Column = Column {}
- data PersistentSqlException
- data SqlBackend
- newtype SqlPersistT m a = SqlPersistT {
- unSqlPersistT :: ReaderT Connection m a
- type SqlPersist = SqlPersistT
- type SqlPersistM = SqlPersistT (NoLoggingT (ResourceT IO))
- type Sql = Text
- type CautiousMigration = [(Bool, Sql)]
- type Migration m = WriterT [Text] (WriterT CautiousMigration m) ()
- type ConnectionPool = Pool Connection
- newtype Single a = Single {
- unSingle :: a
- class (MonadIO m, MonadLogger m) => MonadSqlPersist m where
- askSqlConn :: m Connection
- class RawSql a where
- rawSqlCols :: (DBName -> Text) -> a -> (Int, [Text])
- rawSqlColCountReason :: a -> String
- rawSqlProcessRow :: [PersistValue] -> Either Text a
- class PersistField a => PersistFieldSql a where
- runSqlPool :: MonadBaseControl IO m => SqlPersistT m a -> Pool Connection -> m a
- withResourceTimeout :: MonadBaseControl IO m => Int -> Pool a -> (a -> m b) -> m (Maybe b)
- runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> Connection -> m a
- runSqlPersistM :: SqlPersistM a -> Connection -> IO a
- runSqlPersistMPool :: SqlPersistM a -> Pool Connection -> IO a
- withSqlPool :: MonadIO m => IO Connection -> Int -> (Pool Connection -> m a) -> m a
- createSqlPool :: MonadIO m => IO Connection -> Int -> m (Pool Connection)
- withSqlConn :: (MonadIO m, MonadBaseControl IO m) => IO Connection -> (Connection -> m a) -> m a
- close' :: Connection -> IO ()
- parseMigration :: Monad m => Migration m -> m (Either [Text] CautiousMigration)
- parseMigration' :: Monad m => Migration m -> m CautiousMigration
- printMigration :: MonadIO m => Migration m -> m ()
- getMigration :: (MonadBaseControl IO m, MonadIO m) => Migration m -> m [Sql]
- runMigration :: MonadSqlPersist m => Migration m -> m ()
- runMigrationSilent :: (MonadBaseControl IO m, MonadSqlPersist m) => Migration m -> m [Text]
- runMigrationUnsafe :: MonadSqlPersist m => Migration m -> m ()
- migrate :: MonadSqlPersist m => [EntityDef SqlType] -> EntityDef SqlType -> Migration m
- module Database.Persist
- rawQuery :: (MonadSqlPersist m, MonadResource m) => Text -> [PersistValue] -> Source m [PersistValue]
- rawExecute :: MonadSqlPersist m => Text -> [PersistValue] -> m ()
- rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64
- rawSql :: (RawSql a, MonadSqlPersist m, MonadResource m) => Text -> [PersistValue] -> m [a]
- deleteWhereCount :: (PersistEntity val, MonadSqlPersist m) => [Filter val] -> m Int64
- updateWhereCount :: (PersistEntity val, MonadSqlPersist m) => [Filter val] -> [Update val] -> m Int64
- transactionSave :: MonadSqlPersist m => m ()
- transactionUndo :: MonadSqlPersist m => m ()
- getStmtConn :: Connection -> Text -> IO Statement
- mkColumns :: [EntityDef a] -> EntityDef SqlType -> ([Column], [UniqueDef], [ForeignDef])
- convertKey :: Bool -> KeyBackend t t1 -> [PersistValue]
- decorateSQLWithLimitOffset :: Text -> (Int, Int) -> Bool -> Text -> Text
Documentation
data InsertSqlResult Source
Constructors
ISRSingle Text | |
ISRInsertGet Text Text | |
ISRManyKeys Text [PersistValue] |
data Connection Source
Constructors
Connection | |
Fields
|
Constructors
Statement | |
Fields
|
Constructors
Column | |
data PersistentSqlException Source
Constructors
StatementAlreadyFinalized Text | |
Couldn'tGetSQLConnection |
data SqlBackend Source
Instances
Typeable * SqlBackend | |
PathPiece (KeyBackend SqlBackend entity) | |
PersistFieldSql (KeyBackend SqlBackend a) |
newtype SqlPersistT m a Source
Constructors
SqlPersistT | |
Fields
|
Instances
type SqlPersist = SqlPersistT Source
Deprecated: Please use SqlPersistT instead
type SqlPersistM = SqlPersistT (NoLoggingT (ResourceT IO)) Source
type CautiousMigration = [(Bool, Sql)] Source
type ConnectionPool = Pool Connection Source
Although it covers most of the useful cases, persistent
's
API may not be enough for some of your tasks. May be you need
some complex JOIN
query, or a database-specific command
needs to be issued.
To issue raw SQL queries you could use withStmt
, which
allows you to do anything you need. However, its API is
low-level and you need to parse each row yourself. However,
most of your complex queries will have simple results -- some
of your entities and maybe a couple of derived columns.
This is where rawSql
comes in. Like withStmt
, you may
issue any SQL query. However, it does all the hard work for
you and automatically parses the rows of the result. It may
return:
- An
Entity
, that whichselectList
returns. All of your entity's fields are automatically parsed. - A
, which is a single, raw column of typeSingle
aa
. You may use a Haskell type (such as in your entity definitions), for exampleSingle Text
orSingle Int
, or you may get the raw column value withSingle
.PersistValue
- A tuple combining any of these (including other tuples). Using tuples allows you to return many entities in one query.
The only difference between issuing SQL queries with rawSql
and using other means is that we have an entity selection
placeholder, the double question mark ??
. It must be
used whenever you want to SELECT
an Entity
from your
query. Here's a sample SQL query sampleStmt
that may be
issued:
SELECT ??, ?? FROM "Person", "Likes", "Object" WHERE "Person".id = "Likes"."personId" AND "Object".id = "Likes"."objectId" AND "Person".name LIKE ?
To use that query, you could say
do results <- rawSql
sampleStmt ["%Luke%"]
forM_ results $
\( Entity personKey person
, Entity objectKey object
) -> do ...
Note that rawSql
knows how to replace the double question
marks ??
because of the type of the results
.
A single column (see rawSql
). Any PersistField
may be
used here, including PersistValue
(which does not do any
processing).
class (MonadIO m, MonadLogger m) => MonadSqlPersist m where Source
Minimal complete definition
Nothing
Methods
askSqlConn :: m Connection Source
Instances
MonadSqlPersist m => MonadSqlPersist (MaybeT m) | |
MonadSqlPersist m => MonadSqlPersist (LoggingT m) | |
MonadSqlPersist m => MonadSqlPersist (ListT m) | |
MonadSqlPersist m => MonadSqlPersist (ResourceT m) | |
MonadSqlPersist m => MonadSqlPersist (IdentityT m) | |
(MonadIO m, MonadLogger m) => MonadSqlPersist (SqlPersistT m) | |
(Monoid w, MonadSqlPersist m) => MonadSqlPersist (WriterT w m) | |
(Monoid w, MonadSqlPersist m) => MonadSqlPersist (WriterT w m) | |
MonadSqlPersist m => MonadSqlPersist (StateT s m) | |
MonadSqlPersist m => MonadSqlPersist (StateT s m) | |
MonadSqlPersist m => MonadSqlPersist (ReaderT r m) | |
(Error e, MonadSqlPersist m) => MonadSqlPersist (ErrorT e m) | |
MonadSqlPersist m => MonadSqlPersist (ContT r m) | |
MonadSqlPersist m => MonadSqlPersist (ExceptT e m) | |
MonadSqlPersist m => MonadSqlPersist (ConduitM i o m) | |
(Monoid w, MonadSqlPersist m) => MonadSqlPersist (RWST r w s m) | |
(Monoid w, MonadSqlPersist m) => MonadSqlPersist (RWST r w s m) | |
MonadSqlPersist m => MonadSqlPersist (Pipe l i o u m) |
Class for data types that may be retrived from a rawSql
query.
Methods
rawSqlCols :: (DBName -> Text) -> a -> (Int, [Text]) Source
Number of columns that this data type needs and the list
of substitutions for SELECT
placeholders ??
.
rawSqlColCountReason :: a -> String Source
A string telling the user why the column count is what it is.
rawSqlProcessRow :: [PersistValue] -> Either Text a Source
Transform a row of the result into the data type.
Instances
RawSql a => RawSql (Maybe a) | Since 1.0.1. |
PersistEntity a => RawSql (Entity a) | |
PersistField a => RawSql (Single a) | |
(RawSql a, RawSql b) => RawSql (a, b) | |
(RawSql a, RawSql b, RawSql c) => RawSql (a, b, c) | |
(RawSql a, RawSql b, RawSql c, RawSql d) => RawSql (a, b, c, d) | |
(RawSql a, RawSql b, RawSql c, RawSql d, RawSql e) => RawSql (a, b, c, d, e) | |
(RawSql a, RawSql b, RawSql c, RawSql d, RawSql e, RawSql f) => RawSql (a, b, c, d, e, f) | |
(RawSql a, RawSql b, RawSql c, RawSql d, RawSql e, RawSql f, RawSql g) => RawSql (a, b, c, d, e, f, g) | |
(RawSql a, RawSql b, RawSql c, RawSql d, RawSql e, RawSql f, RawSql g, RawSql h) => RawSql (a, b, c, d, e, f, g, h) |
class PersistField a => PersistFieldSql a where Source
Instances
runSqlPool :: MonadBaseControl IO m => SqlPersistT m a -> Pool Connection -> m a Source
Get a connection from the pool, run the given action, and then return the connection to the pool.
Arguments
:: MonadBaseControl IO m | |
=> Int | Timeout period in microseconds |
-> Pool a | |
-> (a -> m b) | |
-> m (Maybe b) |
runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> Connection -> m a Source
runSqlPersistM :: SqlPersistM a -> Connection -> IO a Source
runSqlPersistMPool :: SqlPersistM a -> Pool Connection -> IO a Source
Arguments
:: MonadIO m | |
=> IO Connection | create a new connection |
-> Int | connection count |
-> (Pool Connection -> m a) | |
-> m a |
createSqlPool :: MonadIO m => IO Connection -> Int -> m (Pool Connection) Source
withSqlConn :: (MonadIO m, MonadBaseControl IO m) => IO Connection -> (Connection -> m a) -> m a Source
close' :: Connection -> IO () Source
parseMigration :: Monad m => Migration m -> m (Either [Text] CautiousMigration) Source
parseMigration' :: Monad m => Migration m -> m CautiousMigration Source
printMigration :: MonadIO m => Migration m -> m () Source
getMigration :: (MonadBaseControl IO m, MonadIO m) => Migration m -> m [Sql] Source
runMigration :: MonadSqlPersist m => Migration m -> m () Source
runMigrationSilent :: (MonadBaseControl IO m, MonadSqlPersist m) => Migration m -> m [Text] Source
Same as runMigration
, but returns a list of the SQL commands executed
instead of printing them to stderr.
runMigrationUnsafe :: MonadSqlPersist m => Migration m -> m () Source
module Database.Persist
rawQuery :: (MonadSqlPersist m, MonadResource m) => Text -> [PersistValue] -> Source m [PersistValue] Source
rawExecute :: MonadSqlPersist m => Text -> [PersistValue] -> m () Source
rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64 Source
Arguments
:: (RawSql a, MonadSqlPersist m, MonadResource m) | |
=> Text | SQL statement, possibly with placeholders. |
-> [PersistValue] | Values to fill the placeholders. |
-> m [a] |
Execute a raw SQL statement and return its results as a list.
If you're using Entity
s
(which is quite likely), then you
must use entity selection placeholders (double question
mark, ??
). These ??
placeholders are then replaced for
the names of the columns that we need for your entities.
You'll receive an error if you don't use the placeholders.
Please see the Entity
s
documentation for more details.
You may put value placeholders (question marks, ?
) in your
SQL query. These placeholders are then replaced by the values
you pass on the second parameter, already correctly escaped.
You may want to use toPersistValue
to help you constructing
the placeholder values.
Since you're giving a raw SQL statement, you don't get any
guarantees regarding safety. If rawSql
is not able to parse
the results of your query back, then an exception is raised.
However, most common problems are mitigated by using the
entity selection placeholder ??
, and you shouldn't see any
error at all if you're not using Single
.
deleteWhereCount :: (PersistEntity val, MonadSqlPersist m) => [Filter val] -> m Int64 Source
Same as deleteWhere
, but returns the number of rows affected.
Since 1.1.5
updateWhereCount :: (PersistEntity val, MonadSqlPersist m) => [Filter val] -> [Update val] -> m Int64 Source
Same as updateWhere
, but returns the number of rows affected.
Since 1.1.5
transactionSave :: MonadSqlPersist m => m () Source
Commit the current transaction and begin a new one.
Since 1.2.0
transactionUndo :: MonadSqlPersist m => m () Source
Roll back the current transaction and begin a new one.
Since 1.2.0
getStmtConn :: Connection -> Text -> IO Statement Source
Internal
mkColumns :: [EntityDef a] -> EntityDef SqlType -> ([Column], [UniqueDef], [ForeignDef]) Source
Create the list of columns for the given entity.
convertKey :: Bool -> KeyBackend t t1 -> [PersistValue] Source