{-# language DeriveFunctor #-}
{-# language DerivingStrategies #-}
{-# language FlexibleContexts #-}
{-# language MonoLocalBinds #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TupleSections #-}
{-# language UndecidableInstances #-}

module Rel8.Tabulate
  ( Tabulation
  , tabulate
  , tabulateA
  , runTabulation
  , fromQuery
  , liftQuery
  , prebind
  , postbind
  , indexed
  , ifilter
  , lookup
  , align
  , alignWith
  , leftAlign
  , leftAlignWith
  , zip
  , zipWith
  , similarity
  , difference
  , aggregateTabulation
  , orderTabulation
  , distinctTabulation
  , optionalTabulation
  , manyTabulation
  , someTabulation
  )
where

-- base
import Control.Applicative ( liftA2 )
import Control.Monad ( join, liftM2 )
import Data.Bifunctor ( bimap, first )
import Data.Foldable ( traverse_ )
import Data.Functor.Contravariant ( (>$<) )
import Data.Maybe ( fromMaybe )
import Prelude hiding ( filter, lookup, zip, zipWith )

-- rel8
import Rel8.Aggregate ( Aggregates )
import Rel8.Expr ( Expr )
import Rel8.Order ( Order )
import Rel8.Query ( Query )
import Rel8.Query.Aggregate ( aggregate )
import Rel8.Query.Distinct ( distinctOn )
import Rel8.Query.Exists ( withBy, withoutBy )
import Rel8.Query.Filter ( filter, where_ )
import Rel8.Query.Maybe ( optional )
import Rel8.Query.Order ( orderBy )
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.Eq ( EqTable, (==:), eqTable )
import Rel8.Table.List ( ListTable( ListTable ) )
import Rel8.Table.Maybe ( MaybeTable, maybeTable )
import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
import Rel8.Table.Ord ( OrdTable )
import Rel8.Table.Order ( ascTable )
import Rel8.Table.These ( TheseTable, theseTable )

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


-- | @'Tabulation' k a@ is denotionally a @MultiMap k a@ — a @Map@ where each
-- key @k@ corresponds to potentially multiple @a@ (i.e., @'Query' a@).  This
-- @MultiMap@ supports 'lookup' and other operations you would expect it to.
--
-- \"Identity\" 'Tabulation's are created using 'tabulate'. 'Tabulation's can
-- be composed with 'Query's with 'prebind' or 'postbind' to form new
-- 'Tabulation's.
newtype Tabulation k a = Tabulation (k -> Query (Maybe k, a))
  deriving stock a -> Tabulation k b -> Tabulation k a
(a -> b) -> Tabulation k a -> Tabulation k b
(forall a b. (a -> b) -> Tabulation k a -> Tabulation k b)
-> (forall a b. a -> Tabulation k b -> Tabulation k a)
-> Functor (Tabulation k)
forall a b. a -> Tabulation k b -> Tabulation k a
forall a b. (a -> b) -> Tabulation k a -> Tabulation k b
forall k a b. a -> Tabulation k b -> Tabulation k a
forall k a b. (a -> b) -> Tabulation k a -> Tabulation k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Tabulation k b -> Tabulation k a
$c<$ :: forall k a b. a -> Tabulation k b -> Tabulation k a
fmap :: (a -> b) -> Tabulation k a -> Tabulation k b
$cfmap :: forall k a b. (a -> b) -> Tabulation k a -> Tabulation k b
Functor


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


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
  join :: Tabulation k (Tabulation k a) -> Tabulation k a
join = Tabulation k (Tabulation k a) -> Tabulation k a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join


instance EqTable k => Monad (Tabulation k) where
  Tabulation k -> Query (Maybe k, a)
as >>= :: Tabulation k a -> (a -> Tabulation k b) -> Tabulation k b
>>= a -> Tabulation k b
f = (k -> Query (Maybe k, b)) -> Tabulation k b
forall k a. (k -> Query (Maybe k, a)) -> Tabulation k a
Tabulation ((k -> Query (Maybe k, b)) -> Tabulation k b)
-> (k -> Query (Maybe k, b)) -> Tabulation k b
forall a b. (a -> b) -> a -> b
$ \k
i -> do
    (Maybe k
mk, a
a) <- k -> Query (Maybe k, a)
as k
i
    case Maybe k
mk of
      Maybe k
Nothing -> case a -> Tabulation k b
f a
a of
        Tabulation k -> Query (Maybe k, b)
bs -> k -> Query (Maybe k, b)
bs k
i
      Just k
k -> case a -> Tabulation k b
f a
a of
        Tabulation k -> Query (Maybe k, b)
bs -> do
          (Maybe k
mk', b
b) <- k -> Query (Maybe k, b)
bs k
k
          case Maybe k
mk' of
            Maybe k
Nothing -> (Maybe k, b) -> Query (Maybe k, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe k
mk, b
b)
            Just k
k' -> do
              Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ k
k k -> k -> Expr Bool
forall a. EqTable a => a -> a -> Expr Bool
==: k
k'
              (Maybe k, b) -> Query (Maybe k, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe k
mk', b
b)


instance EqTable k => AltTable (Tabulation k) where
  Tabulation k a
kas <|>: :: Tabulation k a -> Tabulation k a -> Tabulation k a
<|>: Tabulation k a
kbs = do
    Query (k, a)
as <- Tabulation k a -> Tabulation k (Query (k, a))
forall k a. Tabulation k a -> Tabulation k (Query (k, a))
toQuery Tabulation k a
kas
    Query (k, a)
bs <- Tabulation k a -> Tabulation k (Query (k, a))
forall k a. Tabulation k a -> Tabulation k (Query (k, a))
toQuery Tabulation k a
kbs
    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


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


instance (EqTable k, Table Expr a, Semigroup a) => Semigroup (Tabulation k a)
 where
  <> :: Tabulation k a -> Tabulation k a -> Tabulation k a
(<>) = (TheseTable a a -> a)
-> Tabulation k a -> Tabulation k a -> Tabulation k a
forall k a b c.
(EqTable k, Table Expr a, Table Expr b) =>
(TheseTable a b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith ((a -> a) -> (a -> a) -> (a -> a -> a) -> TheseTable a a -> a
forall c a b.
Table Expr c =>
(a -> c) -> (b -> c) -> (a -> b -> c) -> TheseTable 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


runTabulation :: EqTable k => Query k -> Tabulation k a -> Query (k, a)
runTabulation :: Query k -> Tabulation k a -> Query (k, a)
runTabulation Query k
ks Tabulation k a
tabulation = do
  k
k <- Query k
ks
  a
a <- k -> Tabulation k a -> Query a
forall k a. EqTable k => k -> Tabulation k a -> Query a
lookup k
k Tabulation k a
tabulation
  (k, a) -> Query (k, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k
k, a
a)


liftQuery :: Query a -> Tabulation k a
liftQuery :: Query a -> Tabulation k a
liftQuery Query a
query = (k -> Query (Maybe k, a)) -> Tabulation k a
forall k a. (k -> Query (Maybe k, a)) -> Tabulation k a
Tabulation ((k -> Query (Maybe k, a)) -> Tabulation k a)
-> (k -> Query (Maybe k, a)) -> Tabulation k a
forall a b. (a -> b) -> a -> b
$ Query (Maybe k, a) -> k -> Query (Maybe k, a)
forall a b. a -> b -> a
const (Query (Maybe k, a) -> k -> Query (Maybe k, a))
-> Query (Maybe k, a) -> k -> Query (Maybe k, a)
forall a b. (a -> b) -> a -> b
$ (a -> (Maybe k, a)) -> Query a -> Query (Maybe k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe k
forall a. Maybe a
Nothing,) Query a
query


-- | 'tabulate' creates an \"identity\" @'Tabulation' k a@ that allows @a@ be
-- indexed by one or more of its columns @k@. Some examples:
--
-- [Tabulation by primary key]:
--   @
--   projectsById :: Project 'Expr' -> 'Tabulation' ('Expr' ProjectId) (Project 'Expr')
--   projectsById = 'tabulate' projectId
--   @
--
--   Note: the nature of primary keys means that each key will be mapped to a
--   singleton value in this case.
--
-- [Tabulation by other unique key]:
--   @
--   projectsByName :: Project 'Expr' -> 'Tabulation' ('Expr' Text) (Project 'Expr')
--   projectsByName = 'tabulate' projectName
--   @
--
-- [Tabulation by foreign key (tabulate a child table by parent key)]:
--   @
--   revisionsByProjectId :: Revision 'Expr' -> 'Tabulation' ('Expr' ProjectId) (Revision 'Expr')
--   revisionsByProjectId = 'tabulate' revisionProjectId
--   @
tabulate :: (a -> k) -> a -> Tabulation k a
tabulate :: (a -> k) -> a -> Tabulation k a
tabulate a -> k
key a
a = 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
$ (k, a) -> Query (k, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> k
key a
a, a
a)


-- | Like 'tabulate' but takes a monadic 'Query' function instead of a pure
-- one.  This means you can filter rows while calculating the key, which is
-- useful in conjunction with 'Rel8.Extra.catNulls'.
tabulateA :: (a -> Query k) -> a -> Tabulation k a
tabulateA :: (a -> Query k) -> a -> Tabulation k a
tabulateA a -> Query k
key a
a = 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
$ (,a
a) (k -> (k, a)) -> Query k -> Query (k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Query k
key a
a


-- | Analgous to 'Data.Map.Strict.fromList'.
fromQuery :: Query (k, a) -> Tabulation k a
fromQuery :: Query (k, a) -> Tabulation k a
fromQuery = (k -> Query (Maybe k, a)) -> Tabulation k a
forall k a. (k -> Query (Maybe k, a)) -> Tabulation k a
Tabulation ((k -> Query (Maybe k, a)) -> Tabulation k a)
-> (Query (k, a) -> k -> Query (Maybe k, a))
-> Query (k, a)
-> Tabulation k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query (Maybe k, a) -> k -> Query (Maybe k, a)
forall a b. a -> b -> a
const (Query (Maybe k, a) -> k -> Query (Maybe k, a))
-> (Query (k, a) -> Query (Maybe k, a))
-> Query (k, a)
-> k
-> Query (Maybe k, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, a) -> (Maybe k, a)) -> Query (k, a) -> Query (Maybe k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((k -> Maybe k) -> (k, a) -> (Maybe k, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first k -> Maybe k
forall a. a -> Maybe a
Just)


indexed :: Tabulation k a -> Tabulation k (k, a)
indexed :: Tabulation k a -> Tabulation k (k, a)
indexed (Tabulation k -> Query (Maybe k, a)
query) = (k -> Query (Maybe k, (k, a))) -> Tabulation k (k, a)
forall k a. (k -> Query (Maybe k, a)) -> Tabulation k a
Tabulation ((k -> Query (Maybe k, (k, a))) -> Tabulation k (k, a))
-> (k -> Query (Maybe k, (k, a))) -> Tabulation k (k, a)
forall a b. (a -> b) -> a -> b
$ \k
i ->
  (\(Maybe k
mk, a
a) -> (Maybe k
mk, (k -> Maybe k -> k
forall a. a -> Maybe a -> a
fromMaybe k
i Maybe k
mk, a
a))) ((Maybe k, a) -> (Maybe k, (k, a)))
-> Query (Maybe k, a) -> Query (Maybe k, (k, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> Query (Maybe k, a)
query k
i


ifilter :: (k -> a -> Expr Bool) -> Tabulation k a -> Tabulation k a
ifilter :: (k -> a -> Expr Bool) -> Tabulation k a -> Tabulation k a
ifilter k -> a -> Expr Bool
f Tabulation k a
tabulation = (k, a) -> a
forall a b. (a, b) -> b
snd ((k, a) -> a) -> Tabulation k (k, a) -> Tabulation k a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  ((k, a) -> Expr Bool) -> (k, a) -> Query (k, a)
forall a. (a -> Expr Bool) -> a -> Query a
filter ((k -> a -> Expr Bool) -> (k, a) -> Expr Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> a -> Expr Bool
f) ((k, a) -> Query (k, a))
-> Tabulation k (k, a) -> Tabulation k (k, a)
forall a b k. (a -> Query b) -> Tabulation k a -> Tabulation k b
`postbind` Tabulation k a -> Tabulation k (k, a)
forall k a. Tabulation k a -> Tabulation k (k, a)
indexed Tabulation k a
tabulation


-- | Map a 'Query' over the input side of a 'Tabulation'. 
prebind :: (a -> Tabulation k b) -> Query a -> Tabulation k b
prebind :: (a -> Tabulation k b) -> Query a -> Tabulation k b
prebind a -> Tabulation k b
f Query a
as = (k -> Query (Maybe k, b)) -> Tabulation k b
forall k a. (k -> Query (Maybe k, a)) -> Tabulation k a
Tabulation ((k -> Query (Maybe k, b)) -> Tabulation k b)
-> (k -> Query (Maybe k, b)) -> Tabulation k b
forall a b. (a -> b) -> a -> b
$ \k
k -> do
  a
a <- Query a
as
  case a -> Tabulation k b
f a
a of
    Tabulation k -> Query (Maybe k, b)
query -> k -> Query (Maybe k, b)
query k
k
infixr 1 `prebind`


-- | Map a 'Query' over the output side of a 'Tabulation'.
postbind :: (a -> Query b) -> Tabulation k a -> Tabulation k b
postbind :: (a -> Query b) -> Tabulation k a -> Tabulation k b
postbind a -> Query b
f (Tabulation k -> Query (Maybe k, a)
as) = (k -> Query (Maybe k, b)) -> Tabulation k b
forall k a. (k -> Query (Maybe k, a)) -> Tabulation k a
Tabulation ((k -> Query (Maybe k, b)) -> Tabulation k b)
-> (k -> Query (Maybe k, b)) -> Tabulation k b
forall a b. (a -> b) -> a -> b
$ \k
i -> do
  (Maybe k
k, a
a) <- k -> Query (Maybe k, a)
as k
i
  case a -> Query b
f a
a of
    Query b
bs -> do
      b
b <- Query b
bs
      (Maybe k, b) -> Query (Maybe k, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe k
k, b
b)
infixr 1 `postbind`


-- | Note that because 'Tabulation' is a @MultiMap@, the 'Query' returned by
-- 'lookup' can and often does contain multiple results.
lookup :: EqTable k => k -> Tabulation k a -> Query a
lookup :: k -> Tabulation k a -> Query a
lookup k
key (Tabulation k -> Query (Maybe k, a)
query) = do
  (Maybe k
mk, a
a) <- k -> Query (Maybe k, a)
query k
key
  (k -> Query ()) -> Maybe k -> Query ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> (k -> Expr Bool) -> k -> Query ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k
key k -> k -> Expr Bool
forall a. EqTable a => a -> a -> Expr Bool
==:)) Maybe k
mk
  a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


-- | Analagous to
-- [@align@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:align).
--
-- If 'zip' makes an @INNER JOIN@, then 'align' makes a @FULL OUTER JOIN@.
align :: (EqTable k, Table Expr a, Table Expr b)
  => Tabulation k a -> Tabulation k b -> Tabulation k (TheseTable a b)
align :: Tabulation k a -> Tabulation k b -> Tabulation k (TheseTable a b)
align = (TheseTable a b -> TheseTable a b)
-> Tabulation k a
-> Tabulation k b
-> Tabulation k (TheseTable a b)
forall k a b c.
(EqTable k, Table Expr a, Table Expr b) =>
(TheseTable a b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith TheseTable a b -> TheseTable a b
forall a. a -> a
id


-- | Analagous to
-- [@alignWith@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:alignWith).
--
-- See 'zipWith' and 'align'.
alignWith :: (EqTable k, Table Expr a, Table Expr b)
  => (TheseTable a b -> c)
  -> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith :: (TheseTable a b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith TheseTable a b -> c
f Tabulation k a
kas Tabulation k b
kbs = do
  Query (k, a)
as <- Tabulation k a -> Tabulation k (Query (k, a))
forall k a. Tabulation k a -> Tabulation k (Query (k, a))
toQuery Tabulation k a
kas
  Query (k, b)
bs <- Tabulation k b -> Tabulation k (Query (k, b))
forall k a. Tabulation k a -> Tabulation k (Query (k, a))
toQuery Tabulation k b
kbs
  Query (k, c) -> Tabulation k c
forall k a. Query (k, a) -> Tabulation k a
fromQuery (Query (k, c) -> Tabulation k c) -> Query (k, c) -> Tabulation k c
forall a b. (a -> b) -> a -> b
$ do
    TheseTable (k, a) (k, b)
tkab <- ((k, a) -> (k, b) -> Expr Bool)
-> Query (k, a) -> Query (k, b) -> Query (TheseTable (k, a) (k, b))
forall a b.
(Table Expr a, Table Expr b) =>
(a -> b -> Expr Bool)
-> Query a -> Query b -> Query (TheseTable a b)
alignBy (\(k
l, a
_) (k
m, b
_) -> k
l k -> k -> Expr Bool
forall a. EqTable a => a -> a -> Expr Bool
==: k
m) Query (k, a)
as Query (k, b)
bs
    let
      k' :: k
k' = ((k, a) -> k)
-> ((k, b) -> k)
-> ((k, a) -> (k, b) -> k)
-> TheseTable (k, a) (k, b)
-> k
forall c a b.
Table Expr c =>
(a -> c) -> (b -> c) -> (a -> b -> c) -> TheseTable a b -> c
theseTable (k, a) -> k
forall a b. (a, b) -> a
fst (k, b) -> k
forall a b. (a, b) -> a
fst (((k, b) -> k) -> (k, a) -> (k, b) -> k
forall a b. a -> b -> a
const (k, b) -> k
forall a b. (a, b) -> a
fst) TheseTable (k, a) (k, b)
tkab
      tab :: TheseTable a b
tab = ((k, a) -> a)
-> ((k, b) -> b) -> TheseTable (k, a) (k, b) -> TheseTable a b
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (k, a) -> a
forall a b. (a, b) -> b
snd (k, b) -> b
forall a b. (a, b) -> b
snd TheseTable (k, a) (k, b)
tkab
    (k, c) -> Query (k, c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k
k', TheseTable a b -> c
f TheseTable a b
tab)


-- | If 'zip' makes an @INNER JOIN@, then 'leftAlign' makes a @LEFT JOIN@.
-- This means it will return at least one row for every row in the left
-- 'Tabulation', even if there is no corresponding row in the right (hence the
-- 'Rel8.MaybeTable').
--
-- Analagous to
-- [@rpadZip@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:rpadZip).
leftAlign :: EqTable k
  => Tabulation k a -> Tabulation k b -> Tabulation k (a, MaybeTable b)
leftAlign :: Tabulation k a -> Tabulation k b -> Tabulation k (a, MaybeTable b)
leftAlign = (a -> MaybeTable b -> (a, MaybeTable b))
-> Tabulation k a
-> Tabulation k b
-> Tabulation k (a, MaybeTable b)
forall k a b c.
EqTable k =>
(a -> MaybeTable b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
leftAlignWith (,)


-- | See 'zipWith' and 'leftAlign'.
--
-- Analagous to
-- [@rpadZipWith@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:rpadZipWith).
leftAlignWith :: EqTable k
  => (a -> MaybeTable b -> c)
  -> Tabulation k a -> Tabulation k b -> Tabulation k c
leftAlignWith :: (a -> MaybeTable b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
leftAlignWith a -> MaybeTable b -> c
f Tabulation k a
left Tabulation k b
right = (a -> MaybeTable b -> c)
-> Tabulation k a -> Tabulation k (MaybeTable b) -> Tabulation k c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> MaybeTable b -> c
f Tabulation k a
left (Tabulation k b -> Tabulation k (MaybeTable b)
forall k a.
EqTable k =>
Tabulation k a -> Tabulation k (MaybeTable a)
optionalTabulation Tabulation k b
right)


-- | Analagous to
-- [@zip@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:zip).
--
-- There are multiple correct ways of understanding what this does.
--
-- You can think of it as @'Data.Map.Strict.intersectionWith'
-- ('Control.Applicative.liftA2' (,))@.  That is, @intersect@ the two
-- `Tabulation`s by matching their keys together (with 'Rel8.==:'), and combine
-- their values (remembering that 'Tabulation' is a 'MultiMap' so that the
-- values are keys) by getting their cartesian product.
--
-- You can think of it as performing a cross product of the underlying 'Query's
-- of the given 'Tabulation's and filtering the results for 'match'ing keys.
--
-- You can think of it as a natural join in SQL terms.
--
-- The size of the resulting 'Tabulation' will be \(\sum_{k} min(n_k, m_k) \)
-- in terms of the number of keys, but \(\sum_{k} n_k \times m_k\) in terms of
-- the number of values.
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 (,)


-- | Analagous to
-- [@zipWith@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:zipWith).
--
-- See 'zip'.
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


-- | 'similarity' returns all the entries in the left 'Tabulation' that have a
-- corresponding entry in the right 'Tabulation'. This corresponds to a
-- semijoin in relational algebra.
--
-- This differs from @'zipWith' const x y@ when the right 'Tabulation' @y@
-- contains an entry with multiple rows. For 'similarity', the entries in the
-- resulting 'Tabulation' will contain the same number of rows as their
-- respective entries in the left 'Tabulation' @x@. With `zipWith const x y`,
-- each entry would contain the /product/ of the number of rows of their
-- respective entries in @x@ and @y@.
--
-- See 'Rel8.with'.
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
kas Tabulation k b
kbs = do
  Query (k, a)
as <- Tabulation k a -> Tabulation k (Query (k, a))
forall k a. Tabulation k a -> Tabulation k (Query (k, a))
toQuery Tabulation k a
kas
  Query (k, b)
bs <- Tabulation k b -> Tabulation k (Query (k, b))
forall k a. Tabulation k a -> Tabulation k (Query (k, a))
toQuery Tabulation k b
kbs
  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) -> ((k, a) -> Query (k, a)) -> Query (k, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((k, a) -> (k, b) -> Expr Bool)
-> Query (k, b) -> (k, a) -> Query (k, a)
forall a b. (a -> b -> Expr Bool) -> Query b -> a -> Query a
withBy (\(k
k, a
_) (k
l, b
_) -> k
k k -> k -> Expr Bool
forall a. EqTable a => a -> a -> Expr Bool
==: k
l) Query (k, b)
bs


-- | 'difference' returns all the entries in the left 'Tabulation' that don't
-- exist in the right 'Tabulation'. This corresponds to an antijoin in
-- relational algebra.
--
-- See 'Rel8.without'.
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
kas Tabulation k b
kbs = do
  Query (k, a)
as <- Tabulation k a -> Tabulation k (Query (k, a))
forall k a. Tabulation k a -> Tabulation k (Query (k, a))
toQuery Tabulation k a
kas
  Query (k, b)
bs <- Tabulation k b -> Tabulation k (Query (k, b))
forall k a. Tabulation k a -> Tabulation k (Query (k, a))
toQuery Tabulation k b
kbs
  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) -> ((k, a) -> Query (k, a)) -> Query (k, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((k, a) -> (k, b) -> Expr Bool)
-> Query (k, b) -> (k, a) -> Query (k, a)
forall a b. (a -> b -> Expr Bool) -> Query b -> a -> Query a
withoutBy (\(k
k, a
_) (k
l, b
_) -> k
k k -> k -> Expr Bool
forall a. EqTable a => a -> a -> Expr Bool
==: k
l) Query (k, b)
bs


aggregateTabulation :: forall k aggregates exprs.
  ( EqTable k
  , Aggregates aggregates exprs
  )
  => Tabulation k aggregates -> Tabulation k exprs
aggregateTabulation :: Tabulation k aggregates -> Tabulation k exprs
aggregateTabulation = (Query (k, aggregates) -> Query (k, exprs))
-> Tabulation k aggregates -> Tabulation k exprs
forall k a b.
(Query (k, a) -> Query (k, b)) -> Tabulation k a -> Tabulation k b
mapQuery ((Query (k, aggregates) -> Query (k, exprs))
 -> Tabulation k aggregates -> Tabulation k exprs)
-> (Query (k, aggregates) -> Query (k, exprs))
-> Tabulation k aggregates
-> Tabulation k exprs
forall a b. (a -> b) -> a -> b
$
  ((Columns k (Col Expr), exprs) -> (k, exprs))
-> Query (Columns k (Col Expr), exprs) -> Query (k, exprs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Columns k (Col Expr) -> k)
-> (Columns k (Col Expr), exprs) -> (k, exprs)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Columns k (Col Expr) -> k
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns) (Query (Columns k (Col Expr), exprs) -> Query (k, exprs))
-> (Query (k, aggregates) -> Query (Columns k (Col Expr), exprs))
-> Query (k, aggregates)
-> Query (k, exprs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Query (Columns k (Col Aggregate), aggregates)
-> Query (Columns k (Col Expr), exprs)
forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate (Query (Columns k (Col Aggregate), aggregates)
 -> Query (Columns k (Col Expr), exprs))
-> (Query (k, aggregates)
    -> Query (Columns k (Col Aggregate), aggregates))
-> Query (k, aggregates)
-> Query (Columns k (Col Expr), exprs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ((k, aggregates) -> (Columns k (Col Aggregate), aggregates))
-> Query (k, aggregates)
-> Query (Columns k (Col Aggregate), aggregates)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((k -> Columns k (Col Aggregate))
-> (k, aggregates) -> (Columns k (Col Aggregate), aggregates)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Columns k (Dict (ConstrainDBType DBEq))
-> Columns k (Col Expr) -> Columns k (Col Aggregate)
forall (t :: HTable).
HTable t =>
t (Dict (ConstrainDBType DBEq))
-> t (Col Expr) -> t (Col Aggregate)
hgroupBy (EqTable k => Columns k (Dict (ConstrainDBType DBEq))
forall a. EqTable a => Columns a (Dict (ConstrainDBType DBEq))
eqTable @k) (Columns k (Col Expr) -> Columns k (Col Aggregate))
-> (k -> Columns k (Col Expr)) -> k -> Columns k (Col Aggregate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Columns k (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns))


-- | 'orderTabulation' orders the /values/ of a 'Tabulation' within each key.
--
-- In general this is meaningless, but if used together with 'manyTabulation'
-- or 'someTabulation', the resulting lists will be ordered according to
-- ordering given to 'orderTabulation'.
orderTabulation :: OrdTable k => Order a -> Tabulation k a -> Tabulation k a
orderTabulation :: Order a -> Tabulation k a -> Tabulation k a
orderTabulation Order a
ordering = (Query (k, a) -> Query (k, a)) -> Tabulation k a -> Tabulation k a
forall k a b.
(Query (k, a) -> Query (k, b)) -> Tabulation k a -> Tabulation k b
mapQuery ((Query (k, a) -> Query (k, a))
 -> Tabulation k a -> Tabulation k a)
-> (Query (k, a) -> Query (k, a))
-> Tabulation k a
-> Tabulation k a
forall a b. (a -> b) -> a -> b
$ Order (k, a) -> Query (k, a) -> Query (k, a)
forall a. Order a -> Query a -> Query a
orderBy Order (k, a)
ordering'
  where
    ordering' :: Order (k, a)
ordering' = ((k, a) -> k
forall a b. (a, b) -> a
fst ((k, a) -> k) -> Order k -> Order (k, a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Order k
forall a. OrdTable a => Order a
ascTable) Order (k, a) -> Order (k, a) -> Order (k, a)
forall a. Semigroup a => a -> a -> a
<> ((k, a) -> a
forall a b. (a, b) -> b
snd ((k, a) -> a) -> Order a -> Order (k, a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Order a
ordering)


-- | Turns the given 'Tabulation' from a \"multimap\" into a \"map\". If there
-- is more than one value at a particular key, only the first one is kept.
-- \"First\" is in general undefined, but 'orderTabulation' can be used to
-- make it deterministic.
distinctTabulation :: EqTable k => Tabulation k a -> Tabulation k a
distinctTabulation :: Tabulation k a -> Tabulation k a
distinctTabulation = (Query (k, a) -> Query (k, a)) -> Tabulation k a -> Tabulation k a
forall k a b.
(Query (k, a) -> Query (k, b)) -> Tabulation k a -> Tabulation k b
mapQuery (((k, a) -> k) -> Query (k, a) -> Query (k, a)
forall b a. EqTable b => (a -> b) -> Query a -> Query a
distinctOn (k, a) -> k
forall a b. (a, b) -> a
fst)


optionalTabulation :: EqTable k
  => Tabulation k a -> Tabulation k (MaybeTable a)
optionalTabulation :: Tabulation k a -> Tabulation k (MaybeTable a)
optionalTabulation Tabulation k a
as = (k -> Query (Maybe k, MaybeTable a)) -> Tabulation k (MaybeTable a)
forall k a. (k -> Query (Maybe k, a)) -> Tabulation k a
Tabulation ((k -> Query (Maybe k, MaybeTable a))
 -> Tabulation k (MaybeTable a))
-> (k -> Query (Maybe k, MaybeTable a))
-> Tabulation k (MaybeTable a)
forall a b. (a -> b) -> a -> b
$ \k
k -> do
  MaybeTable a
ma <- Query a -> Query (MaybeTable a)
forall a. Query a -> Query (MaybeTable a)
optional (Query a -> Query (MaybeTable a))
-> Query a -> Query (MaybeTable a)
forall a b. (a -> b) -> a -> b
$ k -> Tabulation k a -> Query a
forall k a. EqTable k => k -> Tabulation k a -> Query a
lookup k
k Tabulation k a
as
  (Maybe k, MaybeTable a) -> Query (Maybe k, MaybeTable a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k -> Maybe k
forall a. a -> Maybe a
Just k
k, MaybeTable a
ma)


manyTabulation :: (EqTable k, Table Expr a)
  => Tabulation k a -> Tabulation k (ListTable a)
manyTabulation :: Tabulation k a -> Tabulation k (ListTable a)
manyTabulation =
  (MaybeTable (ListTable (Columns a (Col Expr))) -> ListTable a)
-> Tabulation k (MaybeTable (ListTable (Columns a (Col Expr))))
-> Tabulation k (ListTable a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ListTable a
-> (ListTable (Columns a (Col Expr)) -> ListTable a)
-> MaybeTable (ListTable (Columns a (Col Expr)))
-> ListTable a
forall b a. Table Expr b => b -> (a -> b) -> MaybeTable a -> b
maybeTable ListTable a
forall a. Monoid a => a
mempty (\(ListTable HListTable
  (Columns (Columns a (Col Expr)))
  (Col (Context (Columns a (Col Expr))))
a) -> HListTable (Columns a) (Col (Context a)) -> ListTable a
forall a. HListTable (Columns a) (Col (Context a)) -> ListTable a
ListTable HListTable (Columns a) (Col (Context a))
HListTable
  (Columns (Columns a (Col Expr)))
  (Col (Context (Columns a (Col Expr))))
a)) (Tabulation k (MaybeTable (ListTable (Columns a (Col Expr))))
 -> Tabulation k (ListTable a))
-> (Tabulation k a
    -> Tabulation k (MaybeTable (ListTable (Columns a (Col Expr)))))
-> Tabulation k a
-> Tabulation k (ListTable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Tabulation k (ListTable (Columns a (Col Expr)))
-> Tabulation k (MaybeTable (ListTable (Columns a (Col Expr))))
forall k a.
EqTable k =>
Tabulation k a -> Tabulation k (MaybeTable a)
optionalTabulation (Tabulation k (ListTable (Columns a (Col Expr)))
 -> Tabulation k (MaybeTable (ListTable (Columns a (Col Expr)))))
-> (Tabulation k a
    -> Tabulation k (ListTable (Columns a (Col Expr))))
-> Tabulation k a
-> Tabulation k (MaybeTable (ListTable (Columns a (Col Expr))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Tabulation k (ListTable (Columns a (Col Aggregate)))
-> Tabulation k (ListTable (Columns a (Col Expr)))
forall k aggregates exprs.
(EqTable k, Aggregates aggregates exprs) =>
Tabulation k aggregates -> Tabulation k exprs
aggregateTabulation (Tabulation k (ListTable (Columns a (Col Aggregate)))
 -> Tabulation k (ListTable (Columns a (Col Expr))))
-> (Tabulation k a
    -> Tabulation k (ListTable (Columns a (Col Aggregate))))
-> Tabulation k a
-> Tabulation k (ListTable (Columns a (Col Expr)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> ListTable (Columns a (Col Aggregate)))
-> Tabulation k a
-> Tabulation k (ListTable (Columns a (Col Aggregate)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Columns a (Col Expr) -> ListTable (Columns a (Col Aggregate))
forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> ListTable aggregates
listAgg (Columns a (Col Expr) -> ListTable (Columns a (Col Aggregate)))
-> (a -> Columns a (Col Expr))
-> a
-> ListTable (Columns a (Col Aggregate))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns)


someTabulation :: (EqTable k, Table Expr a)
  => Tabulation k a -> Tabulation k (NonEmptyTable a)
someTabulation :: Tabulation k a -> Tabulation k (NonEmptyTable a)
someTabulation =
  (NonEmptyTable (Columns a (Col Expr)) -> NonEmptyTable a)
-> Tabulation k (NonEmptyTable (Columns a (Col Expr)))
-> Tabulation k (NonEmptyTable a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(NonEmptyTable HNonEmptyTable
  (Columns (Columns a (Col Expr)))
  (Col (Context (Columns a (Col Expr))))
a) -> HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
forall a.
HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
NonEmptyTable HNonEmptyTable (Columns a) (Col (Context a))
HNonEmptyTable
  (Columns (Columns a (Col Expr)))
  (Col (Context (Columns a (Col Expr))))
a) (Tabulation k (NonEmptyTable (Columns a (Col Expr)))
 -> Tabulation k (NonEmptyTable a))
-> (Tabulation k a
    -> Tabulation k (NonEmptyTable (Columns a (Col Expr))))
-> Tabulation k a
-> Tabulation k (NonEmptyTable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Tabulation k (NonEmptyTable (Columns a (Col Aggregate)))
-> Tabulation k (NonEmptyTable (Columns a (Col Expr)))
forall k aggregates exprs.
(EqTable k, Aggregates aggregates exprs) =>
Tabulation k aggregates -> Tabulation k exprs
aggregateTabulation (Tabulation k (NonEmptyTable (Columns a (Col Aggregate)))
 -> Tabulation k (NonEmptyTable (Columns a (Col Expr))))
-> (Tabulation k a
    -> Tabulation k (NonEmptyTable (Columns a (Col Aggregate))))
-> Tabulation k a
-> Tabulation k (NonEmptyTable (Columns a (Col Expr)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> NonEmptyTable (Columns a (Col Aggregate)))
-> Tabulation k a
-> Tabulation k (NonEmptyTable (Columns a (Col Aggregate)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Columns a (Col Expr) -> NonEmptyTable (Columns a (Col Aggregate))
forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> NonEmptyTable aggregates
nonEmptyAgg (Columns a (Col Expr) -> NonEmptyTable (Columns a (Col Aggregate)))
-> (a -> Columns a (Col Expr))
-> a
-> NonEmptyTable (Columns a (Col Aggregate))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns)


mapQuery :: (Query (k, a) -> Query (k, b)) -> Tabulation k a -> Tabulation k b
mapQuery :: (Query (k, a) -> Query (k, b)) -> Tabulation k a -> Tabulation k b
mapQuery Query (k, a) -> Query (k, b)
f (Tabulation k -> Query (Maybe k, a)
query) = (k -> Query (Maybe k, b)) -> Tabulation k b
forall k a. (k -> Query (Maybe k, a)) -> Tabulation k a
Tabulation ((k -> Query (Maybe k, b)) -> Tabulation k b)
-> (k -> Query (Maybe k, b)) -> Tabulation k b
forall a b. (a -> b) -> a -> b
$ \k
k ->
  (k -> Maybe k) -> (k, b) -> (Maybe k, b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first k -> Maybe k
forall a. a -> Maybe a
Just ((k, b) -> (Maybe k, b)) -> Query (k, b) -> Query (Maybe k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query (k, a) -> Query (k, b)
f ((Maybe k -> k) -> (Maybe k, a) -> (k, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (k -> Maybe k -> k
forall a. a -> Maybe a -> a
fromMaybe k
k) ((Maybe k, a) -> (k, a)) -> Query (Maybe k, a) -> Query (k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> Query (Maybe k, a)
query k
k)


toQuery :: Tabulation k a -> Tabulation k (Query (k, a))
toQuery :: Tabulation k a -> Tabulation k (Query (k, a))
toQuery (Tabulation k -> Query (Maybe k, a)
as) = (k -> Query (Maybe k, Query (k, a))) -> Tabulation k (Query (k, a))
forall k a. (k -> Query (Maybe k, a)) -> Tabulation k a
Tabulation ((k -> Query (Maybe k, Query (k, a)))
 -> Tabulation k (Query (k, a)))
-> (k -> Query (Maybe k, Query (k, a)))
-> Tabulation k (Query (k, a))
forall a b. (a -> b) -> a -> b
$ \k
k ->
  (Maybe k, Query (k, a)) -> Query (Maybe k, Query (k, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe k
forall a. Maybe a
Nothing, (Maybe k -> k) -> (Maybe k, a) -> (k, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (k -> Maybe k -> k
forall a. a -> Maybe a -> a
fromMaybe k
k) ((Maybe k, a) -> (k, a)) -> Query (Maybe k, a) -> Query (k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> Query (Maybe k, a)
as k
k)