{-# OPTIONS_HADDOCK not-home #-}
module Opaleye.Internal.Order where
import Data.Function (on)
import qualified Data.Functor.Contravariant as C
import qualified Data.Functor.Contravariant.Divisible as Divisible
import qualified Data.List.NonEmpty as NL
import qualified Data.Monoid as M
import qualified Data.Profunctor as P
import qualified Data.Semigroup as S
import qualified Data.Void as Void
import qualified Opaleye.Field as F
import qualified Opaleye.Internal.Column as IC
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
import qualified Opaleye.Internal.PrimQuery as PQ
import qualified Opaleye.Internal.Unpackspec as U
newtype Order a = Order (a -> [(HPQ.OrderOp, HPQ.PrimExpr)])
instance C.Contravariant Order where
contramap :: forall a' a. (a' -> a) -> Order a -> Order a'
contramap a' -> a
f (Order a -> [(OrderOp, PrimExpr)]
g) = forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap a' -> a
f a -> [(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' = forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order (a -> [(OrderOp, PrimExpr)]
o forall a. Semigroup a => a -> a -> a
S.<> a -> [(OrderOp, PrimExpr)]
o')
instance M.Monoid (Order a) where
mempty :: Order a
mempty = forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order forall a. Monoid a => a
M.mempty
mappend :: Order a -> Order a -> Order a
mappend = forall a. Semigroup a => a -> a -> a
(S.<>)
instance Divisible.Divisible Order where
divide :: forall a b c. (a -> (b, c)) -> Order b -> Order c -> Order a
divide a -> (b, c)
f Order b
o Order c
o' = forall a. Monoid a => a -> a -> a
M.mappend (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
C.contramap (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) Order b
o)
(forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
C.contramap (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) Order c
o')
conquer :: forall a. Order a
conquer = forall a. Monoid a => a
M.mempty
instance Divisible.Decidable Order where
lose :: forall a. (a -> Void) -> Order a
lose a -> Void
f = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
C.contramap a -> Void
f (forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order forall a. Void -> a
Void.absurd)
choose :: forall a b c. (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') = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
C.contramap a -> Either b c
f (forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order (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 -> F.Field_ n b) -> Order a
order :: forall a (n :: Nullability) b.
OrderOp -> (a -> Field_ n b) -> Order a
order OrderOp
op a -> Field_ n b
f = forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Field_ n b
column -> [(OrderOp
op, forall (n :: Nullability) a. Field_ n a -> PrimExpr
IC.unColumn Field_ n b
column)]) a -> Field_ n b
f)
orderByU :: Order a -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)
orderByU :: forall a. Order a -> (a, PrimQuery) -> (a, PrimQuery)
orderByU Order a
os (a
columns, PrimQuery
primQ) = (a
columns, PrimQuery
primQ')
where primQ' :: PrimQuery
primQ' = forall a.
Maybe (NonEmpty PrimExpr)
-> [OrderExpr] -> PrimQuery' a -> PrimQuery' a
PQ.DistinctOnOrderBy forall a. Maybe a
Nothing [OrderExpr]
oExprs PrimQuery
primQ
oExprs :: [OrderExpr]
oExprs = forall a. a -> Order a -> [OrderExpr]
orderExprs a
columns Order a
os
orderExprs :: a -> Order a -> [HPQ.OrderExpr]
orderExprs :: forall a. a -> Order a -> [OrderExpr]
orderExprs a
x (Order a -> [(OrderOp, PrimExpr)]
os) = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry OrderOp -> PrimExpr -> OrderExpr
HPQ.OrderExpr) (a -> [(OrderOp, PrimExpr)]
os a
x)
limit' :: Int -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)
limit' :: forall a. Int -> (a, PrimQuery) -> (a, PrimQuery)
limit' Int
n (a
x, PrimQuery
q) = (a
x, forall a. LimitOp -> PrimQuery' a -> PrimQuery' a
PQ.Limit (Int -> LimitOp
PQ.LimitOp Int
n) PrimQuery
q)
offset' :: Int -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)
offset' :: forall a. Int -> (a, PrimQuery) -> (a, PrimQuery)
offset' Int
n (a
x, PrimQuery
q) = (a
x, forall a. LimitOp -> PrimQuery' a -> PrimQuery' a
PQ.Limit (Int -> LimitOp
PQ.OffsetOp Int
n) PrimQuery
q)
distinctOn :: U.Unpackspec b b -> (a -> b)
-> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)
distinctOn :: forall b a.
Unpackspec b b -> (a -> b) -> (a, PrimQuery) -> (a, PrimQuery)
distinctOn Unpackspec b b
ups a -> b
proj = forall b a.
Unpackspec b b
-> (a -> b) -> Order a -> (a, PrimQuery) -> (a, PrimQuery)
distinctOnBy Unpackspec b b
ups a -> b
proj forall a. Monoid a => a
M.mempty
distinctOnBy :: U.Unpackspec b b -> (a -> b) -> Order a
-> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)
distinctOnBy :: forall b a.
Unpackspec b b
-> (a -> b) -> Order a -> (a, PrimQuery) -> (a, PrimQuery)
distinctOnBy Unpackspec b b
ups a -> b
proj Order a
ord (a
cols, PrimQuery
pq) = (a
cols, PrimQuery
pqOut)
where pqOut :: PrimQuery
pqOut = case forall a. [a] -> Maybe (NonEmpty a)
NL.nonEmpty (forall s t. Unpackspec s t -> s -> [PrimExpr]
U.collectPEs Unpackspec b b
ups (a -> b
proj a
cols)) of
Just NonEmpty PrimExpr
xs -> forall a.
Maybe (NonEmpty PrimExpr)
-> [OrderExpr] -> PrimQuery' a -> PrimQuery' a
PQ.DistinctOnOrderBy (forall a. a -> Maybe a
Just NonEmpty PrimExpr
xs) [OrderExpr]
oexprs PrimQuery
pq
Maybe (NonEmpty PrimExpr)
Nothing -> forall a. LimitOp -> PrimQuery' a -> PrimQuery' a
PQ.Limit (Int -> LimitOp
PQ.LimitOp Int
1) (forall a.
Maybe (NonEmpty PrimExpr)
-> [OrderExpr] -> PrimQuery' a -> PrimQuery' a
PQ.DistinctOnOrderBy forall a. Maybe a
Nothing [OrderExpr]
oexprs PrimQuery
pq)
oexprs :: [OrderExpr]
oexprs = forall a. a -> Order a -> [OrderExpr]
orderExprs a
cols Order a
ord
exact :: [IC.Field_ n b] -> (a -> IC.Field_ n b) -> Order a
exact :: forall (n :: Nullability) b a.
[Field_ n b] -> (a -> Field_ n b) -> Order a
exact [Field_ n b]
xs a -> Field_ n b
k = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
M.mempty NonEmpty (Field_ n b) -> Order a
go (forall a. [a] -> Maybe (NonEmpty a)
NL.nonEmpty [Field_ n b]
xs) where
mkEq :: Field_ n a -> Field_ n a -> PrimExpr
mkEq = BinOp -> PrimExpr -> PrimExpr -> PrimExpr
HPQ.BinExpr BinOp
(HPQ.:=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (n :: Nullability) a. Field_ n a -> PrimExpr
IC.unColumn
astOp :: OrderOp
astOp = OrderDirection -> OrderNulls -> OrderOp
HPQ.OrderOp OrderDirection
HPQ.OpDesc OrderNulls
HPQ.NullsFirst
go :: NonEmpty (Field_ n b) -> Order a
go NonEmpty (Field_ n b)
givenOrder = forall a. (a -> [(OrderOp, PrimExpr)]) -> Order a
Order forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Field_ n b
k forall a b. (a -> b) -> a -> b
$ \Field_ n b
col ->
[(OrderOp
astOp, NonEmpty PrimExpr -> PrimExpr
HPQ.ListExpr forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NL.map (forall {n :: Nullability} {a}. Field_ n a -> Field_ n a -> PrimExpr
mkEq Field_ n b
col) NonEmpty (Field_ n b)
givenOrder)]