Copyright | © Thor Michael Støre, 2015 |
---|---|
License | GPL v2 without "any later version" clause |
Maintainer | thormichael át gmail døt com |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
Database.HaskRel.Relational.Algebra and Database.HaskRel.Relational.Assignment defines the functions of the relational algebra and relational assignment, but in order to keep pertinent concerns separated it only defines functions for relational operations that reference values, not relation variables. This module redefines those functions, generalizing them such that they operate upon relation values, relation variables and relational IO (relational expressions that build upon relvars), and also adds HFWPresent
instances for relational IO.
Running "examples/suppliersPartsExample.sh" starts a GHCi session where these examples can be run.
- class MonOp a where
- rename :: (Ord (HList res), HLabelSet [*] (LabelsOf res), HMapAux HList (Relabel tr) a1 res, SameLength' * * res a1, SameLength' * * a1 res, HAllTaggedLV res, MonOp' a, (~) * (MonOpArg' a) (Set (RTuple a1))) => a -> tr -> IO (Relation res)
- 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), MonOp a, (~) * (MonOpArg a) (Set (RTuple r'))) => a -> (Record r' -> Record r) -> MonOpRes a (Relation (HAppendListR * r r'1))
- restrict :: (MonOp a, (~) * (MonOpArg a) (Set a1)) => a -> (a1 -> Bool) -> MonOpRes a (Set a1)
- project :: (Ord (HList a1), HLabelSet [*] (LabelsOf a1), H2ProjectByLabels ls t a1 b, HAllTaggedLV a1, MonOp a, (~) * (MonOpArg a) (Set (RTuple t))) => a -> proxy ls -> MonOpRes a (Relation a1)
- projectAllBut :: (Ord (HList r'), HDeleteLabels ks r r', MonOp a, (~) * (MonOpArg a) (Set (RTuple r))) => a -> proxy ks -> MonOpRes a (Relation r')
- group :: (Eq (HList l), Ord v, Ord (HList r'), Ord (HList l1), HLabelSet [*] (LabelsOf l), HLabelSet [*] ((:) * (Label k t) (LabelsOf l1)), H2ProjectByLabels (LabelsOf l) r l b, H2ProjectByLabels (LabelsOf r) l1 l b1, HDeleteLabels ks r l1, HDeleteLabels (LabelsOf l1) r r', HAllTaggedLV l1, HAllTaggedLV l, MonOp a, (~) * (MonOpArg a) (Set (RTuple r))) => a -> proxy ks -> (Relation r' -> Tagged k t v) -> MonOpRes a (Relation ((:) * (Tagged k t v) l1))
- groupAllBut :: (Eq (HList l), Ord v, Ord (HList r'), Ord (HList l1), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf l1), HLabelSet [*] ((:) * (Label k t) (LabelsOf l1)), H2ProjectByLabels ls t1 l1 b2, H2ProjectByLabels (LabelsOf l) t1 l b, H2ProjectByLabels (LabelsOf t1) l1 l b1, HDeleteLabels (LabelsOf l1) t1 r', HAllTaggedLV l1, HAllTaggedLV l, MonOp a, (~) * (MonOpArg a) (Set (RTuple t1))) => a -> proxy ls -> (Relation r' -> Tagged k t v) -> MonOpRes a (Relation ((:) * (Tagged k t v) l1))
- ungroup :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf t2), HLabelSet [*] (LabelsOf r), HLabelSet [*] (LabelsOf (HAppendListR * t1 t2)), HasField k l1 (Record v) (Relation t), H2ProjectByLabels (LabelsOf t1) t l t2, H2ProjectByLabels (LabelsOf t) t1 r b, H2ProjectByLabels ((:) * (Label k l1) ([] *)) v t3 t1, HRearrange3 (LabelsOf l) r l, 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), MonOp a, (~) * (MonOpArg a) (Set (RTuple v))) => a -> Label k l1 -> MonOpRes a (Relation (HAppendListR * t1 t2))
- dExtend :: (Ord (HList (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r' r)), HDeleteLabels (LabelsOf r) r' r'1, HAppendList r r'1, HAllTaggedLV (HAppendListR * r r'1), HAllTaggedLV (HAppendListR * r' r), MonOp a, (~) * (MonOpArg a) (Set (RTuple r'))) => a -> (Record r' -> Record r) -> MonOpRes a (Relation (HAppendListR * r r'1))
- extendA :: (Ord (HExtendR (Tagged k l e) (r v')), HExtend (Tagged k l e) (r v'), HDeleteAtLabel k r l v v', MonOp a, (~) * (MonOpArg a) (Set (r v))) => a -> (r v -> Tagged k l e) -> MonOpRes a (Set (HExtendR (Tagged k l e) (r v')))
- dExtendA :: (Ord (HExtendR e l), HExtend e l, MonOp a, (~) * (MonOpArg a) (Set l)) => a -> (l -> e) -> MonOpRes a (Set (HExtendR e l))
- renameA :: (Ord (HExtendR (Tagged k1 l1 v1) (r v')), HasField k l (r v) v1, HExtend (Tagged k1 l1 v1) (r v'), HDeleteAtLabel k r l v v', MonOp a, (~) * (MonOpArg a) (Set (r v))) => a -> Tagged k l (Label k1 l1) -> MonOpRes a (Set (HExtendR (Tagged k1 l1 v1) (r v')))
- aSummarize :: (Eq (HList l), Ord (HList r'2), Ord (HList r'), Ord (HList (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r' r)), HLabelSet [*] (LabelsOf l), H2ProjectByLabels (LabelsOf l) r1 l b, H2ProjectByLabels (LabelsOf r1) r' l b1, HDeleteLabels ks r1 r', HDeleteLabels (LabelsOf r) r' r'1, HDeleteLabels (LabelsOf r') r1 r'2, HAppendList r r'1, HAllTaggedLV l, HAllTaggedLV (HAppendListR * r r'1), HAllTaggedLV (HAppendListR * r' r), MonOp a, (~) * (MonOpArg a) (Set (RTuple r1))) => a -> proxy ks -> (Relation r'2 -> Record r) -> MonOpRes a (Relation (HAppendListR * r r'1))
- 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 b1, H2ProjectByLabels (LabelsOf r) l1 l b2, HAllTaggedLV l1, HAllTaggedLV l, DyaOp a b, DyaOpLeft a ~ Set (Record l1), DyaOpRight b ~ Relation r) => a -> b -> Label t -> DyaOpRes a b (Set (Record (Tagged t (Relation r') : l1)))
- image :: (Eq (HList l), Ord (HList r'), HLabelSet [*] (LabelsOf l), H2ProjectByLabels (LabelsOf l) r l b, H2ProjectByLabels (LabelsOf r) l1 l b1, HDeleteLabels (LabelsOf l1) r r', HAllTaggedLV l, MonOp a, (~) * (MonOpArg a) (Set (RTuple r))) => Record l1 -> a -> MonOpRes a (Relation r')
- member :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * l r, SameLength' * * (LabelsOf l) r, MonOp a, (~) * (MonOpArg a) (Set (Record l))) => Record r -> a -> MonOpRes a Bool
- notMember :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * l r, SameLength' * * (LabelsOf l) r, MonOp a, (~) * (MonOpArg a) (Set (Record l))) => Record r -> a -> MonOpRes a Bool
- rafoldr :: (Foldable t, HasField k l a1 b1, MonOp a, (~) * (MonOpArg a) (t a1)) => (b1 -> res -> res) -> res -> Label k l -> a -> MonOpRes a res
- rafoldrU :: (Foldable t, MonOp a, (~) * (MonOpArg a) (t (Record ((:) * (Tagged k t1 b1) ([] *))))) => (b1 -> res -> res) -> res -> a -> MonOpRes a res
- agg :: (Foldable t, HasField l a1 a2, MonOp a, MonOpArg a ~ t a1) => Label l -> a -> MonOpRes a [a2]
- aggU :: (Foldable t, MonOp a, MonOpArg a ~ t (Record `[Tagged t1 a1]`)) => a -> MonOpRes a [a1]
- count :: (MonOp a, MonOpArg a ~ Set a1) => a -> MonOpRes a Int
- isEmpty :: (MonOp a, MonOpArg a ~ Set a1) => a -> MonOpRes a Bool
- rAgg :: (Foldable t, HasField l a1 a2, MonOp a, MonOpArg a ~ t a1) => Label l -> a -> ([a2] -> res) -> MonOpRes a res
- rAggU :: (Foldable t, MonOp a, (~) * (MonOpArg a) (t (Record ((:) * (Tagged k t1 a1) ([] *))))) => a -> ([a1] -> res) -> MonOpRes a res
- class DyaOp a b where
- type DyaOpRes a b res :: *
- type DyaOpLeft a :: *
- type DyaOpRight b :: *
- dyaOp :: (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, DyaOp a b, DyaOpRight b ~ Relation r) => (DyaOpLeft a -> Relation l -> res) -> a -> b -> DyaOpRes a b res
- naturalJoin :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), 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 b1, HRearrange3 (LabelsOf l) r l, 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), DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple t)), (~) * (DyaOpLeft a) (Set (RTuple t1))) => a -> b -> DyaOpRes a b (Relation (HAppendListR * t1 t2))
- nJoin :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), 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 b1, HRearrange3 (LabelsOf l) r l, 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), DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple t)), (~) * (DyaOpLeft a) (Set (RTuple t1))) => a -> b -> DyaOpRes a b (Relation (HAppendListR * t1 t2))
- times :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), HLabelSet [*] (LabelsOf (HAppendListR * t r)), 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 b1, HRearrange3 (LabelsOf l) r l, 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), HAllTaggedLV (HAppendListR * t r), DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple t)), (~) * (DyaOpLeft a) (Set (RTuple t1))) => a -> b -> DyaOpRes a b (Relation (HAppendListR * t1 t2))
- matching :: (Eq (HList l), Ord (HList t), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b1, H2ProjectByLabels (LabelsOf l1) t r b2, HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple l1)), (~) * (DyaOpLeft a) (Set (RTuple t))) => a -> b -> DyaOpRes a b (Relation t)
- semiJoin :: (Eq (HList l), Ord (HList t), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b1, H2ProjectByLabels (LabelsOf l1) t r b2, HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple l1)), (~) * (DyaOpLeft a) (Set (RTuple t))) => a -> b -> DyaOpRes a b (Relation t)
- notMatching :: (Eq (HList l), Ord (HList t), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b1, H2ProjectByLabels (LabelsOf l1) t r b2, HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple l1)), (~) * (DyaOpLeft a) (Set (RTuple t))) => a -> b -> DyaOpRes a b (Relation t)
- semiDiff :: (Eq (HList l), Ord (HList t), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b1, H2ProjectByLabels (LabelsOf l1) t r b2, HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple l1)), (~) * (DyaOpLeft a) (Set (RTuple t))) => a -> b -> DyaOpRes a b (Relation t)
- union :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple l))) => a -> b -> DyaOpRes a b (Relation l)
- dUnion :: (Ord (HList a1), Typeable [*] a1, HLabelSet [*] (LabelsOf a1), RecordValues a1, HRearrange3 (LabelsOf a1) r a1, HFoldr (Mapcar HPresentRecAttr) [[String]] (RecordValuesR a1) [[String]], SameLength' * * a1 r, SameLength' * * r a1, SameLength' * * r (LabelsOf a1), SameLength' * * (LabelsOf a1) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple a1))) => a -> b -> DyaOpRes a b (Relation a1)
- intersect :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple l))) => a -> b -> DyaOpRes a b (Relation l)
- minus :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple l))) => a -> b -> DyaOpRes a b (Relation l)
- xUnion :: (Ord (HList r1), HLabelSet [*] (LabelsOf r1), HRearrange3 (LabelsOf r1) r1 r1, HRearrange3 (LabelsOf r1) r r1, SameLength' * * r1 r1, SameLength' * * r1 r, SameLength' * * r1 (LabelsOf r1), SameLength' * * r r1, SameLength' * * r (LabelsOf r1), SameLength' * * (LabelsOf r1) r1, SameLength' * * (LabelsOf r1) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple r1))) => a -> b -> DyaOpRes a b (Relation r1)
- isProperSubsetOf :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple l))) => a -> b -> DyaOpRes a b Bool
- isSubsetOf :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple l))) => a -> b -> DyaOpRes a b Bool
- rEq :: (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, DyaOp a b, DyaOpLeft a ~ Relation l, DyaOpRight b ~ Relation r) => a -> b -> DyaOpRes a b Bool
- summarize :: (Eq (HList l), Ord (HList r'2), Ord (HList r'), Ord (HList (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r' r)), HLabelSet [*] (LabelsOf l), H2ProjectByLabels (LabelsOf l) r1 l b1, H2ProjectByLabels (LabelsOf r1) r' l b2, HDeleteLabels ks r2 r', HDeleteLabels (LabelsOf r) r' r'1, HDeleteLabels (LabelsOf r') r1 r'2, HAppendList r r'1, HAllTaggedLV l, HAllTaggedLV (HAppendListR * r r'1), HAllTaggedLV (HAppendListR * r' r), DyaOp a b, (~) * (DyaOpLeft a) (Set (RTuple r1)), (~) * (DyaOpRight b) (Set (RTuple r2))) => a -> b -> proxy ks -> (Relation r'2 -> Record r) -> DyaOpRes a b (Relation (HAppendListR * r r'1))
- interJoin :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), HLabelSet [*] (LabelsOf r), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf t2), HLabelSet [*] (LabelsOf (HAppendListR * t1 t2)), H2ProjectByLabels (LabelsOf t) t1 r b1, H2ProjectByLabels (LabelsOf t1) t l t2, HRearrange3 (LabelsOf l) r l, HAppendList t1 t2, HTIntersect (LabelsOf r) (LabelsOf t) i, 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, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple t)), (~) * (DyaOpLeft a) (Set (RTuple t1))) => a -> b -> DyaOpRes a b (Relation (HAppendListR * t1 t2))
- iJoin :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf r), HLabelSet [*] (LabelsOf t2), HLabelSet [*] (LabelsOf (HAppendListR * t1 t2)), H2ProjectByLabels (LabelsOf t) t1 r b1, H2ProjectByLabels (LabelsOf t1) t l t2, HRearrange3 (LabelsOf l) r l, HAppendList t1 t2, HTIntersect (LabelsOf r) (LabelsOf t) i, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, HAllTaggedLV t2, HAllTaggedLV l, HAllTaggedLV r, HAllTaggedLV (HAppendListR * t1 t2), NotEmpty i, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple t)), (~) * (DyaOpLeft a) (Set (RTuple t1))) => a -> b -> DyaOpRes a b (Relation (HAppendListR * t1 t2))
- class RelAssign a where
- type RelAssignArg a :: *
- relAssign :: (RelAssignArg a -> IO ()) -> a -> IO ()
- assign :: (Ord (HList a1), Show (HList (RecordValuesR a1)), HLabelSet [*] (LabelsOf a1), RecordValues a1, HRearrange3 (LabelsOf a1) r a1, SameLength' * * a1 r, SameLength' * * r a1, SameLength' * * r (LabelsOf a1), SameLength' * * (LabelsOf a1) r, RelAssign a, (~) * (RelAssignArg a) (Set (RTuple r))) => Relvar a1 -> a -> IO ()
- insert :: (Ord (HList a1), Read (HList (RecordValuesR a1)), Show (HList (RecordValuesR a1)), HLabelSet [*] (LabelsOf a1), RecordValues a1, HRearrange3 (LabelsOf a1) r a1, HMapAux HList TaggedFn (RecordValuesR a1) a1, SameLength' * * a1 r, SameLength' * * r a1, SameLength' * * r (LabelsOf a1), SameLength' * * (LabelsOf a1) r, RelAssign a, (~) * (RelAssignArg a) (Set (RTuple r))) => Relvar a1 -> a -> IO ()
- dInsert :: (Ord (HList t), Read (HList (RecordValuesR t)), Show (HList (RecordValuesR r)), Typeable [*] t, HLabelSet [*] (LabelsOf t), RecordValues t, RecordValues r, HRearrange3 (LabelsOf t) r t, HFoldr (Mapcar HPresentRecAttr) [[String]] (RecordValuesR t) [[String]], HMapAux HList TaggedFn (RecordValuesR t) t, SameLength' * * t r, SameLength' * * r t, SameLength' * * r (LabelsOf t), SameLength' * * (LabelsOf t) r, RelAssign a, (~) * (RelAssignArg a) (Set (RTuple r))) => Relvar t -> a -> IO ()
- delete :: (Ord (HList t), Read (HList (RecordValuesR t)), Show (HList (RecordValuesR t)), RecordValues t, HMapAux HList TaggedFn (RecordValuesR t) t, RelAssign a, (~) * (RelAssignArg a) (Set (RTuple t))) => Relvar t -> a -> IO ()
- iDelete :: (Ord (HList t), Ord (HList a1), Read (HList (RecordValuesR t)), Show (HList (RecordValuesR t)), Typeable [*] a1, HLabelSet [*] (LabelsOf t), HLabelSet [*] (LabelsOf a1), RecordValues t, RecordValues a1, HRearrange3 (LabelsOf t) a1 t, HRearrange3 (LabelsOf a1) t a1, HFoldr (Mapcar HPresentRecAttr) [[String]] (RecordValuesR a1) [[String]], HMapAux HList TaggedFn (RecordValuesR t) t, SameLength' * * t a1, SameLength' * * t (LabelsOf a1), SameLength' * * a1 t, SameLength' * * a1 (LabelsOf t), SameLength' * * (LabelsOf t) a1, SameLength' * * (LabelsOf a1) t, RelAssign a, (~) * (RelAssignArg a) (Set (RTuple a1))) => Relvar t -> a -> IO ()
- deleteP :: (Ord (HList t), Read (HList (RecordValuesR t)), Show (HList (RecordValuesR t)), RecordValues t, HMapAux HList TaggedFn (RecordValuesR t) t) => Relvar t -> (RTuple t -> Bool) -> IO ()
- update :: (Ord (HList a), Read (HList (RecordValuesR a)), Show (HList (RecordValuesR a)), RecordValues a, HRearrange3 (LabelsOf a) (HAppendListR r r'2) a, HLabelSet (LabelsOf a), HLabelSet (LabelsOf (HAppendListR r r'2)), HDeleteLabels (LabelsOf r) a r'2, HMapAux HList TaggedFn (RecordValuesR a) a, HAppendList r r'2, SameLength' a (HAppendListR r r'2), SameLength' (LabelsOf a) (HAppendListR r r'2), SameLength' (HAppendListR r r'2) a, SameLength' (HAppendListR r r'2) (LabelsOf a), HAllTaggedLV (HAppendListR r r'2)) => Relvar a -> (Record a -> Bool) -> (Record a -> Record r) -> IO ()
- updateAll :: (Ord (HList a), Read (HList (RecordValuesR a)), Show (HList (RecordValuesR a)), RecordValues a, HRearrange3 (LabelsOf a) (HAppendListR r r'2) a, HLabelSet (LabelsOf a), HLabelSet (LabelsOf (HAppendListR r r'2)), HDeleteLabels (LabelsOf r) a r'2, HMapAux HList TaggedFn (RecordValuesR a) a, HAppendList r r'2, SameLength' a (HAppendListR r r'2), SameLength' (LabelsOf a) (HAppendListR r r'2), SameLength' (HAppendListR r r'2) a, SameLength' (HAppendListR r r'2) (LabelsOf a), HAllTaggedLV (HAppendListR r r'2)) => Relvar a -> (Record a -> Record r) -> IO ()
- updateA :: (Ord (HList r), Read (HList (RecordValuesR r)), Show (HList (RecordValuesR r)), HUpdateAtLabel2 k l v r r, RecordValues r, HasField k l (Record r) v, HMapAux HList TaggedFn (RecordValuesR r) r, SameLength' * * r r) => Relvar r -> (Record r -> Bool) -> (Record r -> Tagged k l v) -> IO ()
- updateAllA :: (Ord (HList r), Read (HList (RecordValuesR r)), Show (HList (RecordValuesR r)), HUpdateAtLabel2 k l v r r, RecordValues r, HasField k l (Record r) v, HMapAux HList TaggedFn (RecordValuesR r) r, SameLength' * * r r) => Relvar r -> (Record r -> Tagged k l v) -> IO ()
- class NotEmpty l
Functions defined according to the definition of monadic operators in relational theory
(Not to be confused with Haskell monads.)
The monadic operator class
The class of relational monadic operators
The functions defined as monadic operators in the relational algebra
rename :: (Ord (HList res), HLabelSet [*] (LabelsOf res), HMapAux HList (Relabel tr) a1 res, SameLength' * * res a1, SameLength' * * a1 res, HAllTaggedLV res, MonOp' a, (~) * (MonOpArg' a) (Set (RTuple a1))) => a -> tr -> IO (Relation res) Source
Rename given 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 │ ...
Note that due to an implementation disorder this always results in an IO operation, even on values. This is not an intentional limit and will hopefully be removed in the future. If this is not acceptable (for instance inside extend
and restrict
functions), then one has to rely on renameA
, which renames a single attribute.
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), MonOp a, (~) * (MonOpArg a) (Set (RTuple r'))) => a -> (Record r' -> Record r) -> MonOpRes a (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.
The simplest form (aside from a no-op), extend with one attribute:
>>>
rPrint$ extend p (\ [pun|weight|] -> (Label :: Label "gmwt") .=. weight * 454 .*. emptyRecord )
┌──────────┬─────┬───────┬───────┬────────┬────────┐ │ gmwt │ pno │ pName │ color │ weight │ city │ ╞══════════╪═════╪═══════╪═══════╪════════╪════════╡ │ 5448 % 1 │ P1 │ Nut │ Red │ 12 % 1 │ London │ ... │ 8626 % 1 │ P6 │ Cog │ Red │ 19 % 1 │ London │ └──────────┴─────┴───────┴───────┴────────┴────────┘
When replacing an attribute with extend one must take care not to cause a naming collision. Using pattern matching with case ... of ...
one can pass values from one context to another with Haskell tuples, and reuse variable names, although this does require some duplication. It is also possible to use pun
to build the output, instead of .*.
and emptyRecord
. Add one attribute, replace another:
>>>
rPrint$ extend p (\[pun|weight color|] -> case (weight + 10, color ++ "-ish") of (weight, altColor) -> [pun|weight altColor|])
┌────────┬───────────┬─────┬───────┬───────┬────────┐ │ weight │ altColor │ pno │ pName │ color │ city │ ╞════════╪═══════════╪═════╪═══════╪═══════╪════════╡ │ 22 % 1 │ Blue-ish │ P5 │ Cam │ Blue │ Paris │ ... │ 29 % 1 │ Red-ish │ P6 │ Cog │ Red │ London │ └────────┴───────────┴─────┴───────┴───────┴────────┘
Lining this up with the EXTEND
operator of Tutorial D, we can imagine case (a, b) of (a', b')
as a form of { a' := a , b' := b }
(though we can hardly equate them), while pun
is needed to unpack and pack this from and to the r-tuples.
Also note that if an attribute is replaced then the cardinality of the result will be equal or lower than that of the argument.
>>>
count sp
12>>>
count $ sp `extend` (\_ -> sno .=. "S0" .*. pno .=. "P0" .*. emptyRecord)
4
It is also notable that since HaskRel is not based on SQL but on relational theory as defined by Chris Date et al today, and explicitly does not have support for nulls and outer joins (as specified in [1] chapter 4), extend
is employed to assemble the information SQL assembles with OUTER JOIN
. The following command (a variant of the first query on [1] page 154) gives a result that includes the information given by SQL RIGHT OUTER JOIN
:
>>>
:{
do sp' <- readRelvar sp rPrint$ extend s (\ (image -> ii) -> pq .=. ii sp' .*. emptyRecord) :} ┌───────────────┬─────┬───────┬────────┬────────┐ │ pq │ sno │ sName │ status │ city │ ╞═══════════════╪═════╪═══════╪════════╪════════╡ │ ┌─────┬─────┐ │ S5 │ Adams │ 30 │ Athens │ │ │ pno │ qty │ │ │ │ │ │ │ ╞═════╪═════╡ │ │ │ │ │ │ └─────┴─────┘ │ │ │ │ │ │ ┌─────┬─────┐ │ S1 │ Smith │ 20 │ London │ │ │ pno │ qty │ │ │ │ │ │ │ ╞═════╪═════╡ │ │ │ │ │ │ │ P1 │ 300 │ │ │ │ │ │ │ │ P2 │ 200 │ │ │ │ │ │ ...
See material about extend, image relations and RVAs in [1] chapter 7 for more.
Note the additional plumbing required to employ relvars inside the function extend
takes; the function imageExtendL
has been created to provide a more convenient way to express this, specializing upon extend
and image
.
restrict :: (MonOp a, (~) * (MonOpArg a) (Set a1)) => a -> (a1 -> Bool) -> MonOpRes a (Set a1) 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".
>>>
rPrint$ p `restrict` (\[pun|weight|] -> weight < 17.5)
┌─────┬───────┬───────┬────────┬────────┐ │ pno │ pName │ color │ weight │ city │ ╞═════╪═══════╪═══════╪════════╪════════╡ │ P1 │ Nut │ Red │ 12 % 1 │ London │ ... │ P5 │ Cam │ Blue │ 12 % 1 │ Paris │ └─────┴───────┴───────┴────────┴────────┘
project :: (Ord (HList a1), HLabelSet [*] (LabelsOf a1), H2ProjectByLabels ls t a1 b, HAllTaggedLV a1, MonOp a, (~) * (MonOpArg a) (Set (RTuple t))) => a -> proxy ls -> MonOpRes a (Relation a1) Source
Projects the given relation on the given heading.
>>>
rPrint$ p `project` (rHdr (color,city))
┌───────┬────────┐ │ color │ city │ ╞═══════╪════════╡ │ Blue │ Oslo │ │ Blue │ Paris │ │ Green │ Paris │ │ Red │ London │ └───────┴────────┘
projectAllBut :: (Ord (HList r'), HDeleteLabels ks r r', MonOp a, (~) * (MonOpArg a) (Set (RTuple r))) => a -> proxy ks -> MonOpRes a (Relation r') Source
Projects the given relation on the heading of said given relation minus the given heading.
>>>
rPrint$ p `projectAllBut` (rHdr (city))
┌─────┬───────┬───────┬────────┐ │ pno │ pName │ color │ weight │ ╞═════╪═══════╪═══════╪════════╡ │ P1 │ Nut │ Red │ 12 % 1 │ │ P2 │ Bolt │ Green │ 17 % 1 │ │ P3 │ Screw │ Blue │ 17 % 1 │ │ P4 │ Screw │ Red │ 14 % 1 │ │ P5 │ Cam │ Blue │ 12 % 1 │ │ P6 │ Cog │ Red │ 19 % 1 │ └─────┴───────┴───────┴────────┘
group :: (Eq (HList l), Ord v, Ord (HList r'), Ord (HList l1), HLabelSet [*] (LabelsOf l), HLabelSet [*] ((:) * (Label k t) (LabelsOf l1)), H2ProjectByLabels (LabelsOf l) r l b, H2ProjectByLabels (LabelsOf r) l1 l b1, HDeleteLabels ks r l1, HDeleteLabels (LabelsOf l1) r r', HAllTaggedLV l1, HAllTaggedLV l, MonOp a, (~) * (MonOpArg a) (Set (RTuple r))) => a -> proxy ks -> (Relation r' -> Tagged k t v) -> MonOpRes a (Relation ((:) * (Tagged k 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.
>>>
let pq = (Label :: Label "pq")
>>>
pt$ group sp (rHdr (pno,qty)) (pq .=.)
┌────────────────────────────────────┬───────────────┐ │ pq :: Relation '["pno","qty"] │ sno :: String │ ╞════════════════════════════════════╪═══════════════╡ │ ┌───────────────┬────────────────┐ │ S1 │ │ │ pno :: String │ qty :: Integer │ │ │ │ ╞═══════════════╪════════════════╡ │ │ │ │ P1 │ 300 │ │ │ ... └────────────────────────────────────┴───────────────┘
Note that the last argument is a function that tags any value with a label; an attribute constructor. This is different from Tutorial D GROUP
, which just takes the equivalent of a label, but as long as an attribute constructor is provided it will function the same way. Here is what we get if we aggregate the relation we get as the argument to the receiving function with agg
, instead of just supplying an attribute constructor ("(pq .=.)
" above):
>>>
let qtys = (Label :: Label "qtys")
>>>
pt$ group sp (rHdr (pno,qty))
((qtys .=.) . agg qty) ┌───────────────────────────┬───────────────┐ │ qtys :: [Integer] │ sno :: String │ ╞═══════════════════════════╪═══════════════╡ │ [200] │ S3 │ │ [200,300,400] │ S4 │ │ [300,200,400,200,100,100] │ S1 │ │ [300,400] │ S2 │ └───────────────────────────┴───────────────┘
"Get the quantities of items in stock for those suppliers that supply anything":
>>>
pt$ group sp (rHdr (pno,qty)) ((qtys .=.) . sum . agg qty)
┌─────────────────┬───────────────┐ │ qtys :: Integer │ sno :: String │ ╞═════════════════╪═══════════════╡ │ 200 │ S3 │ │ 700 │ S2 │ │ 900 │ S4 │ │ 1300 │ S1 │ └─────────────────┴───────────────┘
Note the difference between this and the example for image
. These last two examples may be more clearly expressed with groupAllBut
, since we then specify the attributes that the resulting type will have.
groupAllBut :: (Eq (HList l), Ord v, Ord (HList r'), Ord (HList l1), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf l1), HLabelSet [*] ((:) * (Label k t) (LabelsOf l1)), H2ProjectByLabels ls t1 l1 b2, H2ProjectByLabels (LabelsOf l) t1 l b, H2ProjectByLabels (LabelsOf t1) l1 l b1, HDeleteLabels (LabelsOf l1) t1 r', HAllTaggedLV l1, HAllTaggedLV l, MonOp a, (~) * (MonOpArg a) (Set (RTuple t1))) => a -> proxy ls -> (Relation r' -> Tagged k t v) -> MonOpRes a (Relation ((:) * (Tagged k t v) l1)) Source
ungroup :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf t2), HLabelSet [*] (LabelsOf r), HLabelSet [*] (LabelsOf (HAppendListR * t1 t2)), HasField k l1 (Record v) (Relation t), H2ProjectByLabels (LabelsOf t1) t l t2, H2ProjectByLabels (LabelsOf t) t1 r b, H2ProjectByLabels ((:) * (Label k l1) ([] *)) v t3 t1, HRearrange3 (LabelsOf l) r l, 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), MonOp a, (~) * (MonOpArg a) (Set (RTuple v))) => a -> Label k l1 -> MonOpRes a (Relation (HAppendListR * t1 t2)) Source
Ungroups the given relation valued attribute of the given relation.
>>>
sp `rEq` ungroup ( group sp (rHdr (pno,qty)) (pq .=.)) (undefined :: Label "pq")
True
Supplementary functions
Specializations of functions of the relational model, with relational closure
Not part of relational theory
dExtend :: (Ord (HList (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r' r)), HDeleteLabels (LabelsOf r) r' r'1, HAppendList r r'1, HAllTaggedLV (HAppendListR * r r'1), HAllTaggedLV (HAppendListR * r' r), MonOp a, (~) * (MonOpArg a) (Set (RTuple r'))) => a -> (Record r' -> Record r) -> MonOpRes a (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.
extendA :: (Ord (HExtendR (Tagged k l e) (r v')), HExtend (Tagged k l e) (r v'), HDeleteAtLabel k r l v v', MonOp a, (~) * (MonOpArg a) (Set (r v))) => a -> (r v -> Tagged k l e) -> MonOpRes a (Set (HExtendR (Tagged k 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.
Where c
is an expression yielding a single attribute:
>>>
extend a (\b -> c .*. emptyRecord)
Is equivalent to:
>>>
extendA a (\b -> c)
The following has the same result as the first example for extend
:
>>>
let gmwt = (Label::Label "gmwt")
>>>
rPrint$ extendA p (\[pun|weight|] -> gmwt .=. weight * 454)
Note that if one wants to alter the values of an existing attribute then one has to avoid a name collision. The most convenient option will most often be having a constructor function or label constant with a different name from the actual label:
>>>
let _weight a = (Label::Label "weight") .=. a
>>>
rPrint$ extendA p (\[pun|weight|] -> _weight $ weight + 10)
dExtendA :: (Ord (HExtendR e l), HExtend e l, MonOp a, (~) * (MonOpArg a) (Set l)) => a -> (l -> e) -> MonOpRes a (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
.
renameA :: (Ord (HExtendR (Tagged k1 l1 v1) (r v')), HasField k l (r v) v1, HExtend (Tagged k1 l1 v1) (r v'), HDeleteAtLabel k r l v v', MonOp a, (~) * (MonOpArg a) (Set (r v))) => a -> Tagged k l (Label k1 l1) -> MonOpRes a (Set (HExtendR (Tagged k1 l1 v1) (r v'))) Source
Renames one attribute.
>>>
let sCity = Label :: Label "sCity"
>>>
rPrint$ s `renameA` (city `as` sCity)
┌────────┬─────┬───────┬────────┐ │ sCity │ sno │ sName │ status │ ╞════════╪═════╪═══════╪════════╡ │ Athens │ S5 │ Adams │ 30 │ │ London │ S1 │ Smith │ 20 │ │ London │ S4 │ Clark │ 20 │ │ Paris │ S2 │ Jones │ 10 │ │ Paris │ S3 │ Blake │ 30 │ └────────┴─────┴───────┴────────┘
This only accepts a single pair of labels, the label to rename and the new label, in contrast to Tutorial D rename which takes a set of from-to pairs.
renameA
can, unlike rename
, be used by restrict
and extend
:
>>>
:{
do spx <- readRelvar sp rPrint$ sp `restrict` (\( image -> ii ) -> count ( ii $ renameA (renameA spx (sno `as` sn)) (pno `as` pn) ) > 2) :} ...
aSummarize :: (Eq (HList l), Ord (HList r'2), Ord (HList r'), Ord (HList (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r' r)), HLabelSet [*] (LabelsOf l), H2ProjectByLabels (LabelsOf l) r1 l b, H2ProjectByLabels (LabelsOf r1) r' l b1, HDeleteLabels ks r1 r', HDeleteLabels (LabelsOf r) r' r'1, HDeleteLabels (LabelsOf r') r1 r'2, HAppendList r r'1, HAllTaggedLV l, HAllTaggedLV (HAppendListR * r r'1), HAllTaggedLV (HAppendListR * r' r), MonOp a, (~) * (MonOpArg a) (Set (RTuple r1))) => a -> proxy ks -> (Relation r'2 -> Record r) -> MonOpRes a (Relation (HAppendListR * r r'1)) Source
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 b1, H2ProjectByLabels (LabelsOf r) l1 l b2, HAllTaggedLV l1, HAllTaggedLV l, DyaOp a b, DyaOpLeft a ~ Set (Record l1), DyaOpRight b ~ Relation r) => a -> b -> Label t -> DyaOpRes a b (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. The following command gives a result that includes the information given by SQL RIGHT OUTER JOIN
:
>>>
rPrint$ imageExtendL s sp pq
┌───────────────┬─────┬───────┬────────┬────────┐ │ pq │ sno │ sName │ status │ city │ ╞═══════════════╪═════╪═══════╪════════╪════════╡ │ ┌─────┬─────┐ │ S5 │ Adams │ 30 │ Athens │ │ │ pno │ qty │ │ │ │ │ │ │ ╞═════╪═════╡ │ │ │ │ │ │ └─────┴─────┘ │ │ │ │ │ │ ┌─────┬─────┐ │ S1 │ Smith │ 20 │ London │ │ │ pno │ qty │ │ │ │ │ │ │ ╞═════╪═════╡ │ │ │ │ │ │ │ P1 │ 300 │ │ │ │ │ │ │ │ P2 │ 200 │ │ │ │ │ │ ...
See also extend
, which this function specializes, and image
, which it uses to perform this specialization.
Without relational closure
image :: (Eq (HList l), Ord (HList r'), HLabelSet [*] (LabelsOf l), H2ProjectByLabels (LabelsOf l) r l b, H2ProjectByLabels (LabelsOf r) l1 l b1, HDeleteLabels (LabelsOf l1) r r', HAllTaggedLV l, MonOp a, (~) * (MonOpArg a) (Set (RTuple r))) => Record l1 -> a -> MonOpRes a (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.
>>>
rPrint$ rTuple (sno .=. "S2", pno .=. "P1")
┌─────┬─────┐ │ sno │ pno │ ├─────┼─────┤ │ S2 │ P1 │ └─────┴─────┘>>>
rPrint$ rTuple (sno .=. "S2", pName .=. "Nut")
┌─────┬───────┐ │ sno │ pName │ ├─────┼───────┤ │ S2 │ Nut │ └─────┴───────┘>>>
rPrint$ rTuple (sno .=. "S2", pno .=. "P1") `image` sp
┌─────┐ │ qty │ ╞═════╡ │ 300 │ └─────┘>>>
rPrint$ rTuple (sno .=. "S2", pName .=. "Nut") `image` sp
┌─────┬─────┐ │ pno │ qty │ ╞═════╪═════╡ │ P1 │ 300 │ │ P2 │ 400 │ └─────┴─────┘
Image relations give rise to summarization. Here is a form of the query, "get the quantities of items in stock for all suppliers":
>>>
:{
do sp' <- readRelvar sp rPrint$ s `project` (rHdr (sno)) `extendA` (\ (image -> ii) -> (Label::Label "qtySum") .=. ( sum $ agg qty $ ii sp' ) ) :} ┌────────┬─────┐ │ qtySum │ sno │ ╞════════╪═════╡ │ 0 │ S5 │ │ 200 │ S3 │ │ 700 │ S2 │ │ 900 │ S4 │ │ 1300 │ S1 │ └────────┴─────┘
Note how view patterns are used to build the ii
operator, equivalent of Tutorial D's !!
operator. An equivalent form of the lambda would be:
(\t -> (Label::Label "qtySum") .=. ( sum $ agg qty $ t `image` sp' ))
See group
for a similar example.
member :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * l r, SameLength' * * (LabelsOf l) r, MonOp a, (~) * (MonOpArg a) (Set (Record l))) => Record r -> a -> MonOpRes a Bool Source
Gives whether a given r-tuple is member of a given relation.
>>>
member (rTuple(sno .=. "S3", qty .=. 200, pno .=. "P2")) sp
True
notMember :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * l r, SameLength' * * (LabelsOf l) r, MonOp a, (~) * (MonOpArg a) (Set (Record l))) => Record r -> a -> MonOpRes a Bool Source
Gives whether a given r-tuple is not a member of a given relation.
>>>
notMember (rTuple(sno .=. "S3", qty .=. 200, pno .=. "P2")) sp
False
Not part of relational theory
rafoldr :: (Foldable t, HasField k l a1 b1, MonOp a, (~) * (MonOpArg a) (t a1)) => (b1 -> res -> res) -> res -> Label k l -> a -> MonOpRes a res 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 is not used and may be "undefined".
>>>
rafoldr (+) 0 qty sp
3100>>>
rafoldr (*) 1 qty sp
27648000000000000000000000000
rafoldrU :: (Foldable t, MonOp a, (~) * (MonOpArg a) (t (Record ((:) * (Tagged k t1 b1) ([] *))))) => (b1 -> res -> res) -> res -> a -> MonOpRes a res Source
Right-fold of the attribute of a unary relation.
>>>
rafoldrU (+) 0 $ sp `project` (rHdr (qty))
1000>>>
rafoldrU (*) 1 $ sp `project` (rHdr (qty))
2400000000
agg :: (Foldable t, HasField l a1 a2, MonOp a, MonOpArg a ~ t a1) => Label l -> a -> MonOpRes a [a2] 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 is not used and may be "undefined".
>>>
:{
do sp' <- readRelvar sp putStrLn $ show $ sum $ agg qty sp' :} 3100
aggU :: (Foldable t, MonOp a, MonOpArg a ~ t (Record `[Tagged t1 a1]`)) => a -> MonOpRes a [a1] Source
Aggregation of the single attribute of a unary relation. A specialization of agg
, and thus in turn of rafoldr
, that aggregates the single attribute of a unary relation, without requiring the name of that attribute.
>>>
:{
do sp' <- readRelvar sp putStrLn $ show $ sum $ aggU $ sp' `project` (rHdr (qty)) :} 1000
count :: (MonOp a, MonOpArg a ~ Set a1) => a -> MonOpRes a Int Source
Gives the cardinality of the argument.
>>>
count sp
12
isEmpty :: (MonOp a, MonOpArg a ~ Set a1) => a -> MonOpRes a Bool Source
Gives whether the given argument is empty or not.
>>>
isEmpty sp
False
rAgg :: (Foldable t, HasField l a1 a2, MonOp a, MonOpArg a ~ t a1) => Label l -> a -> ([a2] -> res) -> MonOpRes a res Source
Aggregates an attribute and applies a function to the result of that. A specialization of rafoldr
.
Note that the value of the first argument is not used and may be "undefined".
>>>
rAgg qty sp sum
3100
rAggU :: (Foldable t, MonOp a, (~) * (MonOpArg a) (t (Record ((:) * (Tagged k t1 a1) ([] *))))) => a -> ([a1] -> res) -> MonOpRes a res Source
Aggregates the attribute of a unary relation and applies a function to the result of that. A specialization of rafoldrU
.
>>>
rAggU (sp `project` (rHdr (qty))) sum
1000
Functions defined according to the definition of dyadic operators in relational theory
The dyadic operator class
The class of relational dyadic operators
dyaOp'
dyaOp :: (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, DyaOp a b, DyaOpRight b ~ Relation r) => (DyaOpLeft a -> Relation l -> res) -> a -> b -> DyaOpRes a b res Source
Binary relational function application.
>>>
let newSups = ( relation [rTuple (sno .=. "S6", sName .=. "Nena", city .=. "Berlin", status .=. 40)] )
>>>
dyaOp (/=) s newSups
True
The functions defined as dyadic operators in the relational algebra
naturalJoin :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), 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 b1, HRearrange3 (LabelsOf l) r l, 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), DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple t)), (~) * (DyaOpLeft a) (Set (RTuple t1))) => a -> b -> DyaOpRes a b (Relation (HAppendListR * t1 t2)) Source
The natural join of the two given relations.
>>>
rPrint$ sp `naturalJoin` s
┌─────┬─────┬─────┬───────┬────────┬────────┐ │ sno │ pno │ qty │ sName │ status │ city │ ╞═════╪═════╪═════╪═══════╪════════╪════════╡ │ S1 │ P1 │ 300 │ Smith │ 20 │ London │ ... │ S4 │ P5 │ 400 │ Clark │ 20 │ London │ └─────┴─────┴─────┴───────┴────────┴────────┘
nJoin :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), 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 b1, HRearrange3 (LabelsOf l) r l, 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), DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple t)), (~) * (DyaOpLeft a) (Set (RTuple t1))) => a -> b -> DyaOpRes a b (Relation (HAppendListR * t1 t2)) Source
Alias of naturalJoin
.
times :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), HLabelSet [*] (LabelsOf (HAppendListR * t r)), 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 b1, HRearrange3 (LabelsOf l) r l, 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), HAllTaggedLV (HAppendListR * t r), DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple t)), (~) * (DyaOpLeft a) (Set (RTuple t1))) => a -> b -> DyaOpRes a b (Relation (HAppendListR * t1 t2)) Source
The cartesian product of two relations. A specialized natural join; the natural join between two relations with disjoint headings.
>>>
rPrint$ ( sp `projectAllBut` (rHdr (city)) ) `times` ( s `projectAllBut` (rHdr (city)) )
... No instance for (Fail (DuplicatedLabel (Label "sno"))) arising from a use of ‘times’
>>>
rPrint$ ( sp `projectAllBut` (rHdr (sno)) ) `times` ( s `projectAllBut` (rHdr (sno)) )
┌─────┬─────┬───────┬────────┬────────┐ │ pno │ qty │ sName │ status │ city │ ╞═════╪═════╪═══════╪════════╪════════╡ │ P1 │ 300 │ Adams │ 30 │ Athens │ │ P1 │ 300 │ Blake │ 30 │ Paris │ ... │ P6 │ 100 │ Jones │ 10 │ Paris │ │ P6 │ 100 │ Smith │ 20 │ London │ └─────┴─────┴───────┴────────┴────────┘
matching :: (Eq (HList l), Ord (HList t), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b1, H2ProjectByLabels (LabelsOf l1) t r b2, HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple l1)), (~) * (DyaOpLeft a) (Set (RTuple t))) => a -> b -> DyaOpRes a b (Relation t) Source
The semi-join of the first given relation against the second given relation.
>>>
rPrint$ s `matching` sp
┌─────┬───────┬────────┬────────┐ │ sno │ sName │ status │ city │ ╞═════╪═══════╪════════╪════════╡ │ S1 │ Smith │ 20 │ London │ │ S2 │ Jones │ 10 │ Paris │ │ S3 │ Blake │ 30 │ Paris │ │ S4 │ Clark │ 20 │ London │ └─────┴───────┴────────┴────────┘
semiJoin :: (Eq (HList l), Ord (HList t), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b1, H2ProjectByLabels (LabelsOf l1) t r b2, HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple l1)), (~) * (DyaOpLeft a) (Set (RTuple t))) => a -> b -> DyaOpRes a b (Relation t) Source
Alias of matching
.
notMatching :: (Eq (HList l), Ord (HList t), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b1, H2ProjectByLabels (LabelsOf l1) t r b2, HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple l1)), (~) * (DyaOpLeft a) (Set (RTuple t))) => a -> b -> DyaOpRes a b (Relation t) Source
The semi-difference of the first given relation against the second given relation. Aka. antijoin.
>>>
rPrint$ s `notMatching` sp
┌─────┬───────┬────────┬────────┐ │ sno │ sName │ status │ city │ ╞═════╪═══════╪════════╪════════╡ │ S5 │ Adams │ 30 │ Athens │ └─────┴───────┴────────┴────────┘
semiDiff :: (Eq (HList l), Ord (HList t), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf r), H2ProjectByLabels (LabelsOf t) l1 l b1, H2ProjectByLabels (LabelsOf l1) t r b2, HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, HAllTaggedLV l, HAllTaggedLV r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple l1)), (~) * (DyaOpLeft a) (Set (RTuple t))) => a -> b -> DyaOpRes a b (Relation t) Source
Alias of notMatching
.
union :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple l))) => a -> b -> DyaOpRes a b (Relation l) Source
The union of two relations.
>>>
let newSups = ( relation [rTuple (sno .=. "S6", sName .=. "Nena", city .=. "Berlin", status .=. 40)] )
>>>
rPrint$ s `union` newSups
┌─────┬───────┬────────┬────────┐ │ sno │ sName │ status │ city │ ╞═════╪═══════╪════════╪════════╡ │ S1 │ Smith │ 20 │ London │ │ S2 │ Jones │ 10 │ Paris │ │ S3 │ Blake │ 30 │ Paris │ │ S4 │ Clark │ 20 │ London │ │ S5 │ Adams │ 30 │ Athens │ │ S6 │ Nena │ 40 │ Berlin │ └─────┴───────┴────────┴────────┘
dUnion :: (Ord (HList a1), Typeable [*] a1, HLabelSet [*] (LabelsOf a1), RecordValues a1, HRearrange3 (LabelsOf a1) r a1, HFoldr (Mapcar HPresentRecAttr) [[String]] (RecordValuesR a1) [[String]], SameLength' * * a1 r, SameLength' * * r a1, SameLength' * * r (LabelsOf a1), SameLength' * * (LabelsOf a1) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple a1))) => a -> b -> DyaOpRes a b (Relation a1) Source
The disjoint union between the relations. This is a union of disjoint relations, where a runtime error is raised if the arguments are not disjoint.
>>>
:{
rPrint$ ( p' `project` (rHdr (city)) ) `dUnion` ( s' `project` (rHdr (city)) ) :} ┌─*** Exception: Arguments to dUnion are not disjoint, intersection: ┌────────┐ │ city │ ╞════════╡ │ London │ │ Paris │ └────────┘
intersect :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple l))) => a -> b -> DyaOpRes a b (Relation l) Source
The intersection of two relations.
Note how the name is different from Data.Set, where it 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.
>>>
let sX = ( relation [rTuple (sno .=. "S2", sName .=. "Jones", city .=. "Paris", status .=. 10), rTuple (sno .=. "S6", sName .=. "Nena", city .=. "Berlin", status .=. 40)] )
>>>
rPrint$ s `intersect` sX
┌─────┬───────┬────────┬───────┐ │ sno │ sName │ status │ city │ ╞═════╪═══════╪════════╪═══════╡ │ S2 │ Jones │ 10 │ Paris │ └─────┴───────┴────────┴───────┘
Notably, for any given relation values r1 and r2 that are of the same type it holds that:
r1 `intersect` r2 == r1 `naturalJoin` r2
Within relational theory the natural join generalizes as such both intersection and cartesian product.
minus :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple l))) => a -> b -> DyaOpRes a b (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".
>>>
rPrint$ s `minus` sX
┌─────┬───────┬────────┬────────┐ │ sno │ sName │ status │ city │ ╞═════╪═══════╪════════╪════════╡ │ S1 │ Smith │ 20 │ London │ │ S3 │ Blake │ 30 │ Paris │ │ S4 │ Clark │ 20 │ London │ │ S5 │ Adams │ 30 │ Athens │ └─────┴───────┴────────┴────────┘
xUnion :: (Ord (HList r1), HLabelSet [*] (LabelsOf r1), HRearrange3 (LabelsOf r1) r1 r1, HRearrange3 (LabelsOf r1) r r1, SameLength' * * r1 r1, SameLength' * * r1 r, SameLength' * * r1 (LabelsOf r1), SameLength' * * r r1, SameLength' * * r (LabelsOf r1), SameLength' * * (LabelsOf r1) r1, SameLength' * * (LabelsOf r1) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple r1))) => a -> b -> DyaOpRes a b (Relation r1) Source
Exclusive union, aka. symmetric difference
>>>
rPrint$ s `xUnion` sX
┌─────┬───────┬────────┬────────┐ │ sno │ sName │ status │ city │ ╞═════╪═══════╪════════╪════════╡ │ S1 │ Smith │ 20 │ London │ │ S3 │ Blake │ 30 │ Paris │ │ S4 │ Clark │ 20 │ London │ │ S5 │ Adams │ 30 │ Athens │ │ S6 │ Nena │ 40 │ Berlin │ └─────┴───────┴────────┴────────┘
isProperSubsetOf :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple l))) => a -> b -> DyaOpRes a b Bool Source
Tests whether the second argument is a proper subset of the first.
>>>
let spX = relation [rTuple (sno .=. "S1", pno .=. "P4", qty .=. 200), rTuple (sno .=. "S2", pno .=. "P2", qty .=. 400)]
>>>
spX `isProperSubsetOf` sp
True
isSubsetOf :: (Ord (HList l), HLabelSet [*] (LabelsOf l), HRearrange3 (LabelsOf l) r l, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple r)), (~) * (DyaOpLeft a) (Set (RTuple l))) => a -> b -> DyaOpRes a b Bool Source
Tests whether the second argument is a subset of the first.
>>>
spX `isSubsetOf` sp
True
rEq :: (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, DyaOp a b, DyaOpLeft a ~ Relation l, DyaOpRight b ~ Relation r) => a -> b -> DyaOpRes a b Bool Source
Relational equality.
>>>
sp `rEq` (relation [rTuple(sno .=. "S2", qty .=. 400, pno .=. "P2")])
False
Somewhat deprecated operators of the relational algebra
summarize :: (Eq (HList l), Ord (HList r'2), Ord (HList r'), Ord (HList (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r r'1)), HLabelSet [*] (LabelsOf (HAppendListR * r' r)), HLabelSet [*] (LabelsOf l), H2ProjectByLabels (LabelsOf l) r1 l b1, H2ProjectByLabels (LabelsOf r1) r' l b2, HDeleteLabels ks r2 r', HDeleteLabels (LabelsOf r) r' r'1, HDeleteLabels (LabelsOf r') r1 r'2, HAppendList r r'1, HAllTaggedLV l, HAllTaggedLV (HAppendListR * r r'1), HAllTaggedLV (HAppendListR * r' r), DyaOp a b, (~) * (DyaOpLeft a) (Set (RTuple r1)), (~) * (DyaOpRight b) (Set (RTuple r2))) => a -> b -> proxy ks -> (Relation r'2 -> Record r) -> DyaOpRes a b (Relation (HAppendListR * r r'1)) Source
The summarization of the relations by the given function.
>>>
let pct = Label :: Label "pct"
>>>
rPrint$ summarize sp (s `project` (rHdr (sno))) (rHdr (pno)) (\r -> pct .=. count r .*. emptyRecord)
┌─────┬─────┐ │ pct │ sno │ ╞═════╪═════╡ │ 0 │ S5 │ │ 1 │ S3 │ │ 2 │ S2 │ │ 3 │ S4 │ │ 6 │ S1 │ └─────┴─────┘
>>>
rPrint$ summarize sp (s `project` (rHdr (sno))) (rHdr (qty)) (\r -> qty .=. sum ( agg qty r ) .*. emptyRecord)
┌──────┬─────┐ │ qty │ sno │ ╞══════╪═════╡ │ 0 │ S5 │ │ 200 │ S3 │ │ 700 │ S2 │ │ 900 │ S4 │ │ 1300 │ S1 │ └──────┴─────┘
Specializations of functions of the relational model, with relational closure
Not part of relational theory
interJoin :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), HLabelSet [*] (LabelsOf r), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf t2), HLabelSet [*] (LabelsOf (HAppendListR * t1 t2)), H2ProjectByLabels (LabelsOf t) t1 r b1, H2ProjectByLabels (LabelsOf t1) t l t2, HRearrange3 (LabelsOf l) r l, HAppendList t1 t2, HTIntersect (LabelsOf r) (LabelsOf t) i, 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, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple t)), (~) * (DyaOpLeft a) (Set (RTuple t1))) => a -> b -> DyaOpRes a b (Relation (HAppendListR * t1 t2)) Source
The 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 a complement of times
within 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
>>>
rPrint$ ( sp `projectAllBut` (rHdr (sno)) ) `interJoin` ( s `projectAllBut` (rHdr (sno)) )
... Overlapping instances for NotEmpty '[] arising from a use of ‘interJoin’
>>>
rPrint$ sp `interJoin` s
┌─────┬─────┬─────┬───────┬────────┬────────┐ │ sno │ pno │ qty │ sName │ status │ city │ ╞═════╪═════╪═════╪═══════╪════════╪════════╡ │ S1 │ P1 │ 300 │ Smith │ 20 │ London │ │ S1 │ P2 │ 200 │ Smith │ 20 │ London │ ... │ S4 │ P4 │ 300 │ Clark │ 20 │ London │ │ S4 │ P5 │ 400 │ Clark │ 20 │ London │ └─────┴─────┴─────┴───────┴────────┴────────┘
iJoin :: (Eq (HList l), Ord (HList (HAppendListR * t1 t2)), HLabelSet [*] (LabelsOf l), HLabelSet [*] (LabelsOf r), HLabelSet [*] (LabelsOf t2), HLabelSet [*] (LabelsOf (HAppendListR * t1 t2)), H2ProjectByLabels (LabelsOf t) t1 r b1, H2ProjectByLabels (LabelsOf t1) t l t2, HRearrange3 (LabelsOf l) r l, HAppendList t1 t2, HTIntersect (LabelsOf r) (LabelsOf t) i, SameLength' * * l r, SameLength' * * r l, SameLength' * * r (LabelsOf l), SameLength' * * (LabelsOf l) r, HAllTaggedLV t2, HAllTaggedLV l, HAllTaggedLV r, HAllTaggedLV (HAppendListR * t1 t2), NotEmpty i, DyaOp a b, (~) * (DyaOpRight b) (Set (RTuple t)), (~) * (DyaOpLeft a) (Set (RTuple t1))) => a -> b -> DyaOpRes a b (Relation (HAppendListR * t1 t2)) Source
Alias of interJoin
Assignment functions
The assignment operator class
class RelAssign a where Source
The class of relational assignment
type RelAssignArg a :: * Source
relAssign :: (RelAssignArg a -> IO ()) -> a -> IO () Source
Relational IO function application.
The primitive assignment function
assign :: (Ord (HList a1), Show (HList (RecordValuesR a1)), HLabelSet [*] (LabelsOf a1), RecordValues a1, HRearrange3 (LabelsOf a1) r a1, SameLength' * * a1 r, SameLength' * * r a1, SameLength' * * r (LabelsOf a1), SameLength' * * (LabelsOf a1) r, RelAssign a, (~) * (RelAssignArg a) (Set (RTuple r))) => Relvar a1 -> a -> IO () infix 1 Source
Writes a relation value to a relvar file, replacing the existing value.
>>>
assign s s'
Value assigned to SuppliersPartsDB/S.rv
Specialized assignment functions
insert :: (Ord (HList a1), Read (HList (RecordValuesR a1)), Show (HList (RecordValuesR a1)), HLabelSet [*] (LabelsOf a1), RecordValues a1, HRearrange3 (LabelsOf a1) r a1, HMapAux HList TaggedFn (RecordValuesR a1) a1, SameLength' * * a1 r, SameLength' * * r a1, SameLength' * * r (LabelsOf a1), SameLength' * * (LabelsOf a1) r, RelAssign a, (~) * (RelAssignArg a) (Set (RTuple r))) => Relvar a1 -> a -> IO () infix 1 Source
Inserts a relation into a relvar. This differs from SQLs INSERT; the relvar is updated to the union of the relvar and the relation value given as arguments.
>>>
let newSups = relation [rTuple (sno .=. "S6", sName .=. "Nena", city .=. "Berlin", status .=. 40)]
>>>
insert s newSups
Inserted 1 of 1 tuples into SuppliersPartsDB/S.rv>>>
insert s newSups
Inserted 0 of 1 tuples into SuppliersPartsDB/S.rv>>>
rPrint$ s
┌─────┬───────┬────────┬────────┐ │ sno │ sName │ status │ city │ ╞═════╪═══════╪════════╪════════╡ ... │ S6 │ Nena │ 40 │ Berlin │ └─────┴───────┴────────┴────────┘
dInsert :: (Ord (HList t), Read (HList (RecordValuesR t)), Show (HList (RecordValuesR r)), Typeable [*] t, HLabelSet [*] (LabelsOf t), RecordValues t, RecordValues r, HRearrange3 (LabelsOf t) r t, HFoldr (Mapcar HPresentRecAttr) [[String]] (RecordValuesR t) [[String]], HMapAux HList TaggedFn (RecordValuesR t) t, SameLength' * * t r, SameLength' * * r t, SameLength' * * r (LabelsOf t), SameLength' * * (LabelsOf t) r, RelAssign a, (~) * (RelAssignArg a) (Set (RTuple r))) => Relvar t -> a -> IO () infix 1 Source
Disjoint insert. Closer to SQL INSERT, except that this will never insert a duplicate tuple.
>>>
dInsert sp $ relation [rTuple (sno .=. "S6", pno .=. "P7", qty .=. 99)]
Inserted 1 tuples into SuppliersPartsDB/SP.rv>>>
dInsert sp $ relation [rTuple (sno .=. "S6", pno .=. "P7", qty .=. 99), rTuple (sno .=. "S4", pno .=. "P4", qty .=. 300), rTuple (sno .=. "S7", pno .=. "P8", qty .=. 200)]
*** Exception: Unique constraint violation, tuples already present in SuppliersPartsDB/SP.rv: ┌─────┬─────┬─────┐ │ sno │ pno │ qty │ ╞═════╪═════╪═════╡ │ S4 │ P4 │ 300 │ │ S6 │ P7 │ 99 │ └─────┴─────┴─────┘
delete :: (Ord (HList t), Read (HList (RecordValuesR t)), Show (HList (RecordValuesR t)), RecordValues t, HMapAux HList TaggedFn (RecordValuesR t) t, RelAssign a, (~) * (RelAssignArg a) (Set (RTuple t))) => Relvar t -> a -> IO () infix 1 Source
Deletes a specified subset of a relvar. Note that this is not SQL DELETE, but instead a generalization thereof.
>>>
delete s newSups
Deleted 1 tuples from SuppliersPartsDB/S.rv
iDelete :: (Ord (HList t), Ord (HList a1), Read (HList (RecordValuesR t)), Show (HList (RecordValuesR t)), Typeable [*] a1, HLabelSet [*] (LabelsOf t), HLabelSet [*] (LabelsOf a1), RecordValues t, RecordValues a1, HRearrange3 (LabelsOf t) a1 t, HRearrange3 (LabelsOf a1) t a1, HFoldr (Mapcar HPresentRecAttr) [[String]] (RecordValuesR a1) [[String]], HMapAux HList TaggedFn (RecordValuesR t) t, SameLength' * * t a1, SameLength' * * t (LabelsOf a1), SameLength' * * a1 t, SameLength' * * a1 (LabelsOf t), SameLength' * * (LabelsOf t) a1, SameLength' * * (LabelsOf a1) t, RelAssign a, (~) * (RelAssignArg a) (Set (RTuple a1))) => Relvar t -> a -> IO () infix 1 Source
Performs an inclusive delete against a relvar. Also not SQL DELETE. This will fail if the second argument is not a subset of the relation variable.
>>>
iDelete sp $ relation [rTuple (sno .=. "S6", pno .=. "P7", qty .=. 99), rTuple (sno .=. "S4", pno .=. "P4", qty .=. 300), rTuple (sno .=. "S7", pno .=. "P8", qty .=. 200)]
*** Exception: Tuples not found in relvar SuppliersPartsDB/SP.rv: ┌─────┬─────┬─────┐ │ sno │ pno │ qty │ ╞═════╪═════╪═════╡ │ S7 │ P8 │ 200 │ └─────┴─────┴─────┘
deleteP :: (Ord (HList t), Read (HList (RecordValuesR t)), Show (HList (RecordValuesR t)), RecordValues t, HMapAux HList TaggedFn (RecordValuesR t) t) => Relvar t -> (RTuple t -> Bool) -> IO () Source
Delete by predicate, as SQL DELETE.
>>>
let newProd = relation [rTuple (pno .=. "P7", pName .=. "Baloon", color .=. "Red", weight .=. (-5 :: Rational), city .=. "Berlin")]
>>>
insert p newProd
Inserted 1 of 1 tuples into SuppliersPartsDB/P.rv>>>
deleteP p (\ [pun|pno|] -> pno == "P7" )
Deleted 1 tuples from SuppliersPartsDB/P.rv
update :: (Ord (HList a), Read (HList (RecordValuesR a)), Show (HList (RecordValuesR a)), RecordValues a, HRearrange3 (LabelsOf a) (HAppendListR r r'2) a, HLabelSet (LabelsOf a), HLabelSet (LabelsOf (HAppendListR r r'2)), HDeleteLabels (LabelsOf r) a r'2, HMapAux HList TaggedFn (RecordValuesR a) a, HAppendList r r'2, SameLength' a (HAppendListR r r'2), SameLength' (LabelsOf a) (HAppendListR r r'2), SameLength' (HAppendListR r r'2) a, SameLength' (HAppendListR r r'2) (LabelsOf a), HAllTaggedLV (HAppendListR r r'2)) => Relvar a -> (Record a -> Bool) -> (Record a -> Record r) -> IO () Source
Updates tuples of a relvar that match the given predicate. As SQL UPDATE.
>>>
update sp (\ [pun|pno|] -> pno == "P2" || pno == "P3" ) (\ [pun|qty|] -> _qty ( qty - 25 ) .*. emptyRecord)
Updated 5 of 12 tuples in SuppliersPartsDB/SP.rv *SuppliersPartsExample> rPrint$ sp ┌─────┬─────┬─────┐ │ sno │ pno │ qty │ ╞═════╪═════╪═════╡ │ S1 │ P1 │ 300 │ │ S1 │ P2 │ 175 │ │ S1 │ P3 │ 375 │ │ S1 │ P4 │ 200 │ ...
Note how the cardinality of the relvar will be equal or lower after an update:
>>>
assign sp sp'
Value assigned to SuppliersPartsDB/SP.rv>>>
count sp
12>>>
update sp (\[pun|pno|] -> pno == "P1" || pno == "P2" || pno == "P3") (\_ -> _pno "P1" .*. _qty 50 .*. emptyRecord)
Updated 7 of 12 tuples in SuppliersPartsDB/SP.rv>>>
count sp
9
updateAll :: (Ord (HList a), Read (HList (RecordValuesR a)), Show (HList (RecordValuesR a)), RecordValues a, HRearrange3 (LabelsOf a) (HAppendListR r r'2) a, HLabelSet (LabelsOf a), HLabelSet (LabelsOf (HAppendListR r r'2)), HDeleteLabels (LabelsOf r) a r'2, HMapAux HList TaggedFn (RecordValuesR a) a, HAppendList r r'2, SameLength' a (HAppendListR r r'2), SameLength' (LabelsOf a) (HAppendListR r r'2), SameLength' (HAppendListR r r'2) a, SameLength' (HAppendListR r r'2) (LabelsOf a), HAllTaggedLV (HAppendListR r r'2)) => Relvar a -> (Record a -> Record r) -> IO () Source
Updates tuples of a relvar that match the given predicate.
In SQL and Tutorial D both the predicate of UPDATE
is an optional clause, but optional clauses isn't idiomatic Haskell, hence this separate updateAll function.
>>>
updateAll sp (\ [pun|qty pno|] -> _qty ( qty - 25 ) .*. _pno ( pno ++ "X" ) .*. emptyRecord)
Updated 12 tuples in SuppliersPartsDB/SP.rv *SuppliersPartsExample> pt sp ┌───────────────┬───────────────┬────────────────┐ │ sno :: String │ pno :: String │ qty :: Integer │ ╞═══════════════╪═══════════════╪════════════════╡ │ S1 │ P1X │ 275 │ ...
Further specialized and simplified forms of update
Not part of relational theory
updateA :: (Ord (HList r), Read (HList (RecordValuesR r)), Show (HList (RecordValuesR r)), HUpdateAtLabel2 k l v r r, RecordValues r, HasField k l (Record r) v, HMapAux HList TaggedFn (RecordValuesR r) r, SameLength' * * r r) => Relvar r -> (Record r -> Bool) -> (Record r -> Tagged k l v) -> IO () Source
Updates all tuples of a relvar. The second argument is a function that results in an attribute, making for a simpler function than for update
.
>>>
updateA sp (\ [pun|pno|] -> pno == "P2" || pno == "P3" ) (\ [pun|qty|] -> _qty $ qty - 25)
Updated 5 of 12 tuples in SuppliersPartsDB/SP.rv
updateAllA :: (Ord (HList r), Read (HList (RecordValuesR r)), Show (HList (RecordValuesR r)), HUpdateAtLabel2 k l v r r, RecordValues r, HasField k l (Record r) v, HMapAux HList TaggedFn (RecordValuesR r) r, SameLength' * * r r) => Relvar r -> (Record r -> Tagged k l v) -> IO () Source
Updates all tuples of a relvar. The second argument is a function that results in an attribute, making for a simpler function than for updateAll
.
>>>
updateAllA sp (\ [pun|qty|] -> _qty $ qty - 50)
Updated 12 tuples in SuppliersPartsDB/SP.rv>>>
rPrint$ sp
┌───────────────┬───────────────┬────────────────┐ │ sno :: String │ pno :: String │ qty :: Integer │ ╞═══════════════╪═══════════════╪════════════════╡ │ S1 │ P1 │ 250 │ ...