Safe Haskell | None |
---|---|
Language | Haskell2010 |
API for building Selda backends and adding support for more types in queries.
Synopsis
- class MonadIO m => MonadSelda m where
- type Backend m
- withConnection :: (SeldaConnection (Backend m) -> m a) -> m a
- transact :: m a -> m a
- data SeldaT b m a
- type SeldaM b = SeldaT b IO
- data SeldaError
- data StmtID
- data BackendID
- = SQLite
- | PostgreSQL
- | Other Text
- type QueryRunner a = Text -> [Param] -> IO a
- data SeldaBackend b = SeldaBackend {
- runStmt :: Text -> [Param] -> IO (Int, [[SqlValue]])
- runStmtWithPK :: Text -> [Param] -> IO Int
- prepareStmt :: StmtID -> [SqlTypeRep] -> Text -> IO Dynamic
- runPrepared :: Dynamic -> [Param] -> IO (Int, [[SqlValue]])
- getTableInfo :: TableName -> IO TableInfo
- ppConfig :: PPConfig
- closeConnection :: SeldaConnection b -> IO ()
- backendId :: BackendID
- disableForeignKeys :: Bool -> IO ()
- data SeldaConnection b
- data SqlValue where
- data IndexMethod
- data Param where
- data ColAttr
- data AutoIncType
- data PPConfig = PPConfig {
- ppType :: SqlTypeRep -> Text
- ppTypeHook :: SqlTypeRep -> [ColAttr] -> (SqlTypeRep -> Text) -> Text
- ppTypePK :: SqlTypeRep -> Text
- ppPlaceholder :: Int -> Text
- ppColAttrs :: [ColAttr] -> Text
- ppColAttrsHook :: SqlTypeRep -> [ColAttr] -> ([ColAttr] -> Text) -> Text
- ppAutoIncInsert :: Text
- ppMaxInsertParams :: Maybe Int
- ppIndexMethodHook :: IndexMethod -> Text
- defPPConfig :: PPConfig
- data TableName
- data ColName
- data TableInfo = TableInfo {
- tableColumnInfos :: [ColumnInfo]
- tableUniqueGroups :: [[ColName]]
- tablePrimaryKey :: [ColName]
- data ColumnInfo = ColumnInfo {
- colName :: ColName
- colType :: Either Text SqlTypeRep
- colIsAutoPrimary :: Bool
- colIsNullable :: Bool
- colHasIndex :: Bool
- colFKs :: [(TableName, ColName)]
- isAutoPrimary :: ColAttr -> Bool
- isPrimary :: ColAttr -> Bool
- isUnique :: ColAttr -> Bool
- tableInfo :: Table a -> TableInfo
- fromColInfo :: ColInfo -> ColumnInfo
- mkTableName :: Text -> TableName
- mkColName :: Text -> ColName
- fromTableName :: TableName -> Text
- fromColName :: ColName -> Text
- rawTableName :: TableName -> Text
- newConnection :: MonadIO m => SeldaBackend b -> Text -> m (SeldaConnection b)
- allStmts :: SeldaConnection b -> IO [(StmtID, Dynamic)]
- withBackend :: MonadSelda m => (SeldaBackend (Backend m) -> m a) -> m a
- runSeldaT :: (MonadIO m, MonadMask m) => SeldaT b m a -> SeldaConnection b -> m a
- seldaClose :: MonadIO m => SeldaConnection b -> m ()
- module Database.Selda.SqlType
Documentation
class MonadIO m => MonadSelda m where Source #
Some monad with Selda SQL capabilitites.
withConnection :: (SeldaConnection (Backend m) -> m a) -> m a Source #
Pass a Selda connection to the given computation and execute it.
After the computation finishes, withConnection
is free to do anything
it likes to the connection, including closing it or giving it to another
Selda computation.
Thus, the computation must take care never to return or otherwise
access the connection after returning.
transact :: m a -> m a Source #
Perform the given computation as a transaction.
Implementations must ensure that subsequent calls to withConnection
within the same transaction always passes the same connection
to its argument.
Monad transformer adding Selda SQL capabilities.
Instances
data SeldaError Source #
Thrown by any function in SeldaT
if an error occurs.
DbError String | Unable to open or connect to database. |
SqlError String | An error occurred while executing query. |
UnsafeError String | An error occurred due to improper use of an unsafe function. |
Instances
Eq SeldaError Source # | |
Defined in Database.Selda.Backend.Internal (==) :: SeldaError -> SeldaError -> Bool # (/=) :: SeldaError -> SeldaError -> Bool # | |
Show SeldaError Source # | |
Defined in Database.Selda.Backend.Internal showsPrec :: Int -> SeldaError -> ShowS # show :: SeldaError -> String # showList :: [SeldaError] -> ShowS # | |
Exception SeldaError Source # | |
Defined in Database.Selda.Backend.Internal toException :: SeldaError -> SomeException # fromException :: SomeException -> Maybe SeldaError # displayException :: SeldaError -> String # |
A prepared statement identifier. Guaranteed to be unique per application.
Uniquely identifies some particular backend.
When publishing a new backend, consider submitting a pull request with a
constructor for your backend instead of using the Other
constructor.
type QueryRunner a = Text -> [Param] -> IO a Source #
A function which executes a query and gives back a list of extensible tuples; one tuple per result row, and one tuple element per column.
data SeldaBackend b Source #
A collection of functions making up a Selda backend.
SeldaBackend | |
|
data SeldaConnection b Source #
Some value that is representable in SQL.
data IndexMethod Source #
Method to use for indexing with indexedUsing
.
Index methods are ignored by the SQLite backend, as SQLite doesn't support
different index methods.
Instances
Eq IndexMethod Source # | |
Defined in Database.Selda.Table.Type (==) :: IndexMethod -> IndexMethod -> Bool # (/=) :: IndexMethod -> IndexMethod -> Bool # | |
Ord IndexMethod Source # | |
Defined in Database.Selda.Table.Type compare :: IndexMethod -> IndexMethod -> Ordering # (<) :: IndexMethod -> IndexMethod -> Bool # (<=) :: IndexMethod -> IndexMethod -> Bool # (>) :: IndexMethod -> IndexMethod -> Bool # (>=) :: IndexMethod -> IndexMethod -> Bool # max :: IndexMethod -> IndexMethod -> IndexMethod # min :: IndexMethod -> IndexMethod -> IndexMethod # | |
Show IndexMethod Source # | |
Defined in Database.Selda.Table.Type showsPrec :: Int -> IndexMethod -> ShowS # show :: IndexMethod -> String # showList :: [IndexMethod] -> ShowS # |
A parameter to a prepared SQL statement.
Column attributes such as nullability, auto increment, etc. When adding elements, make sure that they are added in the order required by SQL syntax, as this list is only sorted before being pretty-printed.
data AutoIncType Source #
Strongly or weakly auto-incrementing primary key?
Instances
Eq AutoIncType Source # | |
Defined in Database.Selda.Table.Type (==) :: AutoIncType -> AutoIncType -> Bool # (/=) :: AutoIncType -> AutoIncType -> Bool # | |
Ord AutoIncType Source # | |
Defined in Database.Selda.Table.Type compare :: AutoIncType -> AutoIncType -> Ordering # (<) :: AutoIncType -> AutoIncType -> Bool # (<=) :: AutoIncType -> AutoIncType -> Bool # (>) :: AutoIncType -> AutoIncType -> Bool # (>=) :: AutoIncType -> AutoIncType -> Bool # max :: AutoIncType -> AutoIncType -> AutoIncType # min :: AutoIncType -> AutoIncType -> AutoIncType # | |
Show AutoIncType Source # | |
Defined in Database.Selda.Table.Type showsPrec :: Int -> AutoIncType -> ShowS # show :: AutoIncType -> String # showList :: [AutoIncType] -> ShowS # |
Backend-specific configuration for the SQL pretty-printer.
PPConfig | |
|
defPPConfig :: PPConfig Source #
Default settings for pretty-printing. Geared towards SQLite.
The default definition of ppTypePK
is 'defType, so that you don’t have to do anything
special if you don’t use special types for primary keys.
Name of a database table.
Name of a database column.
Comprehensive information about a table.
TableInfo | |
|
data ColumnInfo Source #
Comprehensive information about a column.
ColumnInfo | |
|
Instances
Eq ColumnInfo Source # | |
Defined in Database.Selda.Backend.Internal (==) :: ColumnInfo -> ColumnInfo -> Bool # (/=) :: ColumnInfo -> ColumnInfo -> Bool # | |
Show ColumnInfo Source # | |
Defined in Database.Selda.Backend.Internal showsPrec :: Int -> ColumnInfo -> ShowS # show :: ColumnInfo -> String # showList :: [ColumnInfo] -> ShowS # |
isAutoPrimary :: ColAttr -> Bool Source #
tableInfo :: Table a -> TableInfo Source #
Get the column information for each column in the given table.
fromColInfo :: ColInfo -> ColumnInfo Source #
Convert a ColInfo
into a ColumnInfo
.
mkTableName :: Text -> TableName Source #
Create a column name.
fromTableName :: TableName -> Text Source #
Convert a table name into a string, with quotes.
fromColName :: ColName -> Text Source #
Convert a column name into a string, with quotes.
rawTableName :: TableName -> Text Source #
Convert a table name into a string, without quotes.
newConnection :: MonadIO m => SeldaBackend b -> Text -> m (SeldaConnection b) Source #
Create a new Selda connection for the given backend and database identifier string.
allStmts :: SeldaConnection b -> IO [(StmtID, Dynamic)] Source #
Get all statements and their corresponding identifiers for the current connection.
withBackend :: MonadSelda m => (SeldaBackend (Backend m) -> m a) -> m a Source #
Get the backend in use by the computation.
runSeldaT :: (MonadIO m, MonadMask m) => SeldaT b m a -> SeldaConnection b -> m a Source #
Run a Selda transformer. Backends should use this to implement their
withX
functions.
seldaClose :: MonadIO m => SeldaConnection b -> m () Source #
Close a reusable Selda connection.
Closing a connection while in use is undefined.
Passing a closed connection to runSeldaT
results in a SeldaError
being thrown. Closing a connection more than once is a no-op.
module Database.Selda.SqlType