-- | @ORDER BY@, @LIMIT@, @OFFSET@ and @DISTINCT ON@

module Opaleye.Order ( -- * Order by
                       orderBy
                     , O.Order
                     -- * Order direction
                     , asc
                     , desc
                     , ascNullsFirst
                     , ascNullsLast
                     , descNullsLast
                     , descNullsFirst
                     -- * Limit and offset
                     , limit
                     , offset
                     -- * Distinct on
                     , distinctOn
                     , distinctOnBy
                     -- * Exact ordering
                     , O.exact
                     -- * Other
                     , SqlOrd
                     -- * Explicit versions
                     , distinctOnExplicit
                     , distinctOnByExplicit
                     -- * Deprecated
                     , distinctOnCorrect
                     , distinctOnByCorrect
                     ) where

import qualified Data.Profunctor.Product.Default as D
import qualified Opaleye.Field as F
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
import qualified Opaleye.Internal.Order as O
import qualified Opaleye.Internal.QueryArr as Q
import qualified Opaleye.Internal.Unpackspec as U
import qualified Opaleye.Select         as S
import qualified Opaleye.SqlTypes as T

-- We can probably disable ConstraintKinds and TypeSynonymInstances
-- when we move to Sql... instead of PG..

{-| Order the rows of a `S.Select` according to the `O.Order`.

@
import Data.Monoid ((\<\>))

\-- Order by the first field ascending.  When first fields are equal
\-- order by second field descending.
example :: 'S.Select' ('Opaleye.Field.Field' 'T.SqlInt4', 'Opaleye.Field.Field' 'T.SqlText')
        -> 'S.Select' ('Opaleye.Field.Field' 'T.SqlInt4', 'Opaleye.Field.Field' 'T.SqlText')
example = 'orderBy' ('asc' fst \<\> 'desc' snd)
@

-}
orderBy :: O.Order a -> S.Select a -> S.Select a
orderBy :: forall a. Order a -> Select a -> Select a
orderBy Order a
os Select a
q =
  State Tag (a, PrimQuery) -> Select a
forall a. State Tag (a, PrimQuery) -> Query a
Q.productQueryArr (State Tag (a, PrimQuery) -> Select a)
-> State Tag (a, PrimQuery) -> Select a
forall a b. (a -> b) -> a -> b
$ do
    (a, PrimQuery)
a_pq <- Select a -> State Tag (a, PrimQuery)
forall a. Select a -> State Tag (a, PrimQuery)
Q.runSimpleSelect Select a
q
    (a, PrimQuery) -> State Tag (a, PrimQuery)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Order a -> (a, PrimQuery) -> (a, PrimQuery)
forall a. Order a -> (a, PrimQuery) -> (a, PrimQuery)
O.orderByU Order a
os (a, PrimQuery)
a_pq)

-- | Specify an ascending ordering by the given expression.
asc :: SqlOrd b => (a -> F.Field b) -> O.Order a
asc :: forall b a. SqlOrd b => (a -> Field b) -> Order a
asc = OrderOp -> (a -> Field_ 'NonNullable b) -> Order a
forall a (n :: Nullability) b.
OrderOp -> (a -> Field_ n b) -> Order a
O.order HPQ.OrderOp { orderDirection :: OrderDirection
HPQ.orderDirection = OrderDirection
HPQ.OpAsc
                          , orderNulls :: OrderNulls
HPQ.orderNulls     = OrderNulls
HPQ.NullsLast }

-- | Specify an descending ordering by the given expression.
desc :: SqlOrd b => (a -> F.Field b) -> O.Order a
desc :: forall b a. SqlOrd b => (a -> Field b) -> Order a
desc = OrderOp -> (a -> Field_ 'NonNullable b) -> Order a
forall a (n :: Nullability) b.
OrderOp -> (a -> Field_ n b) -> Order a
O.order HPQ.OrderOp { orderDirection :: OrderDirection
HPQ.orderDirection = OrderDirection
HPQ.OpDesc
                           , orderNulls :: OrderNulls
HPQ.orderNulls     = OrderNulls
HPQ.NullsFirst }

-- | Specify an ascending ordering by the given expression.
--   (Any NULLs appear first)
ascNullsFirst :: SqlOrd b => (a -> F.Field_ n b) -> O.Order a
ascNullsFirst :: forall b a (n :: Nullability).
SqlOrd b =>
(a -> Field_ n b) -> Order a
ascNullsFirst = OrderOp -> (a -> Field_ n b) -> Order a
forall a (n :: Nullability) b.
OrderOp -> (a -> Field_ n b) -> Order a
O.order HPQ.OrderOp { orderDirection :: OrderDirection
HPQ.orderDirection = OrderDirection
HPQ.OpAsc
                                    , orderNulls :: OrderNulls
HPQ.orderNulls     = OrderNulls
HPQ.NullsFirst }

-- | Specify an ascending ordering by the given expression.
--   (Any NULLs appear last)
ascNullsLast :: SqlOrd b => (a -> F.Field_ n b) -> O.Order a
ascNullsLast :: forall b a (n :: Nullability).
SqlOrd b =>
(a -> Field_ n b) -> Order a
ascNullsLast = OrderOp -> (a -> Field_ n b) -> Order a
forall a (n :: Nullability) b.
OrderOp -> (a -> Field_ n b) -> Order a
O.order HPQ.OrderOp { orderDirection :: OrderDirection
HPQ.orderDirection = OrderDirection
HPQ.OpAsc
                                   , orderNulls :: OrderNulls
HPQ.orderNulls     = OrderNulls
HPQ.NullsLast }

-- | Specify an descending ordering by the given expression.
--   (Any NULLs appear first)
descNullsFirst :: SqlOrd b => (a -> F.Field_ n b) -> O.Order a
descNullsFirst :: forall b a (n :: Nullability).
SqlOrd b =>
(a -> Field_ n b) -> Order a
descNullsFirst = OrderOp -> (a -> Field_ n b) -> Order a
forall a (n :: Nullability) b.
OrderOp -> (a -> Field_ n b) -> Order a
O.order HPQ.OrderOp { orderDirection :: OrderDirection
HPQ.orderDirection = OrderDirection
HPQ.OpDesc
                                     , orderNulls :: OrderNulls
HPQ.orderNulls     = OrderNulls
HPQ.NullsFirst }

-- | Specify an descending ordering by the given expression.
--   (Any NULLs appear last)
descNullsLast :: SqlOrd b => (a -> F.Field_ n b) -> O.Order a
descNullsLast :: forall b a (n :: Nullability).
SqlOrd b =>
(a -> Field_ n b) -> Order a
descNullsLast = OrderOp -> (a -> Field_ n b) -> Order a
forall a (n :: Nullability) b.
OrderOp -> (a -> Field_ n b) -> Order a
O.order HPQ.OrderOp { orderDirection :: OrderDirection
HPQ.orderDirection = OrderDirection
HPQ.OpDesc
                                    , orderNulls :: OrderNulls
HPQ.orderNulls     = OrderNulls
HPQ.NullsLast }

-- * Limit and offset

{- |
Limit the results of the given 'S.Select' to the given maximum number of
items.

/WARNING:/ If you're planning on using limit/offset together please use
'offset' /before/ you use 'limit', e.g.:

@
limit 10 (offset 50 yourSelect)
@

This is because Opaleye applies @OFFSET@ and @LIMIT@ to the @SELECT@ separately.
The result of the 'S.Select' given above is the following, which will return
10 rows after skipping the first 50 (probably what you want).

@
SELECT * FROM (SELECT * FROM yourTable OFFSET 50) LIMIT 10
@

However, reversing the order of the limit\/offset will result in the
following, which will result in /no rows being returned/ (probably
not what you want).

@
SELECT * FROM (SELECT * FROM yourTable LIMIT 10) OFFSET 50
@
-}
limit :: Int -> S.Select a -> S.Select a
limit :: forall a. Int -> Select a -> Select a
limit Int
n Select a
a = State Tag (a, PrimQuery) -> Select a
forall a. State Tag (a, PrimQuery) -> Query a
Q.productQueryArr (State Tag (a, PrimQuery) -> Select a)
-> State Tag (a, PrimQuery) -> Select a
forall a b. (a -> b) -> a -> b
$ do
  (a, PrimQuery)
a_pq <- Select a -> State Tag (a, PrimQuery)
forall a. Select a -> State Tag (a, PrimQuery)
Q.runSimpleSelect Select a
a
  (a, PrimQuery) -> State Tag (a, PrimQuery)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> (a, PrimQuery) -> (a, PrimQuery)
forall a. Int -> (a, PrimQuery) -> (a, PrimQuery)
O.limit' Int
n (a, PrimQuery)
a_pq)

{- |
Offset the results of the given 'S.Select' by the given amount, skipping
that many result rows.

/WARNING:/ Please read the documentation of 'limit' before combining
'offset' with 'limit'.
-}
offset :: Int -> S.Select a -> S.Select a
offset :: forall a. Int -> Select a -> Select a
offset Int
n Select a
a = State Tag (a, PrimQuery) -> Select a
forall a. State Tag (a, PrimQuery) -> Query a
Q.productQueryArr (State Tag (a, PrimQuery) -> Select a)
-> State Tag (a, PrimQuery) -> Select a
forall a b. (a -> b) -> a -> b
$ do
  (a, PrimQuery)
a_pq <- Select a -> State Tag (a, PrimQuery)
forall a. Select a -> State Tag (a, PrimQuery)
Q.runSimpleSelect Select a
a
  (a, PrimQuery) -> State Tag (a, PrimQuery)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> (a, PrimQuery) -> (a, PrimQuery)
forall a. Int -> (a, PrimQuery) -> (a, PrimQuery)
O.offset' Int
n (a, PrimQuery)
a_pq)

-- * Distinct on

{-# DEPRECATED distinctOnCorrect "Use 'distinctOn' instead.  Will be removed in 0.11." #-}
distinctOnCorrect :: D.Default U.Unpackspec b b
                  => (a -> b)
                  -> S.Select a
                  -> S.Select a
distinctOnCorrect :: forall b a.
Default Unpackspec b b =>
(a -> b) -> Select a -> Select a
distinctOnCorrect = Unpackspec b b -> (a -> b) -> Select a -> Select a
forall b a. Unpackspec b b -> (a -> b) -> Select a -> Select a
distinctOnExplicit Unpackspec b b
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

{-# DEPRECATED distinctOnByCorrect "Use 'distinctOnBy' instead.  Will be removed in 0.11." #-}
distinctOnByCorrect :: D.Default U.Unpackspec b b
                    => (a -> b)
                    -> O.Order a
                    -> S.Select a
                    -> S.Select a
distinctOnByCorrect :: forall b a.
Default Unpackspec b b =>
(a -> b) -> Order a -> Select a -> Select a
distinctOnByCorrect = Unpackspec b b -> (a -> b) -> Order a -> Select a -> Select a
forall b a.
Unpackspec b b -> (a -> b) -> Order a -> Select a -> Select a
distinctOnByExplicit Unpackspec b b
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def


-- * Other

-- | Typeclass for Postgres types which support ordering operations.
class SqlOrd a where

instance SqlOrd T.SqlBool
instance SqlOrd T.SqlDate
instance SqlOrd T.SqlFloat8
instance SqlOrd T.SqlFloat4
instance SqlOrd T.SqlInt8
instance SqlOrd T.SqlInt4
instance SqlOrd T.SqlInt2
instance SqlOrd T.SqlNumeric
instance SqlOrd T.SqlText
instance SqlOrd T.SqlVarcharN
instance SqlOrd T.SqlTime
instance SqlOrd T.SqlTimestamptz
instance SqlOrd T.SqlTimestamp
instance SqlOrd T.SqlCitext
instance SqlOrd T.SqlUuid

-- | Keep a row from each set where the given function returns the same result. No
--   ordering is guaranteed. Multiple fields may be distinguished by projecting out
--   tuples of 'Opaleye.Field.Field_'s. Use 'distinctOnBy' to control how the rows
--   are chosen.
distinctOn :: D.Default U.Unpackspec b b => (a -> b) -> S.Select a -> S.Select a
distinctOn :: forall b a.
Default Unpackspec b b =>
(a -> b) -> Select a -> Select a
distinctOn = (a -> b) -> Select a -> Select a
forall b a.
Default Unpackspec b b =>
(a -> b) -> Select a -> Select a
distinctOnCorrect

-- | Keep the row from each set where the given function returns the same result. The
--   row is chosen according to which comes first by the supplied ordering. However, no
--   output ordering is guaranteed. Multiple fields may be distinguished by projecting
--   out tuples of 'Opaleye.Field.Field_'s.
distinctOnBy :: D.Default U.Unpackspec b b => (a -> b) -> O.Order a
             -> S.Select a -> S.Select a
distinctOnBy :: forall b a.
Default Unpackspec b b =>
(a -> b) -> Order a -> Select a -> Select a
distinctOnBy = (a -> b) -> Order a -> Select a -> Select a
forall b a.
Default Unpackspec b b =>
(a -> b) -> Order a -> Select a -> Select a
distinctOnByCorrect

distinctOnExplicit :: U.Unpackspec b b
                   -> (a -> b)
                   -> S.Select a
                   -> S.Select a
distinctOnExplicit :: forall b a. Unpackspec b b -> (a -> b) -> Select a -> Select a
distinctOnExplicit Unpackspec b b
unpack a -> b
proj Select a
q = State Tag (a, PrimQuery) -> Select a
forall a. State Tag (a, PrimQuery) -> Query a
Q.productQueryArr (State Tag (a, PrimQuery) -> Select a)
-> State Tag (a, PrimQuery) -> Select a
forall a b. (a -> b) -> a -> b
$ do
  (a, PrimQuery)
a_pq <- Select a -> State Tag (a, PrimQuery)
forall a. Select a -> State Tag (a, PrimQuery)
Q.runSimpleSelect Select a
q
  (a, PrimQuery) -> State Tag (a, PrimQuery)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unpackspec b b -> (a -> b) -> (a, PrimQuery) -> (a, PrimQuery)
forall b a.
Unpackspec b b -> (a -> b) -> (a, PrimQuery) -> (a, PrimQuery)
O.distinctOn Unpackspec b b
unpack a -> b
proj (a, PrimQuery)
a_pq)

distinctOnByExplicit :: U.Unpackspec b b
                     -> (a -> b)
                     -> O.Order a
                     -> S.Select a
                     -> S.Select a
distinctOnByExplicit :: forall b a.
Unpackspec b b -> (a -> b) -> Order a -> Select a -> Select a
distinctOnByExplicit Unpackspec b b
unpack a -> b
proj Order a
ord Select a
q = State Tag (a, PrimQuery) -> Select a
forall a. State Tag (a, PrimQuery) -> Query a
Q.productQueryArr (State Tag (a, PrimQuery) -> Select a)
-> State Tag (a, PrimQuery) -> Select a
forall a b. (a -> b) -> a -> b
$ do
  (a, PrimQuery)
a_pq <- Select a -> State Tag (a, PrimQuery)
forall a. Select a -> State Tag (a, PrimQuery)
Q.runSimpleSelect Select a
q
  (a, PrimQuery) -> State Tag (a, PrimQuery)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unpackspec b b
-> (a -> b) -> Order a -> (a, PrimQuery) -> (a, PrimQuery)
forall b a.
Unpackspec b b
-> (a -> b) -> Order a -> (a, PrimQuery) -> (a, PrimQuery)
O.distinctOnBy Unpackspec b b
unpack a -> b
proj Order a
ord (a, PrimQuery)
a_pq)