{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Opaleye.Internal.Distinct where

import qualified Opaleye.Internal.MaybeFields as M
import           Opaleye.Select (Select)
import           Opaleye.Column (Column)
import           Opaleye.Aggregate (Aggregator, groupBy, aggregate)

import           Control.Applicative (Applicative, pure, (<*>))

import qualified Data.Profunctor as P
import qualified Data.Profunctor.Product as PP
import           Data.Profunctor.Product.Default (Default, def)

-- We implement distinct simply by grouping by all columns.  We could
-- instead implement it as SQL's DISTINCT but implementing it in terms
-- of something else that we already have is easier at this point.

distinctExplicit :: Distinctspec fields fields'
                 -> Select fields -> Select fields'
distinctExplicit :: Distinctspec fields fields' -> Select fields -> Select fields'
distinctExplicit (Distinctspec Aggregator fields fields'
agg) = Aggregator fields fields' -> Select fields -> Select fields'
forall a b. Aggregator a b -> Select a -> Select b
aggregate Aggregator fields fields'
agg

newtype Distinctspec a b = Distinctspec (Aggregator a b)

instance Default Distinctspec (Column a) (Column a) where
  def :: Distinctspec (Column a) (Column a)
def = Aggregator (Column a) (Column a)
-> Distinctspec (Column a) (Column a)
forall a b. Aggregator a b -> Distinctspec a b
Distinctspec Aggregator (Column a) (Column a)
forall a. Aggregator (Column a) (Column a)
groupBy

distinctspecField :: Distinctspec (Column a) (Column a)
distinctspecField :: Distinctspec (Column a) (Column a)
distinctspecField = Distinctspec (Column a) (Column a)
forall (p :: * -> * -> *) a b. Default p a b => p a b
def

distinctspecMaybeFields :: M.WithNulls Distinctspec a b
                        -> Distinctspec (M.MaybeFields a) (M.MaybeFields b)
distinctspecMaybeFields :: WithNulls Distinctspec a b
-> Distinctspec (MaybeFields a) (MaybeFields b)
distinctspecMaybeFields = Distinctspec (Field SqlBool) (Field SqlBool)
-> WithNulls Distinctspec a b
-> Distinctspec (MaybeFields a) (MaybeFields b)
forall (p :: * -> * -> *) a b.
ProductProfunctor p =>
p (Field SqlBool) (Field SqlBool)
-> WithNulls p a b -> p (MaybeFields a) (MaybeFields b)
M.unWithNulls Distinctspec (Field SqlBool) (Field SqlBool)
forall (p :: * -> * -> *) a b. Default p a b => p a b
def

instance Default (M.WithNulls Distinctspec) a b
  => Default Distinctspec (M.MaybeFields a) (M.MaybeFields b) where
  def :: Distinctspec (MaybeFields a) (MaybeFields b)
def = WithNulls Distinctspec a b
-> Distinctspec (MaybeFields a) (MaybeFields b)
forall a b.
WithNulls Distinctspec a b
-> Distinctspec (MaybeFields a) (MaybeFields b)
distinctspecMaybeFields WithNulls Distinctspec a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
def

-- { Boilerplate instances

instance Functor (Distinctspec a) where
  fmap :: (a -> b) -> Distinctspec a a -> Distinctspec a b
fmap a -> b
f (Distinctspec Aggregator a a
g) = Aggregator a b -> Distinctspec a b
forall a b. Aggregator a b -> Distinctspec a b
Distinctspec ((a -> b) -> Aggregator a a -> Aggregator a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Aggregator a a
g)

instance Applicative (Distinctspec a) where
  pure :: a -> Distinctspec a a
pure = Aggregator a a -> Distinctspec a a
forall a b. Aggregator a b -> Distinctspec a b
Distinctspec (Aggregator a a -> Distinctspec a a)
-> (a -> Aggregator a a) -> a -> Distinctspec a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Aggregator a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Distinctspec Aggregator a (a -> b)
f <*> :: Distinctspec a (a -> b) -> Distinctspec a a -> Distinctspec a b
<*> Distinctspec Aggregator a a
x = Aggregator a b -> Distinctspec a b
forall a b. Aggregator a b -> Distinctspec a b
Distinctspec (Aggregator a (a -> b)
f Aggregator a (a -> b) -> Aggregator a a -> Aggregator a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Aggregator a a
x)

instance P.Profunctor Distinctspec where
  dimap :: (a -> b) -> (c -> d) -> Distinctspec b c -> Distinctspec a d
dimap a -> b
f c -> d
g (Distinctspec Aggregator b c
q) = Aggregator a d -> Distinctspec a d
forall a b. Aggregator a b -> Distinctspec a b
Distinctspec ((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
P.dimap a -> b
f c -> d
g Aggregator b c
q)

instance PP.ProductProfunctor Distinctspec where
  purePP :: b -> Distinctspec a b
purePP = b -> Distinctspec a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: Distinctspec a (b -> c) -> Distinctspec a b -> Distinctspec a c
(****) = Distinctspec a (b -> c) -> Distinctspec a b -> Distinctspec a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

instance PP.SumProfunctor Distinctspec where
  Distinctspec Aggregator a b
x1 +++! :: Distinctspec a b
-> Distinctspec a' b' -> Distinctspec (Either a a') (Either b b')
+++! Distinctspec Aggregator a' b'
x2 = Aggregator (Either a a') (Either b b')
-> Distinctspec (Either a a') (Either b b')
forall a b. Aggregator a b -> Distinctspec a b
Distinctspec (Aggregator a b
x1 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')
PP.+++! Aggregator a' b'
x2)

-- }