Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Database.MySQL.Hasqlator.Typed
Synopsis
- data Table (table :: Symbol) database = Table (Maybe Text) Text
- data Field (table :: Symbol) database (nullable :: Nullable) a
- newtype Alias table database (joinType :: JoinType) = Alias {
- getTableAlias :: forall fieldNull a. Field table database fieldNull a -> Expression (JoinNullable joinType fieldNull) a
- (@@) :: Alias table database (joinType :: JoinType) -> Field table database fieldNull a -> Expression (JoinNullable joinType fieldNull) a
- data Nullable
- data JoinType
- quotedTableName :: Table table database -> Text
- quotedFieldName :: Field table database nullable a -> Text
- data QueryClauses database a
- data Query database a
- mkQuery :: QueryClauses database a -> Query database a
- untypeQuery :: Query database (Selector a) -> Query a
- executeQuery :: MySQLConn -> Query database (Selector a) -> IO [a]
- unionAll :: Query database a -> Query database a -> Query database a
- unionDistinct :: Query database a -> Query database a -> Query database a
- data Selector a
- sel :: FromSql a => Expression 'NotNull a -> Selector a
- selMaybe :: FromSql (Maybe a) => Expression 'Nullable a -> Selector (Maybe a)
- forUpdate :: [Table table database] -> WaitLock -> QueryClauses database ()
- forShare :: [Table table database] -> WaitLock -> QueryClauses database ()
- shareMode :: QueryClauses database ()
- data Expression (nullable :: Nullable) a
- data SomeExpression
- someExpr :: Expression nullable a -> SomeExpression
- type Operator a b c = forall nullable. Expression nullable a -> Expression nullable b -> Expression nullable c
- arg :: ToSql a => a -> Expression nullable a
- argMaybe :: ToSql a => Maybe a -> Expression 'Nullable a
- isNull :: Expression nullable a -> Expression 'NotNull Bool
- isNotNull :: Expression 'Nullable a -> Expression 'NotNull Bool
- nullable :: Expression nullable a -> Expression 'Nullable a
- notNull :: Expression 'NotNull a -> Expression 'NotNull a
- orNull :: Expression nullable a -> (Expression 'NotNull a -> Expression 'NotNull Bool) -> Expression 'NotNull Bool
- unlessNull :: Expression nullable a -> (Expression 'NotNull a -> Expression 'NotNull Bool) -> Expression 'NotNull Bool
- cast :: Castable a => Expression nullable b -> Expression nullable a
- unsafeCast :: Expression nullable a -> Expression nullable b
- op :: (QueryBuilder -> QueryBuilder -> QueryBuilder) -> Operator a b c
- fun1 :: (QueryBuilder -> QueryBuilder) -> Expression nullable a -> Expression nullable b
- fun2 :: (QueryBuilder -> QueryBuilder -> QueryBuilder) -> Expression nullable a -> Expression nullable b -> Expression nullable c
- fun3 :: (QueryBuilder -> QueryBuilder -> QueryBuilder -> QueryBuilder) -> Expression nullable a -> Expression nullable b -> Expression nullable c -> Expression nullable d
- (=.) :: ToSql a => Operator a a Bool
- (/=.) :: ToSql a => Operator a a Bool
- (>.) :: ToSql a => Operator a a Bool
- (<.) :: ToSql a => Operator a a Bool
- (>=.) :: ToSql a => Operator a a Bool
- (<=.) :: ToSql a => Operator a a Bool
- (&&.) :: Operator Bool Bool Bool
- (||.) :: Operator Bool Bool Bool
- substr :: Expression nullable Text -> Expression nullable Int -> Expression nullable Int -> Expression nullable Text
- true_ :: Expression nullable Bool
- false_ :: Expression nullable Bool
- in_ :: Expression nullable a -> [Expression nullable a] -> Expression nullable Bool
- notIn_ :: Expression nullable a -> [Expression nullable a] -> Expression nullable Bool
- and_ :: Foldable f => f (Expression nullable Bool) -> Expression nullable Bool
- or_ :: Foldable f => f (Expression nullable Bool) -> Expression nullable Bool
- newtype All_ nullable = All_ {
- getAll_ :: Expression nullable Bool
- newtype Any_ nullable = Any_ {
- getAny_ :: Expression nullable Bool
- all_ :: Foldable f => (a -> Expression nullable Bool) -> f a -> Expression nullable Bool
- any_ :: Foldable f => (a -> Expression nullable Bool) -> f a -> Expression nullable Bool
- from :: Table table database -> QueryClauses database (Alias table database 'InnerJoined)
- fromSubQuery :: (Generic inExprs, Generic outExprs, SubQueryExpr 'LeftJoined (Rep inExprs ()) (Rep outExprs ())) => Query database inExprs -> QueryClauses database outExprs
- innerJoin :: Table table database -> (Alias table database 'InnerJoined -> Expression nullable Bool) -> QueryClauses database (Alias table database 'InnerJoined)
- leftJoin :: Table table database -> (Alias table database 'LeftJoined -> Expression nullable Bool) -> QueryClauses database (Alias table database 'LeftJoined)
- joinSubQuery :: (Generic inExprs, Generic outExprs, SubQueryExpr 'InnerJoined (Rep inExprs ()) (Rep outExprs ())) => Query database inExprs -> (outExprs -> Expression nullable Bool) -> QueryClauses database outExprs
- leftJoinSubQuery :: (Generic inExprs, Generic outExprs, SubQueryExpr 'LeftJoined (Rep inExprs ()) (Rep outExprs ())) => Query database inExprs -> (outExprs -> Expression nullable Bool) -> QueryClauses database outExprs
- where_ :: Expression 'NotNull Bool -> QueryClauses database ()
- groupBy_ :: [SomeExpression] -> QueryClauses database ()
- having :: Expression nullable Bool -> QueryClauses database ()
- orderBy :: [QueryOrdering] -> QueryClauses database ()
- data QueryOrdering
- limit :: Int -> QueryClauses database ()
- limitOffset :: Int -> Int -> QueryClauses database ()
- data Insertor (table :: Symbol) database a
- insertValues :: Table table database -> Insertor table database a -> [a] -> Command
- insertUpdateValues :: Table table database -> Insertor table database a -> (Alias table database 'InnerJoined -> Alias table database 'InnerJoined -> [Updator table database]) -> [a] -> Command
- insertSelect :: Table table database -> QueryClauses database [Into database table] -> Command
- insertData :: (Generic a, Generic b, InsertGeneric tbl db (Rep a ()) (Rep b ())) => a -> Insertor tbl db b
- skipInsert :: Insertor tbl db a
- into :: (a -> Expression nullable b) -> Field table database nullable b -> Insertor table database a
- lensInto :: ToSql b => Getter a b -> Field table database 'NotNull b -> Insertor table database a
- maybeLensInto :: ToSql b => Getter a (Maybe b) -> Field table database 'Nullable b -> Insertor table database a
- opticInto :: (ToSql b, Is k A_Getter) => Optic' k is a b -> Field table database 'NotNull b -> Insertor table database a
- maybeOpticInto :: (ToSql b, Is k A_Getter) => Optic' k is a (Maybe b) -> Field table database 'Nullable b -> Insertor table database a
- insertOne :: ToSql a => Field table database 'NotNull fieldType -> Insertor table database a
- exprInto :: Expression nullable a -> Field table database nullable a -> Into database table
- data Into database (table :: Symbol)
- insertWithout :: Field tables database nullable b -> Insertor table database a -> Insertor table database a
- updateWithout :: Field table database nullable a -> [Updator table database] -> [Updator table database]
- delete :: QueryClauses database (Alias table database 'InnerJoined) -> Command
- data Updator table database = forall nullable a. (Field table database nullable a) := (Expression nullable a)
- update :: Table table database -> (Alias table database 'InnerJoined -> QueryClauses database [Updator table database]) -> Command
- type Getter s a = (a -> Const a a) -> s -> Const a s
- class ToSql a
- class FromSql a
- subQueryExpr :: Query database (Expression nullable a) -> Expression nullable a
- executeCommand :: MySQLConn -> Command -> IO OK
- data Command
- data WaitLock
Database Types
newtype Alias table database (joinType :: JoinType) Source #
An table alias that can be used inside the Query. The function
inside the newtype can also be applied directly to create an
expression from a field. For constructing records, applicativeDo
is the recommended way. However note that this may fail due to a
bug in ghc, that breaks the polymorphism. In that case as a
workaround you should use the Alias newtype directly and use the
@@
operator to create an expression instead
Constructors
Alias | |
Fields
|
(@@) :: Alias table database (joinType :: JoinType) -> Field table database fieldNull a -> Expression (JoinNullable joinType fieldNull) a infixl 9 Source #
Create an expression from an aliased table and a field.
Constructors
LeftJoined | |
InnerJoined |
quotedTableName :: Table table database -> Text Source #
quotedFieldName :: Field table database nullable a -> Text Source #
Querying
data QueryClauses database a Source #
Instances
Applicative (QueryClauses database) Source # | |
Defined in Database.MySQL.Hasqlator.Typed Methods pure :: a -> QueryClauses database a # (<*>) :: QueryClauses database (a -> b) -> QueryClauses database a -> QueryClauses database b # liftA2 :: (a -> b -> c) -> QueryClauses database a -> QueryClauses database b -> QueryClauses database c # (*>) :: QueryClauses database a -> QueryClauses database b -> QueryClauses database b # (<*) :: QueryClauses database a -> QueryClauses database b -> QueryClauses database a # | |
Functor (QueryClauses database) Source # | |
Defined in Database.MySQL.Hasqlator.Typed Methods fmap :: (a -> b) -> QueryClauses database a -> QueryClauses database b # (<$) :: a -> QueryClauses database b -> QueryClauses database a # | |
Monad (QueryClauses database) Source # | |
Defined in Database.MySQL.Hasqlator.Typed Methods (>>=) :: QueryClauses database a -> (a -> QueryClauses database b) -> QueryClauses database b # (>>) :: QueryClauses database a -> QueryClauses database b -> QueryClauses database b # return :: a -> QueryClauses database a # |
mkQuery :: QueryClauses database a -> Query database a Source #
Selectors
selMaybe :: FromSql (Maybe a) => Expression 'Nullable a -> Selector (Maybe a) Source #
make a selector from a column that can be null
shareMode :: QueryClauses database () Source #
Expressions
data Expression (nullable :: Nullable) a Source #
Instances
data SomeExpression Source #
An expression of any type
someExpr :: Expression nullable a -> SomeExpression Source #
Remove types of an expression
type Operator a b c = forall nullable. Expression nullable a -> Expression nullable b -> Expression nullable c Source #
arg :: ToSql a => a -> Expression nullable a Source #
pass an argument
isNull :: Expression nullable a -> Expression 'NotNull Bool Source #
isNotNull :: Expression 'Nullable a -> Expression 'NotNull Bool Source #
nullable :: Expression nullable a -> Expression 'Nullable a Source #
make expression nullable
notNull :: Expression 'NotNull a -> Expression 'NotNull a Source #
ensure expression is not null
orNull :: Expression nullable a -> (Expression 'NotNull a -> Expression 'NotNull Bool) -> Expression 'NotNull Bool Source #
Return a true expression if the given expression is NULL (using the IS NULL sql test), or pass the expression (coerced to 'NotNull) to the given test.
unlessNull :: Expression nullable a -> (Expression 'NotNull a -> Expression 'NotNull Bool) -> Expression 'NotNull Bool Source #
Perform test if given expression is not NULL
cast :: Castable a => Expression nullable b -> Expression nullable a Source #
Safe cast. This uses the SQL CAST function to convert safely from one type to another.
unsafeCast :: Expression nullable a -> Expression nullable b Source #
Cast the return type of an expression to any other type, without changing the query. Since this library adds static typing on top of SQL, you may sometimes want to use this to get back the lenient behaviour of SQL. This opens up more possibilies for runtime errors, so it's up to the programmer to ensure type correctness.
op :: (QueryBuilder -> QueryBuilder -> QueryBuilder) -> Operator a b c Source #
create an operator
fun1 :: (QueryBuilder -> QueryBuilder) -> Expression nullable a -> Expression nullable b Source #
fun2 :: (QueryBuilder -> QueryBuilder -> QueryBuilder) -> Expression nullable a -> Expression nullable b -> Expression nullable c Source #
fun3 :: (QueryBuilder -> QueryBuilder -> QueryBuilder -> QueryBuilder) -> Expression nullable a -> Expression nullable b -> Expression nullable c -> Expression nullable d Source #
substr :: Expression nullable Text -> Expression nullable Int -> Expression nullable Int -> Expression nullable Text Source #
true_ :: Expression nullable Bool Source #
false_ :: Expression nullable Bool Source #
in_ :: Expression nullable a -> [Expression nullable a] -> Expression nullable Bool Source #
notIn_ :: Expression nullable a -> [Expression nullable a] -> Expression nullable Bool Source #
and_ :: Foldable f => f (Expression nullable Bool) -> Expression nullable Bool Source #
or_ :: Foldable f => f (Expression nullable Bool) -> Expression nullable Bool Source #
newtype All_ nullable Source #
Constructors
All_ | |
Fields
|
newtype Any_ nullable Source #
Constructors
Any_ | |
Fields
|
all_ :: Foldable f => (a -> Expression nullable Bool) -> f a -> Expression nullable Bool Source #
any_ :: Foldable f => (a -> Expression nullable Bool) -> f a -> Expression nullable Bool Source #
Clauses
from :: Table table database -> QueryClauses database (Alias table database 'InnerJoined) Source #
fromSubQuery :: (Generic inExprs, Generic outExprs, SubQueryExpr 'LeftJoined (Rep inExprs ()) (Rep outExprs ())) => Query database inExprs -> QueryClauses database outExprs Source #
innerJoin :: Table table database -> (Alias table database 'InnerJoined -> Expression nullable Bool) -> QueryClauses database (Alias table database 'InnerJoined) Source #
leftJoin :: Table table database -> (Alias table database 'LeftJoined -> Expression nullable Bool) -> QueryClauses database (Alias table database 'LeftJoined) Source #
joinSubQuery :: (Generic inExprs, Generic outExprs, SubQueryExpr 'InnerJoined (Rep inExprs ()) (Rep outExprs ())) => Query database inExprs -> (outExprs -> Expression nullable Bool) -> QueryClauses database outExprs Source #
leftJoinSubQuery :: (Generic inExprs, Generic outExprs, SubQueryExpr 'LeftJoined (Rep inExprs ()) (Rep outExprs ())) => Query database inExprs -> (outExprs -> Expression nullable Bool) -> QueryClauses database outExprs Source #
where_ :: Expression 'NotNull Bool -> QueryClauses database () Source #
groupBy_ :: [SomeExpression] -> QueryClauses database () Source #
having :: Expression nullable Bool -> QueryClauses database () Source #
orderBy :: [QueryOrdering] -> QueryClauses database () Source #
data QueryOrdering Source #
Constructors
Asc SomeExpression | |
Desc SomeExpression |
limit :: Int -> QueryClauses database () Source #
limitOffset :: Int -> Int -> QueryClauses database () Source #
Insertion
insertUpdateValues :: Table table database -> Insertor table database a -> (Alias table database 'InnerJoined -> Alias table database 'InnerJoined -> [Updator table database]) -> [a] -> Command Source #
insertSelect :: Table table database -> QueryClauses database [Into database table] -> Command Source #
insertData :: (Generic a, Generic b, InsertGeneric tbl db (Rep a ()) (Rep b ())) => a -> Insertor tbl db b Source #
skipInsert :: Insertor tbl db a Source #
into :: (a -> Expression nullable b) -> Field table database nullable b -> Insertor table database a Source #
lensInto :: ToSql b => Getter a b -> Field table database 'NotNull b -> Insertor table database a Source #
maybeLensInto :: ToSql b => Getter a (Maybe b) -> Field table database 'Nullable b -> Insertor table database a Source #
opticInto :: (ToSql b, Is k A_Getter) => Optic' k is a b -> Field table database 'NotNull b -> Insertor table database a Source #
maybeOpticInto :: (ToSql b, Is k A_Getter) => Optic' k is a (Maybe b) -> Field table database 'Nullable b -> Insertor table database a Source #
insertOne :: ToSql a => Field table database 'NotNull fieldType -> Insertor table database a Source #
exprInto :: Expression nullable a -> Field table database nullable a -> Into database table Source #
insertWithout :: Field tables database nullable b -> Insertor table database a -> Insertor table database a Source #
updateWithout :: Field table database nullable a -> [Updator table database] -> [Updator table database] Source #
Deletion
delete :: QueryClauses database (Alias table database 'InnerJoined) -> Command Source #
Update
data Updator table database Source #
Constructors
forall nullable a. (Field table database nullable a) := (Expression nullable a) infix 0 |
update :: Table table database -> (Alias table database 'InnerJoined -> QueryClauses database [Updator table database]) -> Command Source #
imported from Database.MySQL.Hasqlator
type Getter s a = (a -> Const a a) -> s -> Const a s Source #
A Getter type compatible with the lens library
Minimal complete definition
toSqlValue
Instances
Minimal complete definition
fromSql
Instances
subQueryExpr :: Query database (Expression nullable a) -> Expression nullable a Source #
executeCommand :: MySQLConn -> Command -> IO OK Source #
Execute a Command which doesn't return a result-set. May throw a
SQLError
exception. See the mysql-haskell package for other
exceptions it may throw.
A command is a database query that doesn't return a value, but is executed for the side effect (inserting, updating, deleteing).
Instances
ToQueryBuilder Command Source # | |
Defined in Database.MySQL.Hasqlator Methods toQueryBuilder :: Command -> QueryBuilder Source # |