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

Rel8.Tabulate

Description

Rel8.Tabulate provides an alternative API (Tabulation) for writing queries that complements the main Rel8 API (Query).

Synopsis

Documentation

data Tabulation k a Source #

A Tabulation k a is like a Query a, except that each row also has a key k in addition to the value a. Tabulations can be composed monadically just like Querys, but the resulting join is more like a NATURAL JOIN (based on the common key column(s) k) than the CROSS JOIN given by Query.

Another way to think of Tabulation k a is as analogous to Map k a in the same way Query a is analogous to [a]. However, there's nothing stopping a Tabulation from containing multiple rows with the same key, so technically Map k (NonEmpty a) is more accurate.

Tabulations can be created from Querys with fromQuery and liftQuery and converted back to Querys with lookup and toQuery (though note the caveats that come with the latter).

Instances

Instances details
Bifunctor Tabulation Source # 
Instance details

Defined in Rel8.Tabulate

Methods

bimap :: (a -> b) -> (c -> d) -> Tabulation a c -> Tabulation b d #

first :: (a -> b) -> Tabulation a c -> Tabulation b c #

second :: (b -> c) -> Tabulation a b -> Tabulation a c #

Biprojectable Tabulation Source # 
Instance details

Defined in Rel8.Tabulate

Methods

biproject :: (Projecting a b, Projecting c d) => Projection a b -> Projection c d -> Tabulation a c -> Tabulation b d Source #

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 #
pure = liftQuery . pure
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 #

If Tabulation k a is Map k (NonEmpty a), then (.) is intersectionWith (liftA2 (*))

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 #

Projectable (Tabulation k) Source # 
Instance details

Defined in Rel8.Tabulate

Methods

project :: Projecting a b => Projection a b -> Tabulation k a -> Tabulation k b Source #

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 #

If Tabulation k a is Map k (NonEmpty a), then (|:) is unionWith (<>).

Instance details

Defined in Rel8.Tabulate

Methods

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

(EqTable k, Table Expr a, Semigroup a) => Semigroup (Tabulation k a) Source #

If Tabulation k a is Map k (NonEmpty a), then (<>) is unionWith (liftA2 (<>)).

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 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 #

Interfacing with Querys

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

Any Query of key-value pairs (k, a) can be a Tabulation k a.

toQuery :: Table Expr k => Tabulation k a -> Query (k, a) Source #

Convert a Tabulation k a back into a Query of key-value pairs.

Note that the result of a toQuery is undefined (will always return zero rows) on Tabulations constructed with liftQuery or pure. So while toQuery . fromQuery is always id, fromQuery . toQuery is not.

A safer, more predictable alternative to toQuery is to use lookup with an explicit set of keys:

do
   k <- keys
   a <- lookup k tabulation
   pure (k, a)

Having said that, in practice, most legitimate uses of Tabulation will have a well-defined toQuery. It would be possible in theory to encode the necessary invariants at the type level using an indexed monad, but we would lose the ability to use do-notation, which is the main benefit of having Tabulation as a monad in the first place.

In particular, toQuery t is well-defined for any Tabulation t defined as t = fromQuery _. toQuery t is also well-defined for any Tabulation t defined as t = t' >>= _ or t = t' *> _ where toQuery t' is well-defined. There are other valid permutations too. Generally, anything that uses fromQuery at some point, unless wrapped in a top-level present or absent, will have a well-defined toQuery.

liftQuery :: Query a -> Tabulation k a Source #

A Query a can be treated as a Tabulation k a where the given a values exist at every possible key k.

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

Run a Kleisli arrow in the the Query monad "through" a Tabulation. Useful for filtering a Tabulation.

filter ((>=. 30) . userAge) `through` usersById

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

lookup k t returns the value(s) at the key k in the tabulation t.

Aggregation and Ordering

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

aggregate aggregates the values within each key of a Tabulation. There is an implicit GROUP BY on all the key columns.

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

distinct ensures a Tabulation has at most one value for each key, i.e., it drops duplicates. In general it keeps only the "first" value it encounters for each key, but note that "first" is undefined unless you first call order.

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

order orders the values of a Tabulation within their respective keys. This specifies a defined order for distinct. It also defines the order of the lists produced by many and some.

Magic Tabulations

Some of the following combinators produce "magic" Tabulations. Let's use count as an example to demonstrate this concept. Consider the following:

count $ fromQuery $ values
  [ (lit a, lit True)
  , (lit a, lit False)
  , (lit b, lit True)
  ]

You might expect this to be equivalent to the following Tabulation:

fromQuery $ values
  [ (lit a, 2)
  , (lit b, 1)
  ]

However, it isn't quite. While the resulting Tabulation does effectively contain the above entries, it also behaves as though it contained the value 0 at every other possible key.

This means you can do:

do
  user <- usersById
  orderCount <- count ordersByUserId

To see how many orders a user has (getting 0 if they have no orders).

count :: EqTable k => Tabulation k a -> Tabulation k (Expr Int64) Source #

count returns a count of how many entries are in the given Tabulation at each key.

The resulting Tabulation is "magic" in that the value 0 exists at every possible key that wasn't in the given Tabulation.

optional :: Tabulation k a -> Tabulation k (MaybeTable Expr a) Source #

optional produces a "magic" Tabulation whereby each entry in the given Tabulation is wrapped in justTable, and every other possible key contains a single nothingTable.

This is used to implement leftAlignWith.

many :: (EqTable k, Table Expr a) => Tabulation k a -> Tabulation k (ListTable Expr a) Source #

many aggregates each entry with a particular key into a single entry with all of the values contained in a ListTable.

order can be used to give this ListTable a defined order.

The resulting Tabulation is "magic" in that the value 'Rel8.listTable []' exists at every possible key that wasn't in the given Tabulation.

some :: (EqTable k, Table Expr a) => Tabulation k a -> Tabulation k (NonEmptyTable Expr a) Source #

some aggregates each entry with a particular key into a single entry with all of the values contained in a NonEmptyTable.

order can be used to give this NonEmptyTable a defined order.

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

exists produces a "magic" Tabulation which contains the value true at each key in the given Tabulation, and the value false at every other possible key.

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

present produces a Tabulation where a single () row exists for every key that was present in the given Tabulation.

This is used to implement similarity.

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

absent produces a Tabulation where a single () row exists at every possible key that absent from the given Tabulation.

This is used to implement difference.

Natural joins

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

Performs a NATURAL FULL OUTER JOIN based on the common key columns.

Analogous to align.

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

Performs a NATURAL FULL OUTER JOIN based on the common key columns.

Analogous to alignWith.

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

Performs a NATURAL LEFT OUTER JOIN based on the common key columns.

Analogous to rpadZip.

Note that you can achieve the same effect with optional and the Applicative instance for Tabulation, i.e., this is just left right -> liftA2 (,) left (optional right). You can also use do@-notation.

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

Performs a NATURAL LEFT OUTER JOIN based on the common key columns.

Analogous to rpadZipWith.

Note that you can achieve the same effect with optional and the Applicative instance for Tabulation, i.e., this is just f left right -> liftA2 f left (optional right). You can also use do@-notation.

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

Performs a NATURAL RIGHT OUTER JOIN based on the common key columns.

Analogous to lpadZip.

Note that you can achieve the same effect with optional and the Applicative instance for Tabulation, i.e., this is just left right -> liftA2 (flip (,)) right (optional left). You can also use do@-notation.

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

Performs a NATURAL RIGHT OUTER JOIN based on the common key columns.

Analogous to lpadZipWith.

Note that you can achieve the same effect with optional and the Applicative instance for Tabulation, i.e., this is just f left right -> liftA2 (flip f) right (optional left). You can also use do@-notation.

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

Performs a NATURAL INNER JOIN based on the common key columns.

Analagous to zip.

Note that you can achieve the same effect with the Applicative instance of Tabulation, i.e., this is just 'liftA2 (,)'. You can also use do-notation.

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

Performs a NATURAL INNER JOIN based on the common key columns.

Analagous to zipWith.

Note that you can achieve the same effect with the Applicative instance of Tabulation, i.e., this is just liftA2. You can also use do-notation.

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

Performs a NATURAL SEMI JOIN based on the common key columns.

The result is a subset of the left tabulation where only entries which have a corresponding entry in the right tabulation are kept.

Note that you can achieve a similar effect with present and the Applicative instance of Tabulation, i.e., this is just left right -> left <* present right. You can also use do-notation.

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

Performs a NATURAL ANTI JOIN based on the common key columns.

The result is a subset of the left tabulation where only entries which do not have a corresponding entry in the right tabulation are kept.

Note that you can achieve a similar effect with absent and the Applicative instance of Tabulation, i.e., this is just left right -> left <* absent right. You can also use do-notation.