{-# language FlexibleContexts #-}
{-# language MonoLocalBinds #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TupleSections #-}
{-# language UndecidableInstances #-}

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

module Rel8.Tabulate
  (
    Tabulation

    -- * Interfacing with 'Query's
  , fromQuery
  , toQuery
  , liftQuery
  , through
  , lookup

    -- * Aggregation and Ordering
  , aggregate
  , distinct
  , order

    -- ** Magic 'Tabulation's
    -- $magic
  , count
  , optional
  , many
  , some
  , exists
  , present
  , absent

    -- * Natural joins
  , align
  , alignWith
  , leftAlign
  , leftAlignWith
  , rightAlign
  , rightAlignWith
  , zip
  , zipWith
  , similarity
  , difference
  )
where

-- base
import Control.Applicative ( (<|>), empty, liftA2 )
import Control.Monad ( liftM2 )
import Data.Bifunctor ( Bifunctor, bimap, first, second )
import Data.Foldable ( traverse_ )
import Data.Function ( on )
import Data.Functor.Contravariant ( Contravariant, (>$<), contramap )
import Data.Int ( Int64 )
import Data.Kind ( Type )
import Data.Maybe ( fromJust, fromMaybe )
import Prelude hiding ( lookup, zip, zipWith )

-- bifunctors
import Data.Bifunctor.Clown ( Clown( Clown ), runClown )

-- comonad
import Control.Comonad ( extract )

-- opaleye
import qualified Opaleye.Aggregate as Opaleye
import qualified Opaleye.Order as Opaleye ( orderBy, distinctOnExplicit )

-- profunctors
import Data.Profunctor ( dimap, lmap )

-- product-profunctors
import Data.Profunctor.Product
  ( ProductProfunctor, (***!)
  , SumProfunctor, (+++!)
  )
import qualified Data.Profunctor.Product as PP

-- rel8
import Rel8.Aggregate ( Aggregates )
import Rel8.Expr ( Expr )
import Rel8.Expr.Aggregate ( countStar )
import Rel8.Expr.Bool ( true )
import Rel8.Order ( Order( Order ) )
import Rel8.Query ( Query )
import qualified Rel8.Query.Exists as Q ( exists, present, absent )
import Rel8.Query.Filter ( where_ )
import Rel8.Query.List ( catNonEmptyTable )
import qualified Rel8.Query.Maybe as Q ( optional )
import Rel8.Query.Opaleye ( mapOpaleye, unsafePeekQuery )
import Rel8.Query.These ( alignBy )
import Rel8.Table ( Table, fromColumns, toColumns )
import Rel8.Table.Aggregate ( hgroupBy, listAgg, nonEmptyAgg )
import Rel8.Table.Alternative
  ( AltTable, (<|>:)
  , AlternativeTable, emptyTable
  )
import Rel8.Table.Cols ( fromCols, toCols )
import Rel8.Table.Eq ( EqTable, (==:), eqTable )
import Rel8.Table.List ( ListTable( ListTable ) )
import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), maybeTable )
import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
import Rel8.Table.Opaleye ( aggregator, unpackspec )
import Rel8.Table.Ord ( OrdTable )
import Rel8.Table.Order ( ascTable )
import Rel8.Table.Projection
  ( Biprojectable, biproject
  , Projectable, project
  , apply
  )
import Rel8.Table.These ( TheseTable( TheseTable ), theseTable )

-- semigroupoids
import Data.Functor.Apply ( Apply, liftF2 )
import Data.Functor.Bind ( Bind, (>>-) )


type Key :: Type -> Type
type Key = Maybe


cat :: Table Expr k => Key k -> Query k
cat :: Key k -> Query k
cat = Query k -> (k -> Query k) -> Key k -> Query k
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Query k
forall (f :: * -> *) a. (AlternativeTable f, Table Expr a) => f a
emptyTable k -> Query k
forall (f :: * -> *) a. Applicative f => a -> f a
pure


key :: (ProductProfunctor p, SumProfunctor p)
  => p a b -> p (Key a) (Key b)
key :: p a b -> p (Key a) (Key b)
key p a b
a = (Key a -> Either () a)
-> (Either () b -> Key b)
-> p (Either () a) (Either () b)
-> p (Key a) (Key b)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Key a -> Either () a
forall b. Maybe b -> Either () b
from Either () b -> Key b
forall b a. Either b a -> Maybe a
to (p () ()
forall (p :: * -> * -> *). ProductProfunctor p => p () ()
PP.empty p () () -> p a b -> p (Either () a) (Either () b)
forall (p :: * -> * -> *) a b a' b'.
SumProfunctor p =>
p a b -> p a' b' -> p (Either a a') (Either b b')
+++! p a b
a)
  where
    from :: Maybe b -> Either () b
from = Either () b -> (b -> Either () b) -> Maybe b -> Either () b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either () b
forall a b. a -> Either a b
Left ()) b -> Either () b
forall a b. b -> Either a b
Right
    to :: Either b a -> Maybe a
to = (b -> Maybe a) -> (a -> Maybe a) -> Either b a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just


keyed :: (ProductProfunctor p, SumProfunctor p)
  => p k l -> p a b -> p (Key k, a) (Key l, b)
keyed :: p k l -> p a b -> p (Key k, a) (Key l, b)
keyed p k l
k p a b
a = p k l -> p (Key k) (Key l)
forall (p :: * -> * -> *) a b.
(ProductProfunctor p, SumProfunctor p) =>
p a b -> p (Key a) (Key b)
key p k l
k p (Key k) (Key l) -> p a b -> p (Key k, a) (Key l, b)
forall (p :: * -> * -> *) a b a' b'.
ProductProfunctor p =>
p a b -> p a' b' -> p (a, a') (b, b')
***! p a b
a


type Predicate :: Type -> Type
newtype Predicate a = Predicate (Maybe (a -> Expr Bool))


instance Contravariant Predicate where
  contramap :: (a -> b) -> Predicate b -> Predicate a
contramap a -> b
f (Predicate Maybe (b -> Expr Bool)
a) = Maybe (a -> Expr Bool) -> Predicate a
forall a. Maybe (a -> Expr Bool) -> Predicate a
Predicate ((a -> b) -> (b -> Expr Bool) -> a -> Expr Bool
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f ((b -> Expr Bool) -> a -> Expr Bool)
-> Maybe (b -> Expr Bool) -> Maybe (a -> Expr Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (b -> Expr Bool)
a)


instance Semigroup (Predicate k) where
  Predicate Maybe (k -> Expr Bool)
ma <> :: Predicate k -> Predicate k -> Predicate k
<> Predicate Maybe (k -> Expr Bool)
mb = Maybe (k -> Expr Bool) -> Predicate k
forall a. Maybe (a -> Expr Bool) -> Predicate a
Predicate (Maybe (k -> Expr Bool) -> Predicate k)
-> Maybe (k -> Expr Bool) -> Predicate k
forall a b. (a -> b) -> a -> b
$ Maybe (k -> Expr Bool)
ma Maybe (k -> Expr Bool)
-> Maybe (k -> Expr Bool) -> Maybe (k -> Expr Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (k -> Expr Bool)
mb


instance Monoid (Predicate k) where
  mempty :: Predicate k
mempty = Maybe (k -> Expr Bool) -> Predicate k
forall a. Maybe (a -> Expr Bool) -> Predicate a
Predicate Maybe (k -> Expr Bool)
forall a. Maybe a
Nothing


match :: EqTable k => Key k -> Predicate k
match :: Key k -> Predicate k
match = Maybe (k -> Expr Bool) -> Predicate k
forall a. Maybe (a -> Expr Bool) -> Predicate a
Predicate (Maybe (k -> Expr Bool) -> Predicate k)
-> (Key k -> Maybe (k -> Expr Bool)) -> Key k -> Predicate k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> k -> Expr Bool) -> Key k -> Maybe (k -> Expr Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap k -> k -> Expr Bool
forall a. EqTable a => a -> a -> Expr Bool
(==:)


ensure :: Predicate k -> Key k -> Query ()
ensure :: Predicate k -> Key k -> Query ()
ensure (Predicate Maybe (k -> Expr Bool)
mp) = (k -> Query ()) -> Key k -> Query ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\k
k -> ((k -> Expr Bool) -> Query ())
-> Maybe (k -> Expr Bool) -> Query ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\k -> Expr Bool
p -> Expr Bool -> Query ()
where_ (k -> Expr Bool
p k
k)) Maybe (k -> Expr Bool)
mp)


-- | A @'Tabulation' k a@ is like a @'Query' a@, except that each row also
-- has a key @k@ in addition to the value @a@. 'Tabulation's can be composed
-- monadically just like 'Query's, 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.
--
-- 'Tabulation's can be created from 'Query's with 'fromQuery' and 'liftQuery'
-- and converted back to 'Query's with 'lookup' and 'toQuery' (though note the
-- caveats that come with the latter).
type Tabulation :: Type -> Type -> Type
newtype Tabulation k a = Tabulation (Predicate k -> Query (Key k, a))


instance Biprojectable Tabulation where
  biproject :: Projection a b
-> Projection c d -> Tabulation a c -> Tabulation b d
biproject Projection a b
f Projection c d
g =
    (a -> b) -> (c -> d) -> Tabulation a c -> Tabulation b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
      (Columns (Transpose (Field a) b) (Context b) -> b
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns (Transpose (Field a) b) (Context b) -> b)
-> (a -> Columns (Transpose (Field a) b) (Context b)) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Projection a b -> Columns a (Context b) -> Columns b (Context b)
forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a b
f (Columns a (Context b)
 -> Columns (Transpose (Field a) b) (Context b))
-> (a -> Columns a (Context b))
-> a
-> Columns (Transpose (Field a) b) (Context b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Columns a (Context b)
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
      (Columns (Transpose (Field c) d) (Context d) -> d
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns (Transpose (Field c) d) (Context d) -> d)
-> (c -> Columns (Transpose (Field c) d) (Context d)) -> c -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Projection c d -> Columns c (Context d) -> Columns d (Context d)
forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection c d
g (Columns c (Context d)
 -> Columns (Transpose (Field c) d) (Context d))
-> (c -> Columns c (Context d))
-> c
-> Columns (Transpose (Field c) d) (Context d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Columns c (Context d)
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)


instance Bifunctor Tabulation where
  bimap :: (a -> b) -> (c -> d) -> Tabulation a c -> Tabulation b d
bimap a -> b
f c -> d
g (Tabulation Predicate a -> Query (Key a, c)
a) = (Predicate b -> Query (Key b, d)) -> Tabulation b d
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate b -> Query (Key b, d)) -> Tabulation b d)
-> (Predicate b -> Query (Key b, d)) -> Tabulation b d
forall a b. (a -> b) -> a -> b
$ \Predicate b
p ->
    (Key a -> Key b) -> (c -> d) -> (Key a, c) -> (Key b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> b) -> Key a -> Key b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) c -> d
g ((Key a, c) -> (Key b, d)) -> Query (Key a, c) -> Query (Key b, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Predicate a -> Query (Key a, c)
a (a -> b
f (a -> b) -> Predicate b -> Predicate a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Predicate b
p)


instance Functor (Tabulation k) where
  fmap :: (a -> b) -> Tabulation k a -> Tabulation k b
fmap = (a -> b) -> Tabulation k a -> Tabulation k b
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second


instance Projectable (Tabulation k) where
  project :: Projection a b -> Tabulation k a -> Tabulation k b
project Projection a b
f = (a -> b) -> Tabulation k a -> Tabulation k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Columns (Transpose (Field a) b) (Context b) -> b
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns (Transpose (Field a) b) (Context b) -> b)
-> (a -> Columns (Transpose (Field a) b) (Context b)) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Projection a b -> Columns a (Context b) -> Columns b (Context b)
forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a b
f (Columns a (Context b)
 -> Columns (Transpose (Field a) b) (Context b))
-> (a -> Columns a (Context b))
-> a
-> Columns (Transpose (Field a) b) (Context b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Columns a (Context b)
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)


-- | If @'Tabulation' k a@ is @Map k (NonEmpty a)@, then @(<.>)@ is
-- @intersectionWith (liftA2 (<*>))@
instance EqTable k => Apply (Tabulation k) where
  liftF2 :: (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
liftF2 = (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2


-- | @pure = 'liftQuery' . pure@
instance EqTable k => Applicative (Tabulation k) where
  pure :: a -> Tabulation k a
pure = Query a -> Tabulation k a
forall a k. Query a -> Tabulation k a
liftQuery (Query a -> Tabulation k a)
-> (a -> Query a) -> a -> Tabulation k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  liftA2 :: (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
liftA2 = (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2


instance EqTable k => Bind (Tabulation k) where
  Tabulation Predicate k -> Query (Key k, a)
as >>- :: Tabulation k a -> (a -> Tabulation k b) -> Tabulation k b
>>- a -> Tabulation k b
f = (Predicate k -> Query (Key k, b)) -> Tabulation k b
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, b)) -> Tabulation k b)
-> (Predicate k -> Query (Key k, b)) -> Tabulation k b
forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> do
    (Key k
k, a
a) <- Predicate k -> Query (Key k, a)
as Predicate k
p
    case a -> Tabulation k b
f a
a of
      Tabulation Predicate k -> Query (Key k, b)
bs -> do
        let p' :: Predicate k
p' = Key k -> Predicate k
forall k. EqTable k => Key k -> Predicate k
match Key k
k
        (Key k
k', b
b) <- Predicate k -> Query (Key k, b)
bs (Predicate k
p' Predicate k -> Predicate k -> Predicate k
forall a. Semigroup a => a -> a -> a
<> Predicate k
p)
        Predicate k -> Key k -> Query ()
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p' Key k
k'
        (Key k, b) -> Query (Key k, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key k
k' Key k -> Key k -> Key k
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Key k
k, b
b)


instance EqTable k => Monad (Tabulation k) where
  >>= :: Tabulation k a -> (a -> Tabulation k b) -> Tabulation k b
(>>=) = Tabulation k a -> (a -> Tabulation k b) -> Tabulation k b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)


-- | If @'Tabulation' k a@ is @Map k (NonEmpty a)@, then @(<|>:)@ is
-- @unionWith (<>)@.
instance EqTable k => AltTable (Tabulation k) where
  Tabulation k a
tas <|>: :: Tabulation k a -> Tabulation k a -> Tabulation k a
<|>: Tabulation k a
tbs = do
    Either (Query a) (Query (k, a))
eas <- Tabulation k a -> Tabulation k (Either (Query a) (Query (k, a)))
forall k a.
Tabulation k a -> Tabulation k (Either (Query a) (Query (k, a)))
peek Tabulation k a
tas
    Either (Query a) (Query (k, a))
ebs <- Tabulation k a -> Tabulation k (Either (Query a) (Query (k, a)))
forall k a.
Tabulation k a -> Tabulation k (Either (Query a) (Query (k, a)))
peek Tabulation k a
tbs
    case (Either (Query a) (Query (k, a))
eas, Either (Query a) (Query (k, a))
ebs) of
      (Left Query a
as, Left Query a
bs) -> Query a -> Tabulation k a
forall a k. Query a -> Tabulation k a
liftQuery (Query a -> Tabulation k a) -> Query a -> Tabulation k a
forall a b. (a -> b) -> a -> b
$ Query a
as Query a -> Query a -> Query a
forall (f :: * -> *) a.
(AltTable f, Table Expr a) =>
f a -> f a -> f a
<|>: Query a
bs
      (Right Query (k, a)
as, Right Query (k, a)
bs) -> Query (k, a) -> Tabulation k a
forall k a. Query (k, a) -> Tabulation k a
fromQuery (Query (k, a) -> Tabulation k a) -> Query (k, a) -> Tabulation k a
forall a b. (a -> b) -> a -> b
$ Query (k, a)
as Query (k, a) -> Query (k, a) -> Query (k, a)
forall (f :: * -> *) a.
(AltTable f, Table Expr a) =>
f a -> f a -> f a
<|>: Query (k, a)
bs
      (Either (Query a) (Query (k, a)), Either (Query a) (Query (k, a)))
_ -> NonEmptyTable Expr a -> Query a
forall a. Table Expr a => NonEmptyTable Expr a -> Query a
catNonEmptyTable (NonEmptyTable Expr a -> Query a)
-> Tabulation k (NonEmptyTable Expr a) -> Tabulation k a
forall a b k. (a -> Query b) -> Tabulation k a -> Tabulation k b
`through` (Tabulation k (NonEmptyTable Expr a)
-> Tabulation k (NonEmptyTable Expr a)
-> Tabulation k (NonEmptyTable Expr a)
forall a. Semigroup a => a -> a -> a
(<>) (Tabulation k (NonEmptyTable Expr a)
 -> Tabulation k (NonEmptyTable Expr a)
 -> Tabulation k (NonEmptyTable Expr a))
-> (Tabulation k a -> Tabulation k (NonEmptyTable Expr a))
-> Tabulation k a
-> Tabulation k a
-> Tabulation k (NonEmptyTable Expr a)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Tabulation k a -> Tabulation k (NonEmptyTable Expr a)
forall k a.
(EqTable k, Table Expr a) =>
Tabulation k a -> Tabulation k (NonEmptyTable Expr a)
some) Tabulation k a
tas Tabulation k a
tbs


instance EqTable k => AlternativeTable (Tabulation k) where
  emptyTable :: Tabulation k a
emptyTable = (Predicate k -> Query (Key k, a)) -> Tabulation k a
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, a)) -> Tabulation k a)
-> (Predicate k -> Query (Key k, a)) -> Tabulation k a
forall a b. (a -> b) -> a -> b
$ Query (Key k, a) -> Predicate k -> Query (Key k, a)
forall a b. a -> b -> a
const (Query (Key k, a) -> Predicate k -> Query (Key k, a))
-> Query (Key k, a) -> Predicate k -> Query (Key k, a)
forall a b. (a -> b) -> a -> b
$ (a -> (Key k, a)) -> Query a -> Query (Key k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key k
forall (f :: * -> *) a. Alternative f => f a
empty,) Query a
forall (f :: * -> *) a. (AlternativeTable f, Table Expr a) => f a
emptyTable


-- | If @'Tabulation' k a@ is @Map k (NonEmpty a)@, then @(<>)@ is
-- @unionWith (liftA2 (<>))@.
instance (EqTable k, Table Expr a, Semigroup a) => Semigroup (Tabulation k a)
 where
  <> :: Tabulation k a -> Tabulation k a -> Tabulation k a
(<>) = (TheseTable Expr a a -> a)
-> Tabulation k a -> Tabulation k a -> Tabulation k a
forall k a b c.
EqTable k =>
(TheseTable Expr a b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith ((a -> a) -> (a -> a) -> (a -> a -> a) -> TheseTable Expr a a -> a
forall c a b.
Table Expr c =>
(a -> c) -> (b -> c) -> (a -> b -> c) -> TheseTable Expr a b -> c
theseTable a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>))


instance (EqTable k, Table Expr a, Semigroup a) => Monoid (Tabulation k a)
 where
  mempty :: Tabulation k a
mempty = Tabulation k a
forall (f :: * -> *) a. (AlternativeTable f, Table Expr a) => f a
emptyTable


-- | Any 'Query' of key-value pairs @(k, a)@ can be a @'Tabulation' k a@.
fromQuery :: Query (k, a) -> Tabulation k a
fromQuery :: Query (k, a) -> Tabulation k a
fromQuery = (Predicate k -> Query (Key k, a)) -> Tabulation k a
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, a)) -> Tabulation k a)
-> (Query (k, a) -> Predicate k -> Query (Key k, a))
-> Query (k, a)
-> Tabulation k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query (Key k, a) -> Predicate k -> Query (Key k, a)
forall a b. a -> b -> a
const (Query (Key k, a) -> Predicate k -> Query (Key k, a))
-> (Query (k, a) -> Query (Key k, a))
-> Query (k, a)
-> Predicate k
-> Query (Key k, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, a) -> (Key k, a)) -> Query (k, a) -> Query (Key k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((k -> Key k) -> (k, a) -> (Key k, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first k -> Key k
forall (f :: * -> *) a. Applicative f => a -> f a
pure)


-- | 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 'Tabulation's 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'.
toQuery :: Table Expr k => Tabulation k a -> Query (k, a)
toQuery :: Tabulation k a -> Query (k, a)
toQuery (Tabulation Predicate k -> Query (Key k, a)
f) = do
  (Key k
mk, a
a) <- Predicate k -> Query (Key k, a)
f Predicate k
forall a. Monoid a => a
mempty
  k
k <- Key k -> Query k
forall k. Table Expr k => Key k -> Query k
cat Key k
mk
  (k, a) -> Query (k, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k
k, a
a)


-- | A @'Query' a@ can be treated as a @'Tabulation' k a@ where the given @a@
-- values exist at every possible key @k@.
liftQuery :: Query a -> Tabulation k a
liftQuery :: Query a -> Tabulation k a
liftQuery = (Predicate k -> Query (Key k, a)) -> Tabulation k a
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, a)) -> Tabulation k a)
-> (Query a -> Predicate k -> Query (Key k, a))
-> Query a
-> Tabulation k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query (Key k, a) -> Predicate k -> Query (Key k, a)
forall a b. a -> b -> a
const (Query (Key k, a) -> Predicate k -> Query (Key k, a))
-> (Query a -> Query (Key k, a))
-> Query a
-> Predicate k
-> Query (Key k, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (Key k, a)) -> Query a -> Query (Key k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key k
forall (f :: * -> *) a. Alternative f => f a
empty,)


-- | Run a Kleisli arrow in the the 'Query' monad \"through\" a 'Tabulation'.
-- Useful for 'Rel8.filter'ing a 'Tabulation'.
--
-- @
-- 'Rel8.filter' ((>=. 30) . userAge) `'through'` usersById
-- @
through :: (a -> Query b) -> Tabulation k a -> Tabulation k b
through :: (a -> Query b) -> Tabulation k a -> Tabulation k b
through a -> Query b
f (Tabulation Predicate k -> Query (Key k, a)
as) = (Predicate k -> Query (Key k, b)) -> Tabulation k b
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, b)) -> Tabulation k b)
-> (Predicate k -> Query (Key k, b)) -> Tabulation k b
forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> do
  (Key k
k, a
a) <- Predicate k -> Query (Key k, a)
as Predicate k
p
  b
b <- a -> Query b
f a
a
  (Key k, b) -> Query (Key k, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key k
k, b
b)
infixr 1 `through`


-- | @'lookup' k t@ returns the value(s) at the key @k@ in the tabulation @t@.
lookup :: EqTable k => k -> Tabulation k a -> Query a
lookup :: k -> Tabulation k a -> Query a
lookup k
k (Tabulation Predicate k -> Query (Key k, a)
f) = do
  (Key k
k', a
a) <- Predicate k -> Query (Key k, a)
f Predicate k
p
  Predicate k -> Key k -> Query ()
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p Key k
k'
  a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  where
    p :: Predicate k
p = Key k -> Predicate k
forall k. EqTable k => Key k -> Predicate k
match (k -> Key k
forall (f :: * -> *) a. Applicative f => a -> f a
pure k
k)


-- | 'aggregate' aggregates the values within each key of a
-- 'Tabulation'. There is an implicit @GROUP BY@ on all the key columns.
aggregate :: forall k aggregates exprs.
  ( EqTable k
  , Aggregates aggregates exprs
  )
  => Tabulation k aggregates -> Tabulation k exprs
aggregate :: Tabulation k aggregates -> Tabulation k exprs
aggregate (Tabulation Predicate k -> Query (Key k, aggregates)
f) = (Predicate k -> Query (Key k, exprs)) -> Tabulation k exprs
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, exprs)) -> Tabulation k exprs)
-> (Predicate k -> Query (Key k, exprs)) -> Tabulation k exprs
forall a b. (a -> b) -> a -> b
$
  (Select (Key (Columns k Aggregate), aggregates)
 -> Select (Key k, exprs))
-> Query (Key (Columns k Aggregate), aggregates)
-> Query (Key k, exprs)
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye (Aggregator (Key (Columns k Aggregate), aggregates) (Key k, exprs)
-> Select (Key (Columns k Aggregate), aggregates)
-> Select (Key k, exprs)
forall a b. Aggregator a b -> Select a -> Select b
Opaleye.aggregate (Aggregator (Columns k Aggregate) k
-> Aggregator aggregates exprs
-> Aggregator
     (Key (Columns k Aggregate), aggregates) (Key k, exprs)
forall (p :: * -> * -> *) k l a b.
(ProductProfunctor p, SumProfunctor p) =>
p k l -> p a b -> p (Key k, a) (Key l, b)
keyed Aggregator (Columns k Aggregate) k
haggregator Aggregator aggregates exprs
forall aggregates exprs.
Aggregates aggregates exprs =>
Aggregator aggregates exprs
aggregator)) (Query (Key (Columns k Aggregate), aggregates)
 -> Query (Key k, exprs))
-> (Predicate k -> Query (Key (Columns k Aggregate), aggregates))
-> Predicate k
-> Query (Key k, exprs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ((Key k, aggregates) -> (Key (Columns k Aggregate), aggregates))
-> Query (Key k, aggregates)
-> Query (Key (Columns k Aggregate), aggregates)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key k -> Key (Columns k Aggregate))
-> (Key k, aggregates) -> (Key (Columns k Aggregate), aggregates)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((k -> Columns k Aggregate) -> Key k -> Key (Columns k Aggregate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Columns k (Dict (Sql DBEq))
-> Columns k Expr -> Columns k Aggregate
forall (t :: HTable).
HTable t =>
t (Dict (Sql DBEq)) -> t Expr -> t Aggregate
hgroupBy (EqTable k => Columns k (Dict (Sql DBEq))
forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @k) (Columns k Expr -> Columns k Aggregate)
-> (k -> Columns k Expr) -> k -> Columns k Aggregate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Columns k Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns))) (Query (Key k, aggregates)
 -> Query (Key (Columns k Aggregate), aggregates))
-> (Predicate k -> Query (Key k, aggregates))
-> Predicate k
-> Query (Key (Columns k Aggregate), aggregates)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Predicate k -> Query (Key k, aggregates)
f
  where
    haggregator :: Aggregator (Columns k Aggregate) k
haggregator = (Columns k Aggregate -> Cols Aggregate (Columns k))
-> (Cols Expr (Columns k) -> k)
-> Aggregator (Cols Aggregate (Columns k)) (Cols Expr (Columns k))
-> Aggregator (Columns k Aggregate) k
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Columns k Aggregate -> Cols Aggregate (Columns k)
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns Cols Expr (Columns k) -> k
forall (context :: * -> *) a.
Table context a =>
Cols context (Columns a) -> a
fromCols Aggregator (Cols Aggregate (Columns k)) (Cols Expr (Columns k))
forall aggregates exprs.
Aggregates aggregates exprs =>
Aggregator aggregates exprs
aggregator


-- | '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'.
distinct :: EqTable k => Tabulation k a -> Tabulation k a
distinct :: Tabulation k a -> Tabulation k a
distinct (Tabulation Predicate k -> Query (Key k, a)
f) = (Predicate k -> Query (Key k, a)) -> Tabulation k a
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, a)) -> Tabulation k a)
-> (Predicate k -> Query (Key k, a)) -> Tabulation k a
forall a b. (a -> b) -> a -> b
$
  (Select (Key k, a) -> Select (Key k, a))
-> Query (Key k, a) -> Query (Key k, a)
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye (Unpackspec (Key k) (Key k)
-> ((Key k, a) -> Key k) -> Select (Key k, a) -> Select (Key k, a)
forall b a. Unpackspec b b -> (a -> b) -> Select a -> Select a
Opaleye.distinctOnExplicit (Unpackspec k k -> Unpackspec (Key k) (Key k)
forall (p :: * -> * -> *) a b.
(ProductProfunctor p, SumProfunctor p) =>
p a b -> p (Key a) (Key b)
key Unpackspec k k
forall a. Table Expr a => Unpackspec a a
unpackspec) (Key k, a) -> Key k
forall a b. (a, b) -> a
fst) (Query (Key k, a) -> Query (Key k, a))
-> (Predicate k -> Query (Key k, a))
-> Predicate k
-> Query (Key k, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate k -> Query (Key k, a)
f


-- | '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'.
order :: OrdTable k => Order a -> Tabulation k a -> Tabulation k a
order :: Order a -> Tabulation k a -> Tabulation k a
order Order a
ordering (Tabulation Predicate k -> Query (Key k, a)
f) =
  (Predicate k -> Query (Key k, a)) -> Tabulation k a
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, a)) -> Tabulation k a)
-> (Predicate k -> Query (Key k, a)) -> Tabulation k a
forall a b. (a -> b) -> a -> b
$ (Select (Key k, a) -> Select (Key k, a))
-> Query (Key k, a) -> Query (Key k, a)
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye (Order (Key k, a) -> Select (Key k, a) -> Select (Key k, a)
forall a. Order a -> Select a -> Select a
Opaleye.orderBy Order (Key k, a)
ordering') (Query (Key k, a) -> Query (Key k, a))
-> (Predicate k -> Query (Key k, a))
-> Predicate k
-> Query (Key k, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate k -> Query (Key k, a)
f
  where
    Order Order (Key k, a)
ordering' = Clown Order (Key k, a) (Key Any, Any) -> Order (Key k, a)
forall k1 (f :: k1 -> *) (a :: k1) k2 (b :: k2). Clown f a b -> f a
runClown (Clown Order k Any
-> Clown Order a Any -> Clown Order (Key k, a) (Key Any, Any)
forall (p :: * -> * -> *) k l a b.
(ProductProfunctor p, SumProfunctor p) =>
p k l -> p a b -> p (Key k, a) (Key l, b)
keyed (Order k -> Clown Order k Any
forall k k1 (f :: k -> *) (a :: k) (b :: k1). f a -> Clown f a b
Clown Order k
forall a. OrdTable a => Order a
ascTable) (Order a -> Clown Order a Any
forall k k1 (f :: k -> *) (a :: k) (b :: k1). f a -> Clown f a b
Clown Order a
ordering))


-- $magic
--
-- Some of the following combinators produce \"magic\" 'Tabulation's. 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' 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'.
count :: EqTable k => Tabulation k a -> Tabulation k (Expr Int64)
count :: Tabulation k a -> Tabulation k (Expr Int64)
count =
  (MaybeTable Expr (Expr Int64) -> Expr Int64)
-> Tabulation k (MaybeTable Expr (Expr Int64))
-> Tabulation k (Expr Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Expr Int64
-> (Expr Int64 -> Expr Int64)
-> MaybeTable Expr (Expr Int64)
-> Expr Int64
forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable Expr Int64
0 Expr Int64 -> Expr Int64
forall a. a -> a
id) (Tabulation k (MaybeTable Expr (Expr Int64))
 -> Tabulation k (Expr Int64))
-> (Tabulation k a -> Tabulation k (MaybeTable Expr (Expr Int64)))
-> Tabulation k a
-> Tabulation k (Expr Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Tabulation k (Expr Int64)
-> Tabulation k (MaybeTable Expr (Expr Int64))
forall k a. Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional (Tabulation k (Expr Int64)
 -> Tabulation k (MaybeTable Expr (Expr Int64)))
-> (Tabulation k a -> Tabulation k (Expr Int64))
-> Tabulation k a
-> Tabulation k (MaybeTable Expr (Expr Int64))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Tabulation k (Aggregate Int64) -> Tabulation k (Expr Int64)
forall k aggregates exprs.
(EqTable k, Aggregates aggregates exprs) =>
Tabulation k aggregates -> Tabulation k exprs
aggregate (Tabulation k (Aggregate Int64) -> Tabulation k (Expr Int64))
-> (Tabulation k a -> Tabulation k (Aggregate Int64))
-> Tabulation k a
-> Tabulation k (Expr Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> Aggregate Int64)
-> Tabulation k a -> Tabulation k (Aggregate Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Aggregate Int64 -> a -> Aggregate Int64
forall a b. a -> b -> a
const Aggregate Int64
countStar)


-- | 'optional' produces a \"magic\" 'Tabulation' whereby each
-- entry in the given 'Tabulation' is wrapped in 'Rel8.justTable', and every
-- other possible key contains a single 'Rel8.nothingTable'.
--
-- This is used to implement 'leftAlignWith'.
optional :: Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional :: Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional (Tabulation Predicate k -> Query (Key k, a)
f) = (Predicate k -> Query (Key k, MaybeTable Expr a))
-> Tabulation k (MaybeTable Expr a)
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, MaybeTable Expr a))
 -> Tabulation k (MaybeTable Expr a))
-> (Predicate k -> Query (Key k, MaybeTable Expr a))
-> Tabulation k (MaybeTable Expr a)
forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> case Predicate k
p of
  Predicate Maybe (k -> Expr Bool)
Nothing -> (a -> MaybeTable Expr a)
-> (Key k, a) -> (Key k, MaybeTable Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> MaybeTable Expr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Key k, a) -> (Key k, MaybeTable Expr a))
-> Query (Key k, a) -> Query (Key k, MaybeTable Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Predicate k -> Query (Key k, a)
f Predicate k
p
  Predicate k
_ -> (MaybeTable Expr (Key k, a) -> (Key k, MaybeTable Expr a))
-> Query (MaybeTable Expr (Key k, a))
-> Query (Key k, MaybeTable Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\MaybeTable Expr (Key k, a)
m -> (Key k
forall (f :: * -> *) a. Alternative f => f a
empty, (Key k, a) -> a
forall a b. (a, b) -> b
snd ((Key k, a) -> a)
-> MaybeTable Expr (Key k, a) -> MaybeTable Expr a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeTable Expr (Key k, a)
m)) (Query (MaybeTable Expr (Key k, a))
 -> Query (Key k, MaybeTable Expr a))
-> Query (MaybeTable Expr (Key k, a))
-> Query (Key k, MaybeTable Expr a)
forall a b. (a -> b) -> a -> b
$ Query (Key k, a) -> Query (MaybeTable Expr (Key k, a))
forall a. Query a -> Query (MaybeTable Expr a)
Q.optional (Query (Key k, a) -> Query (MaybeTable Expr (Key k, a)))
-> Query (Key k, a) -> Query (MaybeTable Expr (Key k, a))
forall a b. (a -> b) -> a -> b
$ do
    (Key k
k, a
a) <- Predicate k -> Query (Key k, a)
f Predicate k
p
    Predicate k -> Key k -> Query ()
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p Key k
k
    (Key k, a) -> Query (Key k, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key k
k, a
a)


-- | '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'.
many :: (EqTable k, Table Expr a)
  => Tabulation k a -> Tabulation k (ListTable Expr a)
many :: Tabulation k a -> Tabulation k (ListTable Expr a)
many =
  (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a)))
 -> ListTable Expr a)
-> Tabulation
     k (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a))))
-> Tabulation k (ListTable Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ListTable Expr a
-> (ListTable Expr (Cols Expr (Columns a)) -> ListTable Expr a)
-> MaybeTable Expr (ListTable Expr (Cols Expr (Columns a)))
-> ListTable Expr a
forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable ListTable Expr a
forall a. Monoid a => a
mempty (\(ListTable HListTable
  (Columns (Cols Expr (Columns a))) (Context (Cols Expr (Columns a)))
a) -> HListTable (Columns a) (Context a) -> ListTable Expr a
forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable HListTable (Columns a) (Context a)
HListTable
  (Columns (Cols Expr (Columns a))) (Context (Cols Expr (Columns a)))
a)) (Tabulation
   k (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a))))
 -> Tabulation k (ListTable Expr a))
-> (Tabulation k a
    -> Tabulation
         k (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a)))))
-> Tabulation k a
-> Tabulation k (ListTable Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Tabulation k (ListTable Expr (Cols Expr (Columns a)))
-> Tabulation
     k (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a))))
forall k a. Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional (Tabulation k (ListTable Expr (Cols Expr (Columns a)))
 -> Tabulation
      k (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a)))))
-> (Tabulation k a
    -> Tabulation k (ListTable Expr (Cols Expr (Columns a))))
-> Tabulation k a
-> Tabulation
     k (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Tabulation k (ListTable Aggregate (Cols Aggregate (Columns a)))
-> Tabulation k (ListTable Expr (Cols Expr (Columns a)))
forall k aggregates exprs.
(EqTable k, Aggregates aggregates exprs) =>
Tabulation k aggregates -> Tabulation k exprs
aggregate (Tabulation k (ListTable Aggregate (Cols Aggregate (Columns a)))
 -> Tabulation k (ListTable Expr (Cols Expr (Columns a))))
-> (Tabulation k a
    -> Tabulation k (ListTable Aggregate (Cols Aggregate (Columns a))))
-> Tabulation k a
-> Tabulation k (ListTable Expr (Cols Expr (Columns a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> ListTable Aggregate (Cols Aggregate (Columns a)))
-> Tabulation k a
-> Tabulation k (ListTable Aggregate (Cols Aggregate (Columns a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Cols Expr (Columns a)
-> ListTable Aggregate (Cols Aggregate (Columns a))
forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> ListTable Aggregate aggregates
listAgg (Cols Expr (Columns a)
 -> ListTable Aggregate (Cols Aggregate (Columns a)))
-> (a -> Cols Expr (Columns a))
-> a
-> ListTable Aggregate (Cols Aggregate (Columns a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Cols Expr (Columns a)
forall (context :: * -> *) a.
Table context a =>
a -> Cols context (Columns a)
toCols)


-- | '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.
some :: (EqTable k, Table Expr a)
  => Tabulation k a -> Tabulation k (NonEmptyTable Expr a)
some :: Tabulation k a -> Tabulation k (NonEmptyTable Expr a)
some =
  (NonEmptyTable Expr (Cols Expr (Columns a))
 -> NonEmptyTable Expr a)
-> Tabulation k (NonEmptyTable Expr (Cols Expr (Columns a)))
-> Tabulation k (NonEmptyTable Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(NonEmptyTable HNonEmptyTable
  (Columns (Cols Expr (Columns a))) (Context (Cols Expr (Columns a)))
a) -> HNonEmptyTable (Columns a) (Context a) -> NonEmptyTable Expr a
forall (context :: * -> *) a.
HNonEmptyTable (Columns a) (Context a) -> NonEmptyTable context a
NonEmptyTable HNonEmptyTable (Columns a) (Context a)
HNonEmptyTable
  (Columns (Cols Expr (Columns a))) (Context (Cols Expr (Columns a)))
a) (Tabulation k (NonEmptyTable Expr (Cols Expr (Columns a)))
 -> Tabulation k (NonEmptyTable Expr a))
-> (Tabulation k a
    -> Tabulation k (NonEmptyTable Expr (Cols Expr (Columns a))))
-> Tabulation k a
-> Tabulation k (NonEmptyTable Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Tabulation k (NonEmptyTable Aggregate (Cols Aggregate (Columns a)))
-> Tabulation k (NonEmptyTable Expr (Cols Expr (Columns a)))
forall k aggregates exprs.
(EqTable k, Aggregates aggregates exprs) =>
Tabulation k aggregates -> Tabulation k exprs
aggregate (Tabulation
   k (NonEmptyTable Aggregate (Cols Aggregate (Columns a)))
 -> Tabulation k (NonEmptyTable Expr (Cols Expr (Columns a))))
-> (Tabulation k a
    -> Tabulation
         k (NonEmptyTable Aggregate (Cols Aggregate (Columns a))))
-> Tabulation k a
-> Tabulation k (NonEmptyTable Expr (Cols Expr (Columns a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> NonEmptyTable Aggregate (Cols Aggregate (Columns a)))
-> Tabulation k a
-> Tabulation
     k (NonEmptyTable Aggregate (Cols Aggregate (Columns a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Cols Expr (Columns a)
-> NonEmptyTable Aggregate (Cols Aggregate (Columns a))
forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> NonEmptyTable Aggregate aggregates
nonEmptyAgg (Cols Expr (Columns a)
 -> NonEmptyTable Aggregate (Cols Aggregate (Columns a)))
-> (a -> Cols Expr (Columns a))
-> a
-> NonEmptyTable Aggregate (Cols Aggregate (Columns a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Cols Expr (Columns a)
forall (context :: * -> *) a.
Table context a =>
a -> Cols context (Columns a)
toCols)


-- | 'exists' produces a \"magic\" 'Tabulation' which contains the
-- value 'Rel8.true' at each key in the given 'Tabulation', and the value
-- 'Rel8.false' at every other possible key.
exists :: Tabulation k a -> Tabulation k (Expr Bool)
exists :: Tabulation k a -> Tabulation k (Expr Bool)
exists (Tabulation Predicate k -> Query (Key k, a)
f) = (Predicate k -> Query (Key k, Expr Bool))
-> Tabulation k (Expr Bool)
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, Expr Bool))
 -> Tabulation k (Expr Bool))
-> (Predicate k -> Query (Key k, Expr Bool))
-> Tabulation k (Expr Bool)
forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> case Predicate k
p of
  Predicate Maybe (k -> Expr Bool)
Nothing -> (Expr Bool
true Expr Bool -> (Key k, a) -> (Key k, Expr Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) ((Key k, a) -> (Key k, Expr Bool))
-> Query (Key k, a) -> Query (Key k, Expr Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Predicate k -> Query (Key k, a)
f Predicate k
p
  Predicate k
_ -> (Expr Bool -> (Key k, Expr Bool))
-> Query (Expr Bool) -> Query (Key k, Expr Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key k
forall (f :: * -> *) a. Alternative f => f a
empty,) (Query (Expr Bool) -> Query (Key k, Expr Bool))
-> Query (Expr Bool) -> Query (Key k, Expr Bool)
forall a b. (a -> b) -> a -> b
$ Query () -> Query (Expr Bool)
forall a. Query a -> Query (Expr Bool)
Q.exists (Query () -> Query (Expr Bool)) -> Query () -> Query (Expr Bool)
forall a b. (a -> b) -> a -> b
$ do
    (Key k
k, a
_) <- Predicate k -> Query (Key k, a)
f Predicate k
p
    Predicate k -> Key k -> Query ()
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p Key k
k


-- | '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'.
present :: Tabulation k a -> Tabulation k ()
present :: Tabulation k a -> Tabulation k ()
present (Tabulation Predicate k -> Query (Key k, a)
f) = (Predicate k -> Query (Key k, ())) -> Tabulation k ()
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, ())) -> Tabulation k ())
-> (Predicate k -> Query (Key k, ())) -> Tabulation k ()
forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> do
  Query () -> Query ()
forall a. Query a -> Query ()
Q.present (Query () -> Query ()) -> Query () -> Query ()
forall a b. (a -> b) -> a -> b
$ do
    (Key k
k, a
_) <- Predicate k -> Query (Key k, a)
f Predicate k
p
    Predicate k -> Key k -> Query ()
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p Key k
k
  (Key k, ()) -> Query (Key k, ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key k
forall (f :: * -> *) a. Alternative f => f a
empty, ())


-- | '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'.
absent :: Tabulation k a -> Tabulation k ()
absent :: Tabulation k a -> Tabulation k ()
absent (Tabulation Predicate k -> Query (Key k, a)
f) = (Predicate k -> Query (Key k, ())) -> Tabulation k ()
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, ())) -> Tabulation k ())
-> (Predicate k -> Query (Key k, ())) -> Tabulation k ()
forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> do
  Query () -> Query ()
forall a. Query a -> Query ()
Q.absent (Query () -> Query ()) -> Query () -> Query ()
forall a b. (a -> b) -> a -> b
$ do
    (Key k
k, a
_) <- Predicate k -> Query (Key k, a)
f Predicate k
p
    Predicate k -> Key k -> Query ()
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p Key k
k
  (Key k, ()) -> Query (Key k, ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key k
forall (f :: * -> *) a. Alternative f => f a
empty, ())


-- | Performs a @NATURAL FULL OUTER JOIN@ based on the common key columns.
--
-- Analogous to 'Data.Semialign.align'.
align :: EqTable k
  => Tabulation k a -> Tabulation k b -> Tabulation k (TheseTable Expr a b)
align :: Tabulation k a
-> Tabulation k b -> Tabulation k (TheseTable Expr a b)
align = (TheseTable Expr a b -> TheseTable Expr a b)
-> Tabulation k a
-> Tabulation k b
-> Tabulation k (TheseTable Expr a b)
forall k a b c.
EqTable k =>
(TheseTable Expr a b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith TheseTable Expr a b -> TheseTable Expr a b
forall a. a -> a
id


-- | Performs a @NATURAL FULL OUTER JOIN@ based on the common key columns.
--
-- Analogous to 'Data.Semialign.alignWith'.
alignWith :: EqTable k
  => (TheseTable Expr a b -> c)
  -> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith :: (TheseTable Expr a b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith TheseTable Expr a b -> c
f (Tabulation Predicate k -> Query (Key k, a)
as) (Tabulation Predicate k -> Query (Key k, b)
bs) = (Predicate k -> Query (Key k, c)) -> Tabulation k c
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, c)) -> Tabulation k c)
-> (Predicate k -> Query (Key k, c)) -> Tabulation k c
forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> do
  TheseTable Expr (Key k, a) (Key k, b)
tkab <- (Query (Key k, a)
 -> Query (Key k, b)
 -> Query (TheseTable Expr (Key k, a) (Key k, b)))
-> (Predicate k -> Query (Key k, a))
-> (Predicate k -> Query (Key k, b))
-> Predicate k
-> Query (TheseTable Expr (Key k, a) (Key k, b))
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 (((Key k, a) -> (Key k, b) -> Expr Bool)
-> Query (Key k, a)
-> Query (Key k, b)
-> Query (TheseTable Expr (Key k, a) (Key k, b))
forall a b.
(a -> b -> Expr Bool)
-> Query a -> Query b -> Query (TheseTable Expr a b)
alignBy (Key k, a) -> (Key k, b) -> Expr Bool
forall a b b.
EqTable a =>
(Maybe a, b) -> (Maybe a, b) -> Expr Bool
condition) Predicate k -> Query (Key k, a)
as Predicate k -> Query (Key k, b)
bs Predicate k
p
  let
    k :: Key k
k = TheseTable Expr (Key k) (Key k) -> Key k
forall a.
Table Expr a =>
TheseTable Expr (Maybe a) (Maybe a) -> Maybe a
recover (TheseTable Expr (Key k) (Key k) -> Key k)
-> TheseTable Expr (Key k) (Key k) -> Key k
forall a b. (a -> b) -> a -> b
$ ((Key k, a) -> Key k)
-> ((Key k, b) -> Key k)
-> TheseTable Expr (Key k, a) (Key k, b)
-> TheseTable Expr (Key k) (Key k)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Key k, a) -> Key k
forall a b. (a, b) -> a
fst (Key k, b) -> Key k
forall a b. (a, b) -> a
fst TheseTable Expr (Key k, a) (Key k, b)
tkab
    tab :: TheseTable Expr a b
tab = ((Key k, a) -> a)
-> ((Key k, b) -> b)
-> TheseTable Expr (Key k, a) (Key k, b)
-> TheseTable Expr a b
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Key k, a) -> a
forall a b. (a, b) -> b
snd (Key k, b) -> b
forall a b. (a, b) -> b
snd TheseTable Expr (Key k, a) (Key k, b)
tkab
  (Key k, c) -> Query (Key k, c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key k
k, TheseTable Expr a b -> c
f TheseTable Expr a b
tab)
  where
    condition :: (Maybe a, b) -> (Maybe a, b) -> Expr Bool
condition (Maybe a
k, b
_) (Maybe a
k', b
_) = Expr Bool -> Maybe (Expr Bool) -> Expr Bool
forall a. a -> Maybe a -> a
fromMaybe Expr Bool
true ((a -> a -> Expr Bool) -> Maybe a -> Maybe a -> Maybe (Expr Bool)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Expr Bool
forall a. EqTable a => a -> a -> Expr Bool
(==:) Maybe a
k Maybe a
k')
    recover :: TheseTable Expr (Maybe a) (Maybe a) -> Maybe a
recover (TheseTable mma :: MaybeTable Expr (Maybe a)
mma@(MaybeTable Expr (Maybe MaybeTag)
_ Nullify Expr (Maybe a)
ma) mmb :: MaybeTable Expr (Maybe a)
mmb@(MaybeTable Expr (Maybe MaybeTag)
_ Nullify Expr (Maybe a)
mb)) =
      case Nullify Expr (Maybe a) -> Maybe a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr (Maybe a)
ma of
        Maybe a
Nothing -> Nullify Expr (Maybe a) -> Maybe a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr (Maybe a)
mb
        Just a
a -> case Nullify Expr (Maybe a) -> Maybe a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr (Maybe a)
mb of
          Maybe a
Nothing -> Nullify Expr (Maybe a) -> Maybe a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr (Maybe a)
ma
          Just a
b -> case a
a a -> MaybeTable Expr (Maybe a) -> MaybeTable Expr a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MaybeTable Expr (Maybe a)
mma MaybeTable Expr a -> MaybeTable Expr a -> MaybeTable Expr a
forall (f :: * -> *) a.
(AltTable f, Table Expr a) =>
f a -> f a -> f a
<|>: a
b a -> MaybeTable Expr (Maybe a) -> MaybeTable Expr a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MaybeTable Expr (Maybe a)
mmb of
            MaybeTable Expr (Maybe MaybeTag)
_ Nullify Expr a
c -> a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nullify Expr a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr a
c)


-- | Performs a @NATURAL LEFT OUTER JOIN@ based on the common key columns.
--
-- Analogous to 'Data.Semialign.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.
leftAlign :: EqTable k
  => Tabulation k a -> Tabulation k b -> Tabulation k (a, MaybeTable Expr b)
leftAlign :: Tabulation k a
-> Tabulation k b -> Tabulation k (a, MaybeTable Expr b)
leftAlign = (a -> MaybeTable Expr b -> (a, MaybeTable Expr b))
-> Tabulation k a
-> Tabulation k b
-> Tabulation k (a, MaybeTable Expr b)
forall k a b c.
EqTable k =>
(a -> MaybeTable Expr b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
leftAlignWith (,)


-- | Performs a @NATURAL LEFT OUTER JOIN@ based on the common key columns.
--
-- Analogous to 'Data.Semialign.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.
leftAlignWith :: EqTable k
  => (a -> MaybeTable Expr b -> c)
  -> Tabulation k a -> Tabulation k b -> Tabulation k c
leftAlignWith :: (a -> MaybeTable Expr b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
leftAlignWith a -> MaybeTable Expr b -> c
f Tabulation k a
left Tabulation k b
right = (a -> MaybeTable Expr b -> c)
-> Tabulation k a
-> Tabulation k (MaybeTable Expr b)
-> Tabulation k c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> MaybeTable Expr b -> c
f Tabulation k a
left (Tabulation k b -> Tabulation k (MaybeTable Expr b)
forall k a. Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional Tabulation k b
right)


-- | Performs a @NATURAL RIGHT OUTER JOIN@ based on the common key columns.
--
-- Analogous to 'Data.Semialign.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.
rightAlign :: EqTable k
  => Tabulation k a -> Tabulation k b -> Tabulation k (MaybeTable Expr a, b)
rightAlign :: Tabulation k a
-> Tabulation k b -> Tabulation k (MaybeTable Expr a, b)
rightAlign = (MaybeTable Expr a -> b -> (MaybeTable Expr a, b))
-> Tabulation k a
-> Tabulation k b
-> Tabulation k (MaybeTable Expr a, b)
forall k a b c.
EqTable k =>
(MaybeTable Expr a -> b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
rightAlignWith (,)


-- | Performs a @NATURAL RIGHT OUTER JOIN@ based on the common key columns.
--
-- Analogous to 'Data.Semialign.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.
rightAlignWith :: EqTable k
  => (MaybeTable Expr a -> b -> c)
  -> Tabulation k a -> Tabulation k b -> Tabulation k c
rightAlignWith :: (MaybeTable Expr a -> b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
rightAlignWith MaybeTable Expr a -> b -> c
f Tabulation k a
left Tabulation k b
right = (b -> MaybeTable Expr a -> c)
-> Tabulation k b
-> Tabulation k (MaybeTable Expr a)
-> Tabulation k c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((MaybeTable Expr a -> b -> c) -> b -> MaybeTable Expr a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip MaybeTable Expr a -> b -> c
f) Tabulation k b
right (Tabulation k a -> Tabulation k (MaybeTable Expr a)
forall k a. Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional Tabulation k a
left)


-- | Performs a @NATURAL INNER JOIN@ based on the common key columns.
--
-- Analagous to 'Data.Semialign.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.
zip :: EqTable k
  => Tabulation k a -> Tabulation k b -> Tabulation k (a, b)
zip :: Tabulation k a -> Tabulation k b -> Tabulation k (a, b)
zip = (a -> b -> (a, b))
-> Tabulation k a -> Tabulation k b -> Tabulation k (a, b)
forall k a b c.
EqTable k =>
(a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
zipWith (,)


-- | Performs a @NATURAL INNER JOIN@ based on the common key columns.
--
-- Analagous to 'Data.Semialign.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.
zipWith :: EqTable k
  => (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
zipWith :: (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
zipWith = (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2


-- | Performs a [@NATURAL SEMI JOIN@](https://en.wikipedia.org/wiki/Relational_algebra#Semijoin_%28%E2%8B%89%29%28%E2%8B%8A%29)
-- 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.
similarity :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a
similarity :: Tabulation k a -> Tabulation k b -> Tabulation k a
similarity Tabulation k a
a Tabulation k b
b = Tabulation k a
a Tabulation k a -> Tabulation k () -> Tabulation k a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tabulation k b -> Tabulation k ()
forall k a. Tabulation k a -> Tabulation k ()
present Tabulation k b
b


-- | Performs a [@NATURAL ANTI JOIN@](https://en.wikipedia.org/wiki/Relational_algebra#Antijoin_%28%E2%96%B7%29)
-- 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.
difference :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a
difference :: Tabulation k a -> Tabulation k b -> Tabulation k a
difference Tabulation k a
a Tabulation k b
b = Tabulation k a
a Tabulation k a -> Tabulation k () -> Tabulation k a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tabulation k b -> Tabulation k ()
forall k a. Tabulation k a -> Tabulation k ()
absent Tabulation k b
b


-- | 'Tabulation's can be produced with either 'fromQuery' or 'liftQuery', and
-- in some cases we might want to treat these differently. 'peek' uses
-- 'unsafePeekQuery' to determine which type of 'Tabulation' we have.
peek :: Tabulation k a -> Tabulation k (Either (Query a) (Query (k, a)))
peek :: Tabulation k a -> Tabulation k (Either (Query a) (Query (k, a)))
peek (Tabulation Predicate k -> Query (Key k, a)
f) = (Predicate k -> Query (Key k, Either (Query a) (Query (k, a))))
-> Tabulation k (Either (Query a) (Query (k, a)))
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation ((Predicate k -> Query (Key k, Either (Query a) (Query (k, a))))
 -> Tabulation k (Either (Query a) (Query (k, a))))
-> (Predicate k -> Query (Key k, Either (Query a) (Query (k, a))))
-> Tabulation k (Either (Query a) (Query (k, a)))
forall a b. (a -> b) -> a -> b
$ \Predicate k
p ->
  (Key k, Either (Query a) (Query (k, a)))
-> Query (Key k, Either (Query a) (Query (k, a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Key k, Either (Query a) (Query (k, a)))
 -> Query (Key k, Either (Query a) (Query (k, a))))
-> (Key k, Either (Query a) (Query (k, a)))
-> Query (Key k, Either (Query a) (Query (k, a)))
forall a b. (a -> b) -> a -> b
$ (Key k
forall (f :: * -> *) a. Alternative f => f a
empty,) (Either (Query a) (Query (k, a))
 -> (Key k, Either (Query a) (Query (k, a))))
-> Either (Query a) (Query (k, a))
-> (Key k, Either (Query a) (Query (k, a)))
forall a b. (a -> b) -> a -> b
$ case Query (Key k, a) -> (Key k, a)
forall a. Query a -> a
unsafePeekQuery (Predicate k -> Query (Key k, a)
f Predicate k
p) of
    (Key k
Nothing, a
_) -> Query a -> Either (Query a) (Query (k, a))
forall a b. a -> Either a b
Left (Query a -> Either (Query a) (Query (k, a)))
-> Query a -> Either (Query a) (Query (k, a))
forall a b. (a -> b) -> a -> b
$ ((Key k, a) -> a) -> Query (Key k, a) -> Query a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key k, a) -> a
forall a b. (a, b) -> b
snd (Predicate k -> Query (Key k, a)
f Predicate k
p)
    (Just k
_, a
_) -> Query (k, a) -> Either (Query a) (Query (k, a))
forall a b. b -> Either a b
Right (Query (k, a) -> Either (Query a) (Query (k, a)))
-> Query (k, a) -> Either (Query a) (Query (k, a))
forall a b. (a -> b) -> a -> b
$ ((Key k, a) -> (k, a)) -> Query (Key k, a) -> Query (k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key k -> k) -> (Key k, a) -> (k, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key k -> k
forall a. HasCallStack => Maybe a -> a
fromJust) (Predicate k -> Query (Key k, a)
f Predicate k
p)