git.iko.soy/rel8
on eb180fa help sign in
rel8/src/Rel8/Aggregate.hs
73 lines 2.4 kB history raw
1{-# language DerivingVia #-}
2{-# language GeneralizedNewtypeDeriving #-}
3{-# language NamedFieldPuns #-}
4{-# language StandaloneKindSignatures #-}
6module Rel8.Aggregate
7 ( Aggregate(..), foldInputs, mapInputs
8 , Aggregator(..), unsafeMakeAggregate
9 )
10where
12-- base
13import Data.Functor.Const ( Const( Const ), getConst )
14import Data.Kind ( Type )
15import Prelude
17-- opaleye
18import qualified Opaleye.Internal.Aggregate as Opaleye
19import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
20import qualified Opaleye.Internal.PackMap as Opaleye
22-- semigroupoids
23import Data.Functor.Apply ( Apply, WrappedApplicative(..) )
26-- | An @Aggregate a@ describes how to aggregate @Table@s of type @a@. You can
27-- unpack an @Aggregate@ back to @a@ by running it with 'aggregate'. As
28-- @Aggregate@ is almost an 'Applicative' functor - but there is no 'pure'
29-- operation. This means 'Aggregate' is an instance of 'Apply', and you can
30-- combine @Aggregate@s using the @<.>@ combinator.
31type Aggregate :: Type -> Type
32newtype Aggregate a = Aggregate (Opaleye.Aggregator () a)
33 deriving newtype Functor
34 deriving Apply via (WrappedApplicative (Opaleye.Aggregator ()))
37foldInputs :: Monoid b
38 => (Maybe Aggregator -> Opaleye.PrimExpr -> b) -> Aggregate a -> b
39foldInputs f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
40 getConst $ flip agg () $ \(aggregator, a) ->
41 Const $ f (detuplize <$> aggregator) a
42 where
43 detuplize (operation, ordering, distinction) =
44 Aggregator {operation, ordering, distinction}
47mapInputs :: ()
48 => (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Aggregate a -> Aggregate a
49mapInputs transform (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
50 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ agg . \f input ->
51 f (fmap transform input)
54type Aggregator :: Type
55data Aggregator = Aggregator
56 { operation :: Opaleye.AggrOp
57 , ordering :: [Opaleye.OrderExpr]
58 , distinction :: Opaleye.AggrDistinct
59 }
62unsafeMakeAggregate :: ()
63 => (input -> Opaleye.PrimExpr)
64 -> (Opaleye.PrimExpr -> output)
65 -> Maybe Aggregator
66 -> input
67 -> Aggregate output
68unsafeMakeAggregate input output aggregator expr =
69 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ \f _ ->
70 output <$> f (tuplize <$> aggregator, input expr)
71 where
72 tuplize Aggregator {operation, ordering, distinction} =
73 (operation, ordering, distinction)