{-# language DataKinds #-}
{-# language GADTs #-}
{-# language KindSignatures #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
module Rel8.Aggregate
( Aggregator' (Aggregator)
, Aggregator
, Aggregator1
, toAggregator
, toAggregator1
, filterWhereExplicit
, unsafeMakeAggregator
)
where
import Control.Applicative (liftA2)
import Data.Kind (Type)
import Prelude
import qualified Opaleye.Aggregate as Opaleye
import qualified Opaleye.Internal.MaybeFields as Opaleye
import qualified Opaleye.Internal.Operators as Opaleye
import Data.Profunctor.Product
( ProductProfunctor, purePP, (****)
, SumProfunctor, (+++!)
)
import Data.Profunctor (Profunctor, dimap)
import Rel8.Expr (Expr)
import Rel8.Expr.Opaleye (toPrimExpr, toColumn)
import Rel8.Aggregate.Fold (Fallback (Empty, Fallback), Fold (Full, Semi))
import Data.Functor.Apply (Apply, liftF2)
type Aggregator' :: Fold -> Type -> Type -> Type
data Aggregator' fold i a = Aggregator !(Fallback fold a) !(Opaleye.Aggregator i a)
instance Profunctor (Aggregator' fold) where
dimap :: forall a b c d.
(a -> b)
-> (c -> d) -> Aggregator' fold b c -> Aggregator' fold a d
dimap a -> b
f c -> d
g (Aggregator Fallback fold c
fallback Aggregator b c
a) =
Fallback fold d -> Aggregator a d -> Aggregator' fold a d
forall (fold :: Fold) i a.
Fallback fold a -> Aggregator i a -> Aggregator' fold i a
Aggregator ((c -> d) -> Fallback fold c -> Fallback fold d
forall a b. (a -> b) -> Fallback fold a -> Fallback fold b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g Fallback fold c
fallback) ((a -> b) -> (c -> d) -> Aggregator b c -> Aggregator a d
forall a b c d.
(a -> b) -> (c -> d) -> Aggregator b c -> Aggregator a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> b
f c -> d
g Aggregator b c
a)
instance ProductProfunctor (Aggregator' fold) where
purePP :: forall b a. b -> Aggregator' fold a b
purePP = b -> Aggregator' fold a b
forall a. a -> Aggregator' fold a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
**** :: forall a b c.
Aggregator' fold a (b -> c)
-> Aggregator' fold a b -> Aggregator' fold a c
(****) = Aggregator' fold a (b -> c)
-> Aggregator' fold a b -> Aggregator' fold a c
forall a b.
Aggregator' fold a (a -> b)
-> Aggregator' fold a a -> Aggregator' fold a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
instance SumProfunctor (Aggregator' fold) where
Aggregator Fallback fold b
fallback Aggregator a b
a +++! :: forall a b a' b'.
Aggregator' fold a b
-> Aggregator' fold a' b'
-> Aggregator' fold (Either a a') (Either b b')
+++! Aggregator Fallback fold b'
fallback' Aggregator a' b'
b =
(Fallback fold (Either b b')
-> Aggregator (Either a a') (Either b b')
-> Aggregator' fold (Either a a') (Either b b'))
-> Aggregator (Either a a') (Either b b')
-> Fallback fold (Either b b')
-> Aggregator' fold (Either a a') (Either b b')
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fallback fold (Either b b')
-> Aggregator (Either a a') (Either b b')
-> Aggregator' fold (Either a a') (Either b b')
forall (fold :: Fold) i a.
Fallback fold a -> Aggregator i a -> Aggregator' fold i a
Aggregator (Aggregator a b
a Aggregator a b
-> Aggregator a' b' -> Aggregator (Either a a') (Either b b')
forall a b a' b'.
Aggregator a b
-> Aggregator a' b' -> Aggregator (Either a a') (Either b b')
forall (p :: * -> * -> *) a b a' b'.
SumProfunctor p =>
p a b -> p a' b' -> p (Either a a') (Either b b')
+++! Aggregator a' b'
b) (Fallback fold (Either b b')
-> Aggregator' fold (Either a a') (Either b b'))
-> Fallback fold (Either b b')
-> Aggregator' fold (Either a a') (Either b b')
forall a b. (a -> b) -> a -> b
$ case Fallback fold b
fallback of
Fallback fold b
Empty -> case Fallback fold b'
fallback' of
Fallback fold b'
Empty -> Fallback fold (Either b b')
Fallback 'Semi (Either b b')
forall a. Fallback 'Semi a
Empty
Fallback b'
x -> Either b b' -> Fallback fold (Either b b')
forall a (fold :: Fold). a -> Fallback fold a
Fallback (b' -> Either b b'
forall a b. b -> Either a b
Right b'
x)
Fallback b
x -> Either b b' -> Fallback fold (Either b b')
forall a (fold :: Fold). a -> Fallback fold a
Fallback (b -> Either b b'
forall a b. a -> Either a b
Left b
x)
instance Functor (Aggregator' fold i) where
fmap :: forall a b.
(a -> b) -> Aggregator' fold i a -> Aggregator' fold i b
fmap = (i -> i)
-> (a -> b) -> Aggregator' fold i a -> Aggregator' fold i b
forall a b c d.
(a -> b)
-> (c -> d) -> Aggregator' fold b c -> Aggregator' fold a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap i -> i
forall a. a -> a
id
instance Apply (Aggregator' fold i) where
liftF2 :: forall a b c.
(a -> b -> c)
-> Aggregator' fold i a
-> Aggregator' fold i b
-> Aggregator' fold i c
liftF2 a -> b -> c
f (Aggregator Fallback fold a
fallback Aggregator i a
a) (Aggregator Fallback fold b
fallback' Aggregator i b
b) =
Fallback fold c -> Aggregator i c -> Aggregator' fold i c
forall (fold :: Fold) i a.
Fallback fold a -> Aggregator i a -> Aggregator' fold i a
Aggregator ((a -> b -> c)
-> Fallback fold a -> Fallback fold b -> Fallback fold c
forall a b c.
(a -> b -> c)
-> Fallback fold a -> Fallback fold b -> Fallback fold c
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 a -> b -> c
f Fallback fold a
fallback Fallback fold b
fallback') ((a -> b -> c) -> Aggregator i a -> Aggregator i b -> Aggregator i c
forall a b c.
(a -> b -> c) -> Aggregator i a -> Aggregator i b -> Aggregator i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Aggregator i a
a Aggregator i b
b)
instance Applicative (Aggregator' fold i) where
pure :: forall a. a -> Aggregator' fold i a
pure a
a = Fallback fold a -> Aggregator i a -> Aggregator' fold i a
forall (fold :: Fold) i a.
Fallback fold a -> Aggregator i a -> Aggregator' fold i a
Aggregator (a -> Fallback fold a
forall a. a -> Fallback fold a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (a -> Aggregator i a
forall a. a -> Aggregator i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
liftA2 :: forall a b c.
(a -> b -> c)
-> Aggregator' fold i a
-> Aggregator' fold i b
-> Aggregator' fold i c
liftA2 = (a -> b -> c)
-> Aggregator' fold i a
-> Aggregator' fold i b
-> Aggregator' fold i c
forall a b c.
(a -> b -> c)
-> Aggregator' fold i a
-> Aggregator' fold i b
-> Aggregator' fold i c
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2
type Aggregator :: Type -> Type -> Type
type Aggregator = Aggregator' 'Full
type Aggregator1 :: Type -> Type -> Type
type Aggregator1 = Aggregator' 'Semi
toAggregator1 :: Aggregator' fold i a -> Aggregator1 i a
toAggregator1 :: forall (fold :: Fold) i a. Aggregator' fold i a -> Aggregator1 i a
toAggregator1 (Aggregator Fallback fold a
_ Aggregator i a
a) = Fallback 'Semi a -> Aggregator i a -> Aggregator' 'Semi i a
forall (fold :: Fold) i a.
Fallback fold a -> Aggregator i a -> Aggregator' fold i a
Aggregator Fallback 'Semi a
forall a. Fallback 'Semi a
Empty Aggregator i a
a
toAggregator :: a -> Aggregator' fold i a -> Aggregator' fold' i a
toAggregator :: forall a (fold :: Fold) i (fold' :: Fold).
a -> Aggregator' fold i a -> Aggregator' fold' i a
toAggregator a
fallback (Aggregator Fallback fold a
_ Aggregator i a
a) = Fallback fold' a -> Aggregator i a -> Aggregator' fold' i a
forall (fold :: Fold) i a.
Fallback fold a -> Aggregator i a -> Aggregator' fold i a
Aggregator (a -> Fallback fold' a
forall a (fold :: Fold). a -> Fallback fold a
Fallback a
fallback) Aggregator i a
a
filterWhereExplicit :: ()
=> Opaleye.IfPP a a
-> (i -> Expr Bool)
-> Aggregator i a
-> Aggregator' fold i a
filterWhereExplicit :: forall a i (fold :: Fold).
IfPP a a
-> (i -> Expr Bool) -> Aggregator i a -> Aggregator' fold i a
filterWhereExplicit IfPP a a
ifPP i -> Expr Bool
f (Aggregator (Fallback a
fallback) Aggregator i a
aggregator) =
Fallback fold a -> Aggregator i a -> Aggregator' fold i a
forall (fold :: Fold) i a.
Fallback fold a -> Aggregator i a -> Aggregator' fold i a
Aggregator (a -> Fallback fold a
forall a (fold :: Fold). a -> Fallback fold a
Fallback a
fallback) Aggregator i a
aggregator'
where
aggregator' :: Aggregator i a
aggregator' =
IfPP a a -> a -> MaybeFields a -> a
forall b. IfPP b b -> b -> MaybeFields b -> b
Opaleye.fromMaybeFieldsExplicit IfPP a a
ifPP a
fallback
(MaybeFields a -> a)
-> Aggregator i (MaybeFields a) -> Aggregator i a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> Field SqlBool)
-> Aggregator i a -> Aggregator i (MaybeFields a)
forall a b.
(a -> Field SqlBool)
-> Aggregator a b -> Aggregator a (MaybeFields b)
Opaleye.filterWhere (PrimExpr -> Field SqlBool
forall (n :: Nullability) b. PrimExpr -> Field_ n b
toColumn (PrimExpr -> Field SqlBool)
-> (i -> PrimExpr) -> i -> Field SqlBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Bool -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr (Expr Bool -> PrimExpr) -> (i -> Expr Bool) -> i -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Expr Bool
f) Aggregator i a
aggregator
unsafeMakeAggregator :: forall (i :: Type) (o :: Type) (fold :: Fold) i' o'. ()
=> (i -> i')
-> (o' -> o)
-> Fallback fold o
-> Opaleye.Aggregator i' o'
-> Aggregator' fold i o
unsafeMakeAggregator :: forall i o (fold :: Fold) i' o'.
(i -> i')
-> (o' -> o)
-> Fallback fold o
-> Aggregator i' o'
-> Aggregator' fold i o
unsafeMakeAggregator i -> i'
input o' -> o
output Fallback fold o
fallback =
Fallback fold o -> Aggregator i o -> Aggregator' fold i o
forall (fold :: Fold) i a.
Fallback fold a -> Aggregator i a -> Aggregator' fold i a
Aggregator Fallback fold o
fallback (Aggregator i o -> Aggregator' fold i o)
-> (Aggregator i' o' -> Aggregator i o)
-> Aggregator i' o'
-> Aggregator' fold i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> i') -> (o' -> o) -> Aggregator i' o' -> Aggregator i o
forall a b c d.
(a -> b) -> (c -> d) -> Aggregator b c -> Aggregator a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap i -> i'
input o' -> o
output