Copyright | 2014-2017 Kei Hibino |
---|---|
License | BSD3 |
Maintainer | [email protected] |
Stability | experimental |
Portability | unknown |
Safe Haskell | None |
Language | Haskell2010 |
Database.Relational.Documentation
Description
This module is documentation module for relational-record. The project page of relational-record is http://khibino.github.io/haskell-relational-record/ .
- query :: (MonadQualify ConfigureQuery m, MonadQuery m) => Relation () r -> m (Record Flat r)
- queryMaybe :: (MonadQualify ConfigureQuery m, MonadQuery m) => Relation () r -> m (Record Flat (Maybe r))
- on :: MonadQuery m => Predicate Flat -> m ()
- wheres :: MonadRestrict Flat m => Predicate Flat -> m ()
- groupBy :: MonadAggregate m => forall r. Record Flat r -> m (Record Aggregated r)
- having :: MonadRestrict Aggregated m => Predicate Aggregated -> m ()
- distinct :: MonadQuery m => m ()
- all' :: MonadQuery m => m ()
- (<-#) :: Monad m => AssignTarget r v -> Record Flat v -> Assignings r m ()
- inner :: Relation () a -> Relation () b -> [JoinRestriction a b] -> Relation () (a, b)
- left :: Relation () a -> Relation () b -> [JoinRestriction a (Maybe b)] -> Relation () (a, Maybe b)
- right :: Relation () a -> Relation () b -> [JoinRestriction (Maybe a) b] -> Relation () (Maybe a, b)
- full :: Relation () a -> Relation () b -> [JoinRestriction (Maybe a) (Maybe b)] -> Relation () (Maybe a, Maybe b)
- on' :: ([JoinRestriction a b] -> Relation pc (a, b)) -> [JoinRestriction a b] -> Relation pc (a, b)
- type JoinRestriction a b = Record Flat a -> Record Flat b -> Predicate Flat
- data Relation p r :: * -> * -> *
- relation :: QuerySimple (Record Flat r) -> Relation () r
- aggregateRelation :: QueryAggregate (Record Aggregated r) -> Relation () r
- data UpdateTarget p r :: * -> * -> *
- updateTarget :: AssignStatement r () -> UpdateTarget () r
- data Restriction p r :: * -> * -> *
- restriction :: RestrictedStatement r () -> Restriction () r
- data Record c t :: * -> * -> *
- data Flat :: *
- data Aggregated :: *
- data Exists :: *
- data OverWindow :: *
- data Pi r0 r1 :: * -> * -> *
- (!) :: PersistableWidth a => Record c a -> Pi a b -> Record c b
- (<.>) :: Pi a b -> Pi b c -> Pi a c
- class ShowConstantTermsSQL a
- value :: (ShowConstantTermsSQL t, OperatorContext c) => t -> Record c t
- values :: (ShowConstantTermsSQL t, OperatorContext c) => [t] -> RecordList (Record c) t
- (.=.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool)
- (.<.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool)
- (.<=.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool)
- (.>.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool)
- (.>=.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool)
- (.<>.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool)
- and' :: OperatorContext c => Record c (Maybe Bool) -> Record c (Maybe Bool) -> Record c (Maybe Bool)
- or' :: OperatorContext c => Record c (Maybe Bool) -> Record c (Maybe Bool) -> Record c (Maybe Bool)
- in' :: OperatorContext c => Record c t -> RecordList (Record c) t -> Record c (Maybe Bool)
- (.||.) :: OperatorContext c => Record c a -> Record c a -> Record c a
- like :: (OperatorContext c, IsString a, ShowConstantTermsSQL a) => Record c a -> a -> Record c (Maybe Bool)
- like' :: (OperatorContext c, IsString a) => Record c a -> Record c a -> Record c (Maybe Bool)
- (.+.) :: (OperatorContext c, Num a) => Record c a -> Record c a -> Record c a
- (.-.) :: (OperatorContext c, Num a) => Record c a -> Record c a -> Record c a
- (.*.) :: (OperatorContext c, Num a) => Record c a -> Record c a -> Record c a
- (./.) :: (OperatorContext c, Num a) => Record c a -> Record c a -> Record c a
- isNothing :: (OperatorContext c, HasColumnConstraint NotNull r) => Record c (Maybe r) -> Predicate c
- isJust :: (OperatorContext c, HasColumnConstraint NotNull r) => Record c (Maybe r) -> Predicate c
- fromMaybe :: (OperatorContext c, HasColumnConstraint NotNull r) => Record c r -> Record c (Maybe r) -> Record c r
- not' :: OperatorContext c => Record c (Maybe Bool) -> Record c (Maybe Bool)
- exists :: OperatorContext c => RecordList (Record Exists) r -> Record c (Maybe Bool)
- negate' :: (OperatorContext c, Num a) => Record c a -> Record c a
- fromIntegral' :: (SqlContext c, Integral a, Num b) => Record c a -> Record c b
- showNum :: (SqlContext c, Num a, IsString b) => Record c a -> Record c b
- casesOrElse :: OperatorContext c => [(Predicate c, Record c a)] -> Record c a -> Record c a
- case' :: OperatorContext c => Record c a -> [(Record c a, Record c b)] -> Record c b -> Record c b
- count :: (Integral b, AggregatedContext ac, SqlContext ac) => Record Flat a -> Record ac b
- sum' :: (Num a, AggregatedContext ac, SqlContext ac) => Record Flat a -> Record ac (Maybe a)
- avg :: (Num a, Fractional b, AggregatedContext ac, SqlContext ac) => Record Flat a -> Record ac (Maybe b)
- max' :: (Ord a, AggregatedContext ac, SqlContext ac) => Record Flat a -> Record ac (Maybe a)
- min' :: (Ord a, AggregatedContext ac, SqlContext ac) => Record Flat a -> Record ac (Maybe a)
- every :: (AggregatedContext ac, SqlContext ac) => Predicate Flat -> Record ac (Maybe Bool)
- any' :: (AggregatedContext ac, SqlContext ac) => Predicate Flat -> Record ac (Maybe Bool)
- some' :: (AggregatedContext ac, SqlContext ac) => Predicate Flat -> Record ac (Maybe Bool)
- over :: SqlContext c => Record OverWindow a -> Window c () -> Record c a
- rank :: Integral a => Record OverWindow a
- denseRank :: Integral a => Record OverWindow a
- rowNumber :: Integral a => Record OverWindow a
- percentRank :: Record OverWindow Double
- cumeDist :: Record OverWindow Double
- union :: Relation () a -> Relation () a -> Relation () a
- except :: Relation () a -> Relation () a -> Relation () a
- intersect :: Relation () a -> Relation () a -> Relation () a
- just :: ProjectableMaybe p => forall a. p a -> p (Maybe a)
- flattenMaybe :: ProjectableMaybe p => forall a. p (Maybe (Maybe a)) -> p (Maybe a)
- (?!) :: PersistableWidth a => Record c (Maybe a) -> Pi a b -> Record c (Maybe b)
- (?!?) :: PersistableWidth a => Record c (Maybe a) -> Pi a (Maybe b) -> Record c (Maybe b)
- (<?.>) :: Pi a (Maybe b) -> Pi b c -> Pi a (Maybe c)
- (<?.?>) :: Pi a (Maybe b) -> Pi b (Maybe c) -> Pi a (Maybe c)
- (?+?) :: (OperatorContext c, Num a) => Record c (Maybe a) -> Record c (Maybe a) -> Record c (Maybe a)
- negateMaybe :: (OperatorContext c, Num a) => Record c (Maybe a) -> Record c (Maybe a)
- sumMaybe :: (Num a, AggregatedContext ac, SqlContext ac) => Record Flat (Maybe a) -> Record ac (Maybe a)
- placeholder :: (PersistableWidth t, SqlContext c, Monad m) => (Record c t -> m a) -> m (PlaceHolders t, a)
- query' :: MonadQuery m => forall p r. Relation p r -> m (PlaceHolders p, Record Flat r)
- left' :: Relation pa a -> Relation pb b -> [JoinRestriction a (Maybe b)] -> Relation (pa, pb) (a, Maybe b)
- relation' :: SimpleQuery p r -> Relation p r
- updateTarget' :: AssignStatement r (PlaceHolders p) -> UpdateTarget p r
- restriction' :: RestrictedStatement r (PlaceHolders p) -> Restriction p r
- union' :: Relation p a -> Relation q a -> Relation (p, q) a
- class ProductConstructor c
- class ProductIsoFunctor (f :: * -> *) where
- class ProductIsoFunctor f => ProductIsoApplicative (f :: * -> *) where
- (><) :: ProductIsoApplicative p => p a -> p b -> p (a, b)
- relationalQuery :: Relation p r -> Query p r
- typedInsert :: PersistableWidth r => Table r -> Pi r r' -> Insert r'
- typedInsertQuery :: Table r -> Pi r r' -> Relation p r' -> InsertQuery p
- typedUpdate :: Table r -> UpdateTarget p r -> Update p
- typedDelete :: Table r -> Restriction p r -> Delete p
- typedKeyUpdate :: Table a -> Pi a p -> KeyUpdate p a
- derivedInsert :: (PersistableWidth r, TableDerivable r) => Pi r r' -> Insert r'
- derivedInsertQuery :: TableDerivable r => Pi r r' -> Relation p r' -> InsertQuery p
- derivedUpdate :: TableDerivable r => AssignStatement r (PlaceHolders p) -> Update p
- derivedDelete :: TableDerivable r => RestrictedStatement r (PlaceHolders p) -> Delete p
- class FromSql q a
- class PersistableWidth a => ToSql q a
- data RecordFromSql q a :: * -> * -> *
- data RecordToSql q a :: * -> * -> *
- prepareNoFetch :: (UntypeableNoFetch s, IConnection conn) => conn -> s p -> IO (PreparedStatement p ())
- bind :: ToSql SqlValue p => PreparedStatement p a -> p -> BoundStatement a
- execute :: BoundStatement a -> IO (ExecutedStatement a)
- executeNoFetch :: BoundStatement () -> IO Integer
- prepareQuery :: IConnection conn => conn -> Query p a -> IO (PreparedQuery p a)
- fetch :: FromSql SqlValue a => ExecutedStatement a -> IO (Maybe a)
- runQuery :: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a) => conn -> Query p a -> p -> IO [a]
- runQuery' :: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a) => conn -> Query p a -> p -> IO [a]
- prepareInsert :: IConnection conn => conn -> Insert a -> IO (PreparedInsert a)
- runInsert :: (IConnection conn, ToSql SqlValue a) => conn -> Insert a -> a -> IO Integer
- prepareInsertQuery :: IConnection conn => conn -> InsertQuery p -> IO (PreparedInsertQuery p)
- runInsertQuery :: (IConnection conn, ToSql SqlValue p) => conn -> InsertQuery p -> p -> IO Integer
- prepareUpdate :: IConnection conn => conn -> Update p -> IO (PreparedUpdate p)
- runUpdate :: (IConnection conn, ToSql SqlValue p) => conn -> Update p -> p -> IO Integer
- prepareDelete :: IConnection conn => conn -> Delete p -> IO (PreparedDelete p)
- runDelete :: (IConnection conn, ToSql SqlValue p) => conn -> Delete p -> p -> IO Integer
- prepareKeyUpdate :: IConnection conn => conn -> KeyUpdate p a -> IO (PreparedKeyUpdate p a)
- bindKeyUpdate :: ToSql SqlValue a => PreparedKeyUpdate p a -> a -> BoundStatement ()
- runKeyUpdate :: (IConnection conn, ToSql SqlValue a) => conn -> KeyUpdate p a -> a -> IO Integer
Concepts
User interface of Relational Record has main two part of modules.
Database.Relational
- Relational Query Building DSL
Database.Record and Database.HDBC.Record
- Database Operation Actions
Relational Query Building DSL
Relational Query (Database.Relational) module defines Typed DSL to build complex SQL query.
Monadic Query Context Building
On building query, query structures can be accumulated in monadic context.
Monadic Operators
Some operators are defined to build query structures in monadic context.
query
and queryMaybe
operators grow query product of monadic context like join operation of SQL.
on
operator appends a new condition into recent join product condition.
groupBy
operator aggregates flat record value, and can be used only in MonadAggregate
context.
wheres
and having
operators appends a new condition into whole query condition.
having
only accepts aggregated record value, and can be used only in MonadRestrict
Aggregated
context.
distinct
operator and all'
operator specify SELECT DISTINCT or SELECT ALL, the last specified in monad is used.
<-#
operator assigns update target column and record value to build update statement structure.
query :: (MonadQualify ConfigureQuery m, MonadQuery m) => Relation () r -> m (Record Flat r) #
Join sub-query. Query result is not Maybe
.
queryMaybe :: (MonadQualify ConfigureQuery m, MonadQuery m) => Relation () r -> m (Record Flat (Maybe r)) #
Join sub-query. Query result is Maybe
.
The combinations of query
and queryMaybe
express
inner joins, left outer joins, right outer joins, and full outer joins.
Here is an example of a right outer join:
outerJoin = relation $ do e <- queryMaybe employee d <- query department on $ e ?! E.deptId' .=. just (d ! D.deptId') return $ (,) |$| e |*| d
on :: MonadQuery m => Predicate Flat -> m () #
Add restriction to last join. Record type version.
wheres :: MonadRestrict Flat m => Predicate Flat -> m () #
Add restriction to this not aggregated query.
Arguments
:: MonadAggregate m | |
=> Record Flat r | Record to add into group by |
-> m (Record Aggregated r) | Result context and aggregated record | Add GROUP BY term into context and get aggregated record. Non-traditional group-by version. |
Add GROUP BY term into context and get aggregated record.
having :: MonadRestrict Aggregated m => Predicate Aggregated -> m () #
Add restriction to this aggregated query. Aggregated Record type version.
distinct :: MonadQuery m => m () #
Specify DISTINCT attribute to query context.
all' :: MonadQuery m => m () #
Specify ALL attribute to query context.
(<-#) :: Monad m => AssignTarget r v -> Record Flat v -> Assignings r m () infix 4 #
Add and assginment.
Direct Join Operators
Not monadic style join is supported by some direct join operators.
inner
, left
, right
, full
operators can construct join products directly like SQL.
inner
operator is INNER JOIN of SQL, left
operator is LEFT OUTER JOIN of SQL, and so on.
on'
operator specifies condition of join product.
JoinRestriction
is the type of lambda form which expresses condition of join product.
Arguments
:: Relation () a | Left query to join |
-> Relation () b | Right query to join |
-> [JoinRestriction a b] | Join restrictions |
-> Relation () (a, b) | Result joined relation |
Direct inner join.
Arguments
:: Relation () a | Left query to join |
-> Relation () b | Right query to join |
-> [JoinRestriction a (Maybe b)] | Join restrictions |
-> Relation () (a, Maybe b) | Result joined relation |
Direct left outer join.
Arguments
:: Relation () a | Left query to join |
-> Relation () b | Right query to join |
-> [JoinRestriction (Maybe a) b] | Join restrictions |
-> Relation () (Maybe a, b) | Result joined relation |
Direct right outer join.
Arguments
:: Relation () a | Left query to join |
-> Relation () b | Right query to join |
-> [JoinRestriction (Maybe a) (Maybe b)] | Join restrictions |
-> Relation () (Maybe a, Maybe b) | Result joined relation |
Direct full outer join.
on' :: ([JoinRestriction a b] -> Relation pc (a, b)) -> [JoinRestriction a b] -> Relation pc (a, b) infixl 8 #
Apply restriction for direct join style.
Finalize Context
Several operators are defined to make Relation
type with finalizing query monadic context.
relation
operator finalizes flat (not aggregated) query monadic context,
and aggregateRelation
operator finalizes aggregated query monadic context.
Both operator convert monadic context into Relation
type,
and finalized Relation
can be reused as joining and sub-querying in another queries.
updateTarget
operator finalize monadic context into UpdateTarget
type
which can be used as update statement.
restriction
operator finalize monadic context into Restriction
type
which can be used as delete statement.
data Relation p r :: * -> * -> * #
Relation type with place-holder parameter p
and query result type r
.
relation :: QuerySimple (Record Flat r) -> Relation () r #
Finalize QuerySimple
monad and generate Relation
.
aggregateRelation :: QueryAggregate (Record Aggregated r) -> Relation () r #
Finalize QueryAggregate
monad and geneate Relation
.
data UpdateTarget p r :: * -> * -> * #
UpdateTarget type with place-holder parameter p
and projected record type r
.
Instances
TableDerivable r => Show (UpdateTarget p r) | |
updateTarget :: AssignStatement r () -> UpdateTarget () r #
Finalize Target
monad and generate UpdateTarget
.
data Restriction p r :: * -> * -> * #
Restriction type with place-holder parameter p
and projected record type r
.
Instances
TableDerivable r => Show (Restriction p r) | Show where clause. |
restriction :: RestrictedStatement r () -> Restriction () r #
Finalize Restrict
monad and generate Restriction
.
Record
SQL expression corresponds to Haskell record phantom type in this DSL.
Record Type
Record
c a is projected SQL value type corresponding to Haskell record type a with context type c.
Flat
is not aggregated query context type,
Aggregated
is aggregated query context type,
OverWindow
is window function context type, and so on.
Module Database.Relational.Context contains documentation of other context types.
data Aggregated :: * #
Type tag for aggregated query
data OverWindow :: * #
Type tag for window function building
Projection Path
!
operator is record value selector using projection path type Pi
r0 r1.
Pi
r0 r1 is projection path type selecting column type r1 from record type r0.
<.>
operator makes composed projection path from two projection paths.
fst'
and snd'
are projection paths for pair type.
data Pi r0 r1 :: * -> * -> * #
Projection path from type r0
into type r1
.
This type also indicate key object which type is r1
for record type r0
.
Instances
ProductIsoFunctor (Pi a) | Map projection path |
ProductIsoApplicative (Pi a) | Compose projection path |
Category * Pi | |
ProductIsoEmpty (Pi a) () | |
PersistableWidth r0 => Show (Pi r0 r1) | |
Arguments
:: PersistableWidth a | |
=> Record c a | Source |
-> Pi a b | Record path |
-> Record c b | Narrower projected object |
Get narrower record along with projection path.
Overloaded Projection
On newer or equal GHC 8.0, overloaded projections are supported. So you can use projections like below:
a ! #foo .=. b ! #bar
instead of:
a ! A.foo' .=. b ! B.bar'
Function application style is also available:
#foo a .=. #bar b
#fst
and #snd
are overloaded-projection for pair type.
Record Operators
Some operators are defined to calculate record values.
For example,
value
operator lifts from Haskell value into Record
corresponding SQL row value,
which conversion is implicitly specified by ShowConstantTermsSQL
class.
Generic programming with default signature is available to define instances of ShowConstantTermsSQL
.
values
operator converts from Haskell list value into RecordList
, corresponding SQL set value,
.=.
operator is equal compare operation of record value correspond to SQL =,
.+.
operator is plus operation of record value correspond to SQL +, and so on.
Module Database.Relational.Projectable contains documentation of other record operators.
class ShowConstantTermsSQL a #
ShowConstantTermsSQL
a
is implicit rule to derive function to convert
from haskell record type a
into constant SQL terms.
Generic programming (https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#generic-programming)
with default signature is available for ShowConstantTermsSQL
class,
so you can make instance like below:
{-# LANGUAGE DeriveGeneric #-} import GHC.Generics (Generic) -- data Foo = Foo { ... } deriving Generic instance ShowConstantTermsSQL Foo
value :: (ShowConstantTermsSQL t, OperatorContext c) => t -> Record c t #
Generate record with polymorphic type of SQL constant values from Haskell value.
values :: (ShowConstantTermsSQL t, OperatorContext c) => [t] -> RecordList (Record c) t #
RecordList with polymorphic type of SQL set value from Haskell list.
(.=.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool) infix 4 #
Compare operator corresponding SQL = .
(.<.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool) infix 4 #
Compare operator corresponding SQL < .
(.<=.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool) infix 4 #
Compare operator corresponding SQL <= .
(.>.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool) infix 4 #
Compare operator corresponding SQL > .
(.>=.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool) infix 4 #
Compare operator corresponding SQL >= .
(.<>.) :: OperatorContext c => Record c ft -> Record c ft -> Record c (Maybe Bool) infix 4 #
Compare operator corresponding SQL <> .
and' :: OperatorContext c => Record c (Maybe Bool) -> Record c (Maybe Bool) -> Record c (Maybe Bool) infixr 3 #
Logical operator corresponding SQL AND .
or' :: OperatorContext c => Record c (Maybe Bool) -> Record c (Maybe Bool) -> Record c (Maybe Bool) infixr 2 #
Logical operator corresponding SQL OR .
in' :: OperatorContext c => Record c t -> RecordList (Record c) t -> Record c (Maybe Bool) infix 4 #
Binary operator corresponding SQL IN .
(.||.) :: OperatorContext c => Record c a -> Record c a -> Record c a infixl 5 #
Concatinate operator corresponding SQL || .
like :: (OperatorContext c, IsString a, ShowConstantTermsSQL a) => Record c a -> a -> Record c (Maybe Bool) infix 4 #
String-compare operator corresponding SQL LIKE .
like' :: (OperatorContext c, IsString a) => Record c a -> Record c a -> Record c (Maybe Bool) infix 4 #
String-compare operator corresponding SQL LIKE .
(.+.) :: (OperatorContext c, Num a) => Record c a -> Record c a -> Record c a infixl 6 #
Number operator corresponding SQL + .
(.-.) :: (OperatorContext c, Num a) => Record c a -> Record c a -> Record c a infixl 6 #
Number operator corresponding SQL - .
(.*.) :: (OperatorContext c, Num a) => Record c a -> Record c a -> Record c a infixl 7 #
Number operator corresponding SQL * .
(./.) :: (OperatorContext c, Num a) => Record c a -> Record c a -> Record c a infixl 7 #
Number operator corresponding SQL /// .
isNothing :: (OperatorContext c, HasColumnConstraint NotNull r) => Record c (Maybe r) -> Predicate c #
Operator corresponding SQL IS NULL , and extended against record types.
isJust :: (OperatorContext c, HasColumnConstraint NotNull r) => Record c (Maybe r) -> Predicate c #
Operator corresponding SQL NOT (... IS NULL) , and extended against record type.
fromMaybe :: (OperatorContext c, HasColumnConstraint NotNull r) => Record c r -> Record c (Maybe r) -> Record c r #
Operator from maybe type using record extended isNull
.
not' :: OperatorContext c => Record c (Maybe Bool) -> Record c (Maybe Bool) #
Logical operator corresponding SQL NOT .
exists :: OperatorContext c => RecordList (Record Exists) r -> Record c (Maybe Bool) #
Logical operator corresponding SQL EXISTS .
negate' :: (OperatorContext c, Num a) => Record c a -> Record c a #
Number negate uni-operator corresponding SQL -.
fromIntegral' :: (SqlContext c, Integral a, Num b) => Record c a -> Record c b #
Number fromIntegral uni-operator.
showNum :: (SqlContext c, Num a, IsString b) => Record c a -> Record c b #
Unsafely show number into string-like type in records.
Arguments
:: OperatorContext c | |
=> [(Predicate c, Record c a)] | Each when clauses |
-> Record c a | Else result record |
-> Record c a | Result record |
Same as caseSearch
, but you can write like list casesOrElse
clause.
Arguments
:: OperatorContext c | |
=> Record c a | Record value to match |
-> [(Record c a, Record c b)] | Each when clauses |
-> Record c b | Else result record |
-> Record c b | Result record |
Simple case operator correnponding SQL simple CASE. Like, CASE x WHEN v THEN a WHEN w THEN b ... ELSE c END
Aggregate and Window Functions
Typed aggregate function operators are defined. Aggregated value types is distinguished with Flat value types.
For example,
sum'
operator is aggregate function of flat (not aggregated) record value
correspond to SQL SUM(...),
rank
operator is window function of record value correspond to SQL RANK(), and so on.
To convert window function result into normal record, use the over
operator with built Window
monad.
Module Database.Relational.Projectable contains documentation of other aggregate function operators and window function operators.
count :: (Integral b, AggregatedContext ac, SqlContext ac) => Record Flat a -> Record ac b #
Aggregation function COUNT.
sum' :: (Num a, AggregatedContext ac, SqlContext ac) => Record Flat a -> Record ac (Maybe a) #
Aggregation function SUM.
avg :: (Num a, Fractional b, AggregatedContext ac, SqlContext ac) => Record Flat a -> Record ac (Maybe b) #
Aggregation function AVG.
max' :: (Ord a, AggregatedContext ac, SqlContext ac) => Record Flat a -> Record ac (Maybe a) #
Aggregation function MAX.
min' :: (Ord a, AggregatedContext ac, SqlContext ac) => Record Flat a -> Record ac (Maybe a) #
Aggregation function MIN.
every :: (AggregatedContext ac, SqlContext ac) => Predicate Flat -> Record ac (Maybe Bool) #
Aggregation function EVERY.
any' :: (AggregatedContext ac, SqlContext ac) => Predicate Flat -> Record ac (Maybe Bool) #
Aggregation function ANY.
some' :: (AggregatedContext ac, SqlContext ac) => Predicate Flat -> Record ac (Maybe Bool) #
Aggregation function SOME.
over :: SqlContext c => Record OverWindow a -> Window c () -> Record c a infix 8 #
Operator to make record of window function result using built Window
monad.
rank :: Integral a => Record OverWindow a #
RANK() term.
denseRank :: Integral a => Record OverWindow a #
DENSE_RANK() term.
rowNumber :: Integral a => Record OverWindow a #
ROW_NUMBER() term.
percentRank :: Record OverWindow Double #
PERCENT_RANK() term.
cumeDist :: Record OverWindow Double #
CUME_DIST() term.
Set Operators
Several operators are defined to manipulate relation set.
union
operator makes union relation set of two relation set correspond to SQL UNION.
except
operator makes difference relation set of two relation set correspond to SQL EXCEPT.
intersect
operator makes intersection relation set of two relation set correspond to SQL INTERSECT.
intersect :: Relation () a -> Relation () a -> Relation () a infixl 8 #
Intersection of two relations.
Maybe Records
Some operators are provided to manage records with Maybe
phantom type.
just
operator creates Maybe
typed record,
flattenMaybe
operator joins nested Maybe
typed record.
Maybe
type flavor of operators against projection path, record and aggregation are also provided.
For example,
?!
operator is maybe flavor of !
,
<?.>
operator is maybe flavor of <.>
.
?!?
operator and <?.?>
operator join
two Maybe
phantom functors.
?
is same as ?!
, which is assumed to use with overloaded-projection like (? #foo)
.
??
is same as ?!?
, which is assumed to use with overloaded-projection like (?? #foo)
.
?+?
operator is maybe flavor of .+.
,
negateMaybe
operator is maybe flavor of negate'
,
sumMaybe
operator is maybe flavor of sum'
.
Module Database.Relational.Projectable and Database.Relational.ProjectableExtended
contain documentation of other Maybe
flavor operators.
just :: ProjectableMaybe p => forall a. p a -> p (Maybe a) #
Cast record phantom type into Maybe
.
flattenMaybe :: ProjectableMaybe p => forall a. p (Maybe (Maybe a)) -> p (Maybe a) #
Compose nested Maybe
phantom type on record.
(<?.?>) :: Pi a (Maybe b) -> Pi b (Maybe c) -> Pi a (Maybe c) infixl 8 #
Compose projection path. Maybe
phantom functors are join
-ed like >=>
.
(?+?) :: (OperatorContext c, Num a) => Record c (Maybe a) -> Record c (Maybe a) -> Record c (Maybe a) infixl 6 #
Number operator corresponding SQL + .
negateMaybe :: (OperatorContext c, Num a) => Record c (Maybe a) -> Record c (Maybe a) #
Number negate uni-operator corresponding SQL -.
sumMaybe :: (Num a, AggregatedContext ac, SqlContext ac) => Record Flat (Maybe a) -> Record ac (Maybe a) #
Aggregation function SUM.
Placeholders
placeholders
operator takes
a lambda-form which argument is Record
typed placeholders and its scope is restricted by that lambda-form
and then creates dummy value with Placeholders
typed which propagate placeholder type information into Relation
layer.
Placeholders' flavor of operators against query operation and set operation are also provided, to realize type safe placeholders.
query'
, left'
, relation'
, updateTarget'
, restriction'
, and union'
operator are placeholders' flavor query
, left
, relation
, updateTarget
, restriction
and union
.
Module Database.Relational.Relation and Database.Relational.Effect contains documentation of other placeholders' flavor operators.
placeholder :: (PersistableWidth t, SqlContext c, Monad m) => (Record c t -> m a) -> m (PlaceHolders t, a) #
Provide scoped placeholder and return its parameter object. Monadic version.
query' :: MonadQuery m => forall p r. Relation p r -> m (PlaceHolders p, Record Flat r) #
Join sub-query with place-holder parameter p
. query result is not Maybe
.
Arguments
:: Relation pa a | Left query to join |
-> Relation pb b | Right query to join |
-> [JoinRestriction a (Maybe b)] | Join restrictions |
-> Relation (pa, pb) (a, Maybe b) | Result joined relation |
Direct left outer join with place-holder parameters.
relation' :: SimpleQuery p r -> Relation p r #
Finalize QuerySimple
monad and generate Relation
with place-holder parameter p
.
updateTarget' :: AssignStatement r (PlaceHolders p) -> UpdateTarget p r #
Finalize Target
monad and generate UpdateTarget
with place-holder parameter p
.
restriction' :: RestrictedStatement r (PlaceHolders p) -> Restriction p r #
Finalize Restrict
monad and generate Restriction
with place-holder parameter p
union' :: Relation p a -> Relation q a -> Relation (p, q) a infixl 7 #
Union of two relations with place-holder parameters.
Record Mapping
Applicative style record mapping is supported, for Record
, Pi
and PlaceHolders
.
|$|
operator can be used on ProductIsoFunctor
context, and
|*|
operator can be used on ProductIsoApplicative
context with ProductConstructor
,
like Foo |$| record1 |*| record2 |*| record3
, Foo |$| placeholders1 |*| placeholders2 |*| placeholders3, and so on.
><
operator constructs pair result. x >< y is the same as (,) |$| x |*| y.
class ProductConstructor c #
Define product isomorphic inference rule to specify record constructor
Minimal complete definition
class ProductIsoFunctor (f :: * -> *) where #
Restricted functor on products.
Minimal complete definition
Methods
(|$|) :: ProductConstructor (a -> b) => (a -> b) -> f a -> f b infixl 4 #
Instances
ProductIsoFunctor (ProductConst a) | |
Functor f => ProductIsoFunctor (WrappedFunctor f) | |
ProductIsoFunctor (Pi a) | Map projection path |
ProductIsoFunctor (WrappedAlter f a) | |
class ProductIsoFunctor f => ProductIsoApplicative (f :: * -> *) where #
Restricted applicative functor on products.
Instances
Monoid a => ProductIsoApplicative (ProductConst a) | |
Applicative f => ProductIsoApplicative (WrappedFunctor f) | |
ProductIsoApplicative (Pi a) | Compose projection path |
Alternative f => ProductIsoApplicative (WrappedAlter f a) | |
(><) :: ProductIsoApplicative p => p a -> p b -> p (a, b) infixl 1 #
Binary operator the same as projectZip
.
Database Statements
Some functions are defined to expand query structure into flat SQL statements to be used by database operation.
relationalQuery
function converts Relation
type info flat SQL query like SELECT statement.
derivedInsert
function converts Pi
key type info flat SQL INSERT statement.
derivedInsertValue
function converts InsertTarget
into flat SQL INSERT statement.
derivedInsertQuery
function converts Pi
key type and Relation
type info flat SQL INSERT ... SELECT ... statement.
derivedUpdate
function converts UpdateTarget
type into flat SQL UPDATE statement.
derivedDelete
function converts Restriction
into flat SQL DELETE statement.
derivedKeyUpdate
function converts Pi
key type info flat SQL UPDATE statement.
Some functions which requires to be specified table type,
typedInsert
, typedInsertQuery
, typedUpdate
and typedDelete
.
These functions are useful when table type is undecidable from its statement contexts.
typedInsert :: PersistableWidth r => Table r -> Pi r r' -> Insert r' #
typedInsertQuery :: Table r -> Pi r r' -> Relation p r' -> InsertQuery p #
Make typed InsertQuery
from columns selector Table
, Pi
and Relation
.
typedUpdate :: Table r -> UpdateTarget p r -> Update p #
Make typed Update
using defaultConfig
, Table
and UpdateTarget
.
typedDelete :: Table r -> Restriction p r -> Delete p #
Make typed Delete
from Table
and Restriction
.
typedKeyUpdate :: Table a -> Pi a p -> KeyUpdate p a #
derivedInsert :: (PersistableWidth r, TableDerivable r) => Pi r r' -> Insert r' #
Table type inferred Insert
.
derivedInsertQuery :: TableDerivable r => Pi r r' -> Relation p r' -> InsertQuery p #
Table type inferred InsertQuery
.
derivedUpdate :: TableDerivable r => AssignStatement r (PlaceHolders p) -> Update p #
Make typed Update
from defaultConfig
, derived table and AssignStatement
derivedDelete :: TableDerivable r => RestrictedStatement r (PlaceHolders p) -> Delete p #
Make typed Delete
from defaultConfig
, derived table and RestrictContext
Database Operations
Some HDBC actions are defined for database side effects.
Conversion interfaces to communicate with database
Some record conversion interfaces are defined to communicate with database.
The conversions are implicitly specified by FromSql
class and ToSql
class.
Generic programming with default signature is available to define instances of FromSql
and ToSql
.
The explicit definitions correnponsing those classes are RecordFromSql
and RecordToSql
.
FromSql
q
a
is implicit rule to derive RecordFromSql
q
a
record parser function against type a
.
Generic programming (https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#generic-programming)
with default signature is available for FromSql
class,
so you can make instance like below:
{-# LANGUAGE DeriveGeneric #-} import GHC.Generics (Generic) import Database.HDBC (SqlValue) -- data Foo = Foo { ... } deriving Generic instance FromSql SqlValue Foo
Instances
FromSql q () | Implicit derivation rule of |
(HasColumnConstraint NotNull a, FromSql q a, PersistableType q) => FromSql q (Maybe a) | Implicit derivation rule of |
class PersistableWidth a => ToSql q a #
ToSql
q
a
is implicit rule to derive RecordToSql
q
a
record printer function for type a
.
Generic programming (https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#generic-programming)
with default signature is available for ToSql
class,
so you can make instance like below:
{-# LANGUAGE DeriveGeneric #-} import GHC.Generics (Generic) import Database.HDBC (SqlValue) -- data Foo = Foo { ... } deriving Generic instance ToSql SqlValue Foo
To make instances of ToSql
manually,
ToSql
q
a
and RecordToSql
'q a
are composable with monadic context.
When, you have data constructor and objects like below.
data MyRecord = MyRecord Foo Bar Baz
instance ToSql SqlValue Foo where ... instance ToSql SqlValue Bar where ... instance ToSql SqlValue Baz where ...
You can get composed ToSql
implicit rule like below.
instance ToSql SqlValue MyRecord where recordToSql = recordToSql = wrapToSql $ \ (MyRecord x y z) -> do putRecord x putRecord y putRecord z
Instances
ToSql q () | Implicit derivation rule of |
(PersistableType q, ToSql q a) => ToSql q (Maybe a) | Implicit derivation rule of |
data RecordFromSql q a :: * -> * -> * #
RecordFromSql
q
a
is data-type wrapping function
to convert from list of database value type (to receive from database) [q
] into Haskell type a
This structure is similar to parser.
While running RecordFromSql
behavior is the same as non-fail-able parser
which parse list of database value type [q
] stream.
So, RecordFromSql
q
is Monad
and Applicative
instance like parser monad.
When, you have data constructor and objects like below.
data MyRecord = MyRecord Foo Bar Baz
foo ::RecordFromSql
SqlValue Foo foo = ... bar ::RecordFromSql
SqlValue Bar bar = ... baz ::RecordFromSql
SqlValue Baz baz = ...
You can get composed RecordFromSql
like below.
myRecord :: RecordFromSql SqlValue MyRecord myRecord = MyRecord <$> foo <*> bar <*> baz
Instances
Monad (RecordFromSql q) | |
Functor (RecordFromSql q) | |
Applicative (RecordFromSql q) | Derived |
data RecordToSql q a :: * -> * -> * #
RecordToSql
q
a
is data-type wrapping function
to convert from Haskell type a
into list of database value type (to send to database) [q
].
This structure is similar to printer.
While running RecordToSql
behavior is the same as list printer.
which appends list of database value type [q
] stream.
Generalized Statement
Actions to manage generalized SQL statements.
prepareNoFetch :: (UntypeableNoFetch s, IConnection conn) => conn -> s p -> IO (PreparedStatement p ()) #
Generalized prepare inferred from UntypeableNoFetch
instance.
Arguments
:: ToSql SqlValue p | |
=> PreparedStatement p a | Prepared query to bind to |
-> p | Parameter to bind |
-> BoundStatement a | Result parameter bound statement |
Typed operation to bind parameters. Inferred ToSql
is used.
execute :: BoundStatement a -> IO (ExecutedStatement a) #
Use executeBound
instead of this.
WARNING! This name will be used for executePrepared function in future release.
executeNoFetch :: BoundStatement () -> IO Integer #
Use executeBoundNoFetch
instead of this.
WARNING! This name will be used for runPreparedNoFetch function in future release.
Select
Actions to manage SELECT statements.
runQuery
function is lazy-read and runQuery'
function is strict version,
please use carefully.
Arguments
:: IConnection conn | |
=> conn | Database connection |
-> Query p a | Typed query |
-> IO (PreparedQuery p a) | Result typed prepared query with parameter type |
Same as prepare
.
Arguments
:: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a) | |
=> conn | Database connection |
-> Query p a | Query to get record type |
-> p | Parameter type |
-> IO [a] | Action to get records |
Lazy-IO version of runQuery'
.
Arguments
:: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a) | |
=> conn | Database connection |
-> Query p a | Query to get record type |
-> p | Parameter type |
-> IO [a] | Action to get records |
Prepare SQL, bind parameters, execute statement and strictly fetch all records.
Insert Values
Actions to manage INSERT ... VALUES ... statements.
prepareInsert :: IConnection conn => conn -> Insert a -> IO (PreparedInsert a) #
Same as prepare
.
runInsert :: (IConnection conn, ToSql SqlValue a) => conn -> Insert a -> a -> IO Integer #
Prepare insert statement, bind parameters, execute statement and get execution result.
Insert Select Results
Actions to manage INSERT ... SELECT ... statements.
prepareInsertQuery :: IConnection conn => conn -> InsertQuery p -> IO (PreparedInsertQuery p) #
Same as prepare
.
runInsertQuery :: (IConnection conn, ToSql SqlValue p) => conn -> InsertQuery p -> p -> IO Integer #
Prepare insert statement, bind parameters, execute statement and get execution result.
Update
Actions to manage UPDATE statements.
prepareUpdate :: IConnection conn => conn -> Update p -> IO (PreparedUpdate p) #
Same as prepare
.
runUpdate :: (IConnection conn, ToSql SqlValue p) => conn -> Update p -> p -> IO Integer #
Prepare update statement, bind parameters, execute statement and get execution result.
Delete
Actions to manage DELETE statements.
prepareDelete :: IConnection conn => conn -> Delete p -> IO (PreparedDelete p) #
Same as prepare
.
runDelete :: (IConnection conn, ToSql SqlValue p) => conn -> Delete p -> p -> IO Integer #
Prepare delete statement, bind parameters, execute statement and get execution result.
Update by Key
Actions to manage UPDATE statements which updates columns other than specified key of the records selected by specified key.
prepareKeyUpdate :: IConnection conn => conn -> KeyUpdate p a -> IO (PreparedKeyUpdate p a) #
Same as prepare
.
bindKeyUpdate :: ToSql SqlValue a => PreparedKeyUpdate p a -> a -> BoundStatement () #
Typed operation to bind parameters for PreparedKeyUpdate
type.
runKeyUpdate :: (IConnection conn, ToSql SqlValue a) => conn -> KeyUpdate p a -> a -> IO Integer #
Prepare insert statement, bind parameters, execute statement and get execution result.