selda-0.1.1.1: Type-safe, high-level EDSL for interacting with relational databases.

Safe HaskellNone
LanguageHaskell2010

Database.Selda

Contents

Description

Selda is not LINQ, but they're definitely related.

Selda is a high-level EDSL for interacting with relational databases. Please see https://github.com/valderman/selda/ for a brief tutorial.

Synopsis

Running queries

class Monad m => MonadIO m where #

Monads in which IO computations may be embedded. Any monad built by applying a sequence of monad transformers to the IO monad will be an instance of this class.

Instances should satisfy the following laws, which state that liftIO is a transformer of monads:

Minimal complete definition

liftIO

Methods

liftIO :: IO a -> m a #

Lift a computation from the IO monad.

Instances

MonadIO IO 

Methods

liftIO :: IO a -> IO a #

MonadIO m => MonadIO (ListT m) 

Methods

liftIO :: IO a -> ListT m a #

MonadIO m => MonadIO (MaybeT m) 

Methods

liftIO :: IO a -> MaybeT m a #

MonadIO m => MonadIO (SeldaT m) # 

Methods

liftIO :: IO a -> SeldaT m a #

(Error e, MonadIO m) => MonadIO (ErrorT e m) 

Methods

liftIO :: IO a -> ErrorT e m a #

MonadIO m => MonadIO (ExceptT e m) 

Methods

liftIO :: IO a -> ExceptT e m a #

MonadIO m => MonadIO (StateT s m) 

Methods

liftIO :: IO a -> StateT s m a #

MonadIO m => MonadIO (StateT s m) 

Methods

liftIO :: IO a -> StateT s m a #

(Monoid w, MonadIO m) => MonadIO (WriterT w m) 

Methods

liftIO :: IO a -> WriterT w m a #

(Monoid w, MonadIO m) => MonadIO (WriterT w m) 

Methods

liftIO :: IO a -> WriterT w m a #

MonadIO m => MonadIO (IdentityT * m) 

Methods

liftIO :: IO a -> IdentityT * m a #

MonadIO m => MonadIO (ContT * r m) 

Methods

liftIO :: IO a -> ContT * r m a #

MonadIO m => MonadIO (ReaderT * r m) 

Methods

liftIO :: IO a -> ReaderT * r m a #

(Monoid w, MonadIO m) => MonadIO (RWST r w s m) 

Methods

liftIO :: IO a -> RWST r w s m a #

(Monoid w, MonadIO m) => MonadIO (RWST r w s m) 

Methods

liftIO :: IO a -> RWST r w s m a #

class MonadIO m => MonadSelda m Source #

Some monad with Selda SQL capabilitites.

Minimal complete definition

seldaBackend

data SeldaT m a Source #

Monad transformer adding Selda SQL capabilities.

Instances

MonadTrans SeldaT Source # 

Methods

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

Monad m => Monad (SeldaT m) Source # 

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 # 

Methods

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

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

Monad m => Applicative (SeldaT m) Source # 

Methods

pure :: a -> SeldaT m a #

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

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

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

MonadIO m => MonadIO (SeldaT m) Source # 

Methods

liftIO :: IO a -> SeldaT m a #

MonadThrow m => MonadThrow (SeldaT m) Source # 

Methods

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

MonadCatch m => MonadCatch (SeldaT m) Source # 

Methods

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

MonadMask m => MonadMask (SeldaT m) Source # 

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 #

MonadIO m => MonadSelda (SeldaT m) Source # 

data Table a Source #

A database table. Tables are parameterized over their column types. For instance, a table containing one string and one integer, in that order, would have the type Table (Text :*: Int), and a table containing only a single string column would have the type Table Text.

Instances

(~) * ((:+++:) a b) ((:*:) a b) => ComposeSpec Table a b Source # 

Methods

(+++) :: Table a -> Table b -> ColSpec (a :+++: b) Source #

(ComposeSpec Table a b, ComposeSpec Table b c) => ComposeSpec Table ((:*:) a b) c Source # 

Methods

(+++) :: Table (a :*: b) -> Table c -> ColSpec ((a :*: b) :+++: c) Source #

data Query s a Source #

An SQL query.

Instances

Monad (Query s) Source # 

Methods

(>>=) :: Query s a -> (a -> Query s b) -> Query s b #

(>>) :: Query s a -> Query s b -> Query s b #

return :: a -> Query s a #

fail :: String -> Query s a #

Functor (Query s) Source # 

Methods

fmap :: (a -> b) -> Query s a -> Query s b #

(<$) :: a -> Query s b -> Query s a #

Applicative (Query s) Source # 

Methods

pure :: a -> Query s a #

(<*>) :: Query s (a -> b) -> Query s a -> Query s b #

(*>) :: Query s a -> Query s b -> Query s b #

(<*) :: Query s a -> Query s b -> Query s a #

data Col s a Source #

A database column. A column is often a literal column table, but can also be an expression over such a column or a constant expression.

Instances

Columns b => Columns ((:*:) (Col k s a) b) Source # 

Methods

toTup :: [ColName] -> Col k s a :*: b

fromTup :: (Col k s a :*: b) -> [SomeCol]

(Typeable * a, SqlType a, Result b) => Result ((:*:) (Col * s a) b) Source # 

Associated Types

type Res ((:*:) (Col * s a) b) :: * Source #

Methods

toRes :: Proxy * (Col * s a :*: b) -> [SqlValue] -> Res (Col * s a :*: b)

finalCols :: (Col * s a :*: b) -> [SomeCol]

Fractional (Col k s (Maybe Int)) Source # 

Methods

(/) :: Col k s (Maybe Int) -> Col k s (Maybe Int) -> Col k s (Maybe Int) #

recip :: Col k s (Maybe Int) -> Col k s (Maybe Int) #

fromRational :: Rational -> Col k s (Maybe Int) #

Fractional (Col k s Int) Source # 

Methods

(/) :: Col k s Int -> Col k s Int -> Col k s Int #

recip :: Col k s Int -> Col k s Int #

fromRational :: Rational -> Col k s Int #

Fractional (Col k s (Maybe Double)) Source # 

Methods

(/) :: Col k s (Maybe Double) -> Col k s (Maybe Double) -> Col k s (Maybe Double) #

recip :: Col k s (Maybe Double) -> Col k s (Maybe Double) #

fromRational :: Rational -> Col k s (Maybe Double) #

Fractional (Col k s Double) Source # 

Methods

(/) :: Col k s Double -> Col k s Double -> Col k s Double #

recip :: Col k s Double -> Col k s Double #

fromRational :: Rational -> Col k s Double #

(SqlType a, Num a) => Num (Col k s (Maybe a)) Source # 

Methods

(+) :: Col k s (Maybe a) -> Col k s (Maybe a) -> Col k s (Maybe a) #

(-) :: Col k s (Maybe a) -> Col k s (Maybe a) -> Col k s (Maybe a) #

(*) :: Col k s (Maybe a) -> Col k s (Maybe a) -> Col k s (Maybe a) #

negate :: Col k s (Maybe a) -> Col k s (Maybe a) #

abs :: Col k s (Maybe a) -> Col k s (Maybe a) #

signum :: Col k s (Maybe a) -> Col k s (Maybe a) #

fromInteger :: Integer -> Col k s (Maybe a) #

(SqlType a, Num a) => Num (Col k s a) Source # 

Methods

(+) :: Col k s a -> Col k s a -> Col k s a #

(-) :: Col k s a -> Col k s a -> Col k s a #

(*) :: Col k s a -> Col k s a -> Col k s a #

negate :: Col k s a -> Col k s a #

abs :: Col k s a -> Col k s a #

signum :: Col k s a -> Col k s a #

fromInteger :: Integer -> Col k s a #

IsString (Col k s Text) Source # 

Methods

fromString :: String -> Col k s Text #

Columns (Col k s a) Source # 

Methods

toTup :: [ColName] -> Col k s a

fromTup :: Col k s a -> [SomeCol]

(Typeable * a, SqlType a) => Result (Col * s a) Source # 

Associated Types

type Res (Col * s a) :: * Source #

Methods

toRes :: Proxy * (Col * s a) -> [SqlValue] -> Res (Col * s a)

finalCols :: Col * s a -> [SomeCol]

type Res ((:*:) (Col * s a) b) Source # 
type Res ((:*:) (Col * s a) b) = (:*:) a (Res b)
type Res (Col * s a) Source # 
type Res (Col * s a) = a

class Typeable (Res r) => Result r Source #

An acceptable query result type; one or more columns stitched together with :*:.

Minimal complete definition

toRes, finalCols

Associated Types

type Res r Source #

Instances

(Typeable * a, SqlType a, Result b) => Result ((:*:) (Col * s a) b) Source # 

Associated Types

type Res ((:*:) (Col * s a) b) :: * Source #

Methods

toRes :: Proxy * (Col * s a :*: b) -> [SqlValue] -> Res (Col * s a :*: b)

finalCols :: (Col * s a :*: b) -> [SomeCol]

(Typeable * a, SqlType a) => Result (Col * s a) Source # 

Associated Types

type Res (Col * s a) :: * Source #

Methods

toRes :: Proxy * (Col * s a) -> [SqlValue] -> Res (Col * s a)

finalCols :: Col * s a -> [SomeCol]

query :: (MonadSelda m, Result a) => Query s a -> m [Res a] Source #

Run a query within a Selda monad. In practice, this is often a SeldaT transformer on top of some other monad. Selda transformers are entered using backend-specific withX functions, such as withSQLite from the SQLite backend.

transaction :: (MonadSelda m, MonadThrow m, MonadCatch m) => m a -> m a Source #

Perform the given computation atomically. If an exception is raised during its execution, the enture transaction will be rolled back, and the exception re-thrown.

setLocalCache :: MonadSelda m => Int -> m () Source #

Set the maximum local cache size to n. A cache size of zero disables local cache altogether. Changing the cache size will also flush all entries.

By default, local caching is turned off.

WARNING: local caching is guaranteed to be consistent with the underlying database, ONLY under the assumption that no other process will modify it. Also note that the cache is shared between ALL Selda computations running within the same process.

Constructing queries

class SqlType a Source #

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

Minimal complete definition

mkLit, sqlType, fromSql

data Text :: * #

A space efficient, packed, unboxed Unicode text type.

Instances

type family Cols s a where ... Source #

Convert a tuple of Haskell types to a tuple of column types.

Equations

Cols s (a :*: b) = Col s a :*: Cols s b 
Cols s a = Col s a 

class Columns a Source #

Any column tuple.

Minimal complete definition

toTup, fromTup

Instances

Columns b => Columns ((:*:) (Col k s a) b) Source # 

Methods

toTup :: [ColName] -> Col k s a :*: b

fromTup :: (Col k s a :*: b) -> [SomeCol]

Columns (Col k s a) Source # 

Methods

toTup :: [ColName] -> Col k s a

fromTup :: Col k s a -> [SomeCol]

data Order Source #

The order in which to sort result rows.

Constructors

Asc 
Desc 

Instances

Eq Order Source # 

Methods

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

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

Ord Order Source # 

Methods

compare :: Order -> Order -> Ordering #

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

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

(>) :: Order -> Order -> Bool #

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

max :: Order -> Order -> Order #

min :: Order -> Order -> Order #

Show Order Source # 

Methods

showsPrec :: Int -> Order -> ShowS #

show :: Order -> String #

showList :: [Order] -> ShowS #

data a :*: b where infixr 1 Source #

An inductively defined "tuple", or heterogeneous, non-empty list.

Constructors

(:*:) :: a -> b -> a :*: b infixr 1 

Instances

(ComposeSpec ColSpec a b, ComposeSpec ColSpec b c) => ComposeSpec ColSpec ((:*:) a b) c Source # 

Methods

(+++) :: ColSpec (a :*: b) -> ColSpec c -> ColSpec ((a :*: b) :+++: c) Source #

(ComposeSpec Table a b, ComposeSpec Table b c) => ComposeSpec Table ((:*:) a b) c Source # 

Methods

(+++) :: Table (a :*: b) -> Table c -> ColSpec ((a :*: b) :+++: c) Source #

(Eq a, Eq b) => Eq ((:*:) a b) Source # 

Methods

(==) :: (a :*: b) -> (a :*: b) -> Bool #

(/=) :: (a :*: b) -> (a :*: b) -> Bool #

(Ord a, Ord b) => Ord ((:*:) a b) Source # 

Methods

compare :: (a :*: b) -> (a :*: b) -> Ordering #

(<) :: (a :*: b) -> (a :*: b) -> Bool #

(<=) :: (a :*: b) -> (a :*: b) -> Bool #

(>) :: (a :*: b) -> (a :*: b) -> Bool #

(>=) :: (a :*: b) -> (a :*: b) -> Bool #

max :: (a :*: b) -> (a :*: b) -> a :*: b #

min :: (a :*: b) -> (a :*: b) -> a :*: b #

(Show a, Show b) => Show ((:*:) a b) Source # 

Methods

showsPrec :: Int -> (a :*: b) -> ShowS #

show :: (a :*: b) -> String #

showList :: [a :*: b] -> ShowS #

Tup ((:*:) a b) Source # 

Methods

tupHead :: (a :*: b) -> Head (a :*: b)

Columns b => Columns ((:*:) (Col k s a) b) Source # 

Methods

toTup :: [ColName] -> Col k s a :*: b

fromTup :: (Col k s a :*: b) -> [SomeCol]

Aggregates b => Aggregates ((:*:) (Aggr (Inner s) a) b) Source # 

Methods

unAggrs :: (Aggr (Inner s) a :*: b) -> [SomeCol]

(SqlType a, Insert b) => Insert ((:*:) a b) Source # 

Methods

params :: (a :*: b) -> [Maybe Param]

(Typeable * a, SqlType a, Result b) => Result ((:*:) (Col * s a) b) Source # 

Associated Types

type Res ((:*:) (Col * s a) b) :: * Source #

Methods

toRes :: Proxy * (Col * s a :*: b) -> [SqlValue] -> Res (Col * s a :*: b)

finalCols :: (Col * s a :*: b) -> [SomeCol]

type Res ((:*:) (Col * s a) b) Source # 
type Res ((:*:) (Col * s a) b) = (:*:) a (Res b)

select :: Columns (Cols s a) => Table a -> Query s (Cols s a) Source #

Query the given table. Result is returned as an inductive tuple, i.e. first :*: second :*: third <- query tableOfThree.

selectValues :: (Insert a, Columns (Cols s a)) => [a] -> Query s (Cols s a) Source #

Query an ad hoc table of type a. Each element in the given list represents one row in the ad hoc table.

restrict :: Col s Bool -> Query s () Source #

Restrict the query somehow. Roughly equivalent to WHERE.

limit :: Int -> Int -> Query s () Source #

Drop the first m rows, then get at most n of the remaining rows.

order :: Col s a -> Order -> Query s () Source #

Sort the result rows in ascending or descending order on the given row.

ascending :: Order Source #

Ordering for order.

descending :: Order Source #

Ordering for order.

Expressions over columns

(.==) :: SqlType a => Col s a -> Col s a -> Col s Bool infixl 4 Source #

(./=) :: SqlType a => Col s a -> Col s a -> Col s Bool Source #

(.>) :: SqlType a => Col s a -> Col s a -> Col s Bool infixl 4 Source #

(.<) :: SqlType a => Col s a -> Col s a -> Col s Bool infixl 4 Source #

(.>=) :: SqlType a => Col s a -> Col s a -> Col s Bool infixl 4 Source #

(.<=) :: SqlType a => Col s a -> Col s a -> Col s Bool infixl 4 Source #

like :: Col s Text -> Col s Text -> Col s Bool infixl 4 Source #

The SQL LIKE operator; matches strings with % wildcards. For instance:

"%gon" `like` "dragon" .== true

(.&&) :: Col s Bool -> Col s Bool -> Col s Bool infixr 3 Source #

(.||) :: Col s Bool -> Col s Bool -> Col s Bool infixr 2 Source #

not_ :: Col s Bool -> Col s Bool Source #

Boolean negation.

literal :: SqlType a => a -> Col s a Source #

A literal expression.

int :: Int -> Col s Int Source #

Specialization of literal for integers.

float :: Double -> Col s Double Source #

Specialization of literal for doubles.

text :: Text -> Col s Text Source #

Specialization of literal for text.

true :: Col s Bool Source #

True and false boolean literals.

false :: Col s Bool Source #

True and false boolean literals.

null_ :: SqlType a => Col s (Maybe a) Source #

SQL NULL, at any type you like.

roundTo :: Col s Int -> Col s Double -> Col s Double Source #

Round a column to the given number of decimals places.

length_ :: Col s Text -> Col s Int Source #

Calculate the length of a string column.

isNull :: Col s (Maybe a) -> Col s Bool Source #

Is the given column null?

Converting between column types

round_ :: Num a => Col s Double -> Col s a Source #

Round a value to the nearest integer. Equivalent to roundTo 0.

just :: SqlType a => Col s a -> Col s (Maybe a) Source #

Lift a non-nullable column to a nullable one. Useful for creating expressions over optional columns:

people :: Table (Text :*: Int :*: Maybe Text)
people = table "people" $ required "name" ¤ required "age" ¤ optional "pet"

peopleWithCats = do
  name :*: _ :*: pet <- select people
  restrict (pet .== just "cat")
  return name

fromBool :: (SqlType a, Num a) => Col s Bool -> Col s a Source #

Convert a boolean column to any numeric type.

fromInt :: (SqlType a, Num a) => Col s Int -> Col s a Source #

Convert an integer column to any numeric type.

toString :: Col s a -> Col s String Source #

Convert any column to a string.

Inner queries

data Aggr s a Source #

A single aggregate column. Aggregate columns may not be used to restrict queries. When returned from an aggregate subquery, an aggregate column is converted into a non-aggregate column.

Instances

Aggregates b => Aggregates ((:*:) (Aggr (Inner s) a) b) Source # 

Methods

unAggrs :: (Aggr (Inner s) a :*: b) -> [SomeCol]

Aggregates (Aggr (Inner s) a) Source # 

Methods

unAggrs :: Aggr (Inner s) a -> [SomeCol]

class Aggregates a Source #

One or more aggregate columns.

Minimal complete definition

unAggrs

Instances

Aggregates b => Aggregates ((:*:) (Aggr (Inner s) a) b) Source # 

Methods

unAggrs :: (Aggr (Inner s) a :*: b) -> [SomeCol]

Aggregates (Aggr (Inner s) a) Source # 

Methods

unAggrs :: Aggr (Inner s) a -> [SomeCol]

type family OuterCols a where ... Source #

Convert one or more inner column to equivalent columns in the outer query. OuterCols (Aggr (Inner s) a :*: Aggr (Inner s) b) = Col s a :*: Col s b, for instance.

Equations

OuterCols (t (Inner s) a :*: b) = Col s a :*: OuterCols b 
OuterCols (t (Inner s) a) = Col s a 

type family JoinCols a where ... Source #

The results of a join are always nullable, as there is no guarantee that all joined columns will be non-null. JoinCols a where a is an extensible tuple is that same tuple, but in the outer query and with all elements nullable. For instance:

 JoinCols (Col (Inner s) Int :*: Col (Inner s) Text)
   = Col s (Maybe Int) :*: Col s (Maybe Text)

Equations

JoinCols (Col (Inner s) (Maybe a) :*: b) = Col s (Maybe a) :*: JoinCols b 
JoinCols (Col (Inner s) a :*: b) = Col s (Maybe a) :*: JoinCols b 
JoinCols (Col (Inner s) (Maybe a)) = Col s (Maybe a) 
JoinCols (Col (Inner s) a) = Col s (Maybe a) 

data Inner s Source #

Denotes an inner query. For aggregation, treating sequencing as the cartesian product of queries does not work well. Instead, we treat the sequencing of aggregate with other queries as the cartesian product of the aggregated result of the query, a small but important difference.

However, for this to work, the aggregate query must not depend on any columns in the outer product. Therefore, we let the aggregate query be parameterized over Inner s if the parent query is parameterized over s, to enforce this separation.

Instances

Aggregates b => Aggregates ((:*:) (Aggr (Inner s) a) b) Source # 

Methods

unAggrs :: (Aggr (Inner s) a :*: b) -> [SomeCol]

Aggregates (Aggr (Inner s) a) Source # 

Methods

unAggrs :: Aggr (Inner s) a -> [SomeCol]

class SqlType a => MinMax a Source #

Any column type that can be used with the min_ and max_ functions.

Instances

leftJoin Source #

Arguments

:: (Columns a, Columns (OuterCols a), Columns (JoinCols a)) 
=> (OuterCols a -> Col s Bool)

Predicate determining which lines to join. | Right-hand query to join.

-> Query (Inner s) a 
-> Query s (JoinCols a) 

Perform a LEFT JOIN with the current result set (i.e. the outer query) as the left hand side, and the given query as the right hand side. Like with aggregate, the inner (or right) query must not depend on the outer (or right) one.

The given predicate over the values returned by the inner query determines for each row whether to join or not. This predicate may depend on any values from the outer query.

For instance, the following will list everyone in the people table together with their address if they have one; if they don't, the address field will be NULL.

getAddresses :: Query s (Col s Text :*: Col s (Maybe Text))
getAddresses = do
  name :*: _ <- select people
  _ :*: address <- leftJoin (\(n :*: _) -> n .== name)
                            (select addresses)
  return (name :*: address)

aggregate :: (Columns (OuterCols a), Aggregates a) => Query (Inner s) a -> Query s (OuterCols a) Source #

Execute a query, returning an aggregation of its results. The query must return an inductive tuple of Aggregate columns. When aggregate returns, those columns are converted into non-aggregate columns, which may then be used to further restrict the query.

Note that aggregate queries must not depend on outer queries, nor must they return any non-aggregate columns. Attempting to do either results in a type error.

The SQL HAVING keyword can be implemented by combining aggregate and restrict:

-- Find the number of people living on every address, for all addresses
-- with more than one tenant:
-- SELECT COUNT(name) AS c, address FROM housing GROUP BY name HAVING c > 1

numPpl = do
  num_tenants :*: address <- aggregate $ do
    _ :*: address <- select housing
    groupBy address
    return (count address :*: some address)
 restrict (num_tenants .> 1)
 return (num_tenants :*: address)

groupBy :: Col (Inner s) a -> Query (Inner s) (Aggr (Inner s) a) Source #

Group an aggregate query by a column. Attempting to group a non-aggregate query is a type error. An aggregate representing the grouped-by column is returned, which can be returned from the aggregate query. For instance, if you want to find out how many people have a pet at home:

aggregate $ do
  name :*: pet_name <- select people
  name' <- groupBy name
  return (name' :*: count(pet_name) > 0)

count :: SqlType a => Col s a -> Aggr s Int Source #

The number of non-null values in the given column.

avg :: (SqlType a, Num a) => Col s a -> Aggr s a Source #

The average of all values in the given column.

sum_ :: (SqlType a, Num a) => Col s a -> Aggr s a Source #

Sum all values in the given column.

max_ :: MinMax a => Col s a -> Aggr s a Source #

The greatest value in the given column. Texts are compared lexically.

min_ :: MinMax a => Col s a -> Aggr s a Source #

The smallest value in the given column. Texts are compared lexically.

Modifying tables

class Insert a Source #

An inductive tuple of Haskell-level values (i.e. Int :*: Maybe Text) which can be inserted into a table.

Minimal complete definition

params

Instances

SqlType a => Insert a Source # 

Methods

params :: a -> [Maybe Param]

(SqlType a, Insert b) => Insert ((:*:) a b) Source # 

Methods

params :: (a :*: b) -> [Maybe Param]

insert :: (MonadSelda m, Insert a) => Table a -> [a] -> m Int Source #

Insert the given values into the given table. All columns of the table must be present. If your table has an auto-incrementing primary key, use the special value def for that column to get the auto-incrementing behavior. Returns the number of rows that were inserted.

To insert a list of tuples into a table with auto-incrementing primary key:

people :: Table (Auto Int :*: Text :*: Int :*: Maybe Text)
people = table "ppl"
       $ autoPrimary "id"
       ¤ required "name"
       ¤ required "age"
       ¤ optional "pet"

main = withSQLite "my_database.sqlite" $ do
  insert_ people
    [ def :*: "Link"  :*: 125 :*: Just "horse"
    , def :*: "Zelda" :*: 119 :*: Nothing
    , ...
    ]

insert_ :: (MonadSelda m, Insert a) => Table a -> [a] -> m () Source #

Like insert, but does not return anything. Use this when you really don't care about how many rows were inserted.

insertWithPK :: (MonadSelda m, Insert a) => Table a -> [a] -> m Int Source #

Like insert, but returns the primary key of the last inserted row. Attempting to run this operation on a table without an auto-incrementing primary key is a type error.

def :: SqlType a => a Source #

The default value for a column during insertion. For an auto-incrementing primary key, the default value is the next key.

Using def in any other context than insertion results in a runtime error. Likewise, if def is given for a column that does not have a default value, the insertion will fail.

update Source #

Arguments

:: (MonadSelda m, Columns (Cols s a), Result (Cols s a)) 
=> Table a

The table to update.

-> (Cols s a -> Col s Bool)

Predicate.

-> (Cols s a -> Cols s a)

Update function.

-> m Int 

Update the given table using the given update function, for all rows matching the given predicate. Returns the number of updated rows.

update_ :: (MonadSelda m, Columns (Cols s a), Result (Cols s a)) => Table a -> (Cols s a -> Col s Bool) -> (Cols s a -> Cols s a) -> m () Source #

Like update, but doesn't return the number of updated rows.

deleteFrom :: (MonadSelda m, Columns (Cols s a)) => Table a -> (Cols s a -> Col s Bool) -> m Int Source #

From the given table, delete all rows matching the given predicate. Returns the number of deleted rows.

deleteFrom_ :: (MonadSelda m, Columns (Cols s a)) => Table a -> (Cols s a -> Col s Bool) -> m () Source #

Like deleteFrom, but does not return the number of deleted rows.

Defining schemas

data ColSpec a Source #

A table column specification.

Instances

(~) * ((:+++:) a b) ((:*:) a b) => ComposeSpec ColSpec a b Source # 

Methods

(+++) :: ColSpec a -> ColSpec b -> ColSpec (a :+++: b) Source #

(ComposeSpec ColSpec a b, ComposeSpec ColSpec b c) => ComposeSpec ColSpec ((:*:) a b) c Source # 

Methods

(+++) :: ColSpec (a :*: b) -> ColSpec c -> ColSpec ((a :*: b) :+++: c) Source #

type TableName = Text Source #

Name of a database table.

type ColName = Text Source #

Name of a database column.

class SqlType a => NonNull a Source #

Any SQL type which is NOT nullable.

Instances

type family IsNullable a where ... Source #

Is the given type nullable?

data Nullable Source #

Used by IsNullable to indicate a nullable type.

data NotNullable Source #

Used by IsNullable to indicate a nullable type.

table :: TableName -> ColSpec a -> Table a Source #

A table with the given name and columns.

(¤) :: ColSpec a -> ColSpec b -> ColSpec (a :*: b) infixr 1 Source #

Combine two column specifications. Table descriptions are built by chaining columns using this operator:

people :: Table (Text :*: Int :*: Maybe Text)
people = table "people" $ required "name" ¤ required "age" ¤ optional "pet"

To combine two pre-built tables into a table comprised of both tables' fields, see '(+++)'.

required :: NonNull a => ColName -> ColSpec a Source #

A non-nullable column with the given name.

optional :: SqlType a => ColName -> ColSpec (Maybe a) Source #

A nullable column with the given name.

primary :: NonNull a => ColName -> ColSpec a Source #

Marks the given column as the table's primary key. A table may only have one primary key; marking more than one key as primary will result in a run-time error.

autoPrimary :: ColName -> ColSpec Int Source #

Automatically increment the given attribute if not specified during insert. Also adds the PRIMARY KEY attribute on the column.

Combining schemas

class ComposeSpec t a b where Source #

Minimal complete definition

(+++)

Methods

(+++) :: t a -> t b -> ColSpec (a :+++: b) infixr 5 Source #

Combine the given tables or column specifications into a new column specification which can be used to create a new table. Useful for building composable table specifications.

Note that this function is only suitable for combining specifications which have a concrete type. To build a column specification from scratch, use '(¤)' instead.

Instances

(~) * ((:+++:) a b) ((:*:) a b) => ComposeSpec ColSpec a b Source # 

Methods

(+++) :: ColSpec a -> ColSpec b -> ColSpec (a :+++: b) Source #

(~) * ((:+++:) a b) ((:*:) a b) => ComposeSpec Table a b Source # 

Methods

(+++) :: Table a -> Table b -> ColSpec (a :+++: b) Source #

(ComposeSpec ColSpec a b, ComposeSpec ColSpec b c) => ComposeSpec ColSpec ((:*:) a b) c Source # 

Methods

(+++) :: ColSpec (a :*: b) -> ColSpec c -> ColSpec ((a :*: b) :+++: c) Source #

(ComposeSpec Table a b, ComposeSpec Table b c) => ComposeSpec Table ((:*:) a b) c Source # 

Methods

(+++) :: Table (a :*: b) -> Table c -> ColSpec ((a :*: b) :+++: c) Source #

type family a :+++: b where ... infixr 5 Source #

Equations

(a :*: b) :+++: c = a :*: (b :+++: c) 
a :+++: b = a :*: b 

(+++) :: ComposeSpec t a b => t a -> t b -> ColSpec (a :+++: b) Source #

Combine the given tables or column specifications into a new column specification which can be used to create a new table. Useful for building composable table specifications.

Note that this function is only suitable for combining specifications which have a concrete type. To build a column specification from scratch, use '(¤)' instead.

Creating and dropping tables

createTable :: MonadSelda m => Table a -> m () Source #

Create a table from the given schema.

tryCreateTable :: MonadSelda m => Table a -> m () Source #

Create a table from the given schema, unless it already exists.

dropTable :: MonadSelda m => Table a -> m () Source #

Drop the given table.

tryDropTable :: MonadSelda m => Table a -> m () Source #

Drop the given table, if it exists.

Compiling and inspecting queries

compile :: Result a => Query s a -> (Text, [Param]) Source #

Compile a query into a parameterised SQL statement.

compileCreateTable :: (Text -> [ColAttr] -> Maybe Text) -> OnError -> Table a -> Text Source #

Compile a CREATE TABLE query from a table definition.

compileDropTable :: OnError -> Table a -> Text Source #

Compile a DROP TABLE query.

compileInsert :: Insert a => Text -> Table a -> [a] -> (Text, [Param]) Source #

Compile an INSERT query, given the keyword representing default values in the target SQL dialect, a table and a list of items corresponding to the table.

compileUpdate Source #

Arguments

:: (Columns (Cols s a), Result (Cols s a)) 
=> Table a

The table to update.

-> (Cols s a -> Cols s a)

Update function.

-> (Cols s a -> Col s Bool)

Predicate: update only when true.

-> (Text, [Param]) 

Compile an UPDATE query.

Tuple convenience functions

class Tup a Source #

Minimal complete definition

tupHead

Instances

(~) * (Head a) a => Tup a Source # 

Methods

tupHead :: a -> Head a

Tup ((:*:) a b) Source # 

Methods

tupHead :: (a :*: b) -> Head (a :*: b)

type family Head a where ... Source #

Equations

Head (a :*: b) = a 
Head a = a 

first :: Tup a => a -> Head a Source #

Get the first element of an inductive tuple.

second :: Tup b => (a :*: b) -> Head b Source #

Get the second element of an inductive tuple.

third :: Tup c => (a :*: (b :*: c)) -> Head c Source #

Get the third element of an inductive tuple.

fourth :: Tup d => (a :*: (b :*: (c :*: d))) -> Head d Source #

Get the fourth element of an inductive tuple.

fifth :: Tup e => (a :*: (b :*: (c :*: (d :*: e)))) -> Head e Source #

Get the fifth element of an inductive tuple.

sixth :: Tup f => (a :*: (b :*: (c :*: (d :*: (e :*: f))))) -> Head f Source #

Get the sixth element of an inductive tuple.

seventh :: Tup g => (a :*: (b :*: (c :*: (d :*: (e :*: (f :*: g)))))) -> Head g Source #

Get the seventh element of an inductive tuple.

eighth :: Tup h => (a :*: (b :*: (c :*: (d :*: (e :*: (f :*: (g :*: h))))))) -> Head h Source #

Get the eighth element of an inductive tuple.

ninth :: Tup i => (a :*: (b :*: (c :*: (d :*: (e :*: (f :*: (h :*: (h :*: i)))))))) -> Head i Source #

Get the ninth element of an inductive tuple.

tenth :: Tup j => (a :*: (b :*: (c :*: (d :*: (e :*: (f :*: (g :*: (h :*: (i :*: j))))))))) -> Head j Source #

Get the tenth element of an inductive tuple.