selda-0.3.0.0: Multi-backend, high-level EDSL for interacting with SQL databases.

Safe HaskellNone
LanguageHaskell2010

Database.Selda.Backend

Description

API for building Selda backends and adding support for more types in queries.

Synopsis

Documentation

class (MonadIO m, MonadMask m) => MonadSelda m where Source #

Some monad with Selda SQL capabilitites.

Note that the default implementations of invalidateTable and wrapTransaction flush the entire cache and disable caching when invoked. If you want to use Selda's built-in caching mechanism, you will need to implement these operations yourself.

Minimal complete definition

seldaConnection

Methods

seldaConnection :: m SeldaConnection Source #

Get the connection in use by the computation.

invalidateTable :: Table a -> m () Source #

Invalidate the given table as soon as the current transaction finishes. Invalidate the table immediately if no transaction is ongoing.

wrapTransaction Source #

Arguments

:: m ()

Signal transaction commit to SQL backend.

-> m ()

Signal transaction rollback to SQL backend.

-> m a

Transaction to perform.

-> m a 

Safely wrap a transaction. To ensure consistency of the in-process cache, it is important that any cached tables modified during a transaction are invalidated ONLY if that transaction succeeds, AFTER the changes become visible in the database.

In order to be thread-safe in the presence of asynchronous exceptions, instances should:

  1. Mask async exceptions.
  2. Start bookkeeping of tables invalidated during the transaction.
  3. Perform the transaction, with async exceptions restored.
  4. Commit transaction, invalidate tables, and disable bookkeeping; OR
  5. If an exception was raised, rollback transaction, disable bookkeeping, and re-throw the exception.
Instances
(MonadIO m, MonadMask m) => MonadSelda (SeldaT m) Source # 
Instance details

Defined in Database.Selda.Backend.Internal

data SeldaT m a Source #

Monad transformer adding Selda SQL capabilities.

Instances
MonadTrans SeldaT Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Methods

lift :: Monad m => m a -> SeldaT m a #

Monad m => Monad (SeldaT m) Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Methods

(>>=) :: SeldaT m a -> (a -> SeldaT m b) -> SeldaT m b #

(>>) :: SeldaT m a -> SeldaT m b -> SeldaT m b #

return :: a -> SeldaT m a #

fail :: String -> SeldaT m a #

Functor m => Functor (SeldaT m) Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Methods

fmap :: (a -> b) -> SeldaT m a -> SeldaT m b #

(<$) :: a -> SeldaT m b -> SeldaT m a #

Monad m => Applicative (SeldaT m) Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Methods

pure :: a -> SeldaT m a #

(<*>) :: SeldaT m (a -> b) -> SeldaT m a -> SeldaT m b #

liftA2 :: (a -> b -> c) -> SeldaT m a -> SeldaT m b -> SeldaT m c #

(*>) :: SeldaT m a -> SeldaT m b -> SeldaT m b #

(<*) :: SeldaT m a -> SeldaT m b -> SeldaT m a #

MonadIO m => MonadIO (SeldaT m) Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Methods

liftIO :: IO a -> SeldaT m a #

MonadThrow m => MonadThrow (SeldaT m) Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Methods

throwM :: Exception e => e -> SeldaT m a #

MonadCatch m => MonadCatch (SeldaT m) Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Methods

catch :: Exception e => SeldaT m a -> (e -> SeldaT m a) -> SeldaT m a #

MonadMask m => MonadMask (SeldaT m) Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Methods

mask :: ((forall a. SeldaT m a -> SeldaT m a) -> SeldaT m b) -> SeldaT m b #

uninterruptibleMask :: ((forall a. SeldaT m a -> SeldaT m a) -> SeldaT m b) -> SeldaT m b #

generalBracket :: SeldaT m a -> (a -> ExitCase b -> SeldaT m c) -> (a -> SeldaT m b) -> SeldaT m (b, c) #

(MonadIO m, MonadMask m) => MonadSelda (SeldaT m) Source # 
Instance details

Defined in Database.Selda.Backend.Internal

type SeldaM = SeldaT IO Source #

The simplest form of Selda computation; SeldaT specialized to IO.

data SeldaError Source #

Thrown by any function in SeldaT if an error occurs.

Constructors

DbError String

Unable to open or connect to database.

SqlError String

An error occurred while executing query.

data StmtID Source #

A prepared statement identifier. Guaranteed to be unique per application.

Instances
Eq StmtID Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Methods

(==) :: StmtID -> StmtID -> Bool #

(/=) :: StmtID -> StmtID -> Bool #

Ord StmtID Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Show StmtID Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Hashable StmtID Source # 
Instance details

Defined in Database.Selda.Backend.Internal

Methods

hashWithSalt :: Int -> StmtID -> Int #

hash :: StmtID -> Int #

data BackendID Source #

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.

Constructors

SQLite 
PostgreSQL 
Other Text 

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 Source #

A collection of functions making up a Selda backend.

Constructors

SeldaBackend 

Fields

class Typeable a => SqlType a where Source #

Any datatype representable in (Selda's subset of) SQL.

Methods

mkLit :: a -> Lit a Source #

Create a literal of this type.

mkLit :: (Typeable a, SqlEnum a) => a -> Lit a Source #

Create a literal of this type.

sqlType :: Proxy a -> SqlTypeRep Source #

The SQL representation for this type.

fromSql :: SqlValue -> a Source #

Convert an SqlValue into this type.

fromSql :: (Typeable a, SqlEnum a) => SqlValue -> a Source #

Convert an SqlValue into this type.

defaultValue :: Lit a Source #

Default value when using def at this type.

defaultValue :: (Typeable a, SqlEnum a) => Lit a Source #

Default value when using def at this type.

Instances
SqlType Bool Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType Double Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType Int Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType Ordering Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType ByteString Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType ByteString Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType Text Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType TimeOfDay Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType UTCTime Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType Day Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType RowID Source # 
Instance details

Defined in Database.Selda.SqlType

SqlType a => SqlType (Maybe a) Source # 
Instance details

Defined in Database.Selda.SqlType

Typeable a => SqlType (ID a) Source # 
Instance details

Defined in Database.Selda.SqlType

((TypeError (((Text "'Only " :<>: ShowType a) :<>: Text "' is not a proper SQL type.") :$$: Text "Use 'the' to access the value of the column.") :: Constraint), Typeable a) => SqlType (Only a) Source # 
Instance details

Defined in Database.Selda

data SqlValue where Source #

Some value that is representable in SQL.

Instances
Show SqlValue Source # 
Instance details

Defined in Database.Selda.SqlType

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.

Constructors

BTreeIndex 
HashIndex 

data Param where Source #

A parameter to a prepared SQL statement.

Constructors

Param :: !(Lit a) -> Param 
Instances
Eq Param Source # 
Instance details

Defined in Database.Selda.SQL

Methods

(==) :: Param -> Param -> Bool #

(/=) :: Param -> Param -> Bool #

Ord Param Source # 
Instance details

Defined in Database.Selda.SQL

Methods

compare :: Param -> Param -> Ordering #

(<) :: Param -> Param -> Bool #

(<=) :: Param -> Param -> Bool #

(>) :: Param -> Param -> Bool #

(>=) :: Param -> Param -> Bool #

max :: Param -> Param -> Param #

min :: Param -> Param -> Param #

Show Param Source # 
Instance details

Defined in Database.Selda.SQL

Methods

showsPrec :: Int -> Param -> ShowS #

show :: Param -> String #

showList :: [Param] -> ShowS #

Hashable Param # 
Instance details

Defined in Database.Selda.Caching

Methods

hashWithSalt :: Int -> Param -> Int #

hash :: Param -> Int #

data Lit a where Source #

An SQL literal.

Constructors

LText :: !Text -> Lit Text 
LInt :: !Int -> Lit Int 
LDouble :: !Double -> Lit Double 
LBool :: !Bool -> Lit Bool 
LDateTime :: !Text -> Lit UTCTime 
LDate :: !Text -> Lit Day 
LTime :: !Text -> Lit TimeOfDay 
LJust :: SqlType a => !(Lit a) -> Lit (Maybe a) 
LBlob :: !ByteString -> Lit ByteString 
LNull :: SqlType a => Lit (Maybe a) 
LCustom :: Lit a -> Lit b 
Instances
Eq (Lit a) Source # 
Instance details

Defined in Database.Selda.SqlType

Methods

(==) :: Lit a -> Lit a -> Bool #

(/=) :: Lit a -> Lit a -> Bool #

Ord (Lit a) Source # 
Instance details

Defined in Database.Selda.SqlType

Methods

compare :: Lit a -> Lit a -> Ordering #

(<) :: Lit a -> Lit a -> Bool #

(<=) :: Lit a -> Lit a -> Bool #

(>) :: Lit a -> Lit a -> Bool #

(>=) :: Lit a -> Lit a -> Bool #

max :: Lit a -> Lit a -> Lit a #

min :: Lit a -> Lit a -> Lit a #

Show (Lit a) Source # 
Instance details

Defined in Database.Selda.SqlType

Methods

showsPrec :: Int -> Lit a -> ShowS #

show :: Lit a -> String #

showList :: [Lit a] -> ShowS #

Hashable (Lit a) # 
Instance details

Defined in Database.Selda.Caching

Methods

hashWithSalt :: Int -> Lit a -> Int #

hash :: Lit a -> Int #

data ColAttr Source #

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.

Instances
Eq ColAttr Source # 
Instance details

Defined in Database.Selda.Table.Type

Methods

(==) :: ColAttr -> ColAttr -> Bool #

(/=) :: ColAttr -> ColAttr -> Bool #

Ord ColAttr Source # 
Instance details

Defined in Database.Selda.Table.Type

Show ColAttr Source # 
Instance details

Defined in Database.Selda.Table.Type

data PPConfig Source #

Backend-specific configuration for the SQL pretty-printer.

Constructors

PPConfig 

Fields

  • ppType :: SqlTypeRep -> Text

    The SQL type name of the given type.

    This function should be used everywhere a type is needed to be printed but in primary keys position. This is due to the fact that some backends might have a special representation of primary keys (using sequences are such). If you have such a need, please use the ppTypePK record instead.

  • ppTypeHook :: SqlTypeRep -> [ColAttr] -> (SqlTypeRep -> Text) -> Text

    Hook that allows you to modify ppType output.

  • ppTypePK :: SqlTypeRep -> Text

    The SQL type name of the given type for primary keys uses.

  • ppPlaceholder :: Int -> Text

    Parameter placeholder for the nth parameter.

  • ppColAttrs :: [ColAttr] -> Text

    List of column attributes.

  • ppColAttrsHook :: SqlTypeRep -> [ColAttr] -> ([ColAttr] -> Text) -> Text

    Hook that allows you to modify ppColAttrs output.

  • ppAutoIncInsert :: Text

    The value used for the next value for an auto-incrementing column. For instance, DEFAULT for PostgreSQL, and NULL for SQLite.

  • ppMaxInsertParams :: Maybe Int

    Insert queries may have at most this many parameters; if an insertion has more parameters than this, it will be chunked.

    Note that only insertions of multiple rows are chunked. If your table has more than this many columns, you should really rethink your database design.

  • ppIndexMethodHook :: IndexMethod -> Text

    CREATE INDEX suffix to indicate that the index should use the given index method.

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.

data TableName Source #

Name of a database table.

data ColName Source #

Name of a database column.

Instances
Eq ColName Source # 
Instance details

Defined in Database.Selda.Types

Methods

(==) :: ColName -> ColName -> Bool #

(/=) :: ColName -> ColName -> Bool #

Ord ColName Source # 
Instance details

Defined in Database.Selda.Types

Show ColName Source # 
Instance details

Defined in Database.Selda.Types

IsString ColName Source # 
Instance details

Defined in Database.Selda.Types

Methods

fromString :: String -> ColName #

data ColumnInfo Source #

Comprehensive information about a column.

Constructors

ColumnInfo 

Fields

columnInfo :: Table a -> [ColumnInfo] 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.

mkColName :: Text -> ColName 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 -> Text -> m SeldaConnection Source #

Create a new Selda connection for the given backend and database identifier string.

allStmts :: SeldaConnection -> IO [(StmtID, Dynamic)] Source #

Get all statements and their corresponding identifiers for the current connection.

seldaBackend :: MonadSelda m => m SeldaBackend Source #

Get the backend in use by the computation.

runSeldaT :: (MonadIO m, MonadMask m) => SeldaT m a -> SeldaConnection -> m a Source #

Run a Selda transformer. Backends should use this to implement their withX functions.

seldaClose :: MonadIO m => SeldaConnection -> 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.

sqlDateTimeFormat :: String Source #

Format string used to represent date and time when talking to the database backend.

sqlDateFormat :: String Source #

Format string used to represent date when talking to the database backend.

sqlTimeFormat :: String Source #

Format string used to represent time of day when talking to the database backend.