git.iko.soy/rel8
on fce7213 help sign in
rel8/src/Rel8/Aggregate.hs
68 lines 2.0 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(..) )
26type Aggregate :: Type -> Type
27newtype Aggregate a = Aggregate (Opaleye.Aggregator () a)
28 deriving newtype Functor
29 deriving Apply via (WrappedApplicative (Opaleye.Aggregator ()))
32foldInputs :: Monoid b
33 => (Maybe Aggregator -> Opaleye.PrimExpr -> b) -> Aggregate a -> b
34foldInputs f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
35 getConst $ flip agg () $ \(aggregator, a) ->
36 Const $ f (detuplize <$> aggregator) a
37 where
38 detuplize (operation, ordering, distinction) =
39 Aggregator {operation, ordering, distinction}
42mapInputs :: ()
43 => (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Aggregate a -> Aggregate a
44mapInputs transform (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
45 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ agg . \f input ->
46 f (fmap transform input)
49type Aggregator :: Type
50data Aggregator = Aggregator
51 { operation :: Opaleye.AggrOp
52 , ordering :: [Opaleye.OrderExpr]
53 , distinction :: Opaleye.AggrDistinct
54 }
57unsafeMakeAggregate :: ()
58 => (input -> Opaleye.PrimExpr)
59 -> (Opaleye.PrimExpr -> output)
60 -> Maybe Aggregator
61 -> input
62 -> Aggregate output
63unsafeMakeAggregate input output aggregator expr =
64 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ \f _ ->
65 output <$> f (tuplize <$> aggregator, input expr)
66 where
67 tuplize Aggregator {operation, ordering, distinction} =
68 (operation, ordering, distinction)