rel8-0.1.0.0: Hey! Hey! Can u rel8?
Safe HaskellNone
LanguageHaskell2010

Rel8.Tabulate

Synopsis

Documentation

data Tabulation k a Source #

Tabulation k a is denotionally a MultiMap k a — a Map where each key k corresponds to potentially multiple a (i.e., Query a). This MultiMap supports lookup and other operations you would expect it to.

"Identity" Tabulations are created using tabulate. Tabulations can be composed with Querys with prebind or postbind to form new Tabulations.

Instances

Instances details
EqTable k => Monad (Tabulation k) Source # 
Instance details

Defined in Rel8.Tabulate

Methods

(>>=) :: Tabulation k a -> (a -> Tabulation k b) -> Tabulation k b

(>>) :: Tabulation k a -> Tabulation k b -> Tabulation k b

return :: a -> Tabulation k a

Functor (Tabulation k) Source # 
Instance details

Defined in Rel8.Tabulate

Methods

fmap :: (a -> b) -> Tabulation k a -> Tabulation k b

(<$) :: a -> Tabulation k b -> Tabulation k a

EqTable k => Applicative (Tabulation k) Source # 
Instance details

Defined in Rel8.Tabulate

Methods

pure :: a -> Tabulation k a

(<*>) :: Tabulation k (a -> b) -> Tabulation k a -> Tabulation k b

liftA2 :: (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c

(*>) :: Tabulation k a -> Tabulation k b -> Tabulation k b

(<*) :: Tabulation k a -> Tabulation k b -> Tabulation k a

EqTable k => Apply (Tabulation k) Source # 
Instance details

Defined in Rel8.Tabulate

Methods

(<.>) :: Tabulation k (a -> b) -> Tabulation k a -> Tabulation k b

(.>) :: Tabulation k a -> Tabulation k b -> Tabulation k b

(<.) :: Tabulation k a -> Tabulation k b -> Tabulation k a

liftF2 :: (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c

EqTable k => Bind (Tabulation k) Source # 
Instance details

Defined in Rel8.Tabulate

Methods

(>>-) :: Tabulation k a -> (a -> Tabulation k b) -> Tabulation k b

join :: Tabulation k (Tabulation k a) -> Tabulation k a

EqTable k => AlternativeTable (Tabulation k) Source # 
Instance details

Defined in Rel8.Tabulate

Methods

emptyTable :: Table Expr a => Tabulation k a Source #

EqTable k => AltTable (Tabulation k) Source # 
Instance details

Defined in Rel8.Tabulate

Methods

(<|>:) :: Table Expr a => Tabulation k a -> Tabulation k a -> Tabulation k a Source #

(EqTable k, Table (Expr :: X -> Type) a, Semigroup a) => Semigroup (Tabulation k a) Source # 
Instance details

Defined in Rel8.Tabulate

Methods

(<>) :: Tabulation k a -> Tabulation k a -> Tabulation k a

sconcat :: NonEmpty (Tabulation k a) -> Tabulation k a

stimes :: Integral b => b -> Tabulation k a -> Tabulation k a

(EqTable k, Table (Expr :: X -> Type) a, Semigroup a) => Monoid (Tabulation k a) Source # 
Instance details

Defined in Rel8.Tabulate

Methods

mempty :: Tabulation k a

mappend :: Tabulation k a -> Tabulation k a -> Tabulation k a

mconcat :: [Tabulation k a] -> Tabulation k a

tabulate :: (a -> k) -> a -> Tabulation k a Source #

tabulate creates an "identity" Tabulation k a that allows a be indexed by one or more of its columns k. Some examples:

Tabulation by primary key
projectsById :: Project Expr -> Tabulation (Expr ProjectId) (Project Expr) projectsById = tabulate projectId

Note: the nature of primary keys means that each key will be mapped to a singleton value in this case.

Tabulation by other unique key
projectsByName :: Project Expr -> Tabulation (Expr Text) (Project Expr) projectsByName = tabulate projectName
Tabulation by foreign key (tabulate a child table by parent key)
revisionsByProjectId :: Revision Expr -> Tabulation (Expr ProjectId) (Revision Expr) revisionsByProjectId = tabulate revisionProjectId

tabulateA :: (a -> Query k) -> a -> Tabulation k a Source #

Like tabulate but takes a monadic Query function instead of a pure one. This means you can filter rows while calculating the key, which is useful in conjunction with catNulls.

runTabulation :: EqTable k => Query k -> Tabulation k a -> Query (k, a) Source #

fromQuery :: Query (k, a) -> Tabulation k a Source #

Analgous to fromList.

prebind :: (a -> Tabulation k b) -> Query a -> Tabulation k b infixr 1 Source #

Map a Query over the input side of a Tabulation.

postbind :: (a -> Query b) -> Tabulation k a -> Tabulation k b infixr 1 Source #

Map a Query over the output side of a Tabulation.

indexed :: Tabulation k a -> Tabulation k (k, a) Source #

ifilter :: (k -> a -> Expr Bool) -> Tabulation k a -> Tabulation k a Source #

lookup :: EqTable k => k -> Tabulation k a -> Query a Source #

Note that because Tabulation is a MultiMap, the Query returned by lookup can and often does contain multiple results.

align :: (EqTable k, Table Expr a, Table Expr b) => Tabulation k a -> Tabulation k b -> Tabulation k (TheseTable a b) Source #

Analagous to align.

If zip makes an INNER JOIN, then align makes a FULL OUTER JOIN.

alignWith :: (EqTable k, Table Expr a, Table Expr b) => (TheseTable a b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c Source #

Analagous to alignWith.

See zipWith and align.

leftAlign :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k (a, MaybeTable b) Source #

If zip makes an INNER JOIN, then leftAlign makes a LEFT JOIN. This means it will return at least one row for every row in the left Tabulation, even if there is no corresponding row in the right (hence the MaybeTable).

Analagous to rpadZip.

leftAlignWith :: EqTable k => (a -> MaybeTable b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c Source #

See zipWith and leftAlign.

Analagous to rpadZipWith.

zip :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k (a, b) Source #

Analagous to zip.

There are multiple correct ways of understanding what this does.

You can think of it as intersectionWith (liftA2 (,)). That is, intersect the two Tabulations by matching their keys together (with ==:), and combine their values (remembering that Tabulation is a MultiMap so that the values are keys) by getting their cartesian product.

You can think of it as performing a cross product of the underlying Querys of the given Tabulations and filtering the results for matching keys.

You can think of it as a natural join in SQL terms.

The size of the resulting Tabulation will be \(\sum_{k} min(n_k, m_k) \) in terms of the number of keys, but \(\sum_{k} n_k \times m_k\) in terms of the number of values.

zipWith :: EqTable k => (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c Source #

Analagous to zipWith.

See zip.

similarity :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a Source #

similarity returns all the entries in the left Tabulation that have a corresponding entry in the right Tabulation. This corresponds to a semijoin in relational algebra.

This differs from zipWith const x y when the right Tabulation y contains an entry with multiple rows. For similarity, the entries in the resulting Tabulation will contain the same number of rows as their respective entries in the left Tabulation x. With `zipWith const x y`, each entry would contain the product of the number of rows of their respective entries in x and y.

See with.

difference :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a Source #

difference returns all the entries in the left Tabulation that don't exist in the right Tabulation. This corresponds to an antijoin in relational algebra.

See without.

aggregateTabulation :: forall k aggregates exprs. (EqTable k, Aggregates aggregates exprs) => Tabulation k aggregates -> Tabulation k exprs Source #

orderTabulation :: OrdTable k => Order a -> Tabulation k a -> Tabulation k a Source #

orderTabulation orders the values of a Tabulation within each key.

In general this is meaningless, but if used together with manyTabulation or someTabulation, the resulting lists will be ordered according to ordering given to orderTabulation.

distinctTabulation :: EqTable k => Tabulation k a -> Tabulation k a Source #

Turns the given Tabulation from a "multimap" into a "map". If there is more than one value at a particular key, only the first one is kept. "First" is in general undefined, but orderTabulation can be used to make it deterministic.