module Opaleye.SQLite.Internal.Order where

import qualified Opaleye.SQLite.Column as C
import qualified Opaleye.SQLite.Internal.Column as IC
import qualified Opaleye.SQLite.Internal.Tag as T
import qualified Opaleye.SQLite.Internal.PrimQuery as PQ

import qualified Opaleye.SQLite.Internal.HaskellDB.PrimQuery as HPQ
import qualified Data.Functor.Contravariant as C
import qualified Data.Functor.Contravariant.Divisible as Divisible
import qualified Data.Profunctor as P
import qualified Data.Monoid as M
import qualified Data.Semigroup as S
import qualified Data.Void as Void

{-|
An `Order` represents an expression to order on and a sort
direction. Multiple `Order`s can be composed with
`Data.Monoid.mappend`.  If two rows are equal according to the first
`Order`, the second is used, and so on.
-}

-- Like the (columns -> RowParser haskells) field of QueryRunner this
-- type is "too big".  We never actually look at the 'a' (in the
-- QueryRunner case the 'colums') except to check the "structure".
-- This is so we can support a SumProfunctor instance.
newtype Order a = Order (a -> [(HPQ.OrderOp, HPQ.PrimExpr)])

instance C.Contravariant Order where
  contramap :: (a -> b) -> Order b -> Order a
contramap a -> b
f (Order b -> [(OrderOp, PrimExpr)]
g) = (a -> [(OrderOp, PrimExpr)]) -> Order a
forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order ((a -> b)
-> (b -> [(OrderOp, PrimExpr)]) -> a -> [(OrderOp, PrimExpr)]
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap a -> b
f b -> [(OrderOp, PrimExpr)]
g)

instance S.Semigroup (Order a) where
  Order a -> [(OrderOp, PrimExpr)]
o <> :: Order a -> Order a -> Order a
<> Order a -> [(OrderOp, PrimExpr)]
o' = (a -> [(OrderOp, PrimExpr)]) -> Order a
forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order (a -> [(OrderOp, PrimExpr)]
o (a -> [(OrderOp, PrimExpr)])
-> (a -> [(OrderOp, PrimExpr)]) -> a -> [(OrderOp, PrimExpr)]
forall a. Monoid a => a -> a -> a
`M.mappend` a -> [(OrderOp, PrimExpr)]
o')

instance M.Monoid (Order a) where
  mempty :: Order a
mempty = (a -> [(OrderOp, PrimExpr)]) -> Order a
forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order a -> [(OrderOp, PrimExpr)]
forall a. Monoid a => a
M.mempty

instance Divisible.Divisible Order where
  divide :: (a -> (b, c)) -> Order b -> Order c -> Order a
divide a -> (b, c)
f Order b
o Order c
o' = Order a -> Order a -> Order a
forall a. Monoid a => a -> a -> a
M.mappend ((a -> b) -> Order b -> Order a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
C.contramap ((b, c) -> b
forall a b. (a, b) -> a
fst ((b, c) -> b) -> (a -> (b, c)) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) Order b
o)
                            ((a -> c) -> Order c -> Order a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
C.contramap ((b, c) -> c
forall a b. (a, b) -> b
snd ((b, c) -> c) -> (a -> (b, c)) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) Order c
o')
  conquer :: Order a
conquer = Order a
forall a. Monoid a => a
M.mempty

instance Divisible.Decidable Order where
  lose :: (a -> Void) -> Order a
lose a -> Void
f = (a -> Void) -> Order Void -> Order a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
C.contramap a -> Void
f ((Void -> [(OrderOp, PrimExpr)]) -> Order Void
forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order Void -> [(OrderOp, PrimExpr)]
forall a. Void -> a
Void.absurd)
  choose :: (a -> Either b c) -> Order b -> Order c -> Order a
choose a -> Either b c
f (Order b -> [(OrderOp, PrimExpr)]
o) (Order c -> [(OrderOp, PrimExpr)]
o') = (a -> Either b c) -> Order (Either b c) -> Order a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
C.contramap a -> Either b c
f ((Either b c -> [(OrderOp, PrimExpr)]) -> Order (Either b c)
forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order ((b -> [(OrderOp, PrimExpr)])
-> (c -> [(OrderOp, PrimExpr)])
-> Either b c
-> [(OrderOp, PrimExpr)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> [(OrderOp, PrimExpr)]
o c -> [(OrderOp, PrimExpr)]
o'))

order :: HPQ.OrderOp -> (a -> C.Column b) -> Order a
order :: OrderOp -> (a -> Column b) -> Order a
order OrderOp
op a -> Column b
f = (a -> [(OrderOp, PrimExpr)]) -> Order a
forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order ((Column b -> [(OrderOp, PrimExpr)])
-> (a -> Column b) -> a -> [(OrderOp, PrimExpr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Column b
column -> [(OrderOp
op, Column b -> PrimExpr
forall a. Column a -> PrimExpr
IC.unColumn Column b
column)]) a -> Column b
f)

orderByU :: Order a -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)
orderByU :: Order a -> (a, PrimQuery, Tag) -> (a, PrimQuery, Tag)
orderByU Order a
os (a
columns, PrimQuery
primQ, Tag
t) = (a
columns, PrimQuery
primQ', Tag
t)
  where primQ' :: PrimQuery
primQ' = [OrderExpr] -> PrimQuery -> PrimQuery
PQ.Order [OrderExpr]
orderExprs PrimQuery
primQ
        Order a -> [(OrderOp, PrimExpr)]
sos = Order a
os
        orderExprs :: [OrderExpr]
orderExprs = ((OrderOp, PrimExpr) -> OrderExpr)
-> [(OrderOp, PrimExpr)] -> [OrderExpr]
forall a b. (a -> b) -> [a] -> [b]
map ((OrderOp -> PrimExpr -> OrderExpr)
-> (OrderOp, PrimExpr) -> OrderExpr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry OrderOp -> PrimExpr -> OrderExpr
HPQ.OrderExpr) (a -> [(OrderOp, PrimExpr)]
sos a
columns)

limit' :: Int -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)
limit' :: Int -> (a, PrimQuery, Tag) -> (a, PrimQuery, Tag)
limit' Int
n (a
x, PrimQuery
q, Tag
t) = (a
x, LimitOp -> PrimQuery -> PrimQuery
PQ.Limit (Int -> LimitOp
PQ.LimitOp Int
n) PrimQuery
q, Tag
t)

offset' :: Int -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)
offset' :: Int -> (a, PrimQuery, Tag) -> (a, PrimQuery, Tag)
offset' Int
n (a
x, PrimQuery
q, Tag
t) = (a
x, LimitOp -> PrimQuery -> PrimQuery
PQ.Limit (Int -> LimitOp
PQ.OffsetOp Int
n) PrimQuery
q, Tag
t)