{-# language FlexibleContexts #-}
{-# language MonoLocalBinds #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TupleSections #-}
{-# language UndecidableInstances #-}
module Rel8.Tabulate
(
Tabulation
, fromQuery
, toQuery
, liftQuery
, through
, lookup
, aggregate
, distinct
, order
, count
, optional
, many
, some
, exists
, present
, absent
, align
, alignWith
, leftAlign
, leftAlignWith
, rightAlign
, rightAlignWith
, zip
, zipWith
, similarity
, difference
)
where
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 )
import Data.Bifunctor.Clown ( Clown( Clown ), runClown )
import Control.Comonad ( extract )
import qualified Opaleye.Aggregate as Opaleye
import qualified Opaleye.Order as Opaleye ( orderBy, distinctOnExplicit )
import Data.Profunctor ( dimap, lmap )
import Data.Profunctor.Product
( ProductProfunctor, (***!)
, SumProfunctor, (+++!)
)
import qualified Data.Profunctor.Product as PP
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.Rebind ( rebind )
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 )
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 :: forall k. Table Expr k => Key k -> Query k
cat = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. (AlternativeTable f, Table Expr a) => f a
emptyTable forall (f :: * -> *) a. Applicative f => a -> f a
pure
key :: (ProductProfunctor p, SumProfunctor p)
=> p a b -> p (Key a) (Key b)
key :: forall (p :: * -> * -> *) a b.
(ProductProfunctor p, SumProfunctor p) =>
p a b -> p (Key a) (Key b)
key p a b
a = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall {b}. Maybe b -> Either () b
from forall {a} {a}. Either a a -> Maybe a
to (forall (p :: * -> * -> *). ProductProfunctor p => p () ()
PP.empty 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left ()) forall a b. b -> Either a b
Right
to :: Either a a -> Maybe a
to = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) 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 :: forall (p :: * -> * -> *) k l a b.
(ProductProfunctor p, SumProfunctor p) =>
p k l -> p a b -> p (Key k, a) (Key l, b)
keyed p k l
k p a b
a = forall (p :: * -> * -> *) a b.
(ProductProfunctor p, SumProfunctor p) =>
p a b -> p (Key a) (Key b)
key p k l
k 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 :: forall a' a. (a' -> a) -> Predicate a -> Predicate a'
contramap a' -> a
f (Predicate Maybe (a -> Expr Bool)
a) = forall a. Maybe (a -> Expr Bool) -> Predicate a
Predicate (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a' -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a -> 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 = forall a. Maybe (a -> Expr Bool) -> Predicate a
Predicate forall a b. (a -> b) -> a -> b
$ Maybe (k -> Expr Bool)
ma 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 = forall a. Maybe (a -> Expr Bool) -> Predicate a
Predicate forall a. Maybe a
Nothing
match :: EqTable k => Key k -> Predicate k
match :: forall k. EqTable k => Key k -> Predicate k
match = forall a. Maybe (a -> Expr Bool) -> Predicate a
Predicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. EqTable a => a -> a -> Expr Bool
(==:)
ensure :: Predicate k -> Key k -> Query ()
ensure :: forall k. Predicate k -> Key k -> Query ()
ensure (Predicate Maybe (k -> Expr Bool)
mp) = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\k
k -> 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)
type Tabulation :: Type -> Type -> Type
newtype Tabulation k a = Tabulation (Predicate k -> Query (Key k, a))
instance Biprojectable Tabulation where
biproject :: forall a b c d.
(Projecting a b, Projecting c d) =>
Projection a b
-> Projection c d -> Tabulation a c -> Tabulation b d
biproject Projection a b
f Projection c d
g =
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
(forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
(forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection c d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
instance Bifunctor Tabulation where
bimap :: forall a b c d.
(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) = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$ \Predicate b
p ->
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) c -> d
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Predicate a -> Query (Key a, c)
a (a -> b
f forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Predicate b
p)
instance Functor (Tabulation k) where
fmap :: forall a b. (a -> b) -> Tabulation k a -> Tabulation k b
fmap = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second
instance Projectable (Tabulation k) where
project :: forall a b.
Projecting a b =>
Projection a b -> Tabulation k a -> Tabulation k b
project Projection a b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
instance EqTable k => Apply (Tabulation k) where
liftF2 :: forall a b c.
(a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
liftF2 = 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 :: forall a. a -> Tabulation k a
pure = forall a k. Query a -> Tabulation k a
liftQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
liftA2 :: forall a b c.
(a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
liftA2 = 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 >>- :: forall a b.
Tabulation k a -> (a -> Tabulation k b) -> Tabulation k b
>>- a -> Tabulation k b
f = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation 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' = 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' forall a. Semigroup a => a -> a -> a
<> Predicate k
p)
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p' Key k
k'
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key k
k' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Key k
k, b
b)
instance EqTable k => Monad (Tabulation k) where
>>= :: forall a b.
Tabulation k a -> (a -> Tabulation k b) -> Tabulation k b
(>>=) = forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)
instance EqTable k => AltTable (Tabulation k) where
Tabulation k a
tas <|>: :: forall a.
Table Expr a =>
Tabulation k a -> Tabulation k a -> Tabulation k a
<|>: Tabulation k a
tbs = do
Either (Query a) (Query (k, a))
eas <- 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 <- 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) -> forall a k. Query a -> Tabulation k a
liftQuery forall a b. (a -> b) -> a -> b
$ Query a
as 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) -> forall k a. Query (k, a) -> Tabulation k a
fromQuery forall a b. (a -> b) -> a -> b
$ Query (k, a)
as 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)))
_ -> forall a. Table Expr a => NonEmptyTable Expr a -> Query a
catNonEmptyTable forall a b k. (a -> Query b) -> Tabulation k a -> Tabulation k b
`through` (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` 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 :: forall a. Table Expr a => Tabulation k a
emptyTable = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Alternative f => f a
empty,) 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
(<>) = forall k a b c.
EqTable k =>
(TheseTable Expr a b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith (forall c a b.
Table Expr c =>
(a -> c) -> (b -> c) -> (a -> b -> c) -> TheseTable Expr a b -> c
theseTable forall a. a -> a
id forall a. a -> a
id 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 = forall (f :: * -> *) a. (AlternativeTable f, Table Expr a) => f a
emptyTable
fromQuery :: Query (k, a) -> Tabulation k a
fromQuery :: forall k a. Query (k, a) -> Tabulation k a
fromQuery = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall (f :: * -> *) a. Applicative f => a -> f a
pure)
toQuery :: Table Expr k => Tabulation k a -> Query (k, a)
toQuery :: forall k a. Table Expr k => 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 forall a. Monoid a => a
mempty
k
k <- forall k. Table Expr k => Key k -> Query k
cat Key k
mk
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k
k, a
a)
liftQuery :: Query a -> Tabulation k a
liftQuery :: forall a k. Query a -> Tabulation k a
liftQuery = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Alternative f => f a
empty,)
through :: (a -> Query b) -> Tabulation k a -> Tabulation k b
through :: forall a b k. (a -> Query b) -> Tabulation k a -> Tabulation k b
through a -> Query b
f (Tabulation Predicate k -> Query (Key k, a)
as) = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key k
k, b
b)
infixr 1 `through`
lookup :: EqTable k => k -> Tabulation k a -> Query a
lookup :: forall k a. EqTable k => 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
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p Key k
k'
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
where
p :: Predicate k
p = forall k. EqTable k => Key k -> Predicate k
match (forall (f :: * -> *) a. Applicative f => a -> f a
pure k
k)
aggregate :: forall k aggregates exprs.
( EqTable k
, Aggregates aggregates exprs
)
=> Tabulation k aggregates -> Tabulation k exprs
aggregate :: forall k aggregates exprs.
(EqTable k, Aggregates aggregates exprs) =>
Tabulation k aggregates -> Tabulation k exprs
aggregate (Tabulation Predicate k -> Query (Key k, aggregates)
f) = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye (forall a b. Aggregator a b -> Select a -> Select b
Opaleye.aggregate (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 forall aggregates exprs.
Aggregates aggregates exprs =>
Aggregator aggregates exprs
aggregator)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: HTable).
HTable t =>
t (Dict (Sql DBEq)) -> t Expr -> t Aggregate
hgroupBy (forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Predicate k -> Query (Key k, aggregates)
f
where
haggregator :: Aggregator (Columns (Cols Aggregate (Columns k)) Aggregate) k
haggregator = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns forall (context :: * -> *) a.
Table context a =>
Cols context (Columns a) -> a
fromCols forall aggregates exprs.
Aggregates aggregates exprs =>
Aggregator aggregates exprs
aggregator
distinct :: EqTable k => Tabulation k a -> Tabulation k a
distinct :: forall k a. EqTable k => Tabulation k a -> Tabulation k a
distinct (Tabulation Predicate k -> Query (Key k, a)
f) = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye (forall b a. Unpackspec b b -> (a -> b) -> Select a -> Select a
Opaleye.distinctOnExplicit (forall (p :: * -> * -> *) a b.
(ProductProfunctor p, SumProfunctor p) =>
p a b -> p (Key a) (Key b)
key forall a. Table Expr a => Unpackspec a a
unpackspec) forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate k -> Query (Key k, a)
f
order :: OrdTable k => Order a -> Tabulation k a -> Tabulation k a
order :: forall k a.
OrdTable k =>
Order a -> Tabulation k a -> Tabulation k a
order Order a
ordering (Tabulation Predicate k -> Query (Key k, a)
f) =
forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$ forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye (forall a. Order a -> Select a -> Select a
Opaleye.orderBy Order (Key k, a)
ordering') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate k -> Query (Key k, a)
f
where
Order Order (Key k, a)
ordering' = forall {k1} {k2} (f :: k1 -> *) (a :: k1) (b :: k2).
Clown f a b -> f a
runClown (forall (p :: * -> * -> *) k l a b.
(ProductProfunctor p, SumProfunctor p) =>
p k l -> p a b -> p (Key k, a) (Key l, b)
keyed (forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown forall a. OrdTable a => Order a
ascTable) (forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown Order a
ordering))
count :: EqTable k => Tabulation k a -> Tabulation k (Expr Int64)
count :: forall k a.
EqTable k =>
Tabulation k a -> Tabulation k (Expr Int64)
count =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable Expr Int64
0 forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k a. Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k aggregates exprs.
(EqTable k, Aggregates aggregates exprs) =>
Tabulation k aggregates -> Tabulation k exprs
aggregate forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Aggregate Int64
countStar)
optional :: Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional :: forall k a. Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional (Tabulation Predicate k -> Query (Key k, a)
f) = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> case Predicate k
p of
Predicate Maybe (k -> Expr Bool)
Nothing -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Predicate k -> Query (Key k, a)
f Predicate k
p
Predicate k
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\MaybeTable Expr (Key k, a)
m -> (forall (f :: * -> *) a. Alternative f => f a
empty, forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeTable Expr (Key k, a)
m)) forall a b. (a -> b) -> a -> b
$ forall a. Query a -> Query (MaybeTable Expr a)
Q.optional forall a b. (a -> b) -> a -> b
$ do
(Key k
k, a
a) <- Predicate k -> Query (Key k, a)
f Predicate k
p
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p Key k
k
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key k
k, a
a)
many :: (EqTable k, Table Expr a)
=> Tabulation k a -> Tabulation k (ListTable Expr a)
many :: forall k a.
(EqTable k, Table Expr a) =>
Tabulation k a -> Tabulation k (ListTable Expr a)
many =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable forall a. Monoid a => a
mempty (\(ListTable HListTable
(Columns (Transpose Expr (Cols Aggregate (Columns a))))
(Context (Transpose Expr (Cols Aggregate (Columns a))))
a) -> forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable HListTable
(Columns (Transpose Expr (Cols Aggregate (Columns a))))
(Context (Transpose Expr (Cols Aggregate (Columns a))))
a)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k a. Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k aggregates exprs.
(EqTable k, Aggregates aggregates exprs) =>
Tabulation k aggregates -> Tabulation k exprs
aggregate forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> ListTable Aggregate aggregates
listAgg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: * -> *) a.
Table context a =>
a -> Cols context (Columns a)
toCols)
some :: (EqTable k, Table Expr a)
=> Tabulation k a -> Tabulation k (NonEmptyTable Expr a)
some :: forall k a.
(EqTable k, Table Expr a) =>
Tabulation k a -> Tabulation k (NonEmptyTable Expr a)
some =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(NonEmptyTable HNonEmptyTable
(Columns (Transpose Expr (Cols Aggregate (Columns a))))
(Context (Transpose Expr (Cols Aggregate (Columns a))))
a) -> forall (context :: * -> *) a.
HNonEmptyTable (Columns a) (Context a) -> NonEmptyTable context a
NonEmptyTable HNonEmptyTable
(Columns (Transpose Expr (Cols Aggregate (Columns a))))
(Context (Transpose Expr (Cols Aggregate (Columns a))))
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k aggregates exprs.
(EqTable k, Aggregates aggregates exprs) =>
Tabulation k aggregates -> Tabulation k exprs
aggregate forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> NonEmptyTable Aggregate aggregates
nonEmptyAgg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: * -> *) a.
Table context a =>
a -> Cols context (Columns a)
toCols)
exists :: Tabulation k a -> Tabulation k (Expr Bool)
exists :: forall k a. Tabulation k a -> Tabulation k (Expr Bool)
exists (Tabulation Predicate k -> Query (Key k, a)
f) = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> case Predicate k
p of
Predicate Maybe (k -> Expr Bool)
Nothing -> (Expr Bool
true forall (f :: * -> *) a b. Functor f => a -> f b -> f 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
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Alternative f => f a
empty,) forall a b. (a -> b) -> a -> b
$ forall a. Query a -> Query (Expr Bool)
Q.exists forall a b. (a -> b) -> a -> b
$ do
(Key k
k, a
_) <- Predicate k -> Query (Key k, a)
f Predicate k
p
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p Key k
k
present :: Tabulation k a -> Tabulation k ()
present :: forall k a. Tabulation k a -> Tabulation k ()
present (Tabulation Predicate k -> Query (Key k, a)
f) = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> do
forall a. Query a -> Query ()
Q.present forall a b. (a -> b) -> a -> b
$ do
(Key k
k, a
_) <- Predicate k -> Query (Key k, a)
f Predicate k
p
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p Key k
k
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Alternative f => f a
empty, ())
absent :: Tabulation k a -> Tabulation k ()
absent :: forall k a. Tabulation k a -> Tabulation k ()
absent (Tabulation Predicate k -> Query (Key k, a)
f) = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> do
forall a. Query a -> Query ()
Q.absent forall a b. (a -> b) -> a -> b
$ do
(Key k
k, a
_) <- Predicate k -> Query (Key k, a)
f Predicate k
p
forall k. Predicate k -> Key k -> Query ()
ensure Predicate k
p Key k
k
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Alternative f => f a
empty, ())
align :: EqTable k
=> Tabulation k a -> Tabulation k b -> Tabulation k (TheseTable Expr a b)
align :: forall k a b.
EqTable k =>
Tabulation k a
-> Tabulation k b -> Tabulation k (TheseTable Expr a b)
align = forall k a b c.
EqTable k =>
(TheseTable Expr a b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith forall a. a -> a
id
alignWith :: EqTable k
=> (TheseTable Expr a b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
alignWith :: 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 -> c
f (Tabulation Predicate k -> Query (Key k, a)
as) (Tabulation Predicate k -> Query (Key k, b)
bs) = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$ \Predicate k
p -> do
TheseTable Expr (Key k, a) (Key k, b)
tkab <- forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 (forall a b.
(a -> b -> Expr Bool)
-> Query a -> Query b -> Query (TheseTable Expr a b)
alignBy forall {b} {b} {b}.
EqTable b =>
(Maybe b, b) -> (Maybe b, b) -> Expr Bool
condition) Predicate k -> Query (Key k, a)
as Predicate k -> Query (Key k, b)
bs Predicate k
p
Key k
k <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. Table Expr a => String -> a -> Query a
rebind String
"key") forall a b. (a -> b) -> a -> b
$ forall {a}.
Table Expr a =>
TheseTable Expr (Maybe a) (Maybe a) -> Maybe a
recover forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a b. (a, b) -> a
fst forall a b. (a, b) -> a
fst TheseTable Expr (Key k, a) (Key k, b)
tkab
let
tab :: TheseTable Expr a b
tab = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a b. (a, b) -> b
snd forall a b. (a, b) -> b
snd TheseTable Expr (Key k, a) (Key k, b)
tkab
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 b, b) -> (Maybe b, b) -> Expr Bool
condition (Maybe b
k, b
_) (Maybe b
k', b
_) = forall a. a -> Maybe a -> a
fromMaybe Expr Bool
true (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. EqTable a => a -> a -> Expr Bool
(==:) Maybe b
k Maybe b
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 forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr (Maybe a)
ma of
Maybe a
Nothing -> forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr (Maybe a)
mb
Just a
a -> case forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr (Maybe a)
mb of
Maybe a
Nothing -> forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr (Maybe a)
ma
Just a
b -> case a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MaybeTable Expr (Maybe a)
mma forall (f :: * -> *) a.
(AltTable f, Table Expr a) =>
f a -> f a -> f a
<|>: a
b 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr a
c)
leftAlign :: EqTable k
=> Tabulation k a -> Tabulation k b -> Tabulation k (a, MaybeTable Expr b)
leftAlign :: forall k a b.
EqTable k =>
Tabulation k a
-> Tabulation k b -> Tabulation k (a, MaybeTable Expr b)
leftAlign = forall k a b c.
EqTable k =>
(a -> MaybeTable Expr b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
leftAlignWith (,)
leftAlignWith :: EqTable k
=> (a -> MaybeTable Expr b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
leftAlignWith :: forall k a b c.
EqTable k =>
(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 = 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 (forall k a. Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional Tabulation k b
right)
rightAlign :: EqTable k
=> Tabulation k a -> Tabulation k b -> Tabulation k (MaybeTable Expr a, b)
rightAlign :: forall k a b.
EqTable k =>
Tabulation k a
-> Tabulation k b -> Tabulation k (MaybeTable Expr a, b)
rightAlign = forall k a b c.
EqTable k =>
(MaybeTable Expr a -> b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
rightAlignWith (,)
rightAlignWith :: EqTable k
=> (MaybeTable Expr a -> b -> c)
-> Tabulation k a -> Tabulation k b -> Tabulation k c
rightAlignWith :: forall k a b c.
EqTable k =>
(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 = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a b c. (a -> b -> c) -> b -> a -> c
flip MaybeTable Expr a -> b -> c
f) Tabulation k b
right (forall k a. Tabulation k a -> Tabulation k (MaybeTable Expr a)
optional Tabulation k a
left)
zip :: EqTable k
=> Tabulation k a -> Tabulation k b -> Tabulation k (a, b)
zip :: forall k a b.
EqTable k =>
Tabulation k a -> Tabulation k b -> Tabulation k (a, b)
zip = forall k a b c.
EqTable k =>
(a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
zipWith (,)
zipWith :: EqTable k
=> (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
zipWith :: forall k a b c.
EqTable k =>
(a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
zipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
similarity :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a
similarity :: forall k a b.
EqTable k =>
Tabulation k a -> Tabulation k b -> Tabulation k a
similarity Tabulation k a
a Tabulation k b
b = Tabulation k a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall k a. Tabulation k a -> Tabulation k ()
present Tabulation k b
b
difference :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a
difference :: forall k a b.
EqTable k =>
Tabulation k a -> Tabulation k b -> Tabulation k a
difference Tabulation k a
a Tabulation k b
b = Tabulation k a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall k a. Tabulation k a -> Tabulation k ()
absent Tabulation k b
b
peek :: Tabulation k a -> Tabulation k (Either (Query a) (Query (k, a)))
peek :: forall k a.
Tabulation k a -> Tabulation k (Either (Query a) (Query (k, a)))
peek (Tabulation Predicate k -> Query (Key k, a)
f) = forall k a. (Predicate k -> Query (Key k, a)) -> Tabulation k a
Tabulation forall a b. (a -> b) -> a -> b
$ \Predicate k
p ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a. Alternative f => f a
empty,) forall a b. (a -> b) -> a -> b
$ case forall a. Query a -> a
unsafePeekQuery (Predicate k -> Query (Key k, a)
f Predicate k
p) of
(Key k
Nothing, a
_) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (Predicate k -> Query (Key k, a)
f Predicate k
p)
(Just k
_, a
_) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. HasCallStack => Maybe a -> a
fromJust) (Predicate k -> Query (Key k, a)
f Predicate k
p)