{-# LANGUAGE MultiParamTypeClasses #-}

module Opaleye.SQLite.Internal.Distinct where

import           Opaleye.SQLite.QueryArr (Query)
import           Opaleye.SQLite.Column (Column)
import           Opaleye.SQLite.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 columns columns'
                 -> Query columns -> Query columns'
distinctExplicit :: Distinctspec columns columns' -> Query columns -> Query columns'
distinctExplicit (Distinctspec Aggregator columns columns'
agg) = Aggregator columns columns' -> Query columns -> Query columns'
forall a b. Aggregator a b -> Query a -> Query b
aggregate Aggregator columns columns'
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

-- { 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
  empty :: Distinctspec () ()
empty = Distinctspec () ()
forall (p :: * -> * -> *). Applicative (p ()) => p () ()
PP.defaultEmpty
  ***! :: Distinctspec a b
-> Distinctspec a' b' -> Distinctspec (a, a') (b, b')
(***!) = Distinctspec a b
-> Distinctspec a' b' -> Distinctspec (a, a') (b, b')
forall (p :: * -> * -> *) a a' b b'.
(Applicative (p (a, a')), Profunctor p) =>
p a b -> p a' b' -> p (a, a') (b, b')
PP.defaultProfunctorProduct

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)

-- }