content: {-# language DataKinds #-}
  {-# language GADTs #-}
  {-# language KindSignatures #-}
  {-# language ScopedTypeVariables #-}
  {-# language StandaloneKindSignatures #-}
  
  module Rel8.Aggregate
    ( Aggregator' (Aggregator)
    , Aggregator
    , Aggregator1
    , toAggregator
    , toAggregator1
    , filterWhereExplicit
    , unsafeMakeAggregator
    )
  where
  
  -- base
  import Control.Applicative (liftA2)
  import Data.Kind (Type)
  import Prelude
  
  -- opaleye
  import qualified Opaleye.Aggregate as Opaleye
  import qualified Opaleye.Internal.MaybeFields as Opaleye
  import qualified Opaleye.Internal.Operators as Opaleye
  
  -- product-profunctor
  import Data.Profunctor.Product
    ( ProductProfunctor, purePP, (****)
    , SumProfunctor, (+++!)
    )
  
  -- profunctors
  import Data.Profunctor (Profunctor, dimap)
  
  -- rel8
  import Rel8.Expr (Expr)
  import Rel8.Expr.Opaleye (toPrimExpr, toColumn)
  import Rel8.Aggregate.Fold (Fallback (Empty, Fallback), Fold (Full, Semi))
  
  -- semigroupoids
  import Data.Functor.Apply (Apply, liftF2)
  
  
  -- | 'Aggregator'' is the most general form of \"aggregator\", of which
  -- 'Aggregator' and 'Aggregator1' are special cases. 'Aggregator''s are
  -- comprised of aggregation functions and/or @GROUP BY@ clauses.
  --
  -- Aggregation functions operating on individual 'Rel8.Expr's such as
  -- 'Rel8.sum' can be combined into 'Aggregator's operating on larger types
  -- using the 'Applicative', 'Profunctor' and 'ProductProfunctor' interfaces.
  -- Working with 'Profunctor's can sometimes be awkward so for every 'Rel8.sum'
  -- we also provide a 'Rel8.sumOn' which bundles an 'Data.Profunctor.lmap'. For
  -- complex aggregations, we recommend using these functions along with
  -- @ApplicativeDo@, @BlockArguments@, @OverloadedRecordDot@ and
  -- @RecordWildCards@:
  --
  -- @
  --
  -- data Input f = Input
  --   { orderId :: Column f OrderId
  --   , customerId :: Column f CustomerId
  --   , productId :: Column f ProductId
  --   , quantity :: Column f Int64
  --   , price :: Column f Scientific
  --   }
  --   deriving (Generic, Rel8able)
  --
  --
  -- totalPrice :: Input Expr -> Expr Scientific
  -- totalPrice input = fromIntegral input.quantity * input.price
  --
  --
  -- data Result f = Result
  --   { customerId :: Column f CustomerId
  --   , totalOrders :: Column f Int64
  --   , productsOrdered :: Column f Int64
  --   , totalPrice :: Column f Scientific
  --   }
  --   deriving (Generic, Rel8able)
  --
  --
  -- allResults :: Query (Result Expr)
  -- allResults =
  --   aggregate
  --     do
  --       customerId <- groupByOn (.customerId)
  --       totalOrders <- countDistinctOn (.orderId)
  --       productsOrdered <- countDistinctOn (.productId)
  --       totalPrice <- sumOn totalPrice
  --       pure Result {..}
  --     do
  --       order <- each orderSchema
  --       orderLine <- each orderLineSchema
  --       where_ $ order.id ==. orderLine.orderId
  --       pure
  --         Input
  --           { orderId = order.id
  --           , customerId = order.customerId
  --           , productId = orderLine.productId
  --           , quantity = orderLine.quantity
  --           , price = orderLine.price
  --           }
  -- @
  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 f g (Aggregator fallback a) =
      Aggregator (fmap g fallback) (dimap f g a)
  
  
  instance ProductProfunctor (Aggregator' fold) where
    purePP = pure
    (****) = (<*>)
  
  
  instance SumProfunctor (Aggregator' fold) where
    Aggregator fallback a +++! Aggregator fallback' b =
      flip Aggregator (a +++! b) $ case fallback of
        Empty -> case fallback' of
          Empty -> Empty
          Fallback x -> Fallback (Right x)
        Fallback x -> Fallback (Left x)
  
  
  instance Functor (Aggregator' fold i) where
    fmap = dimap id
  
  
  instance Apply (Aggregator' fold i) where
    liftF2 f (Aggregator fallback a) (Aggregator fallback' b) =
      Aggregator (liftF2 f fallback fallback') (liftA2 f a b)
  
  
  instance Applicative (Aggregator' fold i) where
    pure a = Aggregator (pure a) (pure a)
    liftA2 = liftF2
  
  
  -- | An 'Aggregator' takes a 'Rel8.Query' producing a collection of rows of
  -- type @a@ and transforms it into a 'Rel8.Query' producing a single row of
  -- type @b@. If the given 'Rel8.Query' produces an empty collection of rows,
  -- then the single row in the resulting 'Rel8.Query' contains the identity
  -- values of the aggregation functions comprising the 'Aggregator' (i.e.,
  -- @0@ for 'Rel8.sum', 'Rel8.false' for 'Rel8.or', etc.).
  --
  -- 'Aggregator' is a special form of 'Aggregator'' parameterised by 'Full'.
  type Aggregator :: Type -> Type -> Type
  type Aggregator = Aggregator' 'Full
  
  
  -- | An 'Aggregator1' takes a collection of rows of type @a@, groups them, and
  -- transforms each group into a single row of type @b@. This corresponds to
  -- aggregators using @GROUP BY@ in SQL. If given an empty collection of rows,
  -- 'Aggregator1' will have no groups and will therefore also return an empty
  -- collection of rows.
  --
  -- 'Aggregator1' is a special form of 'Aggregator'' parameterised by 'Semi'.
  type Aggregator1 :: Type -> Type -> Type
  type Aggregator1 = Aggregator' 'Semi
  
  
  -- | 'toAggregator1' turns an 'Aggregator' into an 'Aggregator1'.
  toAggregator1 :: Aggregator' fold i a -> Aggregator1 i a
  toAggregator1 (Aggregator _ a) = Aggregator Empty a
  
  
  -- | Given a value to fall back on if given an empty collection of rows,
  -- 'toAggregator' turns an 'Aggregator1' into an 'Aggregator'.
  toAggregator :: a -> Aggregator' fold i a -> Aggregator' fold' i a
  toAggregator fallback (Aggregator _ a) = Aggregator (Fallback fallback) a
  
  
  filterWhereExplicit :: ()
    => Opaleye.IfPP a a
    -> (i -> Expr Bool)
    -> Aggregator i a
    -> Aggregator' fold i a
  filterWhereExplicit ifPP f (Aggregator (Fallback fallback) aggregator) =
    Aggregator (Fallback fallback) aggregator'
    where
      aggregator' =
        Opaleye.fromMaybeFieldsExplicit ifPP fallback
          <$> Opaleye.filterWhere (toColumn . toPrimExpr . f) 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 input output fallback =
    Aggregator fallback . dimap input output
  