HaskRel-0.1.0.2: HaskRel, Haskell as a DBMS with support for the relational algebra

Copyright© Thor Michael Støre, 2015
LicenseGPL v2 without "any later version" clause
Maintainerthormichael át gmail døt com
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

Database.HaskRel.Relational.Algebra

Contents

Description

Relational algebra based on HList records.

It is important to note that, in order to build a straight forward foundation, this module defines pure functions, viz. they only operate upon relational values, not relvars or the result of expressions involving relvars. See Database.HaskRel.Relational.Expression for functions that function as conveyed by the relational model, which are the ones that are intended to be used directly.

All the examples in Database.HaskRel.Relational.Expression are defined in terms of the relvars s, p and sp; to run the examples in that module with the functions of this module one can use the relation values s', p' and sp' instead. The script examples/algebraExample.sh starts a GHCi session with the imports and pragmas required to run these examples.

Synopsis

Operators of the relational algebra

rename :: (Ord (HList r), HLabelSet (LabelsOf r), HMapAux HList (Relabel tr) a r, SameLength' r a, SameLength' a r, HAllTaggedLV r) => Relation a -> tr -> Relation r Source

Rename multiple attributes of a relation.

>>> let pnu = Label :: Label "pnu"
>>> let colour = Label :: Label "colour"
>>> rPrint$ p' `rename` nAs( pno `as` pnu, color `as` colour )
┌─────┬───────┬────────┬────────┬────────┐
│ pnu │ pName │ colour │ weight │ city   │
╞═════╪═══════╪════════╪════════╪════════╡
│ P1  │ Nut   │ Red    │ 12 % 1 │ London │
...

extend :: (Ord (HList (HAppendListR r r'1)), HLabelSet (LabelsOf (HAppendListR r r'1)), HDeleteLabels (LabelsOf r) r' r'1, HAppendList r r'1, HAllTaggedLV (HAppendListR r r'1)) => Relation r' -> (Record r' -> Record r) -> Relation (HAppendListR r r'1) Source

Extends the given relation with the r-tuple resulting from the second argument. Existing attributes with the same name will be replaced.

See extend.

restrict :: Set a -> (a -> Bool) -> Set a Source

Restricts the given relation according to the given predicate. Note that this is the well known WHERE operator of both SQL and Tutorial D, but since "where" is a reserved keyword in Haskell it is named "restrict".

See restrict.

project :: (Ord (HList a), HLabelSet (LabelsOf a), H2ProjectByLabels ls t a b, HAllTaggedLV a) => Relation t -> proxy ls -> Relation a Source

Projects the given relation on the given heading.

See project.

projectAllBut :: (Ord (HList r'), HDeleteLabels ks r r') => Relation r -> proxy ks -> Relation r' Source

Projects the given relation on the heading of said given relation minus the given heading.

See projectAllBut.

naturalJoin :: (Eq (HList l), Ord (HList (HAppendListR t1 t2)), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), HLabelSet (LabelsOf t2), HLabelSet (LabelsOf r), HLabelSet (LabelsOf (HAppendListR t1 t2)), H2ProjectByLabels (LabelsOf t1) t l t2, H2ProjectByLabels (LabelsOf t) t1 r b, HAppendList t1 t2, SameLength' l r, SameLength' r l, SameLength' r (LabelsOf l), SameLength' (LabelsOf l) r, HAllTaggedLV t2, HAllTaggedLV l, HAllTaggedLV r, HAllTaggedLV (HAppendListR t1 t2)) => Relation t1 -> Relation t -> Relation (HAppendListR t1 t2) Source

Performs a natural join of the two given relations.

See naturalJoin.

nJoin :: (Eq (HList l), Ord (HList (HAppendListR t1 t2)), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), HLabelSet (LabelsOf t2), HLabelSet (LabelsOf r), HLabelSet (LabelsOf (HAppendListR t1 t2)), H2ProjectByLabels (LabelsOf t1) t l t2, H2ProjectByLabels (LabelsOf t) t1 r b, HAppendList t1 t2, SameLength' l r, SameLength' r l, SameLength' r (LabelsOf l), SameLength' (LabelsOf l) r, HAllTaggedLV t2, HAllTaggedLV l, HAllTaggedLV r, HAllTaggedLV (HAppendListR t1 t2)) => Relation t1 -> Relation t -> Relation (HAppendListR t1 t2) Source

Alias of naturalJoin.

See nJoin.

times :: (HRLabelSet (HAppendListR t r), Eq (HList l), Ord (HList (HAppendListR t1 t2)), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), HLabelSet (LabelsOf t2), HLabelSet (LabelsOf r), HLabelSet (LabelsOf (HAppendListR t1 t2)), H2ProjectByLabels (LabelsOf t1) t l t2, H2ProjectByLabels (LabelsOf t) t1 r b, HAppendList t1 t2, SameLength' l r, SameLength' r l, SameLength' r (LabelsOf l), SameLength' (LabelsOf l) r, HAllTaggedLV t2, HAllTaggedLV l, HAllTaggedLV r, HAllTaggedLV (HAppendListR t1 t2)) => Relation t1 -> Relation t -> Relation (HAppendListR t1 t2) Source

The cartesian product of two relations. A specialized natural join; the natural join between two relations with disjoint headings.

See times.

matching :: (Eq (HList l), Ord (HList t), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), HLabelSet (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b, H2ProjectByLabels (LabelsOf l1) t r b1, SameLength' l r, SameLength' r l, SameLength' r (LabelsOf l), SameLength' (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r) => Relation t -> Relation l1 -> Relation t Source

Performs a semi-join of the first given relation against the second given relation.

See matching.

semiJoin :: (Eq (HList l), Ord (HList t), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), HLabelSet (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b, H2ProjectByLabels (LabelsOf l1) t r b1, SameLength' l r, SameLength' r l, SameLength' r (LabelsOf l), SameLength' (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r) => Relation t -> Relation l1 -> Relation t Source

Alias of matching. See semiJoin.

notMatching :: (Eq (HList l), Ord (HList t), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), HLabelSet (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b, H2ProjectByLabels (LabelsOf l1) t r b1, SameLength' l r, SameLength' r l, SameLength' r (LabelsOf l), SameLength' (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r) => Relation t -> Relation l1 -> Relation t Source

Performs a semi-difference of the first given relation against the second given relation.

Aka. antijoin:

Also known, a trifle inappropriately, as antijoin.

  • Chris Date 2011, SQL and Relational Theory 2nd ed. p. 133

See notMatching.

semiDiff :: (Eq (HList l), Ord (HList t), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), HLabelSet (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b, H2ProjectByLabels (LabelsOf l1) t r b1, SameLength' l r, SameLength' r l, SameLength' r (LabelsOf l), SameLength' (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r) => Relation t -> Relation l1 -> Relation t Source

Alias of notMatching. See semiDiff.

union :: (Ord (HList l), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), SameLength' r l, SameLength' r (LabelsOf l), SameLength' l r, SameLength' (LabelsOf l) r) => Relation l -> Relation r -> Relation l Source

Performs a union of the given relations.

See union.

dUnion :: (Ord (HList a), Typeable a, RecordValues a, HRearrange3 (LabelsOf a) r a, HLabelSet (LabelsOf a), HFoldr (Mapcar HPresentRecAttr) [[String]] (RecordValuesR a) [[String]], SameLength' a r, SameLength' r a, SameLength' r (LabelsOf a), SameLength' (LabelsOf a) r) => Relation a -> Relation r -> Relation a Source

Performs a disjoint union between the two relvars. This is a union of disjoint relations, where a runtime error is raised if the operands are not disjoint.

See dUnion.

intersect :: (Ord (HList l), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), SameLength' r l, SameLength' r (LabelsOf l), SameLength' l r, SameLength' (LabelsOf l) r) => Relation l -> Relation r -> Relation l Source

The intersection of two relations.

Note how the name is different from Data.Set, where the comparable function is named "intersection". This is due to it being referred to as "intersect" in material describing the relational model; specifically named "INTERSECT" in Tutorial D.

See intersect.

minus :: (Ord (HList l), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), SameLength' r l, SameLength' r (LabelsOf l), SameLength' l r, SameLength' (LabelsOf l) r) => Relation l -> Relation r -> Relation l Source

The difference of two relations.

The "minus" term is used in material describing relational theory; specifically Tutorial D names the operator "MINUS".

See minus.

xUnion :: (Ord (HList r1), HRearrange3 (LabelsOf r1) r r1, HRearrange3 (LabelsOf r1) r1 r1, HLabelSet (LabelsOf r1), SameLength' r r1, SameLength' r (LabelsOf r1), SameLength' r1 r, SameLength' r1 r1, SameLength' r1 (LabelsOf r1), SameLength' (LabelsOf r1) r, SameLength' (LabelsOf r1) r1) => Relation r1 -> Relation r -> Relation r1 Source

Exclusive union, aka. symmetric difference.

See xUnion.

group :: (Eq (HList l), Ord v, Ord (HList l1), Ord (HList r'), HLabelSet (LabelsOf l), HLabelSet (Label t : LabelsOf l1), HDeleteLabels ks r l1, HDeleteLabels (LabelsOf l1) r r', H2ProjectByLabels (LabelsOf l) r l b, H2ProjectByLabels (LabelsOf r) l1 l b1, HAllTaggedLV l1, HAllTaggedLV l) => Relation r -> proxy ks -> (Relation r' -> Tagged t v) -> Relation (Tagged t v : l1) Source

Groups the given attributes of the given relation into a given new relation valued attribute.

As the Tutorial D GROUP operator, not SQL GROUP BY.

See group.

groupAllBut :: (Eq (HList l), Ord v, Ord (HList l1), Ord (HList r'), HLabelSet (LabelsOf l), HLabelSet (LabelsOf l1), HLabelSet (Label t : LabelsOf l1), HDeleteLabels (LabelsOf l1) t1 r', H2ProjectByLabels ls t1 l1 b2, H2ProjectByLabels (LabelsOf l) t1 l b, H2ProjectByLabels (LabelsOf t1) l1 l b1, HAllTaggedLV l1, HAllTaggedLV l) => Relation t1 -> proxy ls -> (Relation r' -> Tagged t v) -> Relation (Tagged t v : l1) Source

Groups the given relation on all but the given attributes into a given new attribute.

See groupAllBut.

ungroup :: (Eq (HList l), Ord (HList (HAppendListR t1 t2)), HasField l1 (Record v) (Relation t), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), HLabelSet (LabelsOf t2), HLabelSet (LabelsOf r), HLabelSet (LabelsOf (HAppendListR t1 t2)), H2ProjectByLabels (LabelsOf t1) t l t2, H2ProjectByLabels (LabelsOf t) t1 r b, H2ProjectByLabels `[Label l1]` v t3 t1, HAppendList t1 t2, SameLength' l r, SameLength' r l, SameLength' r (LabelsOf l), SameLength' (LabelsOf l) r, HAllTaggedLV t2, HAllTaggedLV l, HAllTaggedLV r, HAllTaggedLV (HAppendListR t1 t2)) => Relation v -> Label l1 -> Relation (HAppendListR t1 t2) Source

Ungroups the given attribute of the given relation.

>>> let pq = (Label :: Label "pq")
>>> sp' == ungroup ( group sp' (rHdr (pno,qty)) (pq .=.)) pq
True

Note the difference to ungroup, which requires rEq for relational comparison.

Somewhat deprecated operators of the relational algebra

summarize :: (Eq (HList l), Ord (HList r'), Ord (HList r'2), Ord (HList (HAppendListR r r'1)), HLabelSet (LabelsOf (HAppendListR r r'1)), HLabelSet (LabelsOf (HAppendListR r' r)), HLabelSet (LabelsOf l), HDeleteLabels ks r2 r', HDeleteLabels (LabelsOf r) r' r'1, HDeleteLabels (LabelsOf r') r1 r'2, H2ProjectByLabels (LabelsOf l) r1 l b, H2ProjectByLabels (LabelsOf r1) r' l b1, HAppendList r r'1, HAllTaggedLV l, HAllTaggedLV (HAppendListR r r'1), HAllTaggedLV (HAppendListR r' r)) => Relation r1 -> Relation r2 -> proxy ks -> (Relation r'2 -> Record r) -> Relation (HAppendListR r r'1) Source

Summarize.

See summarize.

Additional operators with relational closure

interJoin :: (HTIntersect (LabelsOf r) (LabelsOf t) i, NotEmpty i, Eq (HList l), Ord (HList (HAppendListR t1 t2)), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), HLabelSet (LabelsOf t2), HLabelSet (LabelsOf r), HLabelSet (LabelsOf (HAppendListR t1 t2)), H2ProjectByLabels (LabelsOf t1) t l t2, H2ProjectByLabels (LabelsOf t) t1 r b, HAppendList t1 t2, SameLength' l r, SameLength' r l, SameLength' r (LabelsOf l), SameLength' (LabelsOf l) r, HAllTaggedLV t2, HAllTaggedLV l, HAllTaggedLV r, HAllTaggedLV (HAppendListR t1 t2)) => Relation t1 -> Relation t -> Relation (HAppendListR t1 t2) Source

Performs a natural join between two relations with intersecting headings. A specialized natural join.

A join upon relations r1, r2 where the intersection of the heading of r1 and of r2 is not empty; the headings are not disjoint. This is the complement of times that together with it forms a natural join; all that would be disallowed for times is allowed here and vice-versa. The name is what I quickly settled on, suggestions for a better one would be welcome. (Attribute-Intersecting Natural Join is another candidate.)

This function doesn't have a specific identity value, although it holds that r `interJoin` r = r

See interJoin.

iJoin :: (Eq (HList l), Ord (HList (HAppendListR t1 t2)), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), HLabelSet (LabelsOf r), HLabelSet (LabelsOf t2), HLabelSet (LabelsOf (HAppendListR t1 t2)), H2ProjectByLabels (LabelsOf t) t1 r b, H2ProjectByLabels (LabelsOf t1) t l t2, HTIntersect (LabelsOf r) (LabelsOf t) i, HAppendList t1 t2, SameLength' r l, SameLength' r (LabelsOf l), SameLength' l r, SameLength' (LabelsOf l) r, HAllTaggedLV t2, HAllTaggedLV r, HAllTaggedLV l, HAllTaggedLV (HAppendListR t1 t2), NotEmpty i) => Relation t1 -> Relation t -> Relation (HAppendListR t1 t2) Source

Alias of interJoin. See iJoin.

dExtend :: (Ord (HList (HAppendListR r r'1)), HLabelSet (LabelsOf (HAppendListR r r'1)), HDeleteLabels (LabelsOf r) r' r'1, HAppendList r r'1, HAllTaggedLV (HAppendListR r r'1), HRLabelSet (HAppendListR r' r)) => Relation r' -> (Record r' -> Record r) -> Relation (HAppendListR r r'1) Source

Disjoint extension. Extends the given relation with the result of the second argument, as extend, but without deleting any that exist.

See dExtend.

aSummarize :: (Eq (HList l), Ord (HList r'), Ord (HList r'2), Ord (HList (HAppendListR r r'1)), HLabelSet (LabelsOf (HAppendListR r r'1)), HLabelSet (LabelsOf (HAppendListR r' r)), HLabelSet (LabelsOf l), HDeleteLabels ks r1 r', HDeleteLabels (LabelsOf r) r' r'1, HDeleteLabels (LabelsOf r') r1 r'2, H2ProjectByLabels (LabelsOf l) r1 l b, H2ProjectByLabels (LabelsOf r1) r' l b1, HAppendList r r'1, HAllTaggedLV l, HAllTaggedLV (HAppendListR r r'1), HAllTaggedLV (HAppendListR r' r)) => Relation r1 -> proxy ks -> (Relation r'2 -> Record r) -> Relation (HAppendListR r r'1) Source

Auto-summarization. A specialization of summarize with the same source and destination relation.

See aSummarize.

imageExtendL :: (Eq (HList l), Ord (HList l1), Ord (HList r'), HLabelSet (LabelsOf l), HLabelSet (Label t : LabelsOf l1), HDeleteLabels (LabelsOf l1) r r', H2ProjectByLabels (LabelsOf l) r l b, H2ProjectByLabels (LabelsOf r) l1 l b1, HAllTaggedLV l1, HAllTaggedLV l) => Set (Record l1) -> Relation r -> Label t -> Set (Record (Tagged t (Relation r') : l1)) Source

Extends the first given relation with an attribute resulting from imaging each tuple of said relation against the second given relation. This gives a superset of the information given by SQL RIGHT OUTER JOIN.

See imageExtendL.

minus_ :: (Ord (HList l), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), SameLength' r l, SameLength' r (LabelsOf l), SameLength' l r, SameLength' (LabelsOf l) r) => Relation r -> Relation l -> Relation l Source

The difference of two relations. This differs from minus in that the attribute order of the second argument takes precedence, which is neccessary to swap precedence since minus is non-commutative. This function is as such equal to minus as far as relational theory is concerned, the difference is on a lower level of abstraction.

Alternative, concise functions

extendA :: forall r l e v v'. (Ord (HExtendR (Tagged l e) (r v')), HExtend (Tagged l e) (r v'), HDeleteAtLabel r l v v') => Set (r v) -> (r v -> Tagged l e) -> Set (HExtendR (Tagged l e) (r v')) Source

Extends the given relation with the attribute resulting from the second argument. If an attribute with the same name exists then it will be replaced. This allows for the function of the second argument to be simpler.

See extendA.

dExtendA :: (Ord (HExtendR e l), HExtend e l) => Set l -> (l -> e) -> Set (HExtendR e l) Source

Disjoint extension of a single attribute. Extends the given relation with the result of the second argument, as extend, but without deleting any that exist. l cannot already have any attribute e.

See dExtendA.

renameA :: forall l1 v1 r v' v l. (Ord (HExtendR (Tagged l1 v1) (r v')), HasField l (r v) v1, HExtend (Tagged l1 v1) (r v'), HDeleteAtLabel r l v v') => Set (r v) -> Tagged l (Label l1) -> Set (HExtendR (Tagged l1 v1) (r v')) Source

Renames a single attribute. See renameA

Supporting functions

isProperSubsetOf :: (Ord (HList l), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), SameLength' r l, SameLength' r (LabelsOf l), SameLength' l r, SameLength' (LabelsOf l) r) => Relation l -> Relation r -> Bool Source

Tests whether the second argument is a proper subset of the first.

See isProperSubsetOf.

isSubsetOf :: (Ord (HList l), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), SameLength' r l, SameLength' r (LabelsOf l), SameLength' l r, SameLength' (LabelsOf l) r) => Relation l -> Relation r -> Bool Source

Tests whether the second argument is a subset of the first.

See isSubsetOf.

image :: (Eq (HList l), Ord (HList r'), HLabelSet (LabelsOf l), HDeleteLabels (LabelsOf l1) r r', H2ProjectByLabels (LabelsOf l) r l b, H2ProjectByLabels (LabelsOf r) l1 l b1, HAllTaggedLV l) => Record l1 -> Relation r -> Relation r' Source

The image of a relation corresponding to an r-tuple.

An application of the first argument only, an r-tuple, to this function yields what is known as the !! operator in Tutorial D.

>>> let qtySum = Label::Label "qtySum"
>>> :{
    rPrint$ s'
            `project` (rHdr (sno))
            `extendA` (\ (image -> ii) ->
                            qtySum .=.
                                ( sum $ aggU $ ii ( sp' `project` (rHdr (sno,qty)) ) ) )
 :}

See image.

count :: Set a -> Int Source

Gives the cardinality of the argument.

isEmpty :: Set a -> Bool Source

Gives whether the given argument is empty or not.

Other useful, non-relational associated functions

rafoldr :: (Foldable t, HasField l a b1) => (b1 -> b -> b) -> b -> Label l -> t a -> b Source

Right-fold of an attribute of a relation (although a "right" fold doesn't make sense in the context of the relational model). Note that the value of the third argument, att, is not used and may be "undefined".

See rafoldr.

rafoldrU :: Foldable t => (b1 -> b -> b) -> b -> t (Record `[Tagged t1 b1]`) -> b Source

Right-fold of the attribute of an unary relation.

See rafoldrU.

agg :: (Foldable t, HasField l a a1) => Label l -> t a -> [a1] Source

Attribute value aggregation, a specialization of rafoldr that aggregates the values of a single attribute into a list of the values the attribute type wraps.

Note that the value of the first argument, att, is not used and may be "undefined".

>>> sum $ agg qty sp'
3100

See agg.

aggU :: Foldable t => t (Record `[Tagged t1 a]`) -> [a] Source

Aggregation of the single attribute of an unary relation. A specialization of agg, and thus in turn of rafoldr, that aggregates the single attribute of an unary relation, without requiring the name of that attribute.

>>> sum $ aggU $ sp' `project` (rHdr (qty))
1000

See aggU.

relRearrange :: (Ord (HList l), HRearrange3 (LabelsOf l) r l, HLabelSet (LabelsOf l), SameLength' r l, SameLength' r (LabelsOf l), SameLength' l r, SameLength' (LabelsOf l) r) => Relation r -> Relation l Source

Rearrange a set of HList records to context. From the perspective of relational theory this is a presentation function.

Instances

class NotEmpty l Source

Failure class restricting a type-level operation to a non-empty result.

Instances

NotEmpty l Source 
Fail * IsEmpty => NotEmpty ([] *) Source 

data Relabel tr Source

Instances

(HasFieldM k1 l r v, (~) * (Label k dl) (DemoteMaybe (Label k1 l) v), (~) * b (Tagged k dl a)) => ApplyAB (Relabel r) (Tagged k l a) b Source