@@ -0,0 +1,637 @@
1+{-# language FlexibleContexts #-}
2+{-# language MonoLocalBinds #-}
3+{-# language ScopedTypeVariables #-}
4+{-# language StandaloneKindSignatures #-}
5+{-# language TypeApplications #-}
6+{-# language TupleSections #-}
7+{-# language UndecidableInstances #-}
8+
9+-- | "Rel8.Tabulate" provides an alternative API ('Tabulation') for writing
10+-- queries that complements the main "Rel8" API ('Query').
11+
12+module Rel8.Tabulate
13+ (
14+ Tabulation
15+
16+ -- * Interfacing with 'Query's
17+ , fromQuery
18+ , toQuery
19+ , liftQuery
20+ , through
21+ , lookup
22+
23+ -- * Aggregation and Ordering
24+ , aggregate
25+ , distinct
26+ , order
27+
28+ -- ** Magic 'Tabulation's
29+ -- $magic
30+ , count
31+ , optional
32+ , many
33+ , some
34+ , exists
35+ , present
36+ , absent
37+
38+ -- * Natural joins
39+ , align
40+ , alignWith
41+ , leftAlign
42+ , leftAlignWith
43+ , rightAlign
44+ , rightAlignWith
45+ , zip
46+ , zipWith
47+ , similarity
48+ , difference
49+ )
50+where
51+
52+-- base
53+import Control.Applicative ( (<|>), empty, liftA2 )
54+import Control.Monad ( liftM2 )
55+import Data.Bifunctor ( Bifunctor, bimap, first, second )
56+import Data.Foldable ( traverse_ )
57+import Data.Function ( on )
58+import Data.Functor.Contravariant ( Contravariant, (>$<), contramap )
59+import Data.Int ( Int64 )
60+import Data.Kind ( Type )
61+import Data.Maybe ( fromMaybe )
62+import Prelude hiding ( lookup, zip, zipWith )
63+
64+-- bifunctors
65+import Data.Bifunctor.Clown ( Clown( Clown ), runClown )
66+
67+-- comonad
68+import Control.Comonad ( extract )
69+
70+-- opaleye
71+import qualified Opaleye.Aggregate as Opaleye
72+import qualified Opaleye.Internal.Order as Opaleye
73+import qualified Opaleye.Internal.QueryArr as Opaleye
74+import qualified Opaleye.Order as Opaleye ( orderBy )
75+
76+-- profunctors
77+import Data.Profunctor ( dimap, lmap )
78+
79+-- product-profunctors
80+import Data.Profunctor.Product
81+ ( ProductProfunctor, (***!)
82+ , SumProfunctor, (+++!)
83+ )
84+import qualified Data.Profunctor.Product as PP
85+
86+-- rel8
87+import Rel8.Aggregate ( Aggregates )
88+import Rel8.Expr ( Expr )
89+import Rel8.Expr.Aggregate ( countStar )
90+import Rel8.Expr.Bool ( true )
91+import Rel8.Order ( Order( Order ) )
92+import Rel8.Query ( Query )
93+import qualified Rel8.Query.Exists as Q ( exists, present, absent )
94+import Rel8.Query.Filter ( where_ )
95+import Rel8.Query.Limit ( limit )
96+import Rel8.Query.List ( catNonEmptyTable )
97+import qualified Rel8.Query.Maybe as Q ( optional )
98+import Rel8.Query.Opaleye ( mapOpaleye, unsafePeekQuery )
99+import Rel8.Query.These ( alignBy )
100+import Rel8.Table ( Table, fromColumns, toColumns )
101+import Rel8.Table.Aggregate ( hgroupBy, listAgg, nonEmptyAgg )
102+import Rel8.Table.Alternative
103+ ( AltTable, (<|>:)
104+ , AlternativeTable, emptyTable
105+ )
106+import Rel8.Table.Cols ( fromCols, toCols )
107+import Rel8.Table.Eq ( EqTable, (==:), eqTable )
108+import Rel8.Table.List ( ListTable( ListTable ) )
109+import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), maybeTable )
110+import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
111+import Rel8.Table.Opaleye ( aggregator, unpackspec )
112+import Rel8.Table.Ord ( OrdTable )
113+import Rel8.Table.Order ( ascTable )
114+import Rel8.Table.Projection
115+ ( Biprojectable, biproject
116+ , Projectable, project
117+ , apply
118+ )
119+import Rel8.Table.These ( TheseTable( TheseTable ), theseTable )
120+
121+-- semigroupoids
122+import Data.Functor.Apply ( Apply, liftF2 )
123+import Data.Functor.Bind ( Bind, (>>-) )
124+
125+
126+type Key :: Type -> Type
127+type Key = Maybe
128+
129+
130+cat :: Table Expr k => Key k -> Query k
131+cat = maybe emptyTable pure
132+
133+
134+key :: (ProductProfunctor p, SumProfunctor p)
135+ => p a b -> p (Key a) (Key b)
136+key a = dimap from to (PP.empty +++! a)
137+ where
138+ from = maybe (Left ()) Right
139+ to = either (const Nothing) Just
140+
141+
142+keyed :: (ProductProfunctor p, SumProfunctor p)
143+ => p k l -> p a b -> p (Key k, a) (Key l, b)
144+keyed k a = key k ***! a
145+
146+
147+type Predicate :: Type -> Type
148+newtype Predicate a = Predicate (Maybe (a -> Expr Bool))
149+
150+
151+instance Contravariant Predicate where
152+ contramap f (Predicate a) = Predicate (lmap f <$> a)
153+
154+
155+instance Semigroup (Predicate k) where
156+ Predicate ma <> Predicate mb = Predicate $ ma <|> mb
157+
158+
159+instance Monoid (Predicate k) where
160+ mempty = Predicate Nothing
161+
162+
163+match :: EqTable k => Key k -> Predicate k
164+match = Predicate . fmap (==:)
165+
166+
167+ensure :: Predicate k -> Key k -> Query ()
168+ensure (Predicate mp) = traverse_ (\k -> traverse_ (\p -> where_ (p k)) mp)
169+
170+
171+-- | A @'Tabulation' k a@ is like a @'Query' a@, except that each row also
172+-- has a key @k@ in addition to the value @a@. 'Tabulation's can be composed
173+-- monadically just like 'Query's, but the resulting join is more like a
174+-- @NATURAL JOIN@ (based on the common key column(s) @k@) than the
175+-- @CROSS JOIN@ given by 'Query'.
176+--
177+-- Another way to think of @'Tabulation' k a@ is as analogous to @Map k a@ in
178+-- the same way @'Query' a@ is analogous to @[a]@. However, there's nothing
179+-- stopping a 'Tabulation' from containing multiple rows with the same key, so
180+-- technically @Map k (NonEmpty a)@ is more accurate.
181+--
182+-- 'Tabulation's can be created from 'Query's with 'fromQuery' and 'littQuery'
183+-- and converted back to 'Query's with 'lookup' and 'toQuery' (though note the
184+-- caveats that come with the latter).
185+type Tabulation :: Type -> Type -> Type
186+newtype Tabulation k a = Tabulation (Predicate k -> Query (Key k, a))
187+
188+
189+instance Biprojectable Tabulation where
190+ biproject f g =
191+ bimap
192+ (fromColumns . apply f . toColumns)
193+ (fromColumns . apply g . toColumns)
194+
195+
196+instance Bifunctor Tabulation where
197+ bimap f g (Tabulation a) = Tabulation $ \p ->
198+ bimap (fmap f) g <$> a (f >$< p)
199+
200+
201+instance Functor (Tabulation k) where
202+ fmap = second
203+
204+
205+instance Projectable (Tabulation k) where
206+ project f = fmap (fromColumns . apply f . toColumns)
207+
208+
209+-- | If @'Tabulation' k a@ is @Map k (NonEmpty a)@, then @(<.>)@ is
210+-- @intersectionWith (liftA2 (<*>))@
211+instance EqTable k => Apply (Tabulation k) where
212+ liftF2 = liftA2
213+
214+
215+-- | @pure = 'liftQuery' . pure@
216+instance EqTable k => Applicative (Tabulation k) where
217+ pure = liftQuery . pure
218+ liftA2 = liftM2
219+
220+
221+instance EqTable k => Bind (Tabulation k) where
222+ Tabulation as >>- f = Tabulation $ \p -> do
223+ (k, a) <- as p
224+ case f a of
225+ Tabulation bs -> do
226+ let p' = match k
227+ (k', b) <- bs (p' <> p)
228+ ensure p' k'
229+ pure (k' <|> k, b)
230+
231+
232+instance EqTable k => Monad (Tabulation k) where
233+ (>>=) = (>>-)
234+
235+
236+-- | If @'Tabulation' k a@ is @Map k (NonEmpty a)@, then @(<|>:)@ is
237+-- @unionWith (<>)@.
238+instance EqTable k => AltTable (Tabulation k) where
239+ as <|>: bs = catNonEmptyTable `through` ((<>) `on` some) as bs
240+
241+
242+instance EqTable k => AlternativeTable (Tabulation k) where
243+ emptyTable = Tabulation $ const $ fmap (empty,) emptyTable
244+
245+
246+-- | If @'Tabulation' k a@ is @Map k (NonEmpty a)@, then @(<>)@ is
247+-- @unionWith (liftA2 (<>))@.
248+instance (EqTable k, Table Expr a, Semigroup a) => Semigroup (Tabulation k a)
249+ where
250+ (<>) = alignWith (theseTable id id (<>))
251+
252+
253+instance (EqTable k, Table Expr a, Semigroup a) => Monoid (Tabulation k a)
254+ where
255+ mempty = emptyTable
256+
257+
258+-- | Any 'Query' of key-value pairs @(k, a)@ can be a @'Tabulation' k a@.
259+fromQuery :: Query (k, a) -> Tabulation k a
260+fromQuery = Tabulation . const . fmap (first pure)
261+
262+
263+-- | Convert a @'Tabulation' k a@ back into a 'Query' of key-value pairs.
264+--
265+-- Note that the result of a 'toQuery' is undefined (will always return zero
266+-- rows) on 'Tabulation's constructed with 'liftQuery' or 'pure'. So while
267+-- @toQuery . fromQuery@ is always @id@, @fromQuery . toQuery@ is not.
268+--
269+-- A safer, more predictable alternative to 'toQuery' is to use 'lookup' with
270+-- an explicit set of keys:
271+--
272+-- @
273+-- do
274+-- k <- keys
275+-- a <- lookup k tabulation
276+-- pure (k, a)
277+-- @
278+--
279+-- Having said that, in practice, most legitimate uses of 'Tabulation' will
280+-- have a well-defined 'toQuery'. It would be possible in theory to encode
281+-- the necessary invariants at the type level using an indexed monad, but we
282+-- would lose the ability to use @do@-notation, which is the main benefit
283+-- of having 'Tabulation' as a monad in the first place.
284+--
285+-- In particular, @'toQuery' t@ is well-defined for any 'Tabulation' @t@
286+-- defined as @t = fromQuery _@. @'toQuery' t@ is also well-defined for any
287+-- 'Tabulation' @t@ defined as @t = t' >>= _@ or @t = t' *> _@ where
288+-- @'toQuery' t'@ is well-defined. There are other valid permutations too.
289+-- Generally, anything that uses 'fromQuery' at some point, unless wrapped in
290+-- a top-level 'present' or 'absent', will have a well-defined 'toQuery'.
291+toQuery :: Table Expr k => Tabulation k a -> Query (k, a)
292+toQuery (Tabulation f) = do
293+ (mk, a) <- f mempty
294+ k <- cat mk
295+ pure (k, a)
296+
297+
298+-- | A @'Query' a@ can be treated as a @'Tabulation' k a@ where the given @a@
299+-- values exist at every possible key @k@.
300+liftQuery :: Query a -> Tabulation k a
301+liftQuery = Tabulation . const . fmap (empty,)
302+
303+
304+-- | Run a Kleisli arrow in the the 'Query' monad \"through\" a 'Tabulation'.
305+-- Useful for 'Rel8.filter'ing a 'Tabulation'.
306+--
307+-- @
308+-- 'Rel8.filter' ((>=. 30) . userAge) `'through'` usersById
309+-- @
310+through :: (a -> Query b) -> Tabulation k a -> Tabulation k b
311+through f (Tabulation as) = Tabulation $ \p -> do
312+ (k, a) <- as p
313+ b <- f a
314+ pure (k, b)
315+infixr 1 `through`
316+
317+
318+-- | @'lookup' k t@ returns the value(s) at the key @k@ in the tabulation @t@.
319+lookup :: EqTable k => k -> Tabulation k a -> Query a
320+lookup k (Tabulation f) = do
321+ (k', a) <- f p
322+ ensure p k'
323+ pure a
324+ where
325+ p = match (pure k)
326+
327+
328+-- | 'aggregate' aggregates the values within each key of a
329+-- 'Tabulation'. There is an implicit @GROUP BY@ on all the key columns.
330+aggregate :: forall k aggregates exprs.
331+ ( EqTable k
332+ , Aggregates aggregates exprs
333+ )
334+ => Tabulation k aggregates -> Tabulation k exprs
335+aggregate (Tabulation f) = Tabulation $
336+ mapOpaleye (Opaleye.aggregate (keyed haggregator aggregator)) .
337+ fmap (first (fmap (hgroupBy (eqTable @k) . toColumns))) .
338+ f
339+ where
340+ haggregator = dimap fromColumns fromCols aggregator
341+
342+
343+-- | 'distinct' ensures a 'Tabulation' has at most one value for
344+-- each key, i.e., it drops duplicates. In general it keeps only the
345+-- \"first\" value it encounters for each key, but note that \"first\" is
346+-- undefined unless you first call 'order'.
347+distinct :: EqTable k => Tabulation k a -> Tabulation k a
348+distinct (Tabulation f) = Tabulation $ \p ->
349+ -- workaround for https://github.com/tomjaguarpaw/haskell-opaleye/pull/518
350+ case fst (unsafePeekQuery (f p)) of
351+ Nothing -> limit 1 (f p)
352+ Just _ ->
353+ mapOpaleye
354+ (\q ->
355+ Opaleye.productQueryArr
356+ ( Opaleye.distinctOn (key unpackspec) fst
357+ . Opaleye.runSimpleQueryArr q
358+ )
359+ )
360+ (f p)
361+
362+
363+-- | 'order' orders the /values/ of a 'Tabulation' within their
364+-- respective keys. This specifies a defined order for 'distinct'.
365+-- It also defines the order of the lists produced by 'many' and
366+-- 'some'.
367+order :: OrdTable k => Order a -> Tabulation k a -> Tabulation k a
368+order ordering (Tabulation f) =
369+ Tabulation $ mapOpaleye (Opaleye.orderBy ordering') . f
370+ where
371+ Order ordering' = runClown (keyed (Clown ascTable) (Clown ordering))
372+
373+
374+-- $magic
375+--
376+-- Some of the following combinators produce \"magic\" 'Tabulation's. Let's
377+-- use 'count' as an example to demonstrate this concept. Consider
378+-- the following:
379+--
380+-- @
381+-- count $ fromQuery $ values
382+-- [ (lit 'a', lit True)
383+-- , (lit 'a', lit False)
384+-- , (lit 'b', lit True)
385+-- ]
386+-- @
387+--
388+-- You might expect this to be equivalent to the following 'Tabulation':
389+--
390+-- @
391+-- fromQuery $ values
392+-- [ (lit 'a', 2)
393+-- , (lit 'b', 1)
394+-- ]
395+-- @
396+--
397+-- However, it isn't quite. While the resulting 'Tabulation' does effectively
398+-- contain the above entries, it also behaves as though it contained the value
399+-- @0@ at every other possible key.
400+--
401+-- This means you can do:
402+--
403+-- @
404+-- do
405+-- user <- usersById
406+-- orderCount <- count ordersByUserId
407+-- @
408+--
409+-- To see how many orders a user has (getting @0@ if they have no orders).
410+
411+
412+-- | 'count' returns a count of how many entries are in the given
413+-- 'Tabulation' at each key.
414+--
415+-- The resulting 'Tabulation' is \"magic\" in that the value @0@ exists at
416+-- every possible key that wasn't in the given 'Tabulation'.
417+count :: EqTable k => Tabulation k a -> Tabulation k (Expr Int64)
418+count =
419+ fmap (maybeTable 0 id) .
420+ optional .
421+ aggregate .
422+ fmap (const countStar)
423+
424+
425+-- | 'optional' produces a \"magic\" 'Tabulation' whereby each
426+-- entry in the given 'Tabulation' is wrapped in 'Rel8.justTable', and every
427+-- other possible key contains a single 'Rel8.nothingTable'.
428+--
429+-- This is used to implement 'leftAlignWith'.
430+optional :: Tabulation k a -> Tabulation k (MaybeTable Expr a)
431+optional (Tabulation f) = Tabulation $ \p -> case p of
432+ Predicate Nothing -> fmap pure <$> f p
433+ _ -> fmap (\m -> (empty, snd <$> m)) $ Q.optional $ do
434+ (k, a) <- f p
435+ ensure p k
436+ pure (k, a)
437+
438+
439+-- | 'many' aggregates each entry with a particular key into a
440+-- single entry with all of the values contained in a 'ListTable'.
441+--
442+-- 'order' can be used to give this 'ListTable' a defined order.
443+--
444+-- The resulting 'Tabulation' is \"magic\" in that the value
445+-- @'Rel8.listTable []'@ exists at every possible key that wasn't in the given
446+-- 'Tabulation'.
447+many :: (EqTable k, Table Expr a)
448+ => Tabulation k a -> Tabulation k (ListTable Expr a)
449+many =
450+ fmap (maybeTable mempty (\(ListTable a) -> ListTable a)) .
451+ optional .
452+ aggregate .
453+ fmap (listAgg . toCols)
454+
455+
456+-- | 'some' aggregates each entry with a particular key into a
457+-- single entry with all of the values contained in a 'NonEmptyTable'.
458+--
459+-- 'order' can be used to give this 'NonEmptyTable' a defined order.
460+some :: (EqTable k, Table Expr a)
461+ => Tabulation k a -> Tabulation k (NonEmptyTable Expr a)
462+some =
463+ fmap (\(NonEmptyTable a) -> NonEmptyTable a) .
464+ aggregate .
465+ fmap (nonEmptyAgg . toCols)
466+
467+
468+-- | 'exists' produces a \"magic\" 'Tabulation' which contains the
469+-- value 'Rel8.true' at each key in the given 'Tabulation', and the value
470+-- 'Rel8.false' at every other possible key.
471+exists :: Tabulation k a -> Tabulation k (Expr Bool)
472+exists (Tabulation f) = Tabulation $ \p -> case p of
473+ Predicate Nothing -> (true <$) <$> f p
474+ _ -> fmap (empty,) $ Q.exists $ do
475+ (k, _) <- f p
476+ ensure p k
477+
478+
479+-- | 'present' produces a 'Tabulation' where a single @()@ row
480+-- exists for every key that was present in the given 'Tabulation'.
481+--
482+-- This is used to implement 'similarity'.
483+present :: Tabulation k a -> Tabulation k ()
484+present (Tabulation f) = Tabulation $ \p -> do
485+ Q.present $ do
486+ (k, _) <- f p
487+ ensure p k
488+ pure (empty, ())
489+
490+
491+-- | 'absent' produces a 'Tabulation' where a single @()@ row exists
492+-- at every possible key that absent from the given 'Tabulation'.
493+--
494+-- This is used to implement 'difference'.
495+absent :: Tabulation k a -> Tabulation k ()
496+absent (Tabulation f) = Tabulation $ \p -> do
497+ Q.absent $ do
498+ (k, _) <- f p
499+ ensure p k
500+ pure (empty, ())
501+
502+
503+-- | Performs a @NATURAL FULL OUTER JOIN@ based on the common key columns.
504+--
505+-- Analogous to 'Data.Semialign.align'.
506+align :: EqTable k
507+ => Tabulation k a -> Tabulation k b -> Tabulation k (TheseTable Expr a b)
508+align = alignWith id
509+
510+
511+-- | Performs a @NATURAL FULL OUTER JOIN@ based on the common key columns.
512+--
513+-- Analogous to 'Data.Semialign.alignWith'.
514+alignWith :: EqTable k
515+ => (TheseTable Expr a b -> c)
516+ -> Tabulation k a -> Tabulation k b -> Tabulation k c
517+alignWith f (Tabulation as) (Tabulation bs) = Tabulation $ \p -> do
518+ tkab <- liftF2 (alignBy condition) as bs p
519+ let
520+ k = recover $ bimap fst fst tkab
521+ tab = bimap snd snd tkab
522+ pure (k, f tab)
523+ where
524+ condition (k, _) (k', _) = fromMaybe true (liftA2 (==:) k k')
525+ recover (TheseTable mma@(MaybeTable _ ma) mmb@(MaybeTable _ mb)) =
526+ case extract ma of
527+ Nothing -> extract mb
528+ Just a -> case extract mb of
529+ Nothing -> extract ma
530+ Just b -> case a <$ mma <|>: b <$ mmb of
531+ MaybeTable _ c -> pure (extract c)
532+
533+
534+-- | Performs a @NATURAL LEFT OUTER JOIN@ based on the common key columns.
535+--
536+-- Analogous to 'Data.Semialign.rpadZip'.
537+--
538+-- Note that you can achieve the same effect with 'optional' and the
539+-- 'Applicative' instance for 'Tabulation', i.e., this is just
540+-- @\left right -> liftA2 (,) left (optional right). You can also
541+-- use @do@-notation.
542+leftAlign :: EqTable k
543+ => Tabulation k a -> Tabulation k b -> Tabulation k (a, MaybeTable Expr b)
544+leftAlign = leftAlignWith (,)
545+
546+
547+-- | Performs a @NATURAL LEFT OUTER JOIN@ based on the common key columns.
548+--
549+-- Analogous to 'Data.Semialign.rpadZipWith'.
550+--
551+-- Note that you can achieve the same effect with 'optional' and the
552+-- 'Applicative' instance for 'Tabulation', i.e., this is just
553+-- @\f left right -> liftA2 f left (optional right). You can also
554+-- use @do@-notation.
555+leftAlignWith :: EqTable k
556+ => (a -> MaybeTable Expr b -> c)
557+ -> Tabulation k a -> Tabulation k b -> Tabulation k c
558+leftAlignWith f left right = liftA2 f left (optional right)
559+
560+
561+-- | Performs a @NATURAL RIGHT OUTER JOIN@ based on the common key columns.
562+--
563+-- Analogous to 'Data.Semialign.lpadZip'.
564+--
565+-- Note that you can achieve the same effect with 'optional' and the
566+-- 'Applicative' instance for 'Tabulation', i.e., this is just
567+-- @\left right -> liftA2 (flip (,)) right (optional left). You can
568+-- also use @do@-notation.
569+rightAlign :: EqTable k
570+ => Tabulation k a -> Tabulation k b -> Tabulation k (MaybeTable Expr a, b)
571+rightAlign = rightAlignWith (,)
572+
573+
574+-- | Performs a @NATURAL RIGHT OUTER JOIN@ based on the common key columns.
575+--
576+-- Analogous to 'Data.Semialign.lpadZipWith'.
577+--
578+-- Note that you can achieve the same effect with 'optional' and the
579+-- 'Applicative' instance for 'Tabulation', i.e., this is just
580+-- @\f left right -> liftA2 (flip f) right (optional left). You can
581+-- also use @do@-notation.
582+rightAlignWith :: EqTable k
583+ => (MaybeTable Expr a -> b -> c)
584+ -> Tabulation k a -> Tabulation k b -> Tabulation k c
585+rightAlignWith f left right = liftA2 (flip f) right (optional left)
586+
587+
588+-- | Performs a @NATURAL INNER JOIN@ based on the common key columns.
589+--
590+-- Analagous to 'Data.Semialign.zip'.
591+--
592+-- Note that you can achieve the same effect with the 'Applicative' instance
593+-- of 'Tabulation', i.e., this is just @'liftA2 (,)'@. You can also use
594+-- @do@-notation.
595+zip :: EqTable k
596+ => Tabulation k a -> Tabulation k b -> Tabulation k (a, b)
597+zip = zipWith (,)
598+
599+
600+-- | Performs a @NATURAL INNER JOIN@ based on the common key columns.
601+--
602+-- Analagous to 'Data.Semialign.zipWith'.
603+--
604+-- Note that you can achieve the same effect with the 'Applicative' instance
605+-- of 'Tabulation', i.e., this is just @'liftA2'@. You can also use
606+-- @do@-notation.
607+zipWith :: EqTable k
608+ => (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
609+zipWith = liftA2
610+
611+
612+-- | Performs a [@NATURAL SEMI JOIN@](https://en.wikipedia.org/wiki/Relational_algebra#Semijoin_%28%E2%8B%89%29%28%E2%8B%8A%29)
613+-- based on the common key columns.
614+--
615+-- The result is a subset of the left tabulation where only entries which have
616+-- a corresponding entry in the right tabulation are kept.
617+--
618+-- Note that you can achieve a similar effect with 'present' and the
619+-- 'Applicative' instance of 'Tabulation', i.e., this is just
620+-- @\left right -> left <* present right@. You can also use
621+-- @do@-notation.
622+similarity :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a
623+similarity a b = a <* present b
624+
625+
626+-- | Performs a [@NATURAL ANTI JOIN@](https://en.wikipedia.org/wiki/Relational_algebra#Antijoin_%28%E2%96%B7%29)
627+-- based on the common key columns.
628+--
629+-- The result is a subset of the left tabulation where only entries which do
630+-- not have a corresponding entry in the right tabulation are kept.
631+--
632+-- Note that you can achieve a similar effect with 'absent' and the
633+-- 'Applicative' instance of 'Tabulation', i.e., this is just
634+-- @\left right -> left <* absent right@. You can also use
635+-- @do@-notation.
636+difference :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a
637+difference a b = a <* absent b